/* "I'm thinking of of a X" puzzles: Cheryl's birthday, MrTans birthday, Sum and Product puzzles in Picat. Cheryl's birthday is this (following http://www.theguardian.com/science/alexs-adventures-in-numberland/2015/apr/13/how-to-solve-albert-bernard-and-cheryls-birthday-maths-problem ) """ Problem (NY Times revised version) Albert and Bernard just met Cheryl. "When’s your birthday?” Albert asked Cheryl. Cheryl thought a second and said, "I’m not going to tell you, but I’ll give you some clues.” She wrote down a list of 10 dates: May 15, May 16, May 19 June 17, June 18 July 14, July 16 August 14, August 15, August 17 "My birthday is one of these,” she said. Then Cheryl whispered in Albert’s ear the month — and only the month — of her birthday. To Bernard, she whispered the day, and only the day. "Can you figure it out now?” she asked Albert. Albert: I don’t know when your birthday is, but I know Bernard doesn’t know, either. Bernard: I didn’t know originally, but now I do. Albert: Well, now I know, too! When is Cheryl’s birthday? """ Also, see https://en.wikipedia.org/wiki/Cheryl%27s_Birthday See below for the similar Mr Tan's birthday problem. The approach used in puzzle/2 was heavily inspired by my Picat program http://hakank.org/picat/cheryls_birthday.pi which is a port of the Prolog program https://raw.githubusercontent.com/perng/prolog_collection/master/cheryls_birthday.pl puzzle2/2, puzzle3/3 and puzzle4/4 are my own. * puzzle/2 is a generalization (= anonymization) Cheryl's birthday and Mr Tan's birthday go/0: Solving Cheryl's birthday with the general framework (puzzle/2). go2/0: Solving Mr Tan's birthday problem with puzzle/2. go3/0: Solving the Sum and Product puzzle with puzzle/2. go5/0: Solving Mr Tan's birthday problem with puzzle/2. * puzzle2/2 is another approach of the problem, and it uses a list / loop so we can follow the logic of the problem in detail. go4/0: Solving Cheryl's and Mr Tan's birthday problems using puzzle2/2 which includes tracing the logic. go5/0: Solving SumAndProduct using puzzle2/2 w/o printout + solving for X and Y. * puzzle3/3 is a matrix approach with logic tracing. go6/0: Solving Cheryl's birthday problem with puzzle3/3. * puzzle4/4 is a cp (matrix) approach go7/0: Solving Cheryl's birthday problem with puzzle4/4. The tracing are the three different matrices, X1, X2, and X3 (where X3 has the answer). go8/0: Generates all possible solutions of the 4 x 6 problem (i.e. Cheryl's and Mr Tan's birthday problems). Here's a trace of the Cheryl's birthday problem (from go4/0): """ ... Cheryl: len = 10 n = [15,16,19,17,18,14,16,14,15,17] m = [may,may,may,june,june,july,july,august,august,august] We start with these entries: [[15 / may],[16 / may],[19 / may],[17 / june],[18 / june],[14 / july],[16 / july],[14 / august],[15 / august],[17 / august]] Step 1: Remove complete M for which N is unique uniqueNs = [19,18] nUnique = 19 removeM = [15 / may] removeM = [16 / may] removeM = [19 / may] nUnique = 18 removeM = [17 / june] removeM = [18 / june] left = [[14 / july],[16 / july],[14 / august],[15 / august],[17 / august]] Step 2: Remove entries where N is not unique notUniqueNs2 = [14] removeN = 14 = [14 / july] removeN = 14 = [14 / august] left = [[16 / july],[15 / august],[17 / august]] Step 3: Remove Ms which have no unique N notUniqueMs3 = [august] removeM = august = [15 / august] removeM = august = [17 / august] answer = [[16 / july]] ... """ Here's a trace using matrix approach (puzzle3/3), from go5/0: """ rowValues = [may,june,july,august] columnValues = [14,15,16,17,18,19] Before 14 15 16 17 18 19 ____________________________________ 0 1 1 0 0 1 | may 0 0 0 1 1 0 | june 1 0 1 0 0 0 | july 1 1 0 1 0 0 | august Stage 1: Remove rows which have a unique value in a column removeRows1 = [2,1] [0,0,0,0,0,0] [0,0,0,0,0,0] [1,0,1,0,0,0] [1,1,0,1,0,0] Stage 2: Remove columns with more than one item: removeColumns2 = [1] [0,0,0,0,0,0] [0,0,0,0,0,0] [0,0,1,0,0,0] [0,1,0,1,0,0] Stage 3: Remove rows with more than one item: removeRows3 = [4] [0,0,0,0,0,0] [0,0,0,0,0,0] [0,0,1,0,0,0] [0,0,0,0,0,0] sol = [3,3] [july,16] """ The solution of the Sum and Product puzzle (go/3): """ [sum = 17,product = 52] [x = 4,y = 13] """ Note: go5/0 has little more tracing for Sum and Products puzzle. Also see: * https://en.wikipedia.org/wiki/Cheryl%27s_Birthday * Barteld Kool: https://www.youtube.com/watch?v=doYD1e9k_Ts "An explanation of the solution to the problem of Cheryl's birthday using dynamic epistemic logic." * Alex Bellos: "Can you solve the maths question for Singapore schoolkids that went viral?" https://www.theguardian.com/science/alexs-adventures-in-numberland/2015/apr/13/can-you-solve-the-singapore-primary-maths-question-that-went-viral * Sum and Product puzzle: https://en.wikipedia.org/wiki/Sum_and_Product_Puzzle This model was created by Hakan Kjellerstrand, hakank@gmail.com See also my Picat page: http://www.hakank.org/picat/ */ import cp. import util. main => go. /* Cheryl's birthday http://www.theguardian.com/science/alexs-adventures-in-numberland/2015/apr/13/how-to-solve-albert-bernard-and-cheryls-birthday-maths-problem https://en.wikipedia.org/wiki/Cheryl%27s_Birthday """ Problem (NY Times revised version) Albert and Bernard just met Cheryl. "When’s your birthday?” Albert asked Cheryl. Cheryl thought a second and said, "I’m not going to tell you, but I’ll give you some clues.” She wrote down a list of 10 dates: May 15, May 16, May 19 June 17, June 18 July 14, July 16 August 14, August 15, August 17 "My birthday is one of these,” she said. Then Cheryl whispered in Albert’s ear the month — and only the month — of her birthday. To Bernard, she whispered the day, and only the day. "Can you figure it out now?” she asked Albert. Albert: I don’t know when your birthday is, but I know Bernard doesn’t know, either. Bernard: I didn’t know originally, but now I do. Albert: Well, now I know, too! When is Cheryl’s birthday? """ Answer: July 16 */ go ?=> % p(Part1,Part2) where % - Part1 is the thing person 1 hear % - Part2 is the thing person 2 hear P = $[p(may,15),p(may,16),p(may,19),p(june,17),p(june,18), p(july,14),p(july,16),p(august,14),p(august,15),p(august,17)], cl_facts(P), println(findall([PP1,PP2],p(PP1,PP2))), puzzle(P1,P2), println([p1=P1,p2=P2]), nl. go => true. /* From https://www.mrbrown.com/blog/2013/02/yet-another-psle-maths-question-to-blow-your-mind.html """ Ben and Mark are students of Mr Tan. Mr Tan's birthday is on N/M/1970 and both of them know that Mr Tan's birthday is on one of these 10 dates. 4/3/1970 5/3/1970 8/3 1970 4/6/1970 7/6/1970 1/9/1970 5/9/1970 1/12/1980 2/12/1970 8/12/1970 Mr Tan tells Ben the value of M and tells Mark the value of N. Then Mr Tan asks them: "Do you know when is my birthday?" Ben says: "I don't know but I can ensure that Mark doesn't know too." Mark says: "Initially I don't know, but I know now." Ben says: "Oh, then I know it too." Base[d] of the dialogue and the dates given, can you figure out which date is Mr Tan's birthday? ..... Sequence of elimination: 1. N = {1, 2x, 4, 5, 7x, 8 }, M = { 3, 6x, 9, 12x } 2. N = {1, 4, 5x, 8}, M = { 3, 9} 3. N = {1, 4, 8}, M = {3x, 9} Final answer has to be N=1, M=9. 1. "I know you don't know" - translation: The N values given my value of M have no unique values. Effect: Eliminates the appropriate N and M values from consideration. 2. "Ah, now I know." - translation: My value of N must have a unique value of M. Effect: the elimination of the value of N=5. 3. "Oh, now I also know." - translation: My value of M can only have one unique value of N given the possibilities that remain. Effect: M=3 is eliminated. """ Answer: [p1 = 9,p2 = 1] (i.e. September 1) */ go2 ?=> P = $[p(3,4),p(3,5),p(3,8), p(6,4),p(6,7), p(9,1),p(9,5), p(12,1),p(12,2),p(12,8)], cl_facts(P), println(findall([PP1,PP2],p(PP1,PP2))), puzzle(P1,P2), println([p1=P1,p2=P2]), nl. go2 => true. /* Sum and Product puzzle (https://en.wikipedia.org/wiki/Sum_and_Product_Puzzle) """ X and Y are two different whole numbers greater than 1. Their sum is not greater than 100, and Y is greater than X. S and P are two mathematicians (and consequently perfect logicians); S knows the sum X + Y and P knows the product X × Y. Both S and P know all the information in this paragraph. The following conversation occurs (both participants are telling the truth): S says "P does not know X and Y." P says "Now I know X and Y." S says "Now I also know X and Y." What are X and Y? """ x = 4 and y = 13 (sum = 17 and product = 52) This is a variant of the Mr S and Mr P puzzle from John McCarthy: "Formalization of two Puzzles involving knowledge" http://www-formal.stanford.edu/jmc/puzzles.pdf page 2: """ Here is the Mr. S and Mr. P puzzle: Two numbers $m$ and $n$ are chosen such that 2 < m < n < 99. Mr. S is told their sum and Mr. P is told their product. The following dialogue ensues: Mr. P: I don't know the numbers. Mr. S: I knew you didn't know. I don't know either. Mr. P: Now I know the numbers. Mr S: Now I know them too. In view of the above dialogue, what are the numbers? 2007 note: At the time I wrote this article, I was unable to discover the author. It was Hans Freudenthal, Nieuw Archief Voor Wiskunde, Series 3, Volume 17, 1969, page 152). """ */ go3 ?=> % Note: we use sums and products and below find out % what the numbers are P = $[ p(Sum,Prod) : X in 2..100, Y in X+1..100, X+Y <= 100,Sum=X+Y,Prod=X*Y], println(nums=P.len), cl_facts_table(P,$[p(+,+)]), puzzle(P1,P2), println([sum=P1,product=P2]), % Find X and Y [X,Y] :: 2..100, X + Y #= P1, X * Y #= P2, X #< Y, solve($[ff,split],[X,Y]), println([x=X,y=Y]), fail, nl. go3 => true. % % Using puzzle2(Ns,Ms) % Note: % - Ms are the stuff that the first person hear, i.e. the one % that speaks first and third. % - Ns are the stuff that the second person hear, i.e. the % one that speaks second. % go4 ?=> % P = $[p(may,15),p(may,16),p(may,19),p(june,17),p(june,18), % p(july,14),p(july,16),p(august,14),p(august,15),p(august,17)], Cheryl = [ [ 15, 16, 19, 17, 18, 14, 16, 14, 15, 17], % Ns [may,may,may,june,june,july,july, august,august,august] % Ms ], MrTan = [ [4,5,8, 4,7, 1,5, 1, 2, 8], % Ns [3,3,3, 6,6, 9,9, 12,12,12] % Ms ], % See go5/0 % SumAndProduct = [ % [ Prod : X in 2..100, Y in X+1..100, X+Y <= 100,Prod=X*Y], % Ns % [ Sum : X in 2..100, Y in X+1..100, X+Y <= 100,Sum=X+Y] % Ms % ], println("Cheryl:"), puzzle2(Cheryl[1],Cheryl[2],_AnswerCheryl), println("Mr Tan:"), puzzle2(MrTan[1],MrTan[2],_AnswerMrTan), % Note: Here the answer is the product and sum of X and Y, % not the values of X and Y. % And it's huge and takes a lot of time. % See go8/0. % println("SumAndProduct:"), % puzzle2(SumAndProduct[1],SumAndProduct[2],AnswerSumAndProduct), fail, nl. go4 => true. % % Solve Sum and Product problem with puzzle2/2. % go5 ?=> SumAndProduct = [ [ Prod : X in 2..100, Y in X+1..100, X+Y <= 100,Prod=X*Y], % Ns [ Sum : X in 2..100, Y in X+1..100, X+Y <= 100,Sum=X+Y] % Ms ], % Note: Here the answer is the product and sum of X and Y, % not the values of X and Y so we have to calculate them. println("SumAndProduct:"), puzzle2(SumAndProduct[1],SumAndProduct[2],AnswerSumAndProduct), println(ans=AnswerSumAndProduct), $[Prod / Sum] = AnswerSumAndProduct[1], println([prod=Prod,sum=Sum]), [X,Y] :: 2..100, X #< Y, X + Y #= Sum, X * Y #= Prod, solve($[ff,split],[X,Y]), println([x=X,y=Y]), fail, nl. go5 => true. % % Cheryl's birthday problem, matrix approach % go6 ?=> RowValues = [may,june,july,august], ColumnValues = [14,15,16,17,18,19], M = [ % 14,15,16,17,18,19 [ 0, 1, 1, 0, 0, 1], % May [ 0, 0, 0, 1, 1, 0], % June [ 1, 0, 1, 0, 0, 0], % July [ 1, 1, 0, 1, 0, 0] % August ], puzzle3(M,RowValues,ColumnValues), nl. go6 => true. % % CP approach % go7 ?=> RowValues = [may,june,july,august], ColumnValues = [14,15,16,17,18,19], M = [ % 14,15,16,17,18,19 [ 0, 1, 1, 0, 0, 1], % May [ 0, 0, 0, 1, 1, 0], % June [ 1, 0, 1, 0, 0, 0], % July [ 1, 1, 0, 1, 0, 0] % August ], Rows = M.len, Cols = M[1].len, puzzle4(M,X1,X2,X3), println('m '),print_matrix(M), println(x1),print_matrix(X1), println(x2),print_matrix(X2), println(x3),print_matrix(X3), nl, Sol=[[I,J] : I in 1..Rows, J in 1..Cols, X3[I,J] == 1].first, println(sol=[Sol,RowValues[Sol[1]],ColumnValues[Sol[2]]]), nl, fail, nl. go7 => true. % % Show all valid matrix configurations % (using the CP approach). % % According to this model there are % 25920 different valid configurations that yield % a unique solution. % It took about 25s to generate this result. % % There are in total 66600 possible matrices. % Here is the distribution of the number of solutions % for different solution lengths: % 25560 #solutions = 0 % 25920 #solutions = 1 % 4320 #solutions = 4 % 4320 #solutions = 6 % 4320 #solutions = 7 % 2160 #solutions = 16 % % I.e. there was 25560 matrices that has no solutions, % 2160 matrices that has 16 solutions. % The only correct matrices where the 25920 matrices % with a solution length of 1. % go8 ?=> nolog, Map = get_global_map(), Map.put(count,0), % % Generate the matrix. % Assumptions: % 1) It's a 4 x 6 grid (of 0/1) % 2) There must be 2 rows with 2 entries and % 2 rows with 3 entries % 3) There must be 2 columns with 1 entry and % 4 columns with 2 entries. And no without entry. % Rows = 4, Cols = 6, RowValues = 1..Rows, ColumnValues = 1..Cols, M = new_array(Rows,Cols), M :: 0..1, sum(M.vars) #= 10, RowSums = new_list(Rows), RowSums :: 0..Cols, % RowSums1 = [3,2,2,3], % 1 2 3 global_cardinality2(RowSums,[0,2,2]), foreach(I in 1..Rows) RowSums[I] #= sum([M[I,J] : J in 1..Cols]) end, ColSums = new_list(Cols), ColSums :: 0..Rows, % ColSums1 = [2,2,2,2,1,1], % 1 2 global_cardinality2(ColSums,[2,4]), foreach(J in 1..Cols) ColSums[J] #= sum([M[I,J] : I in 1..Rows]) end, solve($[ff,split],M), println("M:"), print_matrix(M), % Check that is has a unique solution All = findall([M,X1,X2,X3],puzzle4(M,X1,X2,X3)), println(allLen=All.len), if All.len == 1 then [M,X1,X2,X3] = All[1], println('m '),print_matrix(M), println(profile=matrix_profile(M)), println(x1),print_matrix(X1), println(x2),print_matrix(X2), println(x3),print_matrix(X3), nl, Sol=[[I,J] : I in 1..Rows, J in 1..Cols, X3[I,J] == 1].first, println(sol=[Sol,RowValues[Sol[1]],ColumnValues[Sol[2]]]), Map.put(count,Map.get(count)+1), nl else println("NOPE!") end, nl, fail, nl. go8 => println(numsols=get_global_map().get(count)). % "Profile" for 4 x 6 matrices matrix_profile(M) = [Alpha[I] : I in 1..Flatten.len,Flatten[I] == 1 ] => 4 == M.len, 6 == M[1].len, Alpha = "abcdefghijklmnopqrstuvwxyz", Flatten = M.array_matrix_to_list_matrix.flatten. print_matrix(M) => foreach(Row in M) println(Row) end, nl. % % General (= "anonymous") framework using logic programming. % % Asumptions: % - there are two people % - person1 is given the P1 part and is the first to speak % - person2 is given the P2 part (and is the second to speak) % puzzle(P1,P2) :- person1part2(P1,P2). /* A helper predicate. Check if the P1 indicates any P2 that uniquely decides P1 */ deciding_p2(P1) :- p(P1,P2), [_] = findall(P, $p(P,P2)). /* person1 says "I don't know and person2 doesn't know either" */ person1part1(P1, P2) :- p(P1, P2), /* person1 doesn't know, so there are at least 2 different possible P2 for that P1 */ [_,_|_] = findall(P, p(P1,P)), /* person1 doesn't know, so the P1 doesn't contains any possible P2 that uniquely decides P1, e.g. p1=8 decides p2=diamonds in the card problem */ \+ deciding_p2(P1). /* Now person2 knows. That means the P2 uniquely decides P1 */ person2part1(P1, P2) :- p(P1, P2), [P1] = findall(P, person1part1(P, P2)). /* the P2 uniquely decides P1 */ /* Now person1 knows */ person1part2(P1, P2) :- p(P1, P2), [P2] = findall(P, person2part1(P1, P)). /* the P1 uniquely decides P2 */ % % Loop based approach were we can follow the logics. % For larger instances (e.g. Sum And Product) we don't % print anything but the solution. % Also, the pruning (i.e. the reassignments of N, M, and X) % are for speeding up the harder problems (e.g. Sum and Product). % puzzle2(N,M,Ans) ?=> NU = N.remove_dups, MU = M.remove_dups, Len = N.len, println(len=Len), Print = true, if Len > 10 then Print := false end, println2(n=N,Print), println2(m=M,Print), nl, if Print then println("We start with these entries:"), println([$[N[I]/M[I]] : I in 1..Len]), nl end, X = new_list(Len), bind_vars(X,1), println("Step 1: Remove complete M for which N is unique"), % 1. Remove Ms for which N is unique UniqueNs1 = [D : D in NU, sum([1 : DD in N, DD == D]) == 1].remove_dups, println2(uniqueNs=UniqueNs1,Print), foreach(I in 1..Len,X[I] == 1) foreach(U in UniqueNs1, N[I] == U) println2(nUnique=U,Print), foreach(J in 1..Len, X[J] == 1, M[J] == M[I]) println2(removeM=$[N[J]/M[J]],Print), X[J] := 0 end end end, % prune all the removed N := [N[I] : I in 1..Len, X[I] == 1], M := [M[I] : I in 1..Len, X[I] == 1], X := [X[I] : I in 1..Len, X[I] == 1], Len := X.len, nl, println(left=[$[N[I]/M[I]] : I in 1..Len, X[I] == 1]), nl, println("Step 2: Remove entries where N is not unique"), % 2. Remove entries where N is not unique NotUniqueNs2 = [D : D in NU, sum([1 : I in 1..Len, X[I] == 1, N[I] == D]) > 1].remove_dups, println2(notUniqueNs2=NotUniqueNs2,Print), foreach(I in 1..Len,X[I] == 1) foreach(U in NotUniqueNs2, N[I] == U) println2(removeN=N[I]=$[N[I]/M[I]],Print), X[I] := 0 end end, % prune all the removed N := [N[I] : I in 1..Len, X[I] == 1], M := [M[I] : I in 1..Len, X[I] == 1], X := [X[I] : I in 1..Len, X[I] == 1], Len := X.len, nl, println(left=[$[N[I]/M[I]] : I in 1..Len, X[I] == 1]), nl, println("Step 3: Remove Ms which have no unique N"), % 3 Remove Ms for which Ns are not unique (of what's left) NotUniqueMs3 = [D : D in MU, sum([1 : I in 1..Len, M[I] == D,X[I] == 1]) > 1], println2(notUniqueMs3=NotUniqueMs3,Print), foreach(I in 1..Len,X[I] == 1) foreach(U in NotUniqueMs3, M[I] == U) println2(removeM=M[I]=$[N[I]/M[I]],Print), X[I] := 0 end end, nl, % prune all the removed N := [N[I] : I in 1..Len, X[I] == 1], M := [M[I] : I in 1..Len, X[I] == 1], X := [X[I] : I in 1..Len, X[I] == 1], Len := X.len, Ans = [$[N[I]/M[I]] : I in 1..Len, X[I] == 1], println(answer=Ans), nl. % % Matrix approach % puzzle3(M,RowValues,ColumnValues) => Rows = M.len, Cols = M[1].len, println(rowValues=RowValues), println(columnValues=ColumnValues), println("Before"), foreach(J in 1..Cols) printf("%5w ", ColumnValues[J]) end, nl, foreach(_K in 1..Cols*6) print("_") end, nl, foreach(I in 1..Rows) foreach(J in 1..Cols) printf("%5w ", M[I,J]) end, printf("| %w\n", RowValues[I]) end, % Stage 1: Remove rows which have unique values in a column println("\nStage 1: Remove rows which have a unique value in a column"), RemoveRows1 = [], foreach(J in 1..Cols) C=[M[I,J] : I in 1..Rows], if sum(C) == 1 then Row = [I : I in 1..Rows, C[I]==1].first, RemoveRows1 := RemoveRows1 ++ [Row] end end, println(removeRows1=RemoveRows1), foreach(R in RemoveRows1) foreach(J in 1..Cols) M[R,J] := 0 end end, foreach(Row in M) println(Row) end, % Stage 2: Remove columns with entries > 1 println("\nStage 2: Remove columns with more than one item:"), RemoveColumns2 = [], foreach(J in 1..Cols) C=[M[I,J] : I in 1..Rows], if sum(C) > 1 then RemoveColumns2 := RemoveColumns2 ++ [J] end end, println(removeColumns2=RemoveColumns2), foreach(C in RemoveColumns2) foreach(I in 1..Rows) M[I,C] := 0 end end, foreach(Row in M) println(Row) end, % Stage 3: Remove rows with entries > 1 println("\nStage 3: Remove rows with more than one item:"), RemoveRows3 = [], foreach(I in 1..Rows) R=[M[I,J] : J in 1..Cols], if sum(R) > 1 then RemoveRows3 := RemoveRows3 ++ [I] end end, println(removeRows3=RemoveRows3), foreach(R in RemoveRows3) foreach(J in 1..Cols) M[R,J] := 0 end end, foreach(Row in M) println(Row) end, nl, Sol=[[I,J] : I in 1..Rows, J in 1..Cols, M[I,J] == 1 ].first, println(sol=Sol), println([RowValues[Sol[1]],ColumnValues[Sol[2]]]), nl. % % puzzle4/4: CP approach % puzzle4(M,X1,X2,X3) => Rows = M.len, Cols = M[1].len, % Stage 1: Remove rows which have unique values in a column println("\nStage 1: Remove rows which have a unique value in a column"), X1 = new_array(Rows,Cols), X1 :: 0..1, % Keep the 0s foreach(I in 1..Rows, J in 1..Cols) M[I,J] #= 0 #=> X1[I,J] #= 0 end, % Non-CP approach % RemoveRows1 = [], % foreach(J in 1..Cols) % C=[M[I,J] : I in 1..Rows], % if sum(C) == 1 then % Row = [I : I in 1..Rows, C[I]==1].first, % RemoveRows1 := RemoveRows1 ++ [Row] % end % end, % foreach(R in RemoveRows1) % foreach(J in 1..Cols) % X1[R,J] #= 0 % end % end, RemoveRows1 = new_list(Cols), RemoveRows1 :: 0..Rows, foreach(J in 1..Cols) sum([M[I,J] : I in 1..Rows]) #= 1 #<=> RemoveRows1[J] #= sum([I*(M[I,J]#=1) : I in 1..Rows]) end, foreach(I in 1..Rows) sum([RemoveRows1[J]*M[I,J] : J in 1..Cols]) #> 0 #<=> sum([X1[I,J] : J in 1..Cols]) #= 0 end, % Stage 2: Remove columns with entries > 1 X2 = new_array(Rows,Cols), X2 :: 0..1, foreach(I in 1..Rows, J in 1..Cols) X1[I,J] #= 0 #=> X2[I,J] #= 0 end, println("\nStage 2: Remove columns with more than one item:"), foreach(J in 1..Cols) sum([X1[I,J] : I in 1..Rows]) #> 1 #=> sum([X2[I,J] : I in 1..Rows]) #= 0, sum([X1[I,J] : I in 1..Rows]) #= 1 #=> sum([X2[I,J] : I in 1..Rows]) #= 1 end, % Stage 3: Remove rows with entries > 1 println("\nStage 3: Remove rows with more than one item:"), X3 = new_array(Rows,Cols), X3 :: 0..1, foreach(I in 1..Rows, J in 1..Cols) X2[I,J] #= 0 #=> X3[I,J] #= 0 end, foreach(I in 1..Rows) sum([X2[I,J] : J in 1..Cols]) #> 1 #=> sum([X3[I,J] : J in 1..Cols]) #= 0, sum([X2[I,J] : J in 1..Cols]) #= 1 #=> sum([X3[I,J] : J in 1..Cols]) #= 1 end, % We got a single solution sum(X3.vars) #= 1, sum(X1.vars) #> sum(X2.vars), sum(X2.vars) #> sum(X3.vars), if var(M[1,1]) then Vars = M.vars ++ X1.vars ++ X2.vars ++ X3.vars else Vars = X1.vars ++ X2.vars ++ X3.vars end, solve($[degree,updown],Vars). % solve_with_limit(Vars,2). % TEST println2(X,Print) => if Print then println(X) else print(".") end. % % p is the position of the maximum element % argmax(P, X) => foreach(I in 1..X.len) element(P,X,XP), P #!= I #=> (XP #> X[I]) end. solve_with_limit(Vars, Limit) => M = get_global_map(), M.put(limit, Limit), solve($[rand_var,rand_val],Vars), N = M.get(limit), (N > 0 -> M.put(limit, N-1) ; ! ). % % global_cardinality(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.