Try and find a better keyboard layout using evolution algorithm

dvorak-evolution.pl

#!/usr/bin/perl -w
#
#kb calculation by david marsh
#
#version 1.11
#
#This program is free software: you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation, either version 3 of the License, or
#(at your option) any later version.
#
#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.
#
#You should have received a copy of the GNU General Public License
#along with this program.  If not, see <http: licenses="" www.gnu.org="">.
#

use strict;
use warnings;

my @keys;
my ($lasthnd, $hnd);
my ($lastrow, $row);
my ($lastgrp, $grp);
my ($lastfgr, $fgr);
my ($lastkey, $key);

my $file = "data.txt";
my $text;

open (FILE, $file) or die "could not open $file: $!\n";
foreach (<FILE>) {
 chomp;
 $text = $text . $_;
}
close (FILE) or die "could not close $file: $!\n";

chomp ($text);
$text = lc($text);
$text =~ tr/-1234567890[]!@#$%^&*(){}`~=\?+:"<>_/                                                    /;

my $dvorak = q(',.pyfgcrlaoeuidhtns;qjkxbmwvz);
my $daeiou = q(',.pyfgcrlaeioudhtns;qjkxbmwvz);
my $cmbldv = q(',.pyqfgrkoaeiudhtnszxcvjlmwb;);
my $qwerty = q(qwertyuiopasdfghjkl;zxcvbnm,.');
my $xperty = q(xp;rtyuiojqsdfnhaelkzwcvbgm,.');
my $blickn = q(.pwfulcmy,dhiatensor'zxkgbvqj;);
my $evolvd = q(k,uypwlmfcoaeidrnthsq.';zxvgbj);
my $abcdef = q(abcdefghijklmnopqrstuvwxyz;',.);

my %score;

my @text = split //, $text;
my @dvorak = split //, $dvorak;
my @daeiou = split //, $daeiou;
my @cmbldv = split //, $cmbldv;
my @qwerty = split //, $qwerty;
my @xperty = split //, $xperty;
my @blickn = split //, $blickn;
my @evolvd = split //, $evolvd;
my @abcdef = split //, $abcdef;

my @array;
my @array1;
my @array2;

@array = @dvorak;
@array1 = @array;
@array2 = @array;

partialshuffle( \@array1 );
partialshuffle( \@array2 );

calculate("dvorak", @dvorak);
calculate("daeiou", @daeiou);
calculate("cmbldv", @cmbldv);
calculate("qwerty", @qwerty);
calculate("xperty", @xperty);
calculate("blickn", @blickn);
calculate("evolvd", @evolvd);
calculate("abcdef", @abcdef);

calculate("array1", @array1);
calculate("array2", @array2);

$score{'array'} = $score{'array1'};
$score{'lastarray'} = $score{'array2'};

while ("true") {
 if ( $score{'array'} != $score{'lastarray'} ) {
  print "dvorak: $score{'dvorak'} \n";
  print "daeiou: $score{'daeiou'} \n";
  print "cmbldv: $score{'cmbldv'} \n";
  print "\n";
  print "evolvd: $score{'evolvd'} \n";
  print "xperty: $score{'xperty'} \n";
  print "\n";
  print "qwerty: $score{'qwerty'} \n";
  print "blickn: $score{'blickn'} \n";
  print "abcdef: $score{'abcdef'} \n";
  print "\n";
  print "array : $score{'array'}  \n";
  layout(@array);
 }

 $score{'lastarray'} = $score{'array'};

 if ( $score{'array1'} < $score{'array2'} ) {
  @array=@array1;
  @array2=@array1;
  $score{'array'} = $score{'array1'};
  partialshuffle( \@array2 );
  calculate("array2", @array2);
# } elsif ( $score{'array1'} > $score{'array2'} ) {
 } else {
  @array=@array2;
  @array1=@array2;
  $score{'array'} = $score{'array2'};
  partialshuffle( \@array1 );
  calculate("array1", @array1);
 }
}

format STDOUT =
@ @ @ @ @  @ @ @ @ @
$keys[0], $keys[1], $keys[2], $keys[3], $keys[4], $keys[5], $keys[6], $keys[7], $keys[8], $keys[9]
@ @ @ @ @  @ @ @ @ @
$keys[10], $keys[11], $keys[12], $keys[13], $keys[14], $keys[15], $keys[16], $keys[17], $keys[18], $keys[19]
@ @ @ @ @  @ @ @ @ @
$keys[20], $keys[21], $keys[22], $keys[23], $keys[24], $keys[25], $keys[26], $keys[27], $keys[28], $keys[29]
.

###
#subs

sub shuffle {
 my $array = shift;
 my $i;
 for ($i = @$array; --$i; ) {
  my $j = int rand ($i+1);
  next if $i == $j;
  @$array[$i,$j] = @$array[$j,$i];
 }
}

sub partialshuffle {
 my $array = shift;
 my $i;
 for ($i = @$array ; $i -= 2 ; ) {
  my $j = int rand ($i+1);
  next if $i == $j;
  @$array[$i,$j] = @$array[$j,$i];
 }
}

sub calculate {
 my $layout = shift;
 @keys = @_;

 my $score = 0;
 my $lastscore = 0;
 my $change;
 my $first_run = 1;

 foreach my $char ( @text ) {

  if ( "$char" eq " " ) {
   next;
  }

  for ( $key = 0 ; $key < 30 ; $key++ ) {
   if ( "$keys[$key]" eq "$char" ) {
    last;
   }
  }

  if ($key >= 0  and $key <= 4)  {
   $hnd = 0; #left=0 right=1
   $row = 0;
   $grp = 0;
  } elsif ($key >= 5  and $key <= 9) {
   $hnd = 1;
   $row = 0;
   $grp = 1;
  } elsif ($key >= 10 and $key <= 14) {
   $hnd = 0;
   $row = 1;
   $grp = 2;
  } elsif ($key >= 15 and $key <= 19) {
   $hnd = 1;
   $row = 1;
   $grp = 3;
  } elsif ($key >= 20 and $key <= 24) {
   $hnd = 0;
   $row = 2;
   $grp = 4;
  } elsif ($key >= 25 and $key <= 29) {
   $hnd = 1;
   $row = 2;
   $grp = 5;
  } else {
   next;
  }

  #finger
  if ($key == 0 or  $key == 9 or  $key == 10 or  $key == 19 or  $key == 20 or  $key == 29) {
   $fgr = 4;
  } elsif ($key == 1 or  $key == 8 or  $key == 11 or  $key == 18 or  $key == 21 or  $key == 28) {
   $fgr = 3;
  } elsif ($key == 2 or  $key == 7 or  $key == 12 or  $key == 17 or  $key == 22 or  $key == 27) {
   $fgr = 2;
  } elsif ($key == 3 or  $key == 6 or  $key == 13 or  $key == 16 or  $key == 23 or  $key == 26) {
   $fgr = 1;
  } elsif ($key == 4 or  $key == 5 or  $key == 14 or  $key == 15 or  $key == 24 or  $key == 25) {
   $fgr = 0;
  } else {
   next;
  }

  #if it's the first run on the home row
  if ( $first_run ) {
   $first_run = 0;

   $lasthnd = $hnd;
   $lastrow = 1;
   $lastfgr = $fgr;

   if ( $grp == 0 or $grp == 2 or $grp == 4 ) {
    $lastgrp = 2;
   } elsif ( $grp == 1 or $grp == 3 or $grp == 4 ) {
    $lastgrp = 3;
   } else { $lastgrp = 2; }

   if ( $key <= 9 ) {
    $lastkey = $key + 10;
   } elsif ( $key >= 10 and $key <= 19 ) {
    $lastkey = $key;
   } elsif ( $key >= 20 ) {
    $lastkey = $key - 10;
   } else { 
    $lastkey = $key;
   }
  }

  if ( $lasthnd == $hnd ) { #same hand
   if ($fgr < $lastfgr ) { #digigraph
    $score -= 1;
    if ($fgr == ($lastfgr - 1)) {
     $score -= 2;
    }
   } else {
    $score += 2;
   }
  }

  if ( $lastgrp == 2 and $grp == [1,5] ) {
   $score -=1;
  } elsif ( $lastgrp == 3 and $grp == [0,4] ) {
   $score -=1;
  } elsif ( $lastgrp == 2 and $grp == 3 ) {
   $score -=2;
  } elsif ( $lastgrp == 3 and $grp == 2 ) {
   $score -=2;
  }

  if ($lastfgr == $fgr and $lastkey != $key ) { #same finger
   $score += 1;
  }

  if ( $lastgrp == $grp ) { #samegroup
   $score -= 1;
  }

  if ( $row == 0 ) { #top
   $score += 1;
  } elsif ( $row == 2 ) { #bottom
   $score += 2;
  }

  #fingers
  if ( $fgr == 2 ) {
   $score -= 1;
  } elsif ( $fgr == 4 ) { #pinky
   $score += 2;
  }

  #$change = $score - $lastscore;
  #print "$layout: score:$score hand:$hnd row:$row group:$grp finger:$fgr lastkey:$lastkey key:$key \t $keys[$key] $change\n";

  $lasthnd = $hnd;
  $lastrow = $row;
  $lastgrp = $grp;
  $lastfgr = $fgr;
  $lastkey = $key;
  $lastscore = $score;

 }
 $score{$layout}=$score;
}

sub layout {
 @keys = @_;
 write;
 print "\n";
}