From db26c382cec3075224a8f7fbeb52b15a20d4090e Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Tue, 18 Aug 2009 12:32:17 +0200
Subject: import into git from the old website

---
 optkeyb.pl | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)
 create mode 100644 optkeyb.pl

(limited to 'optkeyb.pl')

diff --git a/optkeyb.pl b/optkeyb.pl
new file mode 100644
index 0000000..85ec6bc
--- /dev/null
+++ b/optkeyb.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl -w
+
+use Curses;
+$screen=new Curses;
+
+sub parse_matr {
+  my $fn=shift;
+  my $l;my @l;my $k2;
+
+  open FM,"<$fn" or return;
+
+  $l=<FM>;
+  my @k1=split ' ',$l;
+  $i=0;
+
+  while ($l=<FM>) {
+    @l=split ' ',$l;
+    $k2=shift @l;
+    for ($j=0;$j<=$#k1;$j++) {
+      $matr{$k2}->{$k1[$j]}=shift @l;
+    }
+  }
+  close FM;
+}
+
+# suppongo sia quadrata
+sub simmetrize {
+  for $i (keys %matr) {
+    for $j (keys %{$matr{$i}}) {
+      $matr{$i}->{$j}=($matr{$i}->{$j} + $matr{$j}->{$i})/2;
+    }
+  }
+}
+
+%qw_keyboard=(
+'`'=>[0,0],'1'=>[0,1],'2'=>[0,2],'3'=>[0,3],'4'=>[0,4],'5'=>[0,5],'6'=>[0,6],'7'=>[0,7],'8'=>[0,8],'9'=>[0,9], '0'=>[0,10],'-'=>[0,11],'=' =>[0,12],
+   'q'=>[1,1],'w'=>[1,2],'e'=>[1,3],'r'=>[1,4],'t'=>[1,5],'y'=>[1,6],'u'=>[1,7],'i'=>[1,8],'o'=>[1,9],'p'=>[1,10],'['=>[1,11],']' =>[1,12],'\\' =>[1,13],
+   'a'=>[2,1],'s'=>[2,2],'d'=>[2,3],'f'=>[2,4],'g'=>[2,5],'h'=>[2,6],'j'=>[2,7],'k'=>[2,8],'l'=>[2,9],';'=>[2,10],'\'' =>[2,11],
+              'z'=>[3,2],'x'=>[3,3],'c'=>[3,4],'v'=>[3,5],'b'=>[3,6],'n'=>[3,7],'m'=>[3,8],','=>[3,9],'.'=>[3,10],'/'=>[3,11]
+);
+
+%locked=(1=>1, 2=>1, 3=>1, 4=>1, 5=>1, 6=>1, 7=>1, 8=>1, 9=>1, 0=>1,);
+
+sub show_keyb {
+  my ($k1,$k2,$v)=@_;
+  for $i (keys %keyboard) {
+    $screen->addch($keyboard{$i}->[0],$keyboard{$i}->[1],$i);
+  }
+  $screen->addstr(5,5,$v);
+  $screen->refresh;
+}
+
+sub printout_keyb {
+  my $s;
+  $screen->innstr(0,0,$s,14);print RESULTS $s,"\n";
+  $screen->innstr(1,0,$s,14);print RESULTS $s,"\n";
+  $screen->innstr(2,0,$s,14);print RESULTS $s,"\n";
+  $screen->innstr(3,0,$s,14);print RESULTS $s,"\n";
+  $screen->innstr(5,5,$s,14);print RESULTS $s,"\n";
+}
+
+sub distance {
+  my ($k1,$k2)=@_;
+
+  return sqrt(($keyboard{$k1}->[0]-$keyboard{$k2}->[0])**2+($keyboard{$k1}->[1]-$keyboard{$k2}->[1])**2);
+}
+
+sub calcvalue {
+  my $value=0;
+  for $i (keys %matr) {
+    for $j (keys %{$matr{$i}}) {
+      $value+=distance($i,$j)*$matr{$i}->{$j};
+    }
+  }
+  return $value;
+}
+
+sub swapkeys {
+  my ($k1,$k2)=@_;
+  ($keyboard{$k1},$keyboard{$k2})=($keyboard{$k2},$keyboard{$k1});
+}
+
+# metodo balordo: scambio a caso, e se miglioro accetto
+$PRE_SHUFFLE=1000;  # quanti scambi a casaccio fare all'inizio
+$STARVATION=1000;   # dopo quanti cicli senza miglioramenti ricominciare da un'altra parte
+
+
+$MATRFN='/tmp/freq.matr';
+parse_matr($MATRFN);
+@k=keys %matr;
+
+open RESULTS,">>/tmp/layouts";
+$oldfh=select RESULTS;$|=1;select $oldfh;
+
+while (1) {
+  %keyboard=%qw_keyboard;
+
+  for ($pre=0;$pre<$PRE_SHUFFLE;$pre++) {
+    $k1=$k[int rand ($#k+1)];
+    $k2=$k[int rand ($#k+1)];
+
+    next if ($locked{$k1} or $locked{$k2});
+
+    swapkeys($k1,$k2);
+  }
+
+  $v0=calcvalue;
+  $starve=0;
+
+  while ($starve<$STARVATION) {
+    $k1=$k[int rand ($#k+1)];
+    $k2=$k[int rand ($#k+1)];
+
+    next if ($locked{$k1} or $locked{$k2});
+
+    show_keyb($k1,$k2,$v0);
+
+    swapkeys($k1,$k2);$v1=calcvalue;
+    if ($v1>=$v0) {
+      swapkeys($k1,$k2);$starve++;
+    } else {
+      $v0=$v1;$starve=0;
+    }
+  }
+  printout_keyb;
+}
-- 
cgit v1.2.3