From db26c382cec3075224a8f7fbeb52b15a20d4090e Mon Sep 17 00:00:00 2001 From: dakkar Date: Tue, 18 Aug 2009 12:32:17 +0200 Subject: import into git from the old website --- README | 1 + freq.pl | 147 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ freqdump.pl | 65 +++++++++++++++++++++++++++ optkeyb.pl | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 339 insertions(+) create mode 100644 README create mode 100644 freq.pl create mode 100644 freqdump.pl create mode 100644 optkeyb.pl diff --git a/README b/README new file mode 100644 index 0000000..f18e458 --- /dev/null +++ b/README @@ -0,0 +1 @@ +See http://www.thenautilus.net/SW/kblayout/ diff --git a/freq.pl b/freq.pl new file mode 100644 index 0000000..f5feb6a --- /dev/null +++ b/freq.pl @@ -0,0 +1,147 @@ +#!/usr/bin/perl -w + +sub parse_matr { + my $fn=shift; + my $l;my @l;my $k2; + + open FM,"<$fn" or return; + + $l=; + my @k1=split ' ',$l; + $i=0; + + while ($l=) { + @l=split ' ',$l; + $k2=shift @l; + for ($j=0;$j<=$#k1;$j++) { + $matr{$k2}->{$k1[$j]}=shift @l; + } + } + close FM; +} + +sub compact { + my @r; + + @_=sort @_; + push @r,shift @_; + while (@_) { + if ($_[0] eq $r[-1]) { shift;next } + push @r,shift @_; + } + return @r; +} + +sub save_matr { + my $fn=shift; + my $l; + my @k1;my @k2; + + open FM,">$fn"; + + @k2=sort keys %matr; + @k1=();for (@k2) {@k1=(@k1,keys %{$matr{$_}})}; + @k1=compact(@k1); + + print FM " @k1\n"; + + for ($i=0;$i<=$#k2;$i++) { + print FM "$k2[$i]"; + for ($j=0;$j<=$#k1;$j++) { + print FM " ",defined($matr{$k2[$i]}->{$k1[$j]})?$matr{$k2[$i]}->{$k1[$j]}:0; + } + print FM "\n"; + } + close FM; +} + +%folds=( + '~' => '`', + '!' => '1', + '@' => '2', + '#' => '3', + '$' => '4', + '%' => '5', + '^' => '6', + '&' => '7', + '*' => '8', + '(' => '9', + ')' => '0', + '{' => '[', + '}' => ']', + '"' => '\'', + '<' => ',', + '>' => '.', + 'P' => 'p', + 'Y' => 'y', + 'F' => 'f', + 'G' => 'g', + 'C' => 'c', + 'R' => 'r', + 'L' => 'l', + '?' => '/', + '+' => '=', + '|' => '\\', + 'A' => 'a', + 'O' => 'o', + 'E' => 'e', + 'U' => 'u', + 'I' => 'i', + 'D' => 'd', + 'H' => 'h', + 'T' => 't', + 'N' => 'n', + 'S' => 's', + '_' => '-', + ':' => ';', + 'Q' => 'q', + 'J' => 'j', + 'K' => 'k', + 'X' => 'x', + 'B' => 'b', + 'M' => 'm', + 'W' => 'w', + 'V' => 'v', + 'Z' => 'z', +); + +for (values %folds) { + push @folds,$_;push @folds,$_; +} +%folds=(%folds,@folds); + +sub fold_char { + if (exists $folds{$_[0]}) { + return $folds{$_[0]}; + } else { + return undef; + } +} + +sub upd_matr { + my $fn=shift; + my $l; + + open FM,"<$fn"; + + while ($l=) { + for ($i=0;$i{$k}++; + } + } + } + close FM; +} + +$MATRFN='/tmp/freq.matr'; + +parse_matr($MATRFN); + +while ($f=shift) { + upd_matr($f); +} + +save_matr($MATRFN); diff --git a/freqdump.pl b/freqdump.pl new file mode 100644 index 0000000..ccdd134 --- /dev/null +++ b/freqdump.pl @@ -0,0 +1,65 @@ +#!/usr/bin/perl -w + +sub parse_matr { + my $fn=shift; + my $l;my @l;my $k2; + + open FM,"<$fn" or return; + + $l=; + my @k1=split ' ',$l; + $i=0; + + while ($l=) { + @l=split ' ',$l; + $k2=shift @l; + for ($j=0;$j<=$#k1;$j++) { + $matr{$k2}->{$k1[$j]}=shift @l; + } + } + close FM; +} + +sub make_couples { + my $l=shift; + if (defined $l) { + for $j (sort keys %{$matr{$l}}) { + $couples{"$l$j"}=($matr{$l}->{$j})+($matr{$j}->{$l}); + } + } else { + for $i (sort keys %matr) { + for $j (sort keys %{$matr{$i}}) { + if ($i lt $j) {$k="$i$j"} else {$k="$j$i"} + $couples{$k}+=$matr{$i}->{$j}; + } + } + } +} + +$MATRFN='/tmp/freq.matr'; +parse_matr($MATRFN); + +@tot=(); + +for $k (reverse sort keys %matr) { + %couples=(); + make_couples($k); + @k=keys %couples; + @k=sort {$couples{$b} <=> $couples{$a}} @k; + for (@k[0..9]) {push @tot,$_;push @tot,$couples{$_}}; +} + +$elems=($#tot+1)/2; + +$cols=8; +$rows=1+int $elems/$cols; + +for ($i=0;$i<$rows;$i++) { + $j=$i; + while ($j<$elems) { + print $tot[$j*2],"->",sprintf('%4d',$tot[$j*2+1])," "; + $j+=$rows; + } + print "\n"; +} + 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=; + my @k1=split ' ',$l; + $i=0; + + while ($l=) { + @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