added some cleverness
This commit is contained in:
parent
da0350adc4
commit
8566986389
1 changed files with 30 additions and 17 deletions
47
068.hs
47
068.hs
|
@ -20,8 +20,9 @@
|
||||||
-- SOLUTION in English
|
-- SOLUTION in English
|
||||||
{-
|
{-
|
||||||
|
|
||||||
For each digit from 1 to 10:
|
Here is a backtracking solution.
|
||||||
put the digit in the current partially filled NGon
|
+ You can change the type from list to arrays.
|
||||||
|
Things should be clearly faster with arrays.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
import Data.List
|
import Data.List
|
||||||
|
@ -30,14 +31,16 @@ import Debug.Trace
|
||||||
|
|
||||||
-- For testing
|
-- For testing
|
||||||
-- gonSize = 3
|
-- gonSize = 3
|
||||||
-- magic = 9
|
|
||||||
|
|
||||||
gonSize = 5
|
gonSize = 5
|
||||||
|
|
||||||
data Choice = Choice [Int]
|
data Choice = Choice [Int]
|
||||||
|
|
||||||
safeIndex s l i = if (length l<i+1) then trace ("ERROR (" ++ s ++ "): " ++ show l ++ "(" ++ show i ++ ")") l!!i else l!!i
|
-- For debugging purpose
|
||||||
|
safeIndex s l i = if (length l<i+1)
|
||||||
|
then trace ("ERROR (" ++ s ++ "): " ++ show l ++ "(" ++ show i ++ ")") l!!i
|
||||||
|
else l!!i
|
||||||
|
|
||||||
|
-- A better show
|
||||||
instance Show Choice where
|
instance Show Choice where
|
||||||
show (Choice l)= str
|
show (Choice l)= str
|
||||||
where
|
where
|
||||||
|
@ -49,7 +52,7 @@ instance Show Choice where
|
||||||
b=2*(n-1)
|
b=2*(n-1)
|
||||||
lastelem=if n == gonSize then 1 else b+2
|
lastelem=if n == gonSize then 1 else b+2
|
||||||
|
|
||||||
|
-- Random Access Storage
|
||||||
class RAS a where
|
class RAS a where
|
||||||
at :: a -> Int -> Int
|
at :: a -> Int -> Int
|
||||||
nbChoices :: a -> Int
|
nbChoices :: a -> Int
|
||||||
|
@ -64,15 +67,20 @@ instance RAS Choice where
|
||||||
add (Choice l) e = Choice (l++[e])
|
add (Choice l) e = Choice (l++[e])
|
||||||
loop f (Choice l) = map f l
|
loop f (Choice l) = map f l
|
||||||
|
|
||||||
|
-- Return true if the current choices keep to be okay
|
||||||
testPartialGon :: Int -> Choice -> Bool
|
testPartialGon :: Int -> Choice -> Bool
|
||||||
testPartialGon magic c =
|
testPartialGon lineSum c =
|
||||||
let
|
let
|
||||||
n = nbChoices c
|
n = nbChoices c
|
||||||
nbLines = if n<2*gonSize then (n-1) `div` 2 else gonSize
|
nbLines = if n<2*gonSize then (n-1) `div` 2 else gonSize
|
||||||
in
|
in
|
||||||
all (testLine c magic) [1..nbLines]
|
all (testLine c lineSum) [1..nbLines]
|
||||||
|
|
||||||
testLine :: Choice -> Int -> Int -> Bool
|
-- test that line
|
||||||
|
testLine :: Choice -- the current partial number choosen
|
||||||
|
-> Int -- the sum to verify
|
||||||
|
-> Int -- the line of the n-gon
|
||||||
|
-> Bool -- the line of the n-gon = sum
|
||||||
testLine c val n =
|
testLine c val n =
|
||||||
let
|
let
|
||||||
b=max 0 2*(n-1)
|
b=max 0 2*(n-1)
|
||||||
|
@ -81,26 +89,31 @@ testLine c val n =
|
||||||
in
|
in
|
||||||
(==val) . sum . map (at c) $ line
|
(==val) . sum . map (at c) $ line
|
||||||
|
|
||||||
|
-- return the results
|
||||||
allTests :: [(Int,Choice)]
|
allTests :: [(Int,Choice)]
|
||||||
allTests = concatMap (\s -> testWith s (Choice []) (Choice [n,n-1..1]) ) [6..3*((gonSize*2)-1)]
|
allTests = concatMap (\s -> testWith s nothing allNumbers ) [6..3*(n-1)]
|
||||||
where
|
where
|
||||||
|
nothing = Choice []
|
||||||
|
allNumbers = Choice [n,n-1..1]
|
||||||
n=2*gonSize
|
n=2*gonSize
|
||||||
|
|
||||||
testWith :: Int -- Sum to verify
|
-- Where the lineSum occurs
|
||||||
-> Choice -- choosen
|
testWith :: Int -- Sum to verify
|
||||||
-> Choice -- left choices
|
-> Choice -- choosen
|
||||||
|
-> Choice -- left choices
|
||||||
-> [(Int,Choice)] -- successful choices
|
-> [(Int,Choice)] -- successful choices
|
||||||
testWith magic c lc =
|
testWith lineSum c lc =
|
||||||
if testPartialGon magic c
|
if testPartialGon lineSum c
|
||||||
then if nbChoices lc == 0
|
then if nbChoices lc == 0
|
||||||
then [(magic,c)]
|
then [(lineSum,c)]
|
||||||
else concat $ loop newTest lc
|
else concat $ loop newTest lc
|
||||||
else []
|
else []
|
||||||
where
|
where
|
||||||
len = nbChoices c
|
len = nbChoices c
|
||||||
|
-- newTest verify that no external number is superior to the first one.
|
||||||
newTest x = if len>=3 && (len `rem` 2 == 1) && x<at c 0
|
newTest x = if len>=3 && (len `rem` 2 == 1) && x<at c 0
|
||||||
then []
|
then []
|
||||||
else testWith magic (add c x) (remove lc x)
|
else testWith lineSum (add c x) (remove lc x)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
|
Loading…
Reference in a new issue