Word Morph

Ask a Question

Create a Post

All Posts : Applications, Examples and Libraries

Posted: Christopher2222 5805 Product: Maple

June 06 2022

Here's a procedure using GraphTheory by morphing one four letter word into another by changing only one letter at a time. This is my initial working version. I've commented out the DrawGraph portion as it takes a long time (5 minutes or so) to produce. Using the Neighbors command from the GraphTheory package the graph can be shrunk to only include the relevant paths and will take a shorter time to draw. It's an initial version so there is room for improvements.

The word morph procedure for 4 letter words.

$morph := proc (w1::string, w2::string) local c, i, q, d, r, j, k, g, gg, sp; c := {seq(`if`(HammingDistance(w1, b[i]) = 1, b[i], NULL), i = 1 .. nops(b))}; q := {seq(`if`(HammingDistance(w2, b[i]) = 1, b[i], NULL), i = 1 .. nops(b))}; for i to nops(c) do c || i := {seq(`if`(HammingDistance(c[i], b[j]) = 1, b[j], NULL), j = 1 .. nops(b))} end do; for i to nops(q) do q || i := {seq(`if`(HammingDistance(q[i], b[j]) = 1, b[j], NULL), j = 1 .. nops(b))} end do; d := map(proc (x) options operator, arrow; {x, w1} end proc, c); r := map(proc (x) options operator, arrow; {x, w2} end proc, q); for i to nops(c) do d || i := map(proc (x) options operator, arrow; {c[i], x} end proc, c || i) end do; for i to nops(q) do r || i := map(proc (x) options operator, arrow; {q[i], x} end proc, q || i) end do; for k to nops(c) do for j to nops(c || k) do c || k || _ || j := {seq(`if`(HammingDistance(c || k[j], b[i]) = 1, b[i], NULL), i = 1 .. nops(b))} end do end do; for k to nops(q) do for j to nops(q || k) do q || k || _ || j := {seq(`if`(HammingDistance(q || k[j], b[i]) = 1, b[i], NULL), i = 1 .. nops(b))} end do end do; for i to nops(c) do for j to nops(c || i) do d || i || _ || j := map(proc (x) options operator, arrow; {c || i[j], x} end proc, c || i || _ || j) end do end do; for i to nops(q) do for j to nops(q || i) do r || i || _ || j := map(proc (x) options operator, arrow; {q || i[j], x} end proc, q || i || _ || j) end do end do; g := {d[], r[], seq(d || i[], i = 1 .. nops(c)), seq(r || k[], k = 1 .. nops(q)), seq(seq(d || j || _ || i[], i = 1 .. nops(c || j)), j = 1 .. nops(c)), seq(seq(r || j || _ || i[], i = 1 .. nops(q || j)), j = 1 .. nops(q))}; gg := GraphTheory:-Graph(g); sp := GraphTheory:-ShortestPath(gg, w1, w2); print(sp) end proc$
Today, June 6 is international yoyo day. So I start off with, of course, the word yoyo.