/* State name puzzle (Rosetta Code) in Picat. From http://rosettacode.org/wiki/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 different U.S. States (so that all four state names differ from one another). 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 Gödel 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" """ For two states with out the extrace fictitious states, there is a unique solution: x1 = [33,41] = [north carolina,south dakota] x2 = [34,40] = [north dakota,south carolina] gcc = [4,0,1,1,0,0,0,2,1,0,1,1,0,2,4,0,0,2,1,3,1,0,0,0,0,0,0] Adding the additional states (including some duplicates), there are 28 solutions, e.g. x1 = [32,51] = [new york,new kory] x2 = [52,53] = [wen kory,york new] gcc = [0,0,0,0,2,0,0,0,0,0,2,0,0,2,2,0,0,2,0,0,0,0,2,0,2,0,0] x1 = [32,51] = [new york,new kory] x2 = [52,54] = [wen kory,kory new] gcc = [0,0,0,0,2,0,0,0,0,0,2,0,0,2,2,0,0,2,0,0,0,0,2,0,2,0,0] x1 = [32,51] = [new york,new kory] x2 = [53,54] = [york new,kory new] gcc = [0,0,0,0,2,0,0,0,0,0,2,0,0,2,2,0,0,2,0,0,0,0,2,0,2,0,0] ... x1 = [33,41] = [north carolina,south dakota] x2 = [34,40] = [north dakota,south carolina] gcc = [4,0,1,1,0,0,0,2,1,0,1,1,0,2,4,0,0,2,1,3,1,0,0,0,0,0,0] x1 = [51,52] = [new kory,wen kory] x2 = [53,54] = [york new,kory new] gcc = [0,0,0,0,2,0,0,0,0,0,2,0,0,2,2,0,0,2,0,0,0,0,2,0,2,0,0] x1 = [51,53] = [new kory,york new] x2 = [52,54] = [wen kory,kory new] gcc = [0,0,0,0,2,0,0,0,0,0,2,0,0,2,2,0,0,2,0,0,0,0,2,0,2,0,0] ... For three states (NumGet=3) there are also 28 solutions. Here are some of the solutions (it takes about 12s to get them all): x1 = [32,33,41] = [new york,north carolina,south dakota] x2 = [34,40,55] = [north dakota,south carolina,new kory] gcc = [4,0,1,1,1,0,0,2,1,0,2,1,0,3,5,0,0,3,1,3,1,0,1,0,1,0,0] x1 = [32,33,41] = [new york,north carolina,south dakota] x2 = [34,40,53] = [north dakota,south carolina,york new] gcc = [4,0,1,1,1,0,0,2,1,0,2,1,0,3,5,0,0,3,1,3,1,0,1,0,1,0,0] x1 = [32,34,40] = [new york,north dakota,south carolina] x2 = [33,41,52] = [north carolina,south dakota,wen kory] gcc = [4,0,1,1,1,0,0,2,1,0,2,1,0,3,5,0,0,3,1,3,1,0,1,0,1,0,0] x1 = [33,41,53] = [north carolina,south dakota,york new] x2 = [34,40,54] = [north dakota,south carolina,kory new] gcc = [4,0,1,1,1,0,0,2,1,0,2,1,0,3,5,0,0,3,1,3,1,0,1,0,1,0,0] x1 = [32,34,40] = [new york,north dakota,south carolina] x2 = [33,41,54] = [north carolina,south dakota,kory new] gcc = [4,0,1,1,1,0,0,2,1,0,2,1,0,3,5,0,0,3,1,3,1,0,1,0,1,0,0] ... This Picat model was created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import cp. % For NumGet=2 % import sat. main => time(go). go => nolog, NumLetters = 26, % Q is the only letter not used. A = 1, B = 2, C = 3, D = 4, E = 5, F = 6, G = 7, H = 8, I = 9, J = 10, K = 11, L = 12, M = 13, N = 14, O = 15, P = 16, Q = 17, R = 18, S = 19, T = 20, U = 21, V = 22, W = 23, X = 24, Y = 25, Z = 26, Letters = ["a","b","c","d","e","f","g","h","i","j","k","l","m", "n","o","p","q","r","s","t","u","v","w","x","y","z"], MaxLen = 13, States = [ [A,L,A,B,A,M,A,0,0,0,0,0,0], [A,L,A,S,K,A,0,0,0,0,0,0,0], [A,R,I,Z,O,N,A,0,0,0,0,0,0], [A,R,K,A,N,S,A,S,0,0,0,0,0], [C,A,L,I,F,O,R,N,I,A,0,0,0], [C,O,L,O,R,A,D,O,0,0,0,0,0], [C,O,N,N,E,C,T,I,C,U,T,0,0], [D,E,L,A,W,A,R,E,0,0,0,0,0], [F,L,O,R,I,D,A,0,0,0,0,0,0], [G,E,O,R,G,I,A,0,0,0,0,0,0], [H,A,W,A,I,I,0,0,0,0,0,0,0], [I,D,A,H,O,0,0,0,0,0,0,0,0], [I,L,L,I,N,O,I,S,0,0,0,0,0], [I,N,D,I,A,N,A,0,0,0,0,0,0], [I,O,W,A,0,0,0,0,0,0,0,0,0], [K,A,N,S,A,S,0,0,0,0,0,0,0], [K,E,N,T,U,C,K,Y,0,0,0,0,0], [L,O,U,I,S,I,A,N,A,0,0,0,0], [M,A,I,N,E,0,0,0,0,0,0,0,0], [M,A,R,Y,L,A,N,D,0,0,0,0,0], [M,A,S,S,A,C,H,U,S,E,T,T,S], [M,I,C,H,I,G,A,N,0,0,0,0,0], [M,I,N,N,E,S,O,T,A,0,0,0,0], [M,I,S,S,I,S,S,I,P,P,I,0,0], [M,I,S,S,O,U,R,I,0,0,0,0,0], [M,O,N,T,A,N,A,0,0,0,0,0,0], [N,E,B,R,A,S,K,A,0,0,0,0,0], [N,E,V,A,D,A,0,0,0,0,0,0,0], [N,E,W,H,A,M,P,S,H,I,R,E,0], [N,E,W,J,E,R,S,E,Y,0,0,0,0], [N,E,W,M,E,X,I,C,O,0,0,0,0], [N,E,W,Y,O,R,K,0,0,0,0,0,0], [N,O,R,T,H,C,A,R,O,L,I,N,A], [N,O,R,T,H,D,A,K,O,T,A,0,0], [O,H,I,O,0,0,0,0,0,0,0,0,0], [O,K,L,A,H,O,M,A,0,0,0,0,0], [O,R,E,G,O,N,0,0,0,0,0,0,0], [P,E,N,N,S,Y,L,V,A,N,I,A,0], [R,H,O,D,E,I,S,L,A,N,D,0,0], [S,O,U,T,H,C,A,R,O,L,I,N,A], [S,O,U,T,H,D,A,K,O,T,A,0,0], [T,E,N,N,E,S,S,E,E,0,0,0,0], [T,E,X,A,S,0,0,0,0,0,0,0,0], [U,T,A,H,0,0,0,0,0,0,0,0,0], [V,E,R,M,O,N,T,0,0,0,0,0,0], [V,I,R,G,I,N,I,A,0,0,0,0,0], [W,A,S,H,I,N,G,T,O,N,0,0,0], [W,E,S,T,V,I,R,G,I,N,I,A,0], [W,I,S,C,O,N,S,I,N,0,0,0,0], [W,Y,O,M,I,N,G,0,0,0,0,0,0], % added states [N,E,W,K,O,R,Y,0,0,0,0,0,0], [W,E,N,K,O,R,Y,0,0,0,0,0,0], [Y,O,R,K,N,E,W,0,0,0,0,0,0], [K,O,R,Y,N,E,W,0,0,0,0,0,0], [N,E,W,K,O,R,Y,0,0,0,0,0,0] % duplicate ], NumStates = States.len, StatesStr = [ "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", % added states "new kory", "wen kory", "york new", "kory new", "new kory" % duplicate ], % decision variables % Number of states NumGet = 2, % NumGet = 3, % NumGet = 4, X1 = new_list(NumGet), X1 :: 1..NumStates, % two other states X2 = new_list(NumGet), X2 :: 1..NumStates, GCC = new_list(NumLetters+1), % 0..NumLetters GCC :: 0..MaxLen*2, % global cardinality count all_different(X1 ++ X2), % Ensure that the two states has exactly the same number of letters global_cardinality2( [TT : JJ in 1..NumGet, II in 1..MaxLen, matrix_element(States,X1[JJ],II,TT)], GCC ), global_cardinality2( [TT : JJ in 1..NumGet, II in 1..MaxLen, matrix_element(States,X2[JJ],II,TT)], GCC ), % handle duplicates % This reduces from 46 solutions to 38 solutions. foreach(II in 1..NumGet, JJ in 1..NumGet, II < JJ) sum([T1 #!= T2 : KK in 1..MaxLen, matrix_element(States,X1[II],KK,T1), matrix_element(States,X1[JJ],KK,T2) ]) #> 0, sum([T1 #!= T2 : KK in 1..MaxLen, matrix_element(States,X2[II],KK,T1), matrix_element(States,X2[JJ],KK,T2) ]) #> 0 end, foreach(II in 1..NumGet, JJ in 1..NumGet) sum([T1 #!= T2 : KK in 1..MaxLen, matrix_element(States,X1[II],KK,T1), matrix_element(States,X2[JJ],KK,T2) ]) #> 0, sum([T1 #!= T2 : KK in 1..MaxLen, matrix_element(States,X2[II],KK,T1), matrix_element(States,X1[JJ],KK,T2) ]) #> 0 end, % symmetry breaking increasing(X1), increasing(X2), X1[1] #< X2[1], Vars = X1 ++ X2 ++ GCC.vars, solve($[split],Vars), println(x1=X1=[StatesStr[X1[II]] : II in 1..NumGet]), println(x2=X2=[StatesStr[X2[II]] : II in 1..NumGet]), println(gcc=GCC), nl, fail, nl. % % global_cardinality2(A, Gcc) % % This version is bidirectional but limited: % % Both A and Gcc are (plain) lists. % % The list A can contain only values 1..Max (i.e. the length of Gcc). % This means that the caller must know the max values of A. % Or rather: if A contains another values they will not be counted. % global_cardinality2(A, Gcc) => Len = length(A), Max = length(Gcc), Gcc :: 0..Len, foreach(I in 1..Max) count(I,A,#=,Gcc[I]) end.