------------------------------------------------------------------------------- |-- Module : Data. SBV.Examples. Puzzles. MagicSquare-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental-- Portability : portable---- Solves the magic-square puzzle.  An NxN magic square is one where all entries-- are filled with numbers from 1 to NxN such that sums of all rows, columns-- and diagonals is the same.-----------------------------------------------------------------------------moduleData. SBV.Examples. Puzzles. MagicSquarewhereimportData. List(genericLength,transpose)importData. SBV-- | Use 32-bit words for elements.typeElem=SWord32-- | A row is a list of elementstypeRow=[Elem]-- | The puzzle board is a list of rowstypeBoard=[Row]-- | Checks that all elements in a list are within boundscheck::Elem->Elem->[Elem]->SBoolchecklowhighgrp=bAllrangeFinegrpwhererangeFinex=x.>=low&&&x.<=high-- | Get the diagonal of a square matrixdiag::[[a]]->[a]diag((a:_):rs)=a:diag(maptailrs)diag_=[]-- | Test if a given board is a magic squareisMagic::Board->SBoolisMagicrows=bAnd$fromBoolisSquare:allEqual(mapsumitems):allDifferent(concatrows):mapchkitemswhereitems=d1:d2:rows++columnsn=genericLengthrowsisSquare=all(\r->genericLengthr==n)rowscolumns=transposerowsd1=diagrowsd2=diag(mapreverserows)chk=check(literal1)(literal(n*n))-- | Group a list of elements in the sublists of length @i@chunk::Int->[a]->[[a]]chunk_[]=[]chunkixs=let(f,r)=splitAtixsinf:chunkir-- | Given @n@, magic @n@ prints all solutions to the @nxn@ magic square problemmagic::Int->IO()magicn|n<0=putStrLn$"n must be non-negative, received: "++shown|True=doputStrLn$"Finding all "++shown++"-magic squares.."res<-allSat$mkFreeVarsn2>>=return.isMagic.chunkncnt<-displayModelsdispresputStrLn$"Found: "++showcnt++" solution(s)."wheren2=n*ndispimodel|lmod/=n2=error$"Impossible!  Backend solver returned "++shown++" values, was expecting: "++showlmod|True=doputStrLn$"Solution #"++showimapM_printRowboardputStrLn$"Valid Check: "++show(isMagicsboard)putStrLn"Done. "wherelmod=lengthmodelboard=chunkn$modelsboard=map(mapliteral)boardsh2z=lets=showziniflengths<2then' ':selsesprintRowr=putStr" ">>mapM_(\x->putStr((sh2x)++" "))r>>putStrLn""