[an error occurred while processing this directive] [an error occurred while processing this directive][an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] (none) [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive][an error occurred while processing this directive] [an error occurred while processing this directive][an error occurred while processing this directive] [an error occurred while processing this directive][an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive] (none) [an error occurred while processing this directive] [an error occurred while processing this directive] [an error occurred while processing this directive][an error occurred while processing this directive]
 
[an error occurred while processing this directive] [an error occurred while processing this directive]
Skåne Sjælland Linux User Group - http://www.sslug.dk Home   Subscribe   Mail Archive   Forum   Calendar   Search
MhonArc Date: [Date Prev] [Date Index] [Date Next]   Thread: [Date Prev] [Thread Index] [Date Next]   MhonArc
 

Re: [PROGRAMMERING] decode letter scrambling "kode"



Peter Makholm <sslug@sslug> writes:

> Jeg er sikker på at man kan finde eksempler på ord hvor man ikke uden
> kontekst kan dekode ordet entydigt. Men med en passende ordliste tror
> jeg at det er ganske let at lave.

Sjovt som ens svar udvikler sig efterhånden som man får skrevet
det. Hvis man lige sætter environemtvariablem DEBUG til 1 vil
nedenstående selvfølgelig skrive ud hvilke kollisioner der er.


> Men jeg tror et håndkodet opslag i en ordliste ville have en meget
> bedre hitrate. Prøv nedenstående. Koden tager ikke hensyn til store og
> små bogstaver, så der er to forventede fejl (According og
> University). De resterende fejl jeg får er stavefejl i originalen.

Lige nogle flere fejl der kan forklares. Blandt andet et til ord der
begynder med stort i teksten og "deosn't" bliver heller ikke demanglet
korrekt. 

Umidelbart er der to muligheder: enten opfatter vi "doesn't" som to
ord "doesn" og "t" eller også opfatter vi "'" som et bogstav. Et løst
gæt er at man har brugt den første regel til at mangle med. Det skal
vi selvfølgelig tage hensyn til når vi bygger vores %dictionary.

Lignende gør sig gældende for ejefalds-s'er.


> #!/usr/bin/perl
>
> sub getkey {
>     my $w = shift;
>
>     my $key;
>     $key .= substr $w, 0, 1;
>     $key .= substr $w, -1, 1;
>     $key .= join "", sort split "", substr($w, 1, length($w)-2);

Den sidste substr(...) er selvfølgelig unødvendig. 

>     return $key;

Og lad os iøvrigt lade nøgler ignorere store og små bogstaver. Så
denne linje skal hedde

    return lc $key;

> }
>
> my %dictionary;
> open my $dictfile, '<', '/usr/share/dict/british-english';
> while( <$dictfile> ) {
>     chomp;
>     my $key = getkey $_;

Dette er ikke godt nok da vores linje i dict-filen kan indeholde flere
ord. Oftest vil det eventuelt andet ord dog være "s" eller "t". Så lav
lige en løkke:

    for $word (/(\w+)/g) {

>     warn "Collision $dictionary{$key} ~ $_" if exists $dictionary{$key} and $ENV{DEBUG};
>     $dictionary{$key} = $_;

Istedet for bare at smide kollisioner væk burde man samle dem op. Så
erstat disse to linjer med

    push @{ $dictionary{$key} }, $word;

Men nu kan vi have samme ord i listen flere gange, hovedsagligt vil
ordet "s" være der mange gange og "t" et par gange. Så

    push @{ $dictionary{$key} }, $_ 
        if none { $word eq $_ } @{ $dictionary{$key} };

og husk lige en 'use List::MoreUtils qw(none);' i begyndelsen.

> }
>
> while(<>) {
>
>     s{ (\w+) }
>      {
>          my $key = getkey $1;
>          exists $dictionary{$key} ? $dictionary{$key} : $1;

Nu har vi tre muligheder. Listen en er tom, har et element eller har
flere elementer. Vi mangler også lige at gøre noget ved store og små
bogstaver...

        my $word;
        $word = $1
            if @{ $dictionary{$key} } == 0;
        $word = $dictionary{$key}->[0]
            if @{ $dictionary{$key} } == 1;
        $word = '{' . join(',', @{ $dictionary{$key} }) . '}' 
            if @{ $dictionary{$key} } > 1;

Så skal vi bare lige klare store og små bogstaver. Jeg har ingen
anelse om hvordan reglerne vil håndtere CamelCase, så lad os bare
antage at det kun er relevant for første bogstav.

Jeg tror ikke der er noget i vejen for at bruge et regexp her. Så
dette bør virke:

        $1 =~ /^[A-Z]/ ? "\U$word" : $word;

>      }gex;
>
>      print;
>
> }
>
> __END__    


 
Home   Subscribe   Mail Archive   Index   Calendar   Search

 
 
Questions about the web-pages to <www_admin>. Last modified 2008-02-01, 02:01 CET [an error occurred while processing this directive]
This page is maintained by [an error occurred while processing this directive]MHonArc [an error occurred while processing this directive] # [an error occurred while processing this directive] *