aboutsummaryrefslogtreecommitdiff
path: root/haskell
diff options
context:
space:
mode:
authorCharles <sircharlesaze@gmail.com>2019-09-03 13:00:45 +0200
committerCharles <sircharlesaze@gmail.com>2019-09-03 13:00:45 +0200
commitabf4dbd8c27ff8f7a370fdd7f4c73924660dff3d (patch)
tree0a2cc5784aae01154881fa4fa89eda2384f3ab6f /haskell
parent55b4fc0d8b97e9fd2e922df2e6408bce40f9f93e (diff)
downloadproject_euler-abf4dbd8c27ff8f7a370fdd7f4c73924660dff3d.tar.gz
project_euler-abf4dbd8c27ff8f7a370fdd7f4c73924660dff3d.tar.bz2
project_euler-abf4dbd8c27ff8f7a370fdd7f4c73924660dff3d.zip
c problem 96 (haskell try)
Diffstat (limited to 'haskell')
-rw-r--r--haskell/097-large_non_mersenne_prime.hs5
-rw-r--r--haskell/wip/096_su_doku.hs74
2 files changed, 75 insertions, 4 deletions
diff --git a/haskell/097-large_non_mersenne_prime.hs b/haskell/097-large_non_mersenne_prime.hs
index a2f3f91..a8e57b2 100644
--- a/haskell/097-large_non_mersenne_prime.hs
+++ b/haskell/097-large_non_mersenne_prime.hs
@@ -13,7 +13,4 @@
-- this must be a nightmare in C
-main = putStrLn $ lastN 10 (show (28433 * 2 ^ 7830457 + 1))
-
-lastN :: Int -> [a] -> [a]
-lastN n xs = drop (length xs - n) xs
+main = putStrLn (show ((28433 * 2 ^ 7830457 + 1) `mod` 10 ^ 10))
diff --git a/haskell/wip/096_su_doku.hs b/haskell/wip/096_su_doku.hs
new file mode 100644
index 0000000..d61791d
--- /dev/null
+++ b/haskell/wip/096_su_doku.hs
@@ -0,0 +1,74 @@
+-- Su Doku (Japanese meaning number place) is the name given to a popular puzzle concept.
+-- Its origin is unclear, but credit must be attributed to Leonhard Euler who invented a
+-- similar, and much more difficult, puzzle idea called Latin Squares. The objective of
+-- Su Doku puzzles, however, is to replace the blanks (or zeros) in a 9 by 9 grid in such
+-- that each row, column, and 3 by 3 box contains each of the digits 1 to 9. Below is an
+-- example of a typical starting puzzle grid and its solution grid.
+--
+-- https://projecteuler.net/problem=96
+--
+-- A well constructed Su Doku puzzle has a unique solution and can be solved by logic,
+-- although it may be necessary to employ "guess and test" methods in order to eliminate
+-- options (there is much contested opinion over this). The complexity of the search
+-- determines the difficulty of the puzzle; the example above is considered easy because
+-- it can be solved by straight forward direct deduction.
+--
+-- The 6K text file, sudoku.txt (right click and 'Save Link/Target As...'), contains
+-- fifty different Su Doku puzzles ranging in difficulty, but all with unique solutions
+-- (the first puzzle in the file is the example above).
+--
+-- By solving all fifty puzzles find the sum of the 3-digit numbers found in the top left
+-- corner of each solution grid; for example, 483 is the 3-digit number found in the top
+-- left corner of the solution grid above.
+
+
+import Data.List(transpose, nub, elemIndex)
+import Data.Maybe(isJust, fromJust)
+
+main = do
+ -- print (reject sudoku)
+ -- print (isFull sudoku)
+ print sudoku
+ -- print (drop 4 sudoku)
+ -- print (replaceAt 4 2 sudoku 9)
+ print (backtrack $ Just sudoku)
+
+backtrack :: Maybe [[Int]] -> Maybe [[Int]]
+backtrack Nothing = Nothing
+backtrack (Just square)
+ | reject square = Nothing
+ | isFull square = Just square
+ | otherwise = head $ filter isJust (map backtrack (iterateSquare))
+ where iterateSquare = [Just (replaceAt i j square n) | n <- [1..9]]
+ where j = fromJust $ head $ filter isJust (map (elemIndex 0) square)
+ i = fromJust $ elemIndex True (map (elem 0) square)
+
+replaceAt :: Int -> Int -> [[Int]] -> Int -> [[Int]]
+replaceAt i j xs n = beforeRows ++ middleRow ++ afterRows
+ where beforeRows = take i xs
+ afterRows = reverse $ take (8 - i) (reverse xs)
+ middleRow = [take j row ++ [n] ++ (reverse $ take (8 - i) (reverse row))]
+ row = xs !! i
+
+reject :: [[Int]] -> Bool
+reject square = not $ all isUniqLine square && all isUniqLine (transpose square)
+ where isUniqLine line = length (nub line) == length line
+
+isFull :: [[Int]] -> Bool
+isFull square = not $ or $ map (any (/= 0)) square
+
+next :: [[Int]] -> Maybe [[Int]]
+next square = Just [[]]
+
+
+sudoku = [ [0, 0, 3, 0, 2, 0, 6, 0, 0]
+ , [9, 0, 0, 3, 0, 5, 0, 0, 1]
+ , [0, 0, 1, 8, 0, 6, 4, 0, 0]
+ , [0, 0, 8, 1, 0, 2, 9, 0, 0]
+ , [7, 0, 0, 0, 0, 0, 0, 0, 8]
+ , [0, 0, 6, 7, 0, 8, 2, 0, 0]
+ , [0, 0, 2, 6, 0, 9, 5, 0, 0]
+ , [8, 0, 0, 2, 0, 3, 0, 0, 9]
+ , [0, 0, 5, 0, 1, 0, 3, 0, 0]
+ ]
+