State name puzzle
Background
This task is inspired by Mark Nelson's DDJ Column "Wordplay" and one of the weekly puzzle challenges from Will Shortz on NPR Weekend Edition [1] and originally attributed to David Edelheit.
The challenge was to take the names of two U.S. States, mix them all together, then rearrange the letters to form the names of two other U.S. States. What states are these?
The problem was reissued on the Unicon Discussion Web which includes several solutions with analysis. Several techniques may be helpful and you may wish to refer to Goedel numbering, Equivalence relations, and Equivalence classes. The basic merits of these were discussed in the Unicon Discussion Web.
A second challenge in the form of a set of fictitious new states was also presented.
Task
Write a program to solve the challenge using both the original list of states and the fictitious list.
Caveats:
- case and spacing isn't significant - just letters (harmonize case)
- don't expect the names to be in any order - such as being sorted
- don't rely on names to be unique (eliminate duplicates - meaning if Iowa appears twice you can only use it once)
Comma separated list of state names used in the original puzzle:
"Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming"
Comma separated list of additional fictitious state names to be added to the original (Includes a duplicate):
"New Kory", "Wen Kory", "York New", "Kory New", "New Kory"
C
Sort by letter occurence and deal with dupes. <lang C>#include <stdio.h>
- include <stdlib.h>
- include <string.h>
- define USE_FAKES 1
char *states[] = {
- if USE_FAKES
"New Kory", "Wen Kory", "York New", "Kory New", "New Kory",
- endif
"Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming" };
int n_states = sizeof(states)/sizeof(char*); typedef struct { unsigned char c[26]; char *name[2]; } letters;
void count_letters(letters *l, char *s) { int c; if (!l->name[0]) l->name[0] = s; else l->name[1] = s;
while ((c = *s++)) { if (c >= 'a' && c <= 'z') l->c[c - 'a']++; if (c >= 'A' && c <= 'Z') l->c[c - 'A']++; } }
int lcmp(const void *aa, const void *bb) { int i; const letters *a = aa, *b = bb; for (i = 0; i < 26; i++) if (a->c[i] > b->c[i]) return 1; else if (a->c[i] < b->c[i]) return -1; return 0; }
int scmp(const void *a, const void *b) { return strcmp(*(char**)a, *(char**)b); }
void no_dup() { int i, j;
qsort(states, n_states, sizeof(char*), scmp);
for (i = j = 0; i < n_states;) { while (++i < n_states && !strcmp(states[i], states[j])); if (i < n_states) states[++j] = states[i]; }
n_states = j + 1; }
void find_mix() { int i, j, n; letters *l, *p;
no_dup(); n = n_states * (n_states - 1) / 2; p = l = calloc(n, sizeof(letters));
for (i = 0; i < n_states; i++) for (j = i + 1; j < n_states; j++, p++) { count_letters(p, states[i]); count_letters(p, states[j]); }
qsort(l, n, sizeof(letters), lcmp);
for (j = 0; j < n; j++) { for (i = j + 1; i < n && !lcmp(l + j, l + i); i++) { if (l[j].name[0] == l[i].name[0] || l[j].name[1] == l[i].name[0] || l[j].name[1] == l[i].name[1]) continue; printf("%s + %s => %s + %s\n", l[j].name[0], l[j].name[1], l[i].name[0], l[i].name[1]); } } free(l); }
int main(void) { find_mix(); return 0; }</lang>
Icon and Unicon
Equivalence Class Solution
<lang Icon>link strings # for csort and deletec
procedure main(arglist)
ECsolve(S1 := getStates()) # original state names puzzle ECsolve(S2 := getStates2()) # modified fictious names puzzle GNsolve(S1) GNsolve(S2)
end
procedure ECsolve(S) # Solve challenge using equivalence classes
local T,x,y,z,i,t,s,l,m st := &time # mark runtime /S := getStates() # default every insert(states := set(),deletec(map(!S),' \t')) # ignore case & space # Build a table containing sets of state name pairs # keyed off of canonical form of the pair # Use csort(s) rather than cset(s) to preserve the numbers of each letter # Since we care not of X&Y .vs. Y&X keep only X&Y T := table() every (x := !states ) & ( y := !states ) do if z := csort(x || (x << y)) then { /T[z] := [] put(T[z],set(x,y)) } # For each unique key (canonical pair) find intersection of all pairs # Output is <current key matched> <key> <pairs> i := m := 0 # keys (i) and pairs (m) matched every z := key(T) do { s := &null every l := !T[z] do { /s := l s **:= l } if *s = 0 then { i +:= 1 m +:= *T[z] every x := !T[z] do { #writes(i," ",z) # uncomment for equiv class and match count every writes(!x," ") write() } } } write("... runtime ",(&time - st)/1000.,"\n",m," matches found.")
end</lang>
The following are common routines:<lang Icon>procedure getStates() # return list of state names return ["Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming"]
end
procedure getStates2() # return list of state names + fictious states return getStates() ||| ["New Kory", "Wen Kory", "York New", "Kory New", "New Kory"] end</lang>
Godel Number Solution
<lang Icon>link factors
procedure GNsolve(S)
local min, max st := &time equivClasses := table() statePairs := table() /S := getStates() every put(states := [], map(!S)) # Make case insignificant min := proc("min",0) # Link "factors" loses max/min functions max := proc("max",0) # ... these statements get them back # Build a table of equivalence classes (all state pairs in the # same equivalence class have the same characters in them) # Output new pair couples *before* adding each state pair to class. every (state1 := |get(states)) & (state2 := !states) do { if state1 ~== state2 then { statePair := min(state1, state2)||":"||max(state1,state2) if /statePairs[statePair] := set(state1, state2) then { signature := getClassSignature(state1, state2) /equivClasses[signature] := set() every *(statePairs[statePair] ** # require 4 distinct states statePairs[pair := !equivClasses[signature]]) == 0 do { write(statePair, " and ", pair) } insert(equivClasses[signature], statePair) } } } write(&errout, "Time: ", (&time-st)/1000.0)
end
- Build a (Godel) signature identifying the equivalence class for state pair s.
procedure getClassSignature(s1, s2)
static G initial G := table() /G[s1] := gn(s1) /G[s2] := gn(s2) return G[s1]*G[s2]
end
procedure gn(s) # Compute the Godel number for a string (letters only)
static xlate local p, i, z initial { xlate := table(1) p := create prime() every i := 1 to 26 do { xlate[&lcase[i]] := xlate[&ucase[i]] := @p } } z := 1 every z *:= xlate[!s] return z
end</lang>
strings.icn provides deletec, csort factors.icn provides prime
Sample Output (ECsolve):
northcarolina southdakota northdakota southcarolina ... runtime 0.019 2 matches found. wenkory yorknew wenkory newyork newyork yorknew wenkory korynew newyork korynew newkory korynew korynew yorknew wenkory newkory newkory newyork newkory yorknew northcarolina southdakota northdakota southcarolina ... runtime 0.026 12 matches found.
Sample Output (GNsolve):
north dakota:south carolina and north carolina:south dakota Time: 0.008999999999999999 north dakota:south carolina and north carolina:south dakota new kory:wen kory and new york:york new new kory:wen kory and kory new:new york new kory:york new and new york:wen kory new kory:york new and kory new:new york kory new:new kory and new york:wen kory kory new:new kory and new york:york new wen kory:york new and kory new:new york wen kory:york new and kory new:new kory wen kory:york new and new kory:new york kory new:wen kory and new york:york new kory new:wen kory and new kory:york new kory new:wen kory and new kory:new york kory new:york new and new york:wen kory kory new:york new and new kory:wen kory kory new:york new and new kory:new york Time: 0.018
J
Implementation:
<lang j>require'strings stats'
states=:<;._2]0 :0-.LF
Alabama,Alaska,Arizona,Arkansas,California,Colorado, Connecticut,Delaware,Florida,Georgia,Hawaii,Idaho, Illinois,Indiana,Iowa,Kansas,Kentucky,Louisiana, Maine,Maryland,Massachusetts,Michigan,Minnesota, Mississippi,Missouri,Montana,Nebraska,Nevada, New Hampshire,New Jersey,New Mexico,New York, North Carolina,North Dakota,Ohio,Oklahoma,Oregon, Pennsylvania,Rhode Island,South Carolina, South Dakota,Tennessee,Texas,Utah,Vermont,Virginia, Washington,West Virginia,Wisconsin,Wyoming, Maine,Maine,Maine,Maine,Maine,Maine,Maine,Maine,
)
pairUp=: (#~ matchUp)@({~ 2 comb #)@~. matchUp=: (i.~ ~: i:~)@:(<@normalize@;"1) normalize=: /:~@tolower@-.&' '</lang>
In action:
<lang j> pairUp states ┌──────────────┬──────────────┐ │North Carolina│South Dakota │ ├──────────────┼──────────────┤ │North Dakota │South Carolina│ └──────────────┴──────────────┘</lang>
Note: this approach is sufficient to solve the original problem, but does not properly deal with the addition of fictitious states. So:
<lang j>isolatePairs=: ~.@matchUp2@(#~ *./@matchUp"2)@({~ 2 comb #) matchUp2=: /:~"2@:(/:~"1)@(#~ 4=#@~.@,"2)</lang>
In action:
<lang j> isolatePairs pairUp 'New Kory';'Wen Kory';'York New';'Kory New';'New Kory';states ┌──────────────┬──────────────┐ │Kory New │York New │ ├──────────────┼──────────────┤ │New Kory │Wen Kory │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │New Kory │Wen Kory │ ├──────────────┼──────────────┤ │New York │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New York │ ├──────────────┼──────────────┤ │New Kory │Wen Kory │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │Wen Kory │ ├──────────────┼──────────────┤ │New Kory │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │New Kory │York New │ ├──────────────┼──────────────┤ │New York │Wen Kory │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New York │ ├──────────────┼──────────────┤ │New Kory │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New Kory │ ├──────────────┼──────────────┤ │Wen Kory │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New Kory │ ├──────────────┼──────────────┤ │New York │Wen Kory │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New Kory │ ├──────────────┼──────────────┤ │New York │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │New Kory │New York │ ├──────────────┼──────────────┤ │Wen Kory │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │Wen Kory │ ├──────────────┼──────────────┤ │New Kory │New York │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │York New │ ├──────────────┼──────────────┤ │New Kory │New York │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │New York │ ├──────────────┼──────────────┤ │Wen Kory │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │Wen Kory │ ├──────────────┼──────────────┤ │New York │York New │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │Kory New │York New │ ├──────────────┼──────────────┤ │New York │Wen Kory │ └──────────────┴──────────────┘
┌──────────────┬──────────────┐ │North Carolina│South Dakota │ ├──────────────┼──────────────┤ │North Dakota │South Carolina│ └──────────────┴──────────────┘</lang>
PicoLisp
<lang PicoLisp>(setq *States
(group (mapcar '((Name) (cons (clip (sort (chop (lowc Name)))) Name)) (quote "Alabama" "Alaska" "Arizona" "Arkansas" "California" "Colorado" "Connecticut" "Delaware" "Florida" "Georgia" "Hawaii" "Idaho" "Illinois" "Indiana" "Iowa" "Kansas" "Kentucky" "Louisiana" "Maine" "Maryland" "Massachusetts" "Michigan" "Minnesota" "Mississippi" "Missouri" "Montana" "Nebraska" "Nevada" "New Hampshire" "New Jersey" "New Mexico" "New York" "North Carolina" "North Dakota" "Ohio" "Oklahoma" "Oregon" "Pennsylvania" "Rhode Island" "South Carolina" "South Dakota" "Tennessee" "Texas" "Utah" "Vermont" "Virginia" "Washington" "West Virginia" "Wisconsin" "Wyoming" "New Kory" "Wen Kory" "York New" "Kory New" "New Kory" ) ) ) )
(extract
'((P) (when (cddr P) (mapcar '((X) (cons (cadr (assoc (car X) *States)) (cadr (assoc (cdr X) *States)) ) ) (cdr P) ) ) ) (group (mapcon '((X) (extract '((Y) (cons (sort (conc (copy (caar X)) (copy (car Y)))) (caar X) (car Y) ) ) (cdr X) ) ) *States ) ) )</lang>
Output:
-> ((("North Carolina" . "South Dakota") ("North Dakota" . "South Carolina")))
Prolog
Works with SWI-Prolog. Use of Goedel numbers. <lang Prolog>state_name_puzzle :- L = ["Alabama", "Alaska", "Arizona", "Arkansas", "California", "Colorado", "Connecticut", "Delaware", "Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", "Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", "Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", "Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", "New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", "Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", "South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", "Washington", "West Virginia", "Wisconsin", "Wyoming", "New Kory", "Wen Kory", "York New", "Kory New", "New Kory"],
maplist(goedel, L, R),
% sort remove duplicates sort(R, RS),
study(RS).
study([]).
study([V-Word|T]) :- study_1_Word(V-Word, T, T), study(T).
study_1_Word(_, [], _).
study_1_Word(V1-W1, [V2-W2 | T1], T) :-
TT is V1+V2,
study_2_Word(W1, W2, TT, T),
study_1_Word(V1-W1, T1, T).
study_2_Word(_W1, _W2, _TT, []).
study_2_Word(W1, W2, TT, [V3-W3 | T]) :- ( W2 \= W3 -> study_3_Word(W1, W2, TT, V3-W3, T); true), study_2_Word(W1, W2, TT, T).
study_3_Word(_W1, _W2, _TT, _V3-_W3, []).
study_3_Word(W1, W2, TT, V3-W3, [V4-W4|T]) :- TT1 is V3 + V4, ( TT1 < TT -> study_3_Word(W1, W2, TT, V3-W3, T) ; (TT1 = TT -> ( W4 \= W2 -> format('~w & ~w with ~w & ~w~n', [W1, W2, W3, W4]) ; true),
study_3_Word(W1, W2, TT, V3-W3, T))
; true).
% Compute a Goedel number for the word goedel(Word, Goedel-A) :- name(A, Word), downcase_atom(A, Amin), atom_codes(Amin, LA), compute_Goedel(LA, 0, Goedel).
compute_Goedel([], G, G).
compute_Goedel([32|T], GC, GF) :- compute_Goedel(T, GC, GF).
compute_Goedel([H|T], GC, GF) :- Ind is H - 97, GC1 is GC + 26 ** Ind, compute_Goedel(T, GC1, GF). </lang> Output :
?- time(state_name_puzzle). North Carolina & South Dakota with North Dakota & South Carolina Kory New & New Kory with New York & Wen Kory Kory New & New Kory with New York & York New Kory New & New Kory with Wen Kory & York New Kory New & New York with New Kory & Wen Kory Kory New & New York with New Kory & York New Kory New & New York with Wen Kory & York New Kory New & Wen Kory with New Kory & New York Kory New & Wen Kory with New Kory & York New Kory New & Wen Kory with New York & York New Kory New & York New with New Kory & New York Kory New & York New with New Kory & Wen Kory Kory New & York New with New York & Wen Kory New Kory & New York with Wen Kory & York New New Kory & Wen Kory with New York & York New New Kory & York New with New York & Wen Kory % 1,076,511 inferences, 1.078 CPU in 1.141 seconds (94% CPU, 998503 Lips) true .