Old lady swallowed a fly

From Rosetta Code
Jump to: navigation, search
Task
Old lady swallowed a fly
You are encouraged to solve this task according to the task description, using any language you may know.

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. This song has multiple versions with slightly different lyrics, so all these programs might not emit identical output.

See also: 99 Bottles of Beer

Contents

[edit] Ada

with Ada.Text_IO, Ada.Containers.Indefinite_Doubly_Linked_Lists; use Ada.Text_IO;
 
procedure Swallow_Fly is
 
package Strings is new Ada.Containers.Indefinite_Doubly_Linked_Lists(String);
 
Lines, Animals: Strings.List;
 
procedure Swallow(Animal: String;
Second_Line: String;
Permanent_Second_Line: Boolean := True) is
 
procedure Print(C: Strings.Cursor) is
begin
Put_Line(Strings.Element(C));
end Print;
 
begin
Put_Line("There was an old lady who swallowed a " & Animal & ",");
Put_Line(Second_Line);
if not Animals.Is_Empty then
Lines.Prepend("She swallowed the " & Animal & " to catch the " &
Animals.Last_Element & ",");
end if;
Lines.Iterate(Print'Access);
New_Line;
if Permanent_Second_Line then
Lines.Prepend(Second_Line);
end if;
Animals.Append(Animal); -- you need "to catch the " most recent animal
end Swallow;
 
procedure Swallow_TSA(Animal: String; Part_Of_Line_2: String) is
begin
Swallow(Animal, Part_Of_Line_2 &", to swallow a " & Animal & ";", False);
end Swallow_TSA;
 
procedure Swallow_SSA(Animal: String; Part_Of_Line_2: String) is
begin
Swallow(Animal, Part_Of_Line_2 &" she swallowed a " & Animal & ";", False);
end Swallow_SSA;
 
begin
Lines.Append("Perhaps she'll die!");
 
Swallow("fly", "But I don't know why she swallowed the fly,");
Swallow("spider", "That wriggled and jiggled and tickled inside her;");
Swallow_TSA("bird", "Quite absurd");
Swallow_TSA("cat", "Fancy that");
Swallow_TSA("dog", "What a hog");
Swallow_TSA("pig", "Her mouth was so big");
Swallow_TSA("goat","She just opened her throat");
Swallow_SSA("cow", "I don't know how");
Swallow_TSA("donkey", "It was rather wonky");
 
Put_Line("There was an old lady who swallowed a horse ...");
Put_Line("She's dead, of course!");
end Swallow_Fly;

[edit] ALGOL 68

[edit] 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.
#!/usr/local/bin/a68g --script #
 
STRING sw=" swallow ",swd=sw[:UPB sw-1]+"ed ", tsa=". To"+sw+"a";
 
INT count prev := 0; [9]STRING prev;
 
PROC vs = (STRING in wot,[]STRING co)VOID: (
STRING wot = " "+in wot;
printf(($g$,"I know an old lady who",swd,"a",wot,".",$l$));
IF UPB co = 1 THEN
printf(($gl$,co))
ELIF UPB co > 1 THEN
printf(($g$,co,wot+".",$l$))
FI;
IF count prev NE UPB prev THEN
prev[count prev+:=1]:=wot;
FOR i FROM count prev BY -1 TO 2 DO
printf(($gl$,"She"+swd+"the"+prev[i]+" to catch the"+prev[i-1]+"."))
OD;
printf(($gl$,"I don't know why she"+swd+"the fly.",
"Perhaps she'll die.", $l$))
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!")

[edit] 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.
#!/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

[edit] AWK

 
# syntax: GAWK -f OLD_LADY_SWALLOWED_A_FLY.AWK
BEGIN {
arr[++i] = "fly/"
arr[++i] = "spider/That wriggled and jiggled and tickled inside her"
arr[++i] = "bird/Quite absurd@"
arr[++i] = "cat/Fancy that@"
arr[++i] = "dog/What a hog@"
arr[++i] = "pig/Her mouth was so big@"
arr[++i] = "goat/Opened her throat and down went the goat"
arr[++i] = "cow/I don't know how@"
arr[++i] = "donkey/It was rather wonkey@"
arr[++i] = "horse/She's dead of course"
leng = i # array length
for (i=1; i<=leng; i++) {
s = arr[i]
A[i] = substr(s,1,index(s,"/")-1) # critter name
text = substr(s,index(s,"/")+1)
sub(/@/," to swallow a "A[i],text)
printf("I know an old lady who swallowed a %s.\n",A[i])
if (text != "") {
printf("%s.\n",text)
}
if (i == leng) {
break
}
for (j=i; j>1; j--) {
printf("She swallowed the %s to catch the %s.\n",A[j],A[j-1])
}
printf("I don't know why she swallowed the fly.\n")
printf("Perhaps she'll die.\n\n")
}
exit(0)
}
 

[edit] 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.

#include <stdio.h>
 
const 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(const 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;
}

[edit] D

Translation of: C
import core.stdc.stdio: putchar;
 
immutable data = [
"_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(in string part, bool s=false) nothrow {
foreach (immutable ch; part) {
if (s)
s = oldLady(data[ch - '_'], false);
else if (ch == '_')
s = true;
else
putchar(ch == '/' ? '\n' : ch);
}
 
return s;
}
 
void main() {
data[0].oldLady;
}

A more structured alternative version:

enum Action { once, every, die }
 
immutable struct T {
string anim;
Action act;
string phrase;
}
 
immutable T[] animals;
 
pure nothrow static this() {
with (Action) animals = [
T("horse", die, "She's dead, of course!"),
T("donkey", once, "It was rather wonky. To swallow a donkey."),
T("cow", once, "I don't know how. To swallow a cow."),
T("goat", once, "She just opened her throat. To swallow a goat."),
T("pig", once, "Her mouth was so big. To swallow a pig."),
T("dog", once, "What a hog. To swallow a dog."),
T("cat", once, "Fancy that. To swallow a cat."),
T("bird", once, "Quite absurd. To swallow a bird."),
T("spider", once, "That wriggled and jiggled and tickled inside her."),
T("fly", every, "I don't know why she swallowed the fly.")];
}
 
void main() {
import std.stdio;
 
foreach_reverse (immutable i; 0 .. animals.length) {
writeln("I know an old lady who swallowed a ",
animals[i].anim, ".");
animals[i].phrase.writeln;
 
if (animals[i].act == Action.die)
break;
 
foreach (immutable j, immutable r; animals[i + 1 .. $]) {
writeln("She swallowed the ", animals[i + j].anim,
" to catch the ", r.anim, ".");
if (r.act == Action.every)
r.phrase.writeln;
}
 
"Perhaps she'll die.\n".writeln;
}
}

[edit] Forth

swallow-addr is obviously a good candidate for an object, but Forth has many OO candidates - we won't settle that argument here.

: 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!" ;

[edit] Frege

Translation of: Haskell
Works with: Frege version 3.20.113

Nearly identical to the Haskell. Only the first line and last line of the program had to be changed at all.

module OldLady where
 
import Data.List
 
-- Once means the phrase is only printed in the verse about that animal.
-- Every means the phrase is printed for every verse. It is used for "fly",
-- and could optionally be used for "spider", in the version of the song where
-- "wriggled and jiggled..." is repeated every verse.
-- Die is only used for the horse, and means the chain of animals won't be
-- included in the verse.
data AnimalAction = Once | Every | Die
 
animals = [("horse", Die, "She's dead, of course!"),
("donkey", Once, "It was rather wonky. To swallow a donkey."),
("cow", Once, "I don't know how. To swallow a cow."),
("goat", Once, "She just opened her throat. To swallow a goat."),
("pig", Once, "Her mouth was so big. To swallow a pig."),
("dog", Once, "What a hog. To swallow a dog."),
("cat", Once, "Fancy that. To swallow a cat."),
("bird", Once, "Quite absurd. To swallow a bird."),
("spider", Once, "That wriggled and jiggled and tickled inside her."),
("fly", Every, "I don't know why she swallowed the fly.")]
 
verse :: [(String, AnimalAction, String)] -> [String]
verse ((anim, act, phrase):restAnims) =
let lns = ["I know an old lady who swallowed a " ++ anim ++ ".", phrase]
in case act of Die -> lns
_ -> lns ++ verse' restAnims anim
 
verse' :: [(String, AnimalAction, String)] -> String -> [String]
verse' [] _ = ["Perhaps she'll die."]
verse' ((anim, act, phrase):restAnims) prevAnim =
let why = "She swallowed the " ++ prevAnim ++ " to catch the " ++ anim ++ "."
lns = case act of Every -> [why, phrase]
_ -> [why]
in lns ++ verse' restAnims anim
 
song :: [String]
song = intercalate [""] $ map verse $ tail $ reverse $ tails animals
 
main _ = printStr $ unlines song

[edit] Haskell

#!/usr/bin/runhaskell
 
import Data.List
 
-- Once means the phrase is only printed in the verse about that animal.
-- Every means the phrase is printed for every verse. It is used for "fly",
-- and could optionally be used for "spider", in the version of the song where
-- "wriggled and jiggled..." is repeated every verse.
-- Die is only used for the horse, and means the chain of animals won't be
-- included in the verse.
data AnimalAction = Once | Every | Die
 
animals = [("horse", Die, "She's dead, of course!"),
("donkey", Once, "It was rather wonky. To swallow a donkey."),
("cow", Once, "I don't know how. To swallow a cow."),
("goat", Once, "She just opened her throat. To swallow a goat."),
("pig", Once, "Her mouth was so big. To swallow a pig."),
("dog", Once, "What a hog. To swallow a dog."),
("cat", Once, "Fancy that. To swallow a cat."),
("bird", Once, "Quite absurd. To swallow a bird."),
("spider", Once, "That wriggled and jiggled and tickled inside her."),
("fly", Every, "I don't know why she swallowed the fly.")]
 
verse :: [(String, AnimalAction, String)] -> [String]
verse ((anim, act, phrase):restAnims) =
let lns = ["I know an old lady who swallowed a " ++ anim ++ ".", phrase]
in case act of Die -> lns
_ -> lns ++ verse' restAnims anim
 
verse'
:: [(String, AnimalAction, String)] -> String -> [String]
verse' [] _ = ["Perhaps she'll die."]
verse' ((anim, act, phrase):restAnims) prevAnim =
let why = "
She swallowed the " ++ prevAnim ++ " to catch the " ++ anim ++ "."
lns = case act of Every -> [why, phrase]
_ -> [why]
in lns ++ verse' restAnims anim
 
song :: [String]
song = intercalate ["
"] $ map verse $ tail $ reverse $ tails animals
 
main = putStr $ unlines song

[edit] 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.

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

Sample output omitted.

printf.icn provides printf formatting

[edit] J

This defines T to be the required text.

T=:''
e=:3 :'T=:T,y,LF'
E=:e@,&'.'
O=:'I know an old lady who swallowed a 'E@,]
I=:e bind('I don''t know why she swallowed the fly.',LF,'Perhaps she''ll 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 don''t know how'
'Donkey'N'It was rather wonky'
O'Horse'
e'She''s dead, of course!'

[edit] OCaml

[edit] Using a dictionary

Only one minimalist line of code (the last line):

let d = [|
"I know an old lady who swallowed a "; "fly"; ".\n";
"I don't know why she swallowed the fly.\nPerhaps she'll die.\n\n";
"spider"; "That wriggled and jiggled and tickled inside her";
"She swallowed the "; " to catch the "; "Bird"; "Quite absurd";
". To swallow a "; "Cat"; "Fancy that"; "Dog"; "What a hog"; "Pig";
"Her mouth was so big"; "Goat"; "She just opened her throat"; "Cow";
"I don't know how"; "Donkey"; "It was rather wonky";
"I know an old lady who swallowed a Horse.\nShe's dead, of course!\n";
|]
 
let s0 = [6;4;7;1;2;3]
let s1 = [6;8;7;4;2] @ s0
let s2 = [6;11;7;8;2] @ s1
let s3 = [6;13;7;11;2] @ s2
let s4 = [6;15;7;13;2] @ s3
let s5 = [6;17;7;15;2] @ s4
let s6 = [6;19;7;17;2] @ s5
let s7 = [6;21;7;19;2] @ s6
 
let s =
[0;1;2;3;0;4;2;5;2] @ s0 @
[0;8;2;9;10;8;2] @ s1 @
[0;11;2;12;10;11;2] @ s2 @
[0;13;2;14;10;13;2] @ s3 @
[0;15;2;16;10;15;2] @ s4 @
[0;17;2;18;10;17;2] @ s5 @
[0;19;2;20;10;19;2] @ s6 @
[0;21;2;22;10;21;2] @ s7 @
[23] ;;
 
List.iter (fun i -> print_string d.(i)) s

[edit] Using dictionary based decompression

Translation of: D

Here we use the function String.fold_left 1 which is not available in the standard library but in the extlib:

let dict = [|
"_ha _c _e _p,\nQuite absurd_f_p;_`cat,\nFancy that_fcat;_j`dog,\nWhat a hog_\
fdog;_l`pig,\nHer mouth_qso big_fpig;_d_r,\nShe just opened her throat_f_r;_i\
cow,\n_mhow she_ga cow;_k_o,\nIt_qrather wonky_f_o;_a_o_bcow,_khorse...\nShe'\
s dead, of course!\n"
;"_a_p_b_e ";"\nS_t ";" to catch the ";"fly,\nBut _mwhy \
s_t fly,\nPerhaps she'll die!\n\n_ha"
;"_apig_bdog,_l`";"spider,\nThat wr_nj_n\
tickled 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";" swallow";"he_gthe" |]
 
let rec old_lady part s =
ExtString.String.fold_left (fun s c ->
if s then old_lady dict.(Char.code c - 95) false
else if c = '_' then true
else (print_char c; s)
) s part
 
let _ =
old_lady dict.(0) false

[edit] Using Logic

let an =
[| "fly"; "spider"; "bird"; "cat"; "dog"; "pig"; "goat"; "cow"; "donkey" |]
 
let cm =
[| "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"; |]
 
let p = Printf.printf
 
let h n =
for i = n downto 1 do
if i = 1 then
p "That wriggled and jiggled and tickled inside her;\n";
p "She swallowed the %s to catch the %s,\n" an.(i) an.(i-1)
done
 
let g n =
if n >= 2 then p "%s, to swallow a %s;\n" cm.(n-2) an.(n)
 
let f n =
p "There was an old lady who swallowed a %s,\n" an.(n); g n; h n;
p "But I don't know why she swallowed the fly,\nPerhaps she'll die!\n\n"
 
let () =
for i = 0 to 8 do f i done;
p "There was an old lady who swallowed a horse...\n\
She's dead, of course!"

[edit] Perl

Using string subst:
my @animals = (
"fly",
"spider/That wriggled and jiggled and tickled inside her.\n",
"bird//Quite absurd!",
"cat//Fancy that!",
"dog//What a hog!",
"pig//Her mouth was so big!",
"goat//She just opened her throat!",
"cow//I don't know how;",
"donkey//It was rather wonkey!",
"horse:",
);
 
my $s = "swallow";
my $e = $s."ed";
my $t = "There was an old lady who $e a ";
my $_ = $t."But I don't know why she $e the fly;\nPerhaps she'll die!\n\n";
 
my ($a, $b, $c, $d);
while (my $x = shift @animals) {
s/$c//;
($a, $b, $c) = split('/', $x);
$d = " the $a";
 
$c =~ s/;/ she $e$d;\n/;
$c =~ s/!/, to $s$d;\n/;
 
s/$t/"$t$a,\n$c".(($b||$c) && "${b}She $e$d to catch the ")/e;
 
s/:.*/--\nShe's dead, of course!\n/s;
print;
}

Using compression: (Assumes a Unix-like OS and the availability of the uudecode and bunzip2 utilities).

open OUT, "| uudecode | bunzip2" and
print OUT <DATA> and
close OUT;
 
__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==
====

[edit] Perl 6

my @victims =
fly => " I don't know why S—",
spider => " That wriggled and jiggled and tickled inside her.",
bird => " How absurd, T!",
cat => " Fancy that, S!",
dog => " What a hog, T!",
goat => " She just opened her throat, and in walked the goat!",
cow => " I don't know how S!",
horse => " She's dead, of course...";
 
my @history = "I guess she'll die...\n";
 
for @victims».kv -> $victim, $_ is copy {
say "There was an old lady who swallowed a $victim...";
 
s/ «S» /she swallowed the $victim/;
s/ «T» /to swallow a $victim!/;
.say;
last when /dead/;
 
@history[0] ~~ s/^X/She swallowed the $victim/;
.say for @history;
@history.unshift($_) if @history < 5;
@history.unshift("X to catch the $victim,");
}

And that's how I larned it!

[edit] 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";
}

[edit] PicoLisp

Translation of: C
(de *Dict
`(chop
"_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!/" )
`(chop "_a_p_b_e ")
`(chop "/S_t ")
`(chop " to catch the ")
`(chop "fly,/But _mwhy s_t fly,/Perhaps she'll die!//_ha")
`(chop "_apig_bdog,_l`")
`(chop "spider,/That wr_nj_ntickled inside her;_aspider_b_c")
`(chop ", to_s a ")
`(chop "_sed ")
`(chop "There_qan old lady who_g")
`(chop "_a_r_bpig,_d")
`(chop "_acat_b_p,_")
`(chop "_acow_b_r,_i")
`(chop "_adog_bcat,_j")
`(chop "I don't know ")
`(chop "iggled and ")
`(chop "donkey")
`(chop "bird")
`(chop " was ")
`(chop "goat")
`(chop " swallow")
`(chop "he_gthe") )
 
(de oldLady (Lst Flg)
(loop
(let C (pop 'Lst)
(cond
(Flg
(setq Flg
(oldLady (get *Dict (- (char C) 94))) ) )
((= "_" C) (on Flg))
((= "/" C) (prinl))
(T (prin C)) ) )
(NIL Lst) )
Flg )
 
(oldLady (car *Dict))

[edit] Python

import zlib, base64
 
b64 = b'''
eNrtVE1rwzAMvedXaKdeRn7ENrb21rHCzmrs1m49K9gOJv9+cko/HBcGg0LHcpOfnq2np0QL
2FuKgBbICDAoeoiKwEc0hqIUgLAxfV0tQJCdhQM7qh68kheswKeBt5ROYetTemYMCC3rii//
WMS3WkhXVyuFAaLT261JuBWwu4iDbvYp1tYzHVS68VEIObwFgaDB0KizuFs38aSdqKv3TgcJ
uPYdn2B1opwIpeKE53qPftxRd88Y6uoVbdPzWxznrQ3ZUi3DudQ/bcELbevqM32iCIrj3IIh
W6plOJf6L6xaajZjzqW/qAsKIvITBGs9Nm3glboZzkVP5l6Y+0bHLnedD0CttIyrpEU5Kv7N
Mz3XkPBc/TSN3yxGiqMiipHRekycK0ZwMhM8jerGC9zuZaoTho3kMKSfJjLaF8v8wLzmXMqM
zJvGew/jnZPzclA08yAkikegDTTUMfzwDXBcwoE='''

print(zlib.decompress(base64.b64decode(b64)).decode("utf-8", "strict"))

[edit] Racket

 
#lang at-exp racket
 
(define (line . xs) (for-each display xs) (newline))
 
(let loop ([animals
'([fly #f]
[spider "That wriggled and wiggled and tiggled inside her"]
[bird "How absurd to swallow a bird"]
[cat "Fancy that to swallow a cat"]
[dog "What a hog, to swallow a dog"]
[cow "I don't know how she swallowed a cow"]
[horse "She's dead, of course"])]
[seen '()])
(when (pair? animals)
(match animals
[(list (list animal desc) more ...)
@line{There was an old lady that swallowed a @animal,}
(when desc @line{@|desc|.})
(when (pair? more)
(for ([this (cons animal seen)] [that seen])
@line{She swallowed the @this to catch the @that,})
@line{I don't know why she swallowed a fly - perhaps she'll die!}
@line{}
(loop more (cons animal seen)))])))
 

Alternative solution:

 
#lang s-exp framework/private/decode
7VK7TsQwEOz9FcM1AcncZyCoQaLey/piCyuObJ+s/D3rXHj4lIIKgaCItJkZ7cyOfM0uTZ5m
7J6siQaFEmhE8AxPPCNbykiFvA/FMAhHP2v1AA5jl/EyhoJiZyRrLlW4xWSipSlVtvMe7MyV
Ul/0SZNjE7XIhSjRDYOv+Mgon+a8zm5MIoes3qvHJkuuf8su5ICecm8X7LvuOLjIWt3Lfjqk
U+SaYuVXditxxdu8b338rOvEUas7GvuVa44Tcuu2/qz7CHuu6PeWwGHQ6rmiBCtz24KwWy0I
3KZdqvwDbfWhXPhY+S59RLX5dkTapF66/2/3fYMNMZklVJfAhlgjHKW2k8B7tbtRrw==
 

[edit] REXX

/*REXX program to display the lyrics for the song: "I Know an Old Lady".*/
@ = 'fly spider bird cat dog goat cow horse'  ; #=words(@)
first = "I know an old lady who swallowed a"  ; sw=79
@ate = 'She swallowed the'; @2catch= "to catch the"  ; @.=
@.1 = "I don't know why she swallowed a fly,"
@.2 = "That wriggled and jiggled and tickled inside her."; @.2.0=1
@.3 = "How absurd to swallow a bird!"
@.4 = "Imagine that, to swallow a cat!"
@.5 = "My, what a hog, to swallow a dog!"
@.6 = "Just opened her throat and swallowed a goat!"
@.7 = "I wonder how she swallowed a cow?!"
@.8 = "She's dead, of course!!"
 
do j=1 for #; animal=word(@,j); say
say center(first animal',',sw); if j\==1 then say center(@.j, sw)
if j==# then leave
do k=j to 2 by -1; km=k-1
say center(@ate word(@,k) @2catch word(@,km)',',sw)
if @.km.0\=='' then say center(@.km, sw)
end /*k*/
say center(@.1, sw)
say center("I guess she'll die.", sw)
end /*j*/
/*stick a fork in it, we're done.*/

[edit] Ruby

descriptions = {
:fly => "I don't know why S",
:spider => "That wriggled and jiggled and tickled inside her.",
:bird => "Quite absurd T",
:cat => "Fancy that, S",
:dog => "What a hog, S",
:goat => "She opened her throat T",
:cow => "I don't know how S",
:horse => "She's dead, of course.",
}
animals = descriptions.keys
 
animals.each_with_index do |animal, idx|
puts "There was an old lady who swallowed a #{animal}."
 
d = descriptions[animal]
case d[-1]
when "S" then d[-1] = "she swallowed a #{animal}."
when "T" then d[-1] = "to swallow a #{animal}."
end
puts d
break if animal == :horse
 
idx.downto(1) do |i|
puts "She swallowed the #{animals[i]} to catch the #{animals[i-1]}."
case animals[i-1]
when :spider, :fly then puts descriptions[animals[i-1]]
end
end
 
print "Perhaps she'll die.\n\n"
end

[edit] Tcl

Because the song is highly repetitive, it compresses wonderfully.

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=
"
]]

[edit] TXR

Here is somewhat verbose program showing a different approach.

The idea is to start with the last two verses of the song, and then work backwards to produce the earlier verses. This is done by recursively pattern matching on the song to extract text and produce the earlier verse, which is then prepended to the song.

The later verse does not contain one key piece of information we need to produce the prior verse: the animal-specific answer line for the prior animal. So we look this up by scanning a text which serves as a table.

The recursion terminates when the second pattern case matches the first verse: the third line is "Perhaps she'll die". In this case the song is not lengthened any more, and a terminating flag variable is bound to true.

Note one detail: in the first verse we have "... don't know why she swallowed the fly". But in subsequent verses it is "that fly" not "the fly". So we do a lookup on the fly also to substitute the appropriate line, and in the fly case we skip the original line (see the first @(maybe)).

@(deffilter abbr
("IK" "I know an old lady who swallowed a") ("SW" "She swallowed the")
("SS" "she swallowed") ("CA" "to catch the") ("XX" "Perhaps she'll die")
("C" "cow") ("G" "goat") ("D" "dog") ("T" "cat") ("R" "bird")
("S " "spider ") ("F" "fly"))
@(bind lastverse
("IK C"
"I don't know how SS the C"
"SW C CA G"
"SW G CA D"
"SW D CA T"
"SW T CA R"
"SW R CA S"
"SW S CA F"
"But I don't know why SS that F"
"XX"
""
"IK horse"
"She's alive and well of course!"))
@(bind animal_line
("G: Opened her throat and down went the G!"
"D: What a hog to swallow a D!"
"T: Imagine that! She swallowed a T!"
"R: How absurd to swallow a R!"
"S: That wriggled and jiggled and tickled inside her"
"F: But I don't know why SS the F"))
@(define expand_backwards (song lengthened_song done))
@ (local line2 line3 verse rest animal previous_animal previous_animal_verse)
@ (next :list song)
@ (cases)
IK @animal
@line2
SW @animal CA @previous_animal
@ (maybe)
But @(skip)F
@ (end)
@ (collect)
@ verse
@ (until)
 
@ (end)
@ (collect)
@ rest
@ (end)
@ (next :list animal_line)
@ (skip)
@previous_animal: @previous_animal_verse
@ (output :into lengthened_song)
IK @previous_animal
@previous_animal_verse
@ (repeat)
@ verse
@ (end)
 
@ (repeat)
@ song
@ (end)
@ (end)
@ (bind done nil)
@ (or)
IK @(skip)
@line2
XX
@ (bind lengthened_song song)
@ (bind done t)
@ (end)
@(end)
@(define expand_song (in out))
@ (local lengthened done)
@ (expand_backwards in lengthened done)
@ (cases)
@ (bind done nil)
@ (expand_song lengthened out)
@ (or)
@ (bind out lengthened)
@ (end)
@(end)
@(expand_song lastverse song)
@(output :filter abbr)
@ (repeat)
@song
@ (end)
@(end)
Personal tools
Namespaces

Variants
Actions
Community
Explore
Misc
Toolbox