na diggu pojawiła się informacja, że w języku angielskim jest 9 literowe słowo z którego można odejmować literki i nadal pozostaje prawidłowym słowem.
w toku dyskusji komentującej ktoś wylistował sporo takich słów.

stwierdziłem, że zobaczę jak to w polskim.

wziąłem najnowszą listę słów w polskim (zakładając, że używasz *ubuntu lub debiana, paczka nazywa się wpolish, dla innych dystrybucji/systemów pewnie też jest). (nie gwarantuje poprawności słów z tego słownika. po prostu taki miałem pod ręką)
napisałem mały/prosty programik (kod poniżej) i odpaliłem.

pomieliło, pomieliło, zeżarło 400 mega ramu, i dostałem wyniki.

najdłuższe słowa jakie znalazłem to:

• odkupicielskiej : o => ok => oku => okup => okupi => okupie => okupcie => okupicie => odkupicie => odkupiciel => odkupicieli => odkupicielki => odkupicielski => odkupicielskie => odkupicielskiej
• odkupicielskimi : o => ok => oku => okup => okupi => okupie => okupcie => okupicie => odkupicie => odkupiciel => odkupicieli => odkupicielki => odkupicielski => odkupicielskim => odkupicielskimi
• popodgryzaniach : r => rc => rac => rach => ranch => ranach => pranach => praniach => poraniach => pograniach => pogrzaniach => pogryzaniach => poogryzaniach => poodgryzaniach => popodgryzaniach
• popodgryzaniami : a => pa => pan => pana => panam => panami => pranami => praniami => poraniami => pograniami => pogrzaniami => pogryzaniami => poogryzaniami => poodgryzaniami => popodgryzaniami
• prasowalniczymi : s => si => soi => sowi => asowi => rasowi => prasowi => prasowni => prasowani => prasowalni => prasowalnic => prasowalnicy => prasowalniczy => prasowalniczym => prasowalniczymi

czyli 5 słów 15 literowych. 🙂 polski daje lepsze (dłuższe) słowa niż angielski 🙂 YEAH!

kod:

#!/usr/bin/perl
use strict;
use Text::Iconv;
use Fatal qw( open );
 
my $converter = Text::Iconv->new("iso-8859-2", "utf-8");
my @words = ();
my %paths = ();
 
open my $fh, "<", "/usr/share/dict/polish";
while (my $l = $converter->convert(lc <$fh>)) {
$l =~ s/^\s*//;
$l =~ s/\s*$//;
next if $l eq '';
my $len = length $l;
$words[$len]->{$l} = 1;
}
close $fh;
 
my @possible_words = sort keys %{ $words[1] };
for my $word (@possible_words) {
$paths{$word} = [ $word ];
}
 
while (1) {
printf "Możliwe (%ux%u): %s\n", scalar @possible_words, length $possible_words[0], join(", ", @possible_words);
 
my %found = ();
my $new_len = 1 + length $possible_words[0];
 
for my $word (@possible_words) {
my @to_check = get_check_words($word);
 
my @existing = grep { $words[$new_len]->{$_} } @to_check;
 
for my $found_word (@existing) {
$paths{$found_word} = [ @{ $paths{$word} }, $found_word ];
$found{$found_word} = 1;
}
}
 
last if 0 == scalar keys %found;
for my $word (sort keys %found) {
print "  - $word : " . join(" => ", @{ $paths{$word} } ) . "\n";
}
@possible_words = sort keys %found;
}
 
exit;
 
sub get_check_words {
my $word = shift;
my @reply = ();
for my $i (0..length $word) {
for my $char ("a".."z", qw( ą ć ę ł ń ó ś ź ż ) ) {
my $temp = $word;
substr($temp, $i, 0) = $char;
push @reply, $temp;
}
}
return @reply;
}