optkeyb.pl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
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;
}