Word ladder: Difference between revisions
+algol68
Alextretyak (talk | contribs) (Added 11l) |
(+algol68) |
||
Line 87:
bubble -> babble -> gabble -> garble -> gargle -> gaggle -> giggle -> jiggle -> jingle -> tingle -> tinkle -> tickle
</pre>
=={{header|ALGOL 68}}==
With ''a68g'' use option <code>--storage 2</code>, otherwise it runs out of memory.
<lang algol68># quick implementation of a stack of INT.
real program starts after it.
#
MODE STACK = STRUCT (INT top, FLEX[1:0]INT data, INT increment);
PROC makestack = (INT increment)STACK: (1, (), increment);
PROC pop = (REF STACK s)INT: ( top OF s -:= 1; (data OF s)[top OF s] );
PROC push = (REF STACK s, INT n)VOID:
BEGIN
IF top OF s > UPB data OF s THEN
[ UPB data OF s + increment OF s ]INT tmp;
tmp[1 : UPB data OF s] := data OF s;
data OF s := tmp
FI;
(data OF s)[top OF s] := n;
top OF s +:= 1
END;
PROC empty = (REF STACK s)BOOL: top OF s <= 1;
PROC contents = (REF STACK s)[]INT: (data OF s)[:top OF s - 1];
# start solution #
[]STRING words = BEGIN # load dictionary file into array #
FILE f;
BOOL eof := FALSE;
open(f, "unixdict.txt", stand in channel);
on logical file end(f, (REF FILE f)BOOL: eof := TRUE);
INT idx := 1;
FLEX [1:0] STRING words;
STRING word;
WHILE NOT eof DO
get(f, (word, newline));
IF idx > UPB words THEN
HEAP [1 : UPB words + 10000]STRING tmp;
tmp[1 : UPB words] := words;
words := tmp
FI;
words[idx] := word;
idx +:= 1
OD;
words[1:idx-1]
END;
INT nwords = UPB words;
INT max word length = (INT mwl := 0;
FOR i TO UPB words DO
IF mwl < UPB words[i] THEN mwl := UPB words[i] FI
OD;
mwl);
[nwords]FLEX[0]INT neighbors;
[max word length]BOOL precalculated by length;
FOR i TO UPB precalculated by length DO precalculated by length[i] := FALSE OD;
# precalculating neighbours takes time, but not doing it is even slower... #
PROC precalculate neighbors = (INT word length)VOID:
BEGIN
[nwords]REF STACK stacks;
FOR i TO UPB stacks DO stacks[i] := NIL OD;
FOR i TO UPB words DO
IF UPB words[i] = word length THEN
IF REF STACK(stacks[i]) :=: NIL THEN stacks[i] := HEAP STACK := makestack(10) FI;
FOR j FROM i + 1 TO UPB words DO
IF UPB words[j] = word length THEN
IF neighboring(words[i], words[j]) THEN
push(stacks[i], j);
IF REF STACK(stacks[j]) :=: NIL THEN stacks[j] := HEAP STACK := makestack(10) FI;
push(stacks[j], i)
FI
FI
OD
FI
OD;
FOR i TO UPB neighbors DO
IF REF STACK(stacks[i]) :/=: NIL THEN
neighbors[i] := contents(stacks[i])
FI
OD;
precalculated by length [word length] := TRUE
END;
PROC neighboring = (STRING a, b)BOOL: # do a & b differ in just 1 char? #
BEGIN
INT diff := 0;
FOR i TO UPB a DO IF a[i] /= b[i] THEN diff +:= 1 FI OD;
diff = 1
END;
PROC word ladder = (STRING from, STRING to)[]STRING:
BEGIN
IF UPB from /= UPB to THEN fail FI;
INT word length = UPB from;
IF word length < 1 OR word length > max word length THEN fail FI;
IF from = to THEN fail FI;
INT start := 0;
INT destination := 0;
FOR i TO UPB words DO
IF UPB words[i] = word length THEN
IF words[i] = from THEN start := i
ELIF words[i] = to THEN destination := i
FI
FI
OD;
IF destination = 0 OR start = 0 THEN fail FI;
IF NOT precalculated by length [word length] THEN
precalculate neighbors(word length)
FI;
STACK stack := makestack(1000);
[nwords]INT distance;
[nwords]INT previous;
FOR i TO nwords DO distance[i] := nwords+1; previous[i] := 0 OD;
INT shortest := nwords+1;
distance[start] := 0;
push(stack, start);
WHILE NOT empty(stack)
DO
INT curr := pop(stack);
INT dist := distance[curr];
IF dist < shortest - 1 THEN
# find neighbors and add them to the stack #
FOR i FROM UPB neighbors[curr] BY -1 TO 1 DO
INT n = neighbors[curr][i];
IF distance[n] > dist + 1 THEN
distance[n] := dist + 1;
previous[n] := curr;
IF n = destination THEN
shortest := dist + 1
ELSE
push(stack, n)
FI
FI
OD;
IF curr = destination THEN shortest := dist FI
FI
OD;
INT length = distance[destination] + 1;
IF length > nwords THEN fail FI;
[length]STRING result;
INT curr := destination;
FOR i FROM length BY -1 TO 1
DO
result[i] := words[curr];
curr := previous[curr]
OD;
result EXIT
fail: LOC [0] STRING
END;
[][]STRING pairs = (("boy", "man"), ("bed", "cot"),
("old", "new"), ("dry", "wet"),
("girl", "lady"), ("john", "jane"),
("lead", "gold"), ("poor", "rich"),
("lamb", "stew"), ("kick", "goal"),
("cold", "warm"), ("nude", "clad"),
("child", "adult"), ("white", "black"),
("bread", "toast"), ("lager", "stout"),
("bride", "groom"), ("table", "chair"),
("bubble", "tickle"));
FOR i TO UPB pairs
DO
STRING from = pairs[i][1], to = pairs[i][2];
[]STRING ladder = word ladder(from, to);
IF UPB ladder = 0
THEN print(("No solution for """ + from + """ -> """ + to + """", newline))
ELSE FOR j TO UPB ladder DO print(((j > 1 | "->" | ""), ladder[j])) OD;
print(newline)
FI
OD</lang>
{{out}}
<pre>boy->bay->ban->man
bed->bad->bat->cat->cot
old->odd->ode->one->nne->nee->new
dry->dey->bey->bet->wet
girl->gill->gall->gale->gaze->laze->lazy->lady
john->cohn->conn->cone->cane->jane
lead->load->goad->gold
poor->boor->book->bock->rock->rick->rich
lamb->lame->laue->laud->saud->spud->sped->spew->stew
kick->dick->dock->cock->cook->cool->coal->goal
cold->cord->card->ward->warm
nude->node->bode->bole->bold->gold->goad->glad->clad
No solution for "child" -> "adult"
white->whine->chine->chink->clink->blink->blank->black
bread->break->bleak->bleat->blest->blast->boast->toast
lager->hager->hagen->haven->raven->ravel->navel->novel->hovel->hotel->motel->monel->money->honey->haney->handy->dandy->danny->denny->penny->peony->phony->phone->shone->shore->short->shout->stout
bride->brice->brick->brock->brook->broom->groom
No solution for "table" -> "chair"
bubble->babble->gabble->garble->gargle->gaggle->giggle->jiggle->jingle->tingle->tinkle->tickle</pre>
=={{header|C++}}==
| |||