宇都宮大学教育学部 教育実践総合センター紀要 第 35 号 2012 年 7 月 1 日 15 パズルと Mathematica 佐藤禎宏 ** 長縄直崇 * 宇都宮大学教育学部 ** 名古屋大学理学研究科 13 14 15 13 15 14 Range list0 = Range[16] {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16} m0 = Partition[list0,4] Yoshihiro Sato*, Naotaka Naganawa**: 15 Puzzle Yoshihiro Sato, Naotaka Naganawa : {{1,2,3,4},{5,6,7,8},{9,10,11,12}, 15 and Puzzle Mathematica and Mathematica * {13,14,15,16}} Faculty of of Education, Utsunomiya University University ** Graduate School of of Science, Nagoya Nagoya University University - 335 -
MatrixForm[ mat0 = m0 /. {16 -> " "} ] 9 10 11 13 14 15 12 MatrixForm[ m2 = {{1,2,3,4},{5,6,7,8},{9,10,11,16}, {13,14,15,12}}] list2 = Flatten[m2] {1,2,3,4,5,6,7,8,9,10,11,16,13,14,15,12} PermutationCycles Cycles cycles = PermutationCycles[list2] Cycles[{{12,16}}] PermutationReplace cycles list2 PermutationReplace[Range[16],cycles] {1,2,3,4,5,6,7,8,9,10,11,16,13,14,15,12} list2 == PermutationReplace[Range[16], cycles] True 8 7 6 5 16 15 14 13-336 -
= (10,11,12,13,14) 8 7 6 5 16 15 14 13 8 7 6 5 15 12 14 16 15 14 13 13 14 15 13 9 11 10 pl2cf (placement0 = Partition[Range[16], 4] /. {16 -> " "}) // MatrixForm initialcf = pl2cf[placement0] {1,2,3,4,8,7,6,5,9,10,11,12,15,14,13} (placement1={{1,2,3,4},{5,6,7,8}, {15," ",12,14},{13,9,11,10}}) // MatrixForm startcf = pl2cf[placement1] {1,2,3,4,8,7,6,5,14,12,13,10,15,11,9} findpermutationreplace permutationsignature initialcf startcf cycles1 = findpermutationreplace[initialcf, startcf] Cycles[{{9,14,11,13},{10,12}}] permutationsignature[cycles1] placement2 = {{1,2,3,4},{5,6,7,8}, {9,10,11,12},{13,15,14," "}}; startcf2 = pl2cf[placement2] {1,2,3,4,8,7,6,5,9,10,11,12,15,13,14} cycles2 = findpermutationreplace[initialcf, startcf2] Cycles[{{13,14}}] permutationsignature[cycles2] parityq parityq[placement0, placement2] i,j i,i+1, i = 1,..., 15-1 j,i i,j 1,8 2,7 3,6, 5,12, 6,11 7,10 9,16 10,15 11,14 PermutationGroup AlternatingGroup[15] 10,15 = (10,11,12,13,14) - 337 -
startcf pl2 = {{1,2,3,4},{5,6,7,8},{15,9,12,14}, {13, " ",11,10}}; cf2 = pl2cf[pl2] {1,2,3,4,8,7,6,5,10,13,14,11,15,12,9} 10,15 =findpermutationreplace[startcf, cf2] Cycles[{{10,11,12,13,14}}] effectmove manhattandistance iterate (desired=partition[range[16]/.{16->" "},4]) // MatrixForm 1,8 = Cycles[{{1, 2, 3, 4, 5, 6, 7}}]; 2,7 = Cycles[{{2, 3, 4, 5, 6}}]; 3,6 = Cycles[{{3, 4, 5}}]; 5,12 = Cycles[{{5, 6, 7, 8, 9, 10, 11}}]; 6,11 = Cycles[{{6, 7, 8, 9, 10}}]; 7,10 = Cycles[{{7, 8, 9}}]; 9,16 = Cycles[{{9, 10, 11, 12, 13, 14, 15}}]; 11,14 = Cycles[{{11, 12, 13}}]; list = 1,8 2,7 3,6, 5,12 6,11, 7,10, 9,16, 10,15 11,14 }; PermutationGroup[list] == AlternatingGroup[15] True GroupOrder GroupOrder[AlternatingGroup[15]]== 15!/2 True moves moves Left Right moves desired Up Left moves[desired] {"Up", "Left"} effectmove Left effectmove[desired, "Left"] // MatrixForm (firstmove = effectmove[desired, "Left", "Left", "Up", "Up"]) // MatrixForm manhattandistance desired firstmove - 338 -
manhattandistance[desired, firstmove] P0 moves m1, m2 P1, P2 effectmove P0 m1, m2 listscores P0 firstmoves m1 m2 P1 P2 secondmoves m11 m12 P11 P12 thirdmoves m111 m112 P111 P112 P1, P2 P0 P1 P2 m1 m2 listscores[p0] firstmoves ={{a,m1},{b,m2}} a b a < b firstmoves P11 P12 iterate[p0,firstmoves] secondmoves={{c,m1,m11},{d,m1,m12},{b,m2}}, c < d < b secondmoves P111 P112 thirdmoves iterate[p0,secondmoves] worthwhile bestscore try start = effectmove[desired, "Left", "Up", "Left"]; result = try[start, 10] The following solution was found {0, "Right", "Down", "Right"} puzseq = FoldList[effectmove[#1, #2] &, start, Rest[result]]; viewlolol[puzseq] Partition[RandomSample[Range[16]] /. {16 -> " "}, 4]; - 339 -
parityq[desired, realstart] 1 list1= Flatten[realstart /. {" " -> 16}]; list2= Flatten[desired /. {" " -> 16}]; perm1=findpermutationreplace[list1, list2] Cycles[{{1,15,8,10,16,11,9,6,5,14,2,12,3, 7,4}}] try try[realstart, 1000] Solution not found, best sequence was {28, "Right", "Up",, "Up", "Up"} moves newtryn result = newtryn[realstart] {0, "Down", "Left", "Up",..., "Right", "Right"} Length[Rest[result]] perm1 puzseq2cycles puzseq= FoldList[effectmove[#1, #2] &, realstart, Rest[result]]; cyclesset = puzseq2cycles[puzseq]; perm2=permutationproduct @@ cyclesset Cycles[{{1,15,8,10,16,11,9,6,5,14,2,12,3, 7,4}}] perm2 == perm1 True - 340 -
Appendix1 (1) (Configuration) pl2cfmat_list? MatrixQ : Modulerule, cellconf, blank, rule 1, 1 1, 1, 2 2, 1, 3 3, 1, 4 4, 2, 1 8, 2, 2 7, 2, 3 6, 2, 4 5, 3, 1 9, 3, 2 10, 3, 3 11, 3, 4 12, 4, 1 16, 4, 2 15, 4, 3 14, 4, 4 13; cellconf Positionmat, & Range15. rule; blank Positionmat, &" ". rule; If blank, 1, & cellconf (2) findpermutationreplacelst1_, lst2_ : Maplst1 &, FindPermutationlst2, lst1, 3 permutationsignatureperm_?permutationcyclesq : ApplyTimes, 1^Length Firstperm 1 parityqx_list? MatrixQ, y_list? MatrixQ : permutationsignaturefindpermutationreplacepl2cfx, pl2cfy Appendix2 15 [ 5 ] viewlolola_list : MapMatrixForm, TableSpacing 1, 1 &, a; desired Partition Range16. 16 " ", 4; (1) moves movescurrent_? MatrixQ : Moduleanswer, xdim, ydim, place, xpos, ypos, answer "Up", "Down", "Left", "Right"; ydim Lengthcurrent; xdim Lengthcurrent1; place Positioncurrent, " "; xpos place1, 2; ypos place1, 1; Ifxpos xdim, answer Dropanswer, 4; Ifxpos 1, answer Dropanswer, 3; Ifypos ydim, answer Dropanswer, 2; Ifypos 1, answer Dropanswer, 1; answer (2) effectmove effectmovea, b, " ", c_, d, e, "Right" : a, b, c, " ", d, e effectmovea, b, c_, " ", d, e, "Left" : a, b, " ", c, d, e effectmovea_, "Up" : TransposeeffectmoveTransposea, "Left" effectmovea_, "Down" : TransposeeffectmoveTransposea, "Right" effectmovea_list, b_string, c String : effectmoveeffectmovea, b, c - 341 -
(3) : manhattandistance manhattandistance::incompat "Manhattan distance can only be computed for matrices with tha same dimension"; manhattandistancex_list, y_list : Moduletemp, IfDimensionsx Dimensionsy, Messagemanhattandistance::incompat, temp MapFlattenPositiony, &, x, 2; temp temp MapFlattenPositionx, &, x, 2; temp TotalFlattenAbstemp (4) listscoresx_ : Modulemakemoves, ans, makemoves Mapeffectmovex, &, movesx; ans FlattenMapmanhattandistance1, desired &, makemoves; Transposeans, movesx worthwhilex, "Right", "Left" : False; worthwhilex, "Left", "Right" : False; worthwhilex, "Up", "Down" : False; worthwhilex, "Down", "Up" : False; worthwhilex : True bestscorex_list, y_list, delta_: 0.2 : Ifx1 y1 delta LengthResty LengthRestx, True, False iteratestart_, x_, y, z : Moduleendnode, newnodes, newseq, endnode effectmovestart, y; newnodes listscoresendnode; newseq MapJoinFirst, y, Rest &, newnodes; SortJoinSelectnewseq, worthwhile, z, bestscore; trystart_, n_ : Moduletemp, count, count 0; temp listscoresstart; Whiletemp1, 1 0 && count n, temp iteratestart, temp; count count 1; Ifcount n && temp1, 1 0, Print"Solution not found, best sequence was", Print"The following solution was found"; temp1 (5) findpermutationreplacelst1_, lst2_ : Maplst1 &, FindPermutationlst2, lst1, 3 tolistmat_ : Flattenmat. " " 16 puzseq2cyclespuzseq_ : MapThreadfindPermutationReplacetoList1, tolist2 &, Mostpuzseq, Restpuzseq - 342 -