Source code in the icon programming language

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


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


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