Data commit

Task/State-name-puzzle/Icon/state-name-puzzle-1.icon

@@ -0,0 +1,49 @@
+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

Task/State-name-puzzle/Icon/state-name-puzzle-2.icon

@@ -0,0 +1,21 @@
+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

Task/State-name-puzzle/Icon/state-name-puzzle-3.icon

@@ -0,0 +1,58 @@
+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