with(plots): read `EV3.txt`: read `EV4.txt`: read `EV5.txt`: read `EV6.txt`: read `EV7.txt`: read `EV8.txt`: Help:=proc() if args = NULL then print(`MakeWS(VOC1,VOC2)`, `MakeWSS(VOC1,VOC2,sample_size:=70,give_up:=700)`, `DrawBoard(n,m,clues)`, `DrawFilledBoard(W,clues)`): elif args = 'MakeWS' then print(`MakeWS(VOC1,VOC2) gives a filled word rectangle where all rows are words in VOC1 and all columns are words in VOC2`): elif args = 'MakeWSS' then print(`MakeWS(VOC1,VOC2,sample_size:=70, give_up:=700) gives a filled word rectangle where all rows are words in VOC1 and all columns are words in VOC2. It iteratively adds rows to the word rectangle by sample sample_size many of words in VOC1, and determining whether any of them can be added to the word rectangle while giving partial columns that are prefixes of words in VOC2. After trying to add give_up many rows, it gives up and starts over. For details, see the accompanying write up.`): elif args = 'DrawBoard' then print(`DrawBoard(n,m,clues) produces an image of an empty grid with n rows and m columns with clues printed beneath`): elif args = 'DrawFilledBoard' then print(`DrawFilledBoard(W,clues) produces an image of a completed grid filled with W with clues printed beneath`): else print(`Not a valid function`): fi: end: MakeWSS:=proc(VOC1, VOC2, sample_size:=70, give_up:=700) local l1,l2, output, ra, count, scores, counts, prefs, Vs, I1,J,K, V, pref: l1:=nops(VOC1[1]): l2:=nops(VOC2[1]): output:=[]: #print(nops(VOC1)): ra:=rand(1..nops(VOC1)): count:=0: while nops(output) < l2 do #print(output): Vs:=[seq(VOC1[ra()],i=1..sample_size)]: prefs,counts:=TruncPlus(VOC2,nops(output)+1): scores := [1$sample_size]: for I1 from 1 to l1 do for J from 1 to nops(Vs) do V:=Vs[J]: if scores[J] = 0 then next: fi: pref:=[seq(output[K][I1],K=1..nops(output)), V[I1]]: #print(pref, prefs): if not member(pref, prefs) then scores[J] := 0: else scores[J] := scores[J]*counts[pref]: fi: od: od: #print(output): if convert(scores, `+`) > 0 then J:=WeightedRand(scores): output:=[op(output),Vs[J]]: fi: count:=count+1: if count = 1000 then output := []: count:=0: fi: od: output: end: MakeWS:=proc(VOC1, VOC2) local l1, l2, output, ra, count, v, viable, prefs, pref,i,j: l1:=nops(VOC1[1]): l2:=nops(VOC2[1]): output:=[]: ra:=rand(1..nops(VOC1)): count:=0: while nops(output) < l2 do #print(output): v:=VOC1[ra()]: viable:=true: prefs:=Trunc(VOC2,nops(output)+1): for i from 1 to l1 do pref:=[seq(output[j][i],j=1..nops(output)), v[i]]: #print(pref, prefs): if not member(pref, prefs) then viable:=false: break: fi: od: if viable then output:=[op(output), v]: fi: count:=count+1: if count = 1000 then output := []: count:=0: fi: od: output: end: MakeSWS := proc(VOC1) local l, output, count, d, avail, v, viable, prefs, i, pref: l:=nops(VOC1[1]): output:=[]: #ra:=rand(1..nops(VOC1)): count:=0: while nops(output) < l do #print(output): d:=nops(output): avail:=WordsWithPref(VOC1,[seq(output[i][d+1],i=1..d)]): v:=avail[rand(1..nops(avail))()]: viable:=true: prefs:=Trunc(VOC1,nops(output)+1): for i from 1 to l do pref:=[seq(output[j][i],j=1..nops(output)), v[i]]: if not member(pref, prefs) then #print(pref): viable:=false: break: fi: od: if viable then output:=[op(output), v]: fi: count:=count+1: if count = 1000 then output := []: count:=0: fi: od: output: end: Trunc:=proc(VOC1,k) local output,v: option remember: if k > nops(VOC1[1]) then print(`Too short a word, too long a prefix`): return(FAIL): fi: output:={}: for v in VOC1 do output:=output union {[op(1..k,v)]}: od: output: end: TruncPlus:=proc(VOC1,k) local output, v, counts: option remember: if k > nops(VOC1[1]) then print(`Too short a word, too long a prefix`): return(FAIL): fi: output:={}: counts:=table(): for v in VOC1 do if member([op(1..k,v)], output) then counts[[op(1..k,v)]] := counts[[op(1..k,v)]] + 1: else counts[[op(1..k,v)]] := 1: output:=output union {[op(1..k,v)]}: fi: od: #return({seq([o, counts[o]],o in output)}): output,counts: end: WordsWithPref:=proc(VOC1, pref) local v, output: option remember: output:=[]: for v in VOC1 do if [op(1..nops(pref),v)] = pref then output:=[op(output), v]: fi: od: output: end: #clues should be a list of two lists, the first containing across clues and the second containing down clues DrawBoard:=proc(n,m,clues) local i, lines, textac,textdo: lines:={}: for i from 0 to n do lines:=lines union {plot([[0,i],[m,i]])}: od: for i from 0 to m do lines:=lines union {plot([[i,0],[i,n]])}: od: printf("%s \n", `Across`): for i from 1 to n do printf("%d: %s \n", i, clues[1][i]): od: printf("\n\n%s \n", `Down`): for i from 1 to m do printf("%d: %s \n", i, clues[2][i]): od: #text := textplot({seq(seq([j+.9,n-1-i,W[i+1][j+1]],j=0..(m-1)),i=0..(n-1))},font=['Times','Roman',8]): textac:=textplot({seq([.1,n-1-i+.9,i+1],i=0..(n-1))}): textdo:=textplot({seq([.1+i,n-1+.9,i+1],i=1..(n-1))}): display(lines,textac,textdo,axes=none): end: DrawFilledBoard:=proc(W,clues) local i,j,text,lines,n,m,textac,textdo: n:=nops(W): m:=nops(W[1]): print(n,m): lines:={}: for i from 0 to n do lines:=lines union {plot([[0,i],[m,i]])}: od: for i from 0 to m do lines:=lines union {plot([[i,0],[i,n]])}: od: text := textplot({seq(seq([j+.5,n-1-i+.5,W[i+1][j+1]],j=0..(m-1)),i=0..(n-1))},font=['Times','Roman',20]): textac:=textplot({seq([.1,n-1-i+.9,i+1],i=0..(n-1))}): textdo:=textplot({seq([.1+i,n-1+.9,i+1],i=1..(n-1))}): printf("%s \n", `Across`): for i from 1 to n do printf("%d: %s \n", i, clues[1][i]): od: printf("\n\n%s \n", `Down`): for i from 1 to m do printf("%d: %s \n", i, clues[2][i]): od: display(lines,text,textac,textdo,axes=none): end: WeightedRand:=proc(L) local n, I1, J, current: n:=add(L[I1],I1=1..nops(L)): I1:=rand(1..n)(): current:=0: J:=0: while current < I1 do J:=J+1: current:=current + L[J]: od: J: end: ExportBoard:=proc(W,clues,lab) local i, lines, textac,textdo,f,text,n,m: n:=nops(W): m:=nops(W[1]): lines:={}: for i from 0 to n do lines:=lines union {plot([[0,i],[m,i]])}: od: for i from 0 to m do lines:=lines union {plot([[i,0],[i,n]])}: od: text := textplot({seq(seq([j+.5,n-1-i+.5,W[i+1][j+1]],j=0..(m-1)),i=0..(n-1))},font=['Times','Roman',40]): textac:=textplot({seq([.1,n-1-i+.9,i+1],i=0..(n-1))},font=['Times','Roman',20]): textdo:=textplot({seq([.1+i,n-1+.9,i+1],i=1..(m-1))},font=['Times','Roman',20]): Export(cat("puzz",lab,"grid.jpeg"),display(lines,textac,textdo,axes=none)): Export(cat("puzz",lab,"sol.jpeg"),display(lines,text,textac,textdo,axes=none)): f:=fopen(cat("puzz",lab,".html"),'WRITE','TEXT'): fprintf(f,"\n"): fprintf(f,"
\n"): fprintf(f,"\"A\n",lab,n,m): fprintf(f,"

\n"): fprintf(f,"

\n"): fprintf(f," Across: \n"): for i from 1 to n do fprintf(f,"
\n"): fprintf(f,"   %d. %s\n", i, clues[1][i]): od: fprintf(f,"

\n"): fprintf(f," Down: \n"): for i from 1 to m do fprintf(f,"
\n"): fprintf(f,"   %d. %s\n", i, clues[2][i]): od: fprintf(f,"

\n"): fprintf(f,"

\n"): fprintf(f,"Solution\n",lab): fprintf(f,"

\n"): fprintf(f,"Back to Main Page\n"): fprintf(f,"\n"): fclose(f): f:=fopen(cat("puzz",lab,"sol.html"),'WRITE','TEXT'): fprintf(f,"\n"): fprintf(f,"

\n"): fprintf(f,"\"A\n",lab,n,m): fprintf(f,"

\n"): fprintf(f,"

"): fprintf(f," Across: \n"): for i from 1 to n do fprintf(f,"
\n"): fprintf(f,"   %d. %s\n", i, clues[1][i]): od: fprintf(f,"

\n"): fprintf(f," Down: \n"): for i from 1 to m do fprintf(f,"
\n"): fprintf(f,"   %d. %s\n", i, clues[2][i]): od: fprintf(f,"

\n"): fprintf(f,"

"): fprintf(f,"Grid\n",lab): fprintf(f,"

\n"): fprintf(f,"Back to Main Page\n"): fprintf(f,"\n"): fclose(f): end: