Jump to content

Solve a Hidato puzzle: Difference between revisions

Solve a Hidato puzzle (view source)

Revision as of 18:01, 19 May 2017

61 bytes added ,  7 years ago
→‎{{header|Haskell}}: Made an edit to avoid a Wiki formatting problem (+ hindent)
m (added more related tasks.)
(→‎{{header|Haskell}}: Made an edit to avoid a Wiki formatting problem (+ hindent))
Line 1,355:
 
=={{header|Haskell}}==
 
<lang haskell>{-# LANGUAGE TupleSections #-}
{-# LANGUAGE Rank2Types #-}
 
import qualified Data.IntMap as I
import Data.IntMap (IntMap)
Line 1,364:
import Data.Time.Clock
 
data BoardProblem = Board { cells :: IntMap (IntMap Int)
{ cells :: IntMap (IntMap Int)
, endVal :: Int▼
, onePosendVal :: (Int,Int)
, givensonePos :: [(Int], } deriving (Show,EqInt)
, givens :: [Int]
} deriving (Show, Eq)
 
tupIns x y v m = I.insert x (I.insert y v (I.findWithDefault I.empty x m)) m
 
tupLookup x y m = I.lookup x m >>= I.lookup y
 
makeBoard =
makeBoard = (\x -> x{givens = dropWhile (<=1) $ sort $ givens x})
(\x ->
. foldl' f (Board I.empty 0 (0,0) []) . concatMap (zip [0..])
x
. zipWith (\y w -> map (y,) $ words w) [0..]▼
where f bd{ (x,(y,v))givens = ifdropWhile v=(<="." then1) bd$ elsesort $ givens x
}) .
Board (tupIns x y (read v) (cells bd)) ▼
foldl' --'
(if read v > endVal bd then read v else endVal bd)▼
f
(if v=="1" then (x,y) else onePos bd)▼
(Board I.empty 0 (read0, v:givens0) bd[]) .
▲ concatMap (zip [0 ..]) . zipWith (\y w -> map (y, ) $ words w) [0 ..]
where
f bd (x, (y, v)) =
if v == "."
then bd
else Board
▲ Board (tupIns x y (read v) (cells bd))
▲ (if read v > endVal bd then read v else endVal bd)
then read v
▲ ,else endVal :: Intbd)
(if v == "1"
then (x, y)
▲ (if v=="1" then (x,y) else onePos bd)
(read v : givens bd)
 
hidato brd = listToMaybe $ h 2 (cells brd) (onePos brd) (givens brd) where
where
h nval pmap (x,y) gs | nval == endVal brd = [pmap]▼
h nval pmap (x, y) gs
| nval == head gs = if null nvalAdj then []
▲ h nval pmap (x,y) gs | nval == endVal brd = [pmap]
else h (nval+1) pmap (fst $ head nvalAdj) (tail gs)▼
| notnval $== nullhead nvalAdjgs = h (nval+1) pmap
if (fst $ headnull nvalAdj) gs
then []
| otherwise = hEmptyAdj▼
▲ else h (nval + 1) pmap (fst $ head nvalAdj) (tail gs)
where around = [(x-1,y-1),(x,y-1),(x+1,y-1), (x-1,y),(x+1,y)
| not $ null nvalAdj = h (nval + 1) pmap (fst $ ,(x-1,y+1head nvalAdj),(x,y+1),(x+1,y+1)] gs
▲ | otherwise = hEmptyAdj
lkdUp = map (\(x,y) -> ((x,y),tupLookup x y pmap)) around▼
where
nvalAdj = filter ((==Just nval) . snd) lkdUp▼
around =
hEmptyAdj = concatMap (\((nx,ny),_) -> h (nval+1)
[ (tupInsx nx- ny1, nvaly pmap) (nx,ny)- gs1)
$ filter, ((==Justx, 0)y .- snd1) lkdUp
, (x + 1, y - 1)
, (x - 1, y)
, (x + 1, y)
, (x - 1, y + 1)
, (x, y + 1)
, (x + 1, y + 1)
]
▲ lkdUp = map (\(x, y) -> ((x, y), tupLookup x y pmap)) around
▲ nvalAdj = filter ((== Just nval) . snd) lkdUp
hEmptyAdj =
concatMap
(\((nx, ny), _) -> h (nval + 1) (tupIns nx ny nval pmap) (nx, ny) gs) $
filter ((== Just 0) . snd) lkdUp
 
printCellMap cellmap = putStrLn $ concat strings
where
where maxPos = xyBy I.findMax maximum
minPosmaxPos = xyBy I.findMinfindMax minimummaximum
minPos = xyBy I.findMin minimum
xyBy :: (forall a. IntMap a -> (Int,a)) -> ([Int] -> Int) -> (Int, Int)
xyBy :: (forall a. xyByIntMap a b-> =(Int, a)) -> (fst[Int] -> Int) -> (aInt, cellmapInt)
xyBy a b = (fst (a cellmap), b $ map (fst . a . snd) $ I.toList cellmap)
strings = map f [(x,y) | y<-[snd minPos..snd maxPos]
map
, x<-[fst minPos..fst maxPos]]▼
f
f (x,y) = let z = if x == fst maxPos then "\n" else " " in▼
[ case tupLookup (x, y cellmap of )
| y <- [snd minPos .. snd maxPos] Nothing -> " " ++ z
▲ , x <- [fst minPos .. fst maxPos] ]
Just n -> (if n<10 then ' ':show n else show n) ++ z▼
f (x, y) =
let z =
▲ f (x,y) = let z = if x == fst maxPos then "\n" else " " in
then "\n"
else " "
in case tupLookup x y cellmap of
Nothing -> " " ++ z
Just n ->
(if n < 10
▲ Just n -> (if n<10 then ' ' :show n else show n) ++ z
else show n) ++
z
 
main = do
let sampleBoard = makeBoard sample
printCellMap $ cells sampleBoard
printCellMap $ fromJust $ hidato sampleBoard
 
sample = [" 0 33 35 0 0"
[ ," 0 33 035 24 220 0"
, ," 0 0 24 0 21 022 0"
, " 0 0 ," 0 2621 0 13 40 110"
, ,"27 0 026 0 13 9 0 40 111"
, ,".27 . 0 0 0 18 9 0 01"
, ,". . . . 0 0 718 0 0"
, ,". . . . . 0 . 7 50 0"]
, ". . . . . . 5 0"
]</lang>
Output:
{{Out}}
<pre> 0 33 35 0 0
0 0 24 22 0
Hout
9,655

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/211335"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information