Old lady swallowed a fly
Present a program which emits the lyrics to the song I Knew an Old Lady Who Swallowed a Fly, taking advantage of the repetitive structure of the song's lyrics.
C
Boring, ad hoc dictionary based decompression. The encoder was arguably more interesting, though. <lang c>#include <stdio.h>
char *dict[] = { "_ha _c _e _p,/Quite absurd_f_p;_`cat,/Fancy that_fcat;_j`dog,/What a hog" "_fdog;_l`pig,/Her mouth_qso big_fpig;_d_r,/She just opened her throat_f_" "r;_icow,/_mhow she_ga cow;_k_o,/It_qrather wonky_f_o;_a_o_bcow,_khorse.." "./She's dead, of course!/","_a_p_b_e ","/S_t "," to catch the ","fly,/Bu" "t _mwhy s_t fly,/Perhaps she'll die!//_ha","_apig_bdog,_l`","spider,/Tha" "t wr_nj_ntickled inside her;_aspider_b_c",", to_s a ","_sed ","There_qan" " old lady who_g","_a_r_bpig,_d","_acat_b_p,_","_acow_b_r,_i","_adog_bcat" ",_j","I don't know ","iggled and ","donkey","bird"," was ","goat"," swal" "low","he_gthe" };
int print(char *c, int s) { do { if (s) s = print(dict[*c - 95], 0); else if (*c == '_') s = 1; else putchar(*c == '/' ? '\n' : *c); } while (*++c); return s; }
int main() { print(dict[0], 0); return 0; }</lang>
D
<lang d>import std.stdio;
auto dict = [ "_ha _c _e _p,/Quite absurd_f_p;_`cat,/Fancy that_fcat;_j`dog,/What a hog"~ "_fdog;_l`pig,/Her mouth_qso big_fpig;_d_r,/She just opened her throat_f_"~ "r;_icow,/_mhow she_ga cow;_k_o,/It_qrather wonky_f_o;_a_o_bcow,_khorse.."~ "./She's dead, of course!/","_a_p_b_e ","/S_t "," to catch the ","fly,/Bu"~ "t _mwhy s_t fly,/Perhaps she'll die!//_ha","_apig_bdog,_l`","spider,/Tha"~ "t wr_nj_ntickled inside her;_aspider_b_c",", to_s a ","_sed ","There_qan"~ " old lady who_g","_a_r_bpig,_d","_acat_b_p,_","_acow_b_r,_i","_adog_bcat"~ ",_j","I don't know ","iggled and ","donkey","bird"," was ","goat"," swal"~ "low","he_gthe"];
bool oldLady(string part, bool s) {
foreach (ch; part) {
if (s)
s = oldLady(dict[ch - 95], 0);
else if (ch == '_')
s = true;
else
putchar(ch == '/' ? '\n' : ch);
}
return s;
}
void main() {
oldLady(dict[0], false);
}</lang>
Forth
swallow-addr is obviously a good candidate for an object, but Forth has many OO candidates - we won't settle that argument here.
<lang forth>: string, ( c-addr u -- ) \ store string at HERE , with a count
dup c, here swap dup allot move ;
\ doubly linked list: (0|prev, 0|next, aside?, cstr animal; cstr aside) \ aside? is true if the aside is always displayed. variable swallowed variable first
- >next ( swallow-addr -- swallow-addr' )
cell+ @ ;
- >aside? ( swallow-addr -- f )
2 cells + @ ;
- >animal ( swallow-addr -- c-addr u )
3 cells + count ;
- >aside ( swallow-addr -- c-addr u )
>animal + count ;
- swallow ( "animal" -- )
align swallowed @ if here swallowed @ cell+ ! else here first ! then here swallowed @ , swallowed ! 0 , 0 , parse-word string, ; \ data structure still needs the aside
- always ( -- ) \ set aside? of last-defined swallow to true
swallowed @ 2 cells + on ;
- aside ( "aside" -- )
0 parse string, ;
swallow fly always aside But I don't know why she swallowed the fly, swallow spider always aside That wriggled and jiggled and tickled inside her; swallow bird aside Quite absurd, she swallowed the bird; swallow cat aside Fancy that, she swallowed the cat; swallow dog aside What a hog, she swallowed the dog; swallow pig aside Her mouth was so big, she swallowed the pig; swallow goat aside She just opened her throat, she swallowed the goat; swallow cow aside I don't know how, she swallowed the cow; swallow donkey aside It was rather wonky, she swallowed the donkey;
- ?aside ( swallow-addr -- ) \ print aside if aside? is true
dup >aside? if >aside cr type else drop then ;
- reasons ( swallow-addr -- ) \ print reasons she swallowed something
begin dup @ while dup cr ." She swallowed the " >animal type ." to catch the " @ dup >animal type ." ," dup ?aside repeat drop ;
- verse ( swallow-addr -- )
cr ." There was an old lady who swallowed a " dup >animal type ." ," dup >aside cr type reasons cr ." Perhaps she'll die!" ;
- song ( -- )
first @ begin dup verse cr >next dup 0= until drop cr ." There was an old lady who swallowed a horse..." cr ." She's dead, of course!" ;</lang>
Icon and Unicon
This version isn't as compressed as some of the others but it is very straightforward to modify. Just add a new long and terse verse entry and amend the line marked order. This uses a feature of Icon/Unicon that allows procedures to be called with a list datatype instead of an argument list, so we just pre-build argument lists for printf.
<lang Icon>procedure main() #: There Was An Old Lady Lyrics
verse := table() # arglists for printf - [1] long asides and [2] terse joiners verse["bird"] := [["%s,\nQuite absurd, %s %s;\n",1,2,1],["%s,\n",1]] verse["cat"] := [["%s,\nFancy that, %s %s;\n",1,2,1],["%s,\n",1]] verse["dog"] := [["%s,\nWhat a hog, %s %s;\n",1,2,1],["%s,\n",1]] verse["pig"] := [["%s,\nHer mouth was so big, %s %s;\n",1,2,1],["%s,\n",1]] verse["goat"] := [["%s,\nShe just opened her throat, %s %s;\n",1,2,1],["%s,\n",1]] verse["cow"] := [["%s,\nI don't know how, %s %s;\n",1,2,1],["%s,\n",1]] verse["donkey"] := [["%s,\nIt was rather wonky, %s %s;\n",1,2,1],["%s,\n",1]]
# just long versions of these
verse["fly"] := "%s,\nBut I don't know why %s %s,\nPerhaps she'll die!\n\n",1,2,1 verse["spider"] := "%s,\nThat wriggled and jiggled and tickled inside her;\n",1 verse["horse"] := "%s...\nShe's dead, of course!\n",1
every (f := verse[k := key(verse)][1|2])[i := 1 to *f] do # fix every printf args
f[i] := case f[i] of { 1 : k ; 2 : "she swallowed the"; default : f[i]}
zoofilo := [] "fly,spider,bird,cat,dog,pig,goat,cow,donkey,horse," ? # order
while push(zoofilo,tab(find(","))) & move(1) do {
printf("There was an old lady who swallowed a ")
every critter := !zoofilo do {
printf!verse[critter,(critter == (zoofilo[1] | "spider" | "fly"),1)|2]
if critter == "horse" then stop() # dead
printf("She swallowed the %s to catch the ","fly" ~== critter)
}
}
end
link printf</lang>
Sample output omitted.
printf.icn provides printf formatting
J
This defines T to be the required text.
<lang j>T=: e=:3 :'T=:T,y,LF' E=:e@,&'.' O=:'I know an old lady who swallowed a 'E@,] I=:e bind('I dont know why she swallowed the fly.',LF,'Perhaps shell die.',LF) I O 'fly' O P=:'spider' E 'That wriggled and jiggled and tickled inside her' I E A=:'She swallowed the spider to catch the fly' N=:4 :0
O x E y,'. To swallow a ',x I E A=:'She swallowed the ',x,' to catch the ',P,'.',LF,A P=:x
) 'Bird'N'Quite absurd' 'Cat'N'Fancy that' 'Dog'N'What a hog' 'Pig'N'Her mouth was so big' 'Goat'N'She just opened her throat' 'Cow'N'I dont know how' 'Donkey'N'It was rather wonky' O'Horse' E'Shes dead, of course!'</lang>
PHP
<lang php><?php
$swallowed = array(
array('swallowed' => 'fly.',
'reason' => "I don't know why she swallowed the fly."),
array('swallowed' => 'spider,',
'aside' => "which wiggled and jiggled and tickled inside her.",
'reason' => "She swallowed the spider to catch the fly"),
array('swallowed' => 'bird.',
'aside' => "How absurd! To swallow a bird!",
'reason' => "She swallowed the bird to catch the spider,"),
array('swallowed' => 'cat.',
'aside' => "Imagine that! To swallow a cat!",
'reason' => "She swallowed the cat to catch the bird."),
array('swallowed' => 'dog.',
'aside' => "What a hog! To swallow a dog!",
'reason' => "She swallowed the dog to catch the cat."),
array('swallowed' => 'horse',
'aside' => "She's dead, of course. She swallowed a horse!",
'reason' => "She swallowed the horse to catch the dog."));
foreach($swallowed as $creature) {
print "I knew an old lady who swallowed a " . $creature['swallowed'] . "\n";
if(array_key_exists('aside', $creature))
print $creature['aside'] . "\n";
$reversed = array_reverse($swallowed); $history = array_slice($reversed, array_search($creature, $reversed));
foreach($history as $note)
{
print $note['reason'] . "\n";
}
if($swallowed[count($swallowed) - 1] == $creature) print "But she sure died!\n"; else print "Perhaps she'll die." . "\n\n";
}</lang>