#!/usr/bin/env perl # vim:set foldmethod=marker:ts=4:sw=4:: # Copyright (c) 2008, Marco Fontani # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # * Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # * Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # * The names of its contributors may not be used to endorse or promote products # derived from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY # AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. # IN NO EVENT SHALL Marco Fontani BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS # SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. use strict; use warnings; use 5.10.1; # for say use YAML; use XML::Twig; use Template; use DateTime::Format::ISO8601; use Chart::Strip; ### {{{ usage my $stats = qq{$ENV{HOME}/.kde/share/apps/ktouch/statistics.xml}; if (! -f $stats) { die "Cannot find statistics file\n"; } my $wanted_layout = shift; if (!defined $wanted_layout) { $wanted_layout = 'colemak'; warn "No layout specified, will use $wanted_layout.\nPass the layout name as a parameter if you want to generate graphs for that layout\n"; } my $lc_layout = lc $wanted_layout; ## FIXME my $uf_layout = ucfirst lc $wanted_layout; ## FIXME ### }}} ### {{{ parse # Globals used to return data from parse_lecture_stats() my $tot_rows = 0; my $twig = XML::Twig->new( twig_handlers => { 'KTouchStatistics/LectureStats' => \&parse_lecture_stats, }, ); $twig->parsefile( $stats ); ### }}} ### {{{ PARSER my %levels; # names of the levels parsed so far my %bydate; # data ordered by key date/time when the data was gathered my %c_overall_chars_stats; # datetime, time, value by chr() my %chars; # keys are the characters whose stats have been seen so far my %c_wpm_g_level; my %c_kpm_g_level; my %latest_by_level; sub parse_lecture_stats { my ( $twig, $lecturestats) = @_; my $title = $lecturestats->first_child('Title')->text; return if $title !~ /\Q$wanted_layout\E/i; my $url = $lecturestats->first_child('URL')->text; for my $levelstats ( $lecturestats->first_child('AllLevelStats')->children('LevelStats') ) { my $time = $levelstats->att('Time'); # Time taken (in seconds) to go through the current level next if $time < 20; ## don't even parse anything < 20 seconds my $number = $levelstats->att('Number'); # The level number $levels{$number} = 1; # level $number was parsed my $datetime = $levelstats->first_child('Time')->text; # date/time the level was attempted at my $epoch = DateTime::Format::ISO8601->parse_datetime($datetime)->epoch; my $charstats = $levelstats->first_child('CharStats')->text; # in triplets, stats by character # triplets: ord(char), correctCount, wrongCount my %charstats; # by character, correct and wrong { $charstats =~ s/^\s+//; my @numbers = split(/\s+/, $charstats); my ($ord,$correct); for (0..$#numbers) { $_ % 3 == 0 and $ord = $numbers[$_]; $_ % 3 == 1 and $correct = $numbers[$_]; $_ % 3 == 2 and do { $charstats{$ord}{correct} = $correct; $charstats{$ord}{wrong} = $numbers[$_]; $charstats{$ord}{pct_correct} = $charstats{$ord}{wrong} ? ( $charstats{$ord}{correct} * 100 / ( $charstats{$ord}{wrong} + $charstats{$ord}{correct} ) ) : '100.00', $charstats{$ord}{pct_wrong} = 100 - $charstats{$ord}{pct_correct}; }; } } for my $ord ( sort keys %charstats ) { my $pct = $charstats{$ord}{wrong} ? ( $charstats{$ord}{correct} * 100 / ($charstats{$ord}{wrong}+$charstats{$ord}{correct})) : '100.0'; say sprintf("$datetime Stats for %04d (%s): T %03d C %03d W %03d PW %02.2f%%", $ord, chr($ord), $charstats{$ord}{correct} + $charstats{$ord}{wrong}, $charstats{$ord}{correct}, $charstats{$ord}{wrong}, $charstats{$ord}{wrong} ? ( $charstats{$ord}{correct} * 100 / ($charstats{$ord}{wrong}+$charstats{$ord}{correct})) : '100.00', ) if 0; push @{$c_overall_chars_stats{ chr($ord) }}, { #datetime => $datetime, time => $epoch, value => $pct, }; my ($year,$month,$day,$hours,$minutes) = map { int } do { my ($ymd,$hms) = split('T', $datetime); split('-',$ymd), split(':',$hms); }; $chars{$ord} = 1; } my $corrects = $levelstats->att('Corrects'); my $words = $levelstats->att('Words'); my $chars = $levelstats->att('Chars'); my $wpm = sprintf("%2.2f", ( $words / $time * 60 )); my $kpm = sprintf("%2.2f", ( $chars / $time * 60 )); my $href = { title => $title, datetime => $datetime, charstats => $charstats, time => $time, corrects => $corrects, words => $words, number => $number, level => $number, chars => $chars, wpm => $wpm, kpm => $kpm, epoch => $epoch, wrong_by_char => { map { $_ => { datetime => $datetime, time => $epoch, value => $charstats{$_}{pct_wrong} } } keys %charstats }, correct_by_char => { map { $_ => { datetime => $datetime, time => $epoch, value => $charstats{$_}{pct_correct} } } keys %charstats }, }; push @{$c_wpm_g_level{ $number }}, { time => $epoch, value => $wpm, }; push @{$c_kpm_g_level{ $number }}, { time => $epoch, value => $kpm, }; $latest_by_level{$number}{kpm} = $kpm; $latest_by_level{$number}{wpm} = $wpm; $bydate{$datetime} = {%$href}; $tot_rows++; } } ### }}} PARSER ### {{{ CHARTS GENERATION my @dimensions = ( width => 500, height => 150 ); my @huge_dimensions = ( width => 1000, height => 600 ); my @small_dimensions = ( width => 100, height => 70 ); my $color_averages = 'AA9090'; # http://en.wikipedia.org/wiki/File:ColorAlphabetExample.png my %color_by_letter = ( a => sprintf( '%x' x 3, 0, 0, 180 ), b => sprintf( '%x' x 3, 175, 13, 182 ), c => sprintf( '%x' x 3, 146, 248, 70 ), d => sprintf( '%x' x 3, 255, 200, 47 ), e => sprintf( '%x' x 3, 255, 288, 0 ), f => sprintf( '%x' x 3, 185, 185, 185 ), g => sprintf( '%x' x 3, 235, 235, 222 ), h => sprintf( '%x' x 3, 100, 100, 100 ), i => sprintf( '%x' x 3, 255, 255, 0 ), j => sprintf( '%x' x 3, 55, 19, 112 ), k => sprintf( '%x' x 3, 255, 255, 250 ), l => sprintf( '%x' x 3, 202, 62, 94 ), m => sprintf( '%x' x 3, 205, 245, 63 ), n => sprintf( '%x' x 3, 12, 75, 100 ), o => sprintf( '%x' x 3, 255, 0, 0 ), p => sprintf( '%x' x 3, 175, 155, 50 ), q => sprintf( '%x' x 3, 0, 0, 0 ), r => sprintf( '%x' x 3, 37, 70, 25 ), s => sprintf( '%x' x 3, 121, 33, 135 ), t => sprintf( '%x' x 3, 83, 140, 208 ), u => sprintf( '%x' x 3, 0, 154, 37 ), v => sprintf( '%x' x 3, 178, 220, 205 ), w => sprintf( '%x' x 3, 255, 152, 213 ), x => sprintf( '%x' x 3, 0, 0, 74 ), y => sprintf( '%x' x 3, 175, 200, 74 ), z => sprintf( '%x' x 3, 63, 25, 12 ), ); ## {{{ WPM+KPM chart my @by_level; for my $level ( sort { $a <=> $b } keys %levels ) { next if !defined $c_wpm_g_level{$level}; next if !defined $c_kpm_g_level{$level}; my $wpm_fname = "$lc_layout-wpm-$level"; my $kpm_fname = "$lc_layout-kpm-$level"; my $wpm_fname_huge = $wpm_fname . '-huge'; my $kpm_fname_huge = $kpm_fname . '-huge'; $wpm_fname .= '.png'; $kpm_fname .= '.png'; $wpm_fname_huge .= '.png'; $kpm_fname_huge .= '.png'; my $xml_wpm_fname = "$lc_layout-wpm-$level.xml"; my $xml_kpm_fname = "$lc_layout-kpm-$level.xml"; my $xml_wpm = ''; my $xml_kpm = ''; ## wpm by level my $avg_wpm_this_level = 0; map { $avg_wpm_this_level += $_->{value} } @{$c_wpm_g_level{$level}}; $avg_wpm_this_level = sprintf("%02.2f", $avg_wpm_this_level / scalar @{$c_wpm_g_level{$level}}); my %chars_this_level; my @bychar_this_level = map { my $c = $_->{correct_by_char}; @chars_this_level{keys %$c}=1; $c } grep { $_->{level} eq $level } values %bydate; my $done = 0; for my $t ( [$wpm_fname,\@dimensions], [$wpm_fname_huge, \@huge_dimensions ] ) { my ( $fname, @dimensions ) = ($t->[0], @{$t->[1]}); my $wpm_ch = Chart::Strip->new( title => "$uf_layout WPM level $level", draw_tic_labels => 1, draw_data_labels => 1, transparent => 0, strip_undefined => 1, @dimensions, ); if (!$done) { # XML preamble $xml_wpm .= qq{\n}; # categories are the date/time $xml_wpm .= "\n"; for my $wpml ( sort { $a->{time} <=> $b->{time} } @{$c_wpm_g_level{$level}} ) { $xml_wpm .= qq{\n}; } $xml_wpm .= "\n"; # dataset #1: average WPM $xml_wpm .= qq{\n}; for my $wpml ( @{$c_wpm_g_level{$level}} ) { $xml_wpm .= qq{\n}; } $xml_wpm .= qq{\n}; # datasets: the KPMs for my $char ( keys %chars_this_level ) { my $char_stats = [ sort { $a->{time} <=> $b->{time} } map { $_->{$char} } grep { defined $_->{$char} } @bychar_this_level ]; my $ord = chr $char; $xml_wpm .= qq{\n}; for my $stat ( @$char_stats ) { $xml_wpm .= qq{\n}; } $xml_wpm .= qq{\n}; } # postamble and save $xml_wpm .= qq{\n}; open my $f, '>', $xml_wpm_fname; print $f $xml_wpm; close $f; print "Saved $xml_wpm_fname\n"; $done = 1; } $wpm_ch->add_data([map {{ time => $_->{time}, value => $avg_wpm_this_level }} @{$c_wpm_g_level{$level}}], { label => 'Average WPM', color => $color_averages }); $wpm_ch->add_data($c_wpm_g_level{$level}, { label => "WPM L$level", color => 'FF9900',}); my $cnt = 0; for my $char ( keys %chars_this_level ) { my $char_stats = [ sort { $a->{time} <=> $b->{time} } map { $_->{$char} } grep { defined $_->{$char} } @bychar_this_level ]; #die Dump($char_stats); my $ord = chr $char; $wpm_ch->add_data( $char_stats, { label => "$ord", color => $color_by_letter{$ord} } ); } { open my $png, '>', $fname; binmode $png; print $png $wpm_ch->png(); close $png; } } ## kpm by level my $avg_kpm_this_level = 0; map { $avg_kpm_this_level += $_->{value} } @{$c_kpm_g_level{$level}}; $avg_kpm_this_level = sprintf("%02.2f", $avg_kpm_this_level / scalar @{$c_kpm_g_level{$level}}); for my $t ( [$kpm_fname,\@dimensions], [$kpm_fname_huge, \@huge_dimensions ] ) { my ( $fname, @dimensions ) = ($t->[0], @{$t->[1]}); my $kpm_ch = Chart::Strip->new( title => "$uf_layout KPM level $level", draw_tic_labels => 1, draw_data_labels => 1, transparent => 0, strip_undefined => 1, @dimensions, ); $kpm_ch->add_data([map {{ time => $_->{time}, value => $avg_kpm_this_level }} @{$c_kpm_g_level{$level}}], { label => 'Average KPM', color => $color_averages }); $kpm_ch->add_data($c_kpm_g_level{$level}, { label => "KPM L$level", color => '0099FF' }); { open my $png, '>', $fname; binmode $png; print $png $kpm_ch->png(); close $png; } } ## push on array for template push @by_level, { level => $level, wpm_img_filename => $wpm_fname, kpm_img_filename => $kpm_fname, wpm_img_filename_huge => $wpm_fname_huge, kpm_img_filename_huge => $kpm_fname_huge, wpm_latest => $latest_by_level{$level}{wpm}, kpm_latest => $latest_by_level{$level}{kpm}, wpm_average => $avg_wpm_this_level, kpm_average => $avg_kpm_this_level, xml_wpm_fname => $xml_wpm_fname, xml_kpm_fname => $xml_kpm_fname, }; } ## }}} end of WPM/KPM chart ## {{{ errors by character my %by_char; { for my $char ( sort keys %c_overall_chars_stats ) { my $small_fname = "$lc_layout-key-$char-errors-small.png"; my $large_fname = "$lc_layout-key-$char-errors-large.png"; { my $ch = Chart::Strip->new( title => "$char", draw_grid => 0, strip_undefined => 1, draw_tic_labels => 0, draw_data_labels => 0, transparent => 0, @small_dimensions, ); $ch->add_data($c_overall_chars_stats{$char}, { # label => "$char", color => 'FF00FF', }); open my $png, '>', $small_fname; binmode $png; print $png $ch->png(); close $png; } { my $ch = Chart::Strip->new( title => "$char", draw_tic_labels => 1, draw_data_labels => 1, transparent => 0, strip_undefined => 1, @dimensions, ); $ch->add_data($c_overall_chars_stats{$char}, { # label => "$char", color => 'FF00FF', }); open my $png, '>', $large_fname; binmode $png; print $png $ch->png(); close $png; } $by_char{$char} = { char => $char, small_img_filename => $small_fname, large_img_filename => $large_fname, }; } } ## {{{ map character errors to keyboard row - FIXME colemak only! my $by_row = { errors_top => [ map { $by_char{$_} } split('','qwfpgjluy') ], errors_home => [ map { $by_char{$_} } split('','arstdhneio') ], errors_bottom => [ map { $by_char{$_} } split('','zxcvbkm') ], }; ## }}} ## }}} end errors by character ## {{{ index.tt => index.html template processing my $tt = Template->new; $tt->process('index.tt', { by_level => \@by_level, %$by_row, }, 'index.html') or die $tt->error(); ## }}} ### }}}