4-rings or 4-squares puzzle: Difference between revisions
→Haskell :: By structured search: Tidied
m (→{{header|Phix}}: added syntax colouring the hard way) |
(→Haskell :: By structured search: Tidied) |
||
Line 2,749:
Probably less readable, but already fast, and could be further optimised.
<lang haskell>import Data.List (delete, sortBy, (\\))
--------------- 4 RINGS OR 4 SQUARES PUZZLE --------------
type Rings = [(Int, Int, Int, Int, Int, Int, Int)]
Line 2,756:
rings :: Bool -> [Int] -> Rings
rings u digits =
((>>=) <*> (queen u =<< head))
queen :: Bool -> Int -> [Int] -> Int -> Rings
queen u h ds q = xs >>= leftBishop u q h ts ds
where
xs
| u = delete q ts
Bool ->
▲leftBishop u q h ts ds lb =
Int ->
let lRook = lb + q▼
[Int] ->
(bool ds (ts \\ [q, lb, lRook]) u >>= rightBishop u q h lb ds lRook)▼
Int ->
▲ (lRook <= h)
Rings
leftBishop u q h ts ds lb
| otherwise = []
where
xs
| otherwise = ds
rightBishop ::
Bool ->
rightBishop u q h lb ds lRook rb =▼
Int ->
let rRook = q + rb▼
Int
[Int] ->
▲ (let ks = bool ds (ds \\ [q, lb, rb, rRook, lRook]) u
Int ->
in ks >>= knights u (lRook - rRook) lRook lb q rb rRook ks)▼
Int ->
((rRook <= h) && (not u || (rRook /= lb)))▼
Rings
let ks
| u = (ds \\ [q, lb, rb, rRook, lRook])
| otherwise = ds
in ks
>>= knights
u
(lRook - rRook)
lRook
lb
q
rb
rRook
ks
| otherwise = []
where
knights ::
Bool ->
Int ->
Int ->
Int ->
Int ->
Int ->
Int ->
[Int] ->
Int ->
Rings
knights u rookDelta lRook lb q rb rRook ks k =
let k2 = k + rookDelta▼
| (k2 `elem` ks)
▲ in [ (lRook, k, lb, q, rb, k2, rRook)
|| notElem
k2
)
]
where
-
main :: IO ()
main = do
Line 2,795 ⟶ 2,842:
mapM_
f
[ ("rings True [1 .. 7]", rings True [1 .. 7]),
]
f
f ("length (rings False [0 .. 9])", [length (rings False [0 .. 9])])</lang>▼
( "length (rings False [0 .. 9])",
)</lang>
{{Out}}
<pre>rings True [1 .. 7]
| |||