2008-04-06
i’m trying to write an evolution program that can work out a better keyboard layout than dvorak. i found one that i wrote about two years ago, and it’s not very good. all of this was inspired by peter klauslers’ evolved layout experiments i read about ages ago
the old program basically picks a random sequence of letters and calculates a score for the layout by typing on it with a large piece of text and measuring various stats like finger distance and alternating hands. i then takes that sequence and starts mixing the letters around. if it finds a better one it keeps it, if not it stays with the old one. one thing that i found interesting, qwerty isn’t hard to beat
it takes about 2 minutes before a keyboard that is more efficient to type on is found. it’s not nessacarilly better, as the letters are all over the place. another interesting point, an abcde layout (ie the alphabet) is only just beaten by qwerty
anyway, here it is, it’s really junk code that i used to test a theory, but i’ll throw it up here anyway. i’m working on a much better version, that will hopefully allow two layouts to combine and transform quicker, rather than cloning like i was trying to do before:
(i edited the post to add the capewell-dvorak keyboard layout in as well. from running a brief test it does indeed beat the dvorak. well, i’ll be…)
#!/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";
}