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.

Old lady swallowed a fly is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

ALGOL 68

Using Logic

Works with: ALGOL 68 version Revision 1 - no extensions to language used.

Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

<lang algol68>#!/usr/local/bin/a68g --script #

STRING

 sw="swallow",swd=sw+"ed",
 ikn="I know an old lady who "+swd+" a ",
 tsa=". To "+sw+" a ",
 sst="She "+swd+" the ",tct=" to catch the ",
 dky="I don't know why she "+swd+" the fly.",
 die="Perhaps she'll die.";

INT count pr := 0; [9]STRING pr;

PROC vs = (STRING wot,[]STRING co)VOID: (

 printf(($g$,ikn,wot,".",$l$));
 IF UPB co = 1 THEN
   printf(($gl$,co))
 ELIF UPB co > 1 THEN
   printf(($g$,co,wot+".",$l$))
 FI;
 IF count pr NE UPB pr THEN
   pr[count pr+:=1]:=wot;
   FOR i FROM count pr BY -1 TO 2 DO
     printf(($gl$,sst+pr[i]+tct+pr[i-1]+"."))
   OD;
   printf(($glg2l$,dky,die))
 FI

);

vs("fly",()); vs("spider","That wriggled and jiggled and tickled inside her."); vs("Bird",("Quite absurd",tsa)); vs("Cat",("Fancy that",tsa)); vs("Dog",("What a hog",tsa)); vs("Pig",("Her mouth was so big",tsa)); vs("Goat",("She just opened her throat",tsa)); vs("Cow",("I don't know how",tsa)); vs("Donkey",("It was rather wonky",tsa)); vs("Horse","She's dead, of course!")</lang>

Using a dictionary

Works with: ALGOL 68 version Revision 1 - no extensions to language used.

Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

<lang algol68>#!/usr/local/bin/a68g --script #

STRING a="WBXAY",b="WCXBY",c="WDXCY",d="WEXDY",

      e="WFXEY",f="WGXFY",g="WHXGY",h="WIXHY",
      k="K",z="Z",l="";

[]STRING

 w=( # Assuming ASCII ordering #
   "fly","spider","Bird","Cat","Dog","Pig","Goat","Cow","Donkey","Horse",

   "I don't know why she swallowed the fly.",
   "That wriggled and jiggled and tickled inside her.",
   "Quite absurd","Fancy that","What a hog",
   "Her mouth was so big","She just opened her throat",
   "I don't know how","It was rather wonky",
   "She's dead, of course!",

   "I know an old lady who swallowed a ",
   ". To swallow a ",
   "She swallowed the "," to catch the ",".",
   "Perhaps she'll die."),
 v=(
   "UAY",k,z,l,
   "UBY","L",a,k,z,l,
   "UCY","MVCY",b,a,k,z,l,
   "UDY","NVDY",c,b,a,k,z,l,
   "UEY","OVEY",d,c,b,a,k,z,l,
   "UFY","PVFY",e,d,c,b,a,k,z,l,
   "UGY","QVGY",f,e,d,c,b,a,k,z,l,
   "UHY","RVHY",g,f,e,d,c,b,a,k,z,l,
   "UIY","SVIY",h,g,f,e,d,c,b,a,k,z,l,
   "UJY","T");

FOR i TO UPB v DO

 FOR j TO UPB v[i] DO
   print(w[ABS v[i][j] - ABS "A" + 1])
 OD;
 print(new line)

OD</lang>

C

Boring, ad hoc dictionary based decompression. The encoder was arguably more interesting, though. Output is different from listing in talk page in punctuations and capitalizations. <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

Translation of: C

<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.

Library: Icon Programming Library

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>

Perl

<lang perl>open O, '|-', "uudecode | bunzip2"; print O ; close O;

__DATA__ begin-base64 644 - QlpoOTFBWSZTWUSbX/0AAZRfgAAQYIUACBFgbIA//96gQAK9oAAAxhMTQYIx DIwmDEoAAAAAAxhMTQYIxDIwmBSkiNIaJtCCAzJPU1G4ueVmGZMsMzBz0N5v hr4j29SRSSCZgyv8BDAAdOE3oFIFIhMAQMtm2Zy/MbRs9U1pgzCzGcaGnTYN u5NJ+/D4TfkcZZ39PmNJuN8rxjMrJTfvr8rFkxmTDMGFjDLBleGh3L8zlhuO 9vcq6rom3TonOONxyJ1TlG3dz2Tu3xZNtzTLgZu21y1r0dOW/HLntrgdi9ow hlHTsnRVbJ98DxjYs/K87Q1rJjWazCO7kHbIXUj9DS7dSMHVNSmhwrjHMc8D INk476V5jJDmnOPXZM38aeAd+DUp/39ccxmDEf3H7u30Rk6zDLGZkPYNq9CP Pzj39xsVe+KeupMjKsjONsG6dk1bajByHYPOMHxneP2Og3q+dR9ryGk19o0n onYPUfEfhVc1V+kcbJwmQ/nRwn3Hp6pP4TqvTO/2TfNJkvrrbt8+a9N92oy2 FeXUOI8486Wvor1zajqPDfpwnrn2jOzvo8hkOPrpVajlwnjqPfIry5c0TbKL 559fx8xqpsquRaFYV9I9fT6p7RrI/Gv/F3JFOFCQRJtf/Q== ====</lang>

PHP

This example is incorrect. Please fix the code and remove this message. Details: The program does not produce the correct lyrics. (See talk page)

<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>

Tcl

Because the song is highly repetitive, it compresses wonderfully. <lang tcl>package require Tcl 8.6

puts [zlib inflate [binary decode base64 "

   7VRNa8MwDL3nV2inXkZ+xDa29taxws5q7NZuPSvYDib/fnJKPxwXBoNCx3KTn56t
   p6dEC9hbioAWyAgwKHqIisBHNIaiFICwMX1dLUCQnYUDO6oevJIXrMCngbeUTmHr
   U3pmDAgt64ov/1jEt1pIV1crhQGi09utSbgVsLuIg272KdbWMx1UuvFRCDm8BYGg
   wdCos7hbN/Gknair904HCbj2HZ9gdaKcCKXihOd6j37cUXfPGOrqFW3T81sc560N
   2VItw7nUP23BC23r6jN9ogiK49yCIVuqZTiX+i+sWmo2Y86lv6gLCiLyEwRrPTZt
   4JW6Gc5FT+ZemPtGxy53nQ9ArbSMq6RFOSr+zTM915DwXP00jd8sRoqjIoqR0XpM
   nCtGcDITPI3qxgvc7mWqE4aN5DCknyYy2hfL/MC85lzKjMybxnsP452T83JQNPMg
   JIpHoA001DH88A0=

"]]</lang>