RabbitFarm

The examples used here are from The Weekly Challenge problem statement and demonstrate the working solution.

Part 1

Output or return a list of all abecedarian words in the dictionary, sorted in decreasing order of length.

Solution

use strict;
use warnings;

sub abecedarian{
    sort {$b->[1] <=> $a->[1]} map {[$_, length($_)]} grep{chomp; $_ eq join("", sort {$a cmp $b} split(//, $_))} @_;
}

MAIN:{
    open(DICTIONARY, "dictionary");
    for my $abc (abecedarian(<DICTIONARY>)){
        print $abc->[0] . " length: " . $abc->[1] . "\n";
    }
    close(DICTIONARY);
}

Sample Run

$ perl perl/ch-1.pl
abhors length: 6
accent length: 6
accept length: 6
access length: 6
accost length: 6
almost length: 6
begins length: 6
    .
    .
    .
ox length: 2
qt length: 2
xx length: 2
a length: 1
m length: 1
x length: 1    

Notes

The Power of Perl! This problem reduces to one (one!) line of code, plus a few more to manage reading the data and printing the results.

Reading from left to right what is happening? Well, we are sorting, in descending order, an array of array references based on the value of the element at index 1. Where does this array of array refs come from? From a map which takes in an array of strings and stores each string in an array ref with it's length. Where Does the array fo strings come from? From the grep which takes the list of strings sent to sub abecedarian as arguments, splits them into characters, sorts the characters, and then sees if the characters in sorted order are in the same order as the original word demonstrating that the word fits the definition of Abecedarian.

Ordinarily I will make an effort to avoid these more complicated expressions but in this case the reading of it seems to proceed in a straightforward way as a chain of easily understood sub-expressions.

Part 2

Using the provided dictionary generate at least one pangram.

Solution

use strict;
use warnings;

use Lingua::EN::Tagger;

sub pangram{
    my %tagged_words;
    my $tagger = new Lingua::EN::Tagger;
    for my $word (@_){
        chomp($word);
        my $tagged_text = $tagger->add_tags($word);
        $tagged_text =~ m/<([a-z]*)>([a-z]*<)/;
        my $tag = $1;
        if($tagged_words{$tag}){
            push @{$tagged_words{$tag}}, $word;
        }
        else{
            $tagged_words{$tag} = [$word];
        }
    }
    ##
    # generate sentences from random words in a (somewhat) grammatical way
    ##
    my $sentence;
    my @dets = @{$tagged_words{det}};
    my @adjs = @{$tagged_words{jj}};
    my @nouns = @{$tagged_words{nn}};
    my @verbs = @{$tagged_words{vb}};
    my @cons = @{$tagged_words{cc}};
    my @adverbs = @{$tagged_words{vb}};
    do{
        my $det0 = $dets[rand @dets];
        my $adj0 = $adjs[rand @adjs];
        my $noun = $nouns[rand @nouns];
        my $verb = $verbs[rand @verbs];
        my $det1 = $dets[rand @dets];
        my $adj1 = $adjs[rand @adjs];
        my $object0 = $nouns[rand @nouns];
        my $conj = $cons[rand @cons];
        my $det2 = $dets[rand @dets];
        my $adj2 = $adjs[rand @adjs];
        my $object1 = $nouns[rand @nouns];
        my $adverb = $adverbs[rand @adverbs];
        my %h;
        for my $c (split(//, "$det0$adj0$noun$verb$det1$adj1$object0$conj$det2$adj2$object1")){
            $h{$c} = undef;
        }
        $sentence = "$det0 $adj0 $noun $verb $det1 $adj1 $object0 $conj $det2 $adj2 $object1" if keys %h == 26;        
    }while(!$sentence);
    return $sentence;
}

MAIN:{
    open(DICTIONARY, "dictionary");
    print pangram(<DICTIONARY>) . "\n";
    close(DICTIONARY);
}

Sample Run

$ perl perl/ch-2.pl
each toxic windpipe jeopardize some quick wafted less every favorable arrangement
$ perl perl/ch-2.pl
each exaggerated wilier jeopardize all marketable enunciate and every quirky forgiveness

Notes

I made this a bit ore complicated then it could have been, although I didn't really get into the "Bonus" questions (see the original problem statement on the Weekly Challenge site for details). The main complication I chose to take on here is that I wanted to have the generated pangrams to be reasonably grammatically correct. To simplify things I chose a single template that the generated sentence can take on. The words for the sentences are then chosen at random according to the template. Amazingly this works! As part of this simplification words that need to match in number (plural, singular) will not quite line up. This is certainly doable, but represented more work than I was willing to put in at the time.

In order to get words to fit the template I make a first pass through the dictionary and assign parts of speech. This is another simplification, and seems to be a little rough. This is likely due to the fact that Lingua::EN::Tagger is very sophisticated and uses both its own dictionary and statistical techniques to determine parts of speech from bodies of text. Given just one word at a time its powers are not able to be used fully.

Since words are chosen completely at random the process to generate a valid pangram can take several minutes. The sentences generated can take on a slightly poetic aspect, there are some decent verses amidst all the chaos!

References

Challenge 161

Lingua::EN::Tagger

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

Part 1

Output or return a list of all abecedarian words in the dictionary, sorted in decreasing order of length.

Solution

check_and_read(10, [] ,_):-
    !.
check_and_read(13, [], _):-
    !.
check_and_read(32, [], _):-
    !.
check_and_read(44, [], _):-
    !.
check_and_read(end_of_file, [], _):-
    !.
check_and_read(Char, [Char|Chars], Stream):-
    get_code(Stream, NextChar),
    check_and_read(NextChar, Chars, Stream).

read_data(Stream, []):-
    at_end_of_stream(Stream).
read_data(Stream, [X|L]):-
    \+ at_end_of_stream(Stream),
    get_code(Stream, Char),
    check_and_read(Char, Chars, Stream),
    atom_codes(X, Chars),
    read_data(Stream, L).

abecedarian(Words, Abecedarian):-
    member(Word, Words),
    atom_chars(Word, Chars),
    sort(Chars, SortedChars),
    atom_chars(W, SortedChars),
    W = Word,
    Abecedarian = Word.

word_length(Word, LengthWord):-
    atom_chars(Word, Chars),
    length(Chars, Length),
    LengthWord = Length-Word. 

abecedarians(Words, Abecedarians):-
    findall(Abecedarian, abecedarian(Words, Abecedarian), A),
    maplist(word_length, A, AL), 
    keysort(AL, ALSorted),
    reverse(ALSorted, Abecedarians).

main:-
    open('dictionary', read, Stream),
    read_data(Stream, Dictionary),
    close(Stream),
    abecedarians(Dictionary, Abecedarians),
    write(Abecedarians), nl, 
    halt.

Sample Run

$ gprolog --consult-file prolog/ch-1.p --entry-goal main
[6-chintz,6-chimps,6-begins,6-almost,6-abhors,5-glory,5-ghost,5-forty,5-flops,5-first,5-filmy,5-films,5-empty,5-dirty,5-deity,5-chops,5-chips,5-chins,5-chimp,5-below,5-begin,5-befit,5-aglow,5-adopt,5-adept,5-abort,5-abhor,4-nosy,4-most,4-mops,4-lost,4-lops,4-know,4-knot,4-imps,4-host,4-hops,4-hips,4-hint,4-hims,4-hilt,4-gory,4-glow,4-gist,4-gins,4-gilt,4-foxy,4-fort,4-flux,4-flow,4-flop,4-fist,4-firs,4-fins,4-film,4-envy,4-elms,4-egos,4-dirt,4-dips,4-dins,4-dims,4-deny,4-dent,4-dens,4-defy,4-deft,4-crux,4-cost,4-copy,4-cops,4-clot,4-city,4-chow,4-chop,4-chip,4-chin,4-cent,4-blow,4-blot,4-bins,4-best,4-bent,4-belt,4-begs,4-amps,4-alms,4-airy,4-airs,4-aims,4-ails,4-ahoy,4-aces,4-ably,4-abet,3-pry,3-opt,3-now,3-not,3-nor,3-mow,3-mop,3-low,3-lot,3-lop,3-joy,3-jot,3-ivy,3-ins,3-imp,3-how,3-hot,3-hop,3-hit,3-his,3-hip,3-him,3-guy,3-got,3-gnu,3-gin,3-fry,3-fox,3-for,3-fly,3-flu,3-fix,3-fit,3-fir,3-fin,3-elm,3-ego,3-dry,3-dot,3-dos,3-dip,3-din,3-dim,3-dew,3-den,3-cry,3-coy,3-cox,3-cow,3-cot,3-cop,3-chi,3-buy,3-boy,3-box,3-bow,3-bop,3-bit,3-bin,3-bet,3-beg,3-art,3-apt,3-any,3-ant,3-amp,3-air,3-aim,3-ail,3-ago,3-ads,3-ado,3-act,3-ace,2-qt,2-ox,2-or,2-no,2-my,2-mu,2-ms,2-ix,2-iv,2-it,2-(is),2-in,2-ho,2-hi,2-go,2-em,2-eh,2-do,2-cs,2-by,2-be,2-ax,2-at,2-as,2-an,2-am,2-ah,2-ad,1-x,1-m,1-a]

Notes

Most of the code here is just for reading the provided dictionary of words. Once that is complete Prolog really shines. abecedarian/2 is the majority of the logic: if a word's characters when sorted and re-assembled are the original word then it is an Abecedarian.

abecedarians/2 is necessary only to fulfill the requirements of the problem specification which is that all Abecedarians be sorted by length and returned in descending order.

References

Challenge 161