As part of some "self imposed homework" on Haskell study, I did the classic solution of the Towers of Hanoi:
doHanoi :: Int -> Int -> Int -> [(Int, Int)]
doHanoi 0 _ _ = []
doHanoi n from to = first ++ [(from, to)] ++ last
where
using = 3 - from - to;
first = doHanoi (n - 1) from using;
last = doHanoi (n - 1) using to
(where the meaning of doHanoi n from to using get the asequence of movements assuming the disks 0.. n - 1 are at peg from, and we need to move them to peg to.)
This gives the sequence of movements, e.g.,
>>> doHanoi 3 0 2
[(0,2),(0,1),(2,1),(0,2),(1,0),(1,2),(0,2)]
I then wanted to see if I could transform the output into the set of configurations (i.e., initially, all rings are on the left peg, then there are intermediate configurations, finally all rings are on the right peg). I could do this by writing a changeConfig function
changeConfig :: [[Int]] -> (Int, Int) -> [[Int]]
changeConfig [e0:e0s, e1s, e2s] (0, 1) = [e0s, e0:e1s, e2s]
changeConfig [e0:e0s, e1s, e2s] (0, 2) = [e0s, e1s, e0:e2s]
changeConfig [e0s, e1:e1s, e2s] (1, 0) = [e1:e0s, e1s, e2s]
changeConfig [e0s, e1:e1s, e2s] (1, 2) = [e0s, e1s, e1:e2s]
changeConfig [e0s, e1s, e2:e2s] (2, 0) = [e2:e0s, e1s, e2s]
changeConfig [e0s, e1s, e2:e2s] (2, 1) = [e0s, e2:e1s, e2s]
then using scanl:
>>> scanl changeConfig [[0.. 2], [], []] (doHanoi 3 0 2 1)
[[[0,1,2],[],[]],[[1,2],[],[0]],[[2],[1],[0]],[[2],[0,1],[]],[[],[0,1],[2]],[[0],[1],[2]],[[0],[],[1,2]],[[],[],[0,1,2]]]
While this works, I think I'm missing something in changeConfig: this is just an exhaustive enumeration of all configurations, in a setting that has some form of cyclic symmetry, that happened to work because there are three pegs, and would not scale well (in terms of LOC). What is the "Haskellic" way to write it?
Thanks to kind help by chepner and jberryman, here's what I came up with.
The function finding the movements is unchanged:
doHanoi :: Int -> Int -> Int -> [(Int, Int)]
doHanoi 0 _ _ = []
doHanoi n from to = first ++ [(from, to)] ++ last
where
using = 3 - from - to;
first = doHanoi (n - 1) from using;
last = doHanoi (n - 1) using to
Now an auxiliary function, changePeg es i from to new_e returns the output to peg i assuming it contained elements es, its index was i, the movement was from from to to, and of element new_e.
changePeg :: [Int] -> Int -> Int -> Int -> Int -> [Int]
changePeg es i from to new_e
| i == from = tail es
| i == to = new_e: es
| otherwise = es
Using this, changeConfig becomes
changeConfig :: [[Int]] -> (Int, Int) -> [[Int]]
changeConfig es (from, to) = new_es where
new_e = head $ es !! from;
new_es = [changePeg (es !! i) i from to new_e | i <- [0.. 2]]
As before, the solution can be found with
>>> scanl changeConfig [[0.. 2], [], []] (doHanoi 3 0 2)
[[[0,1,2],[],[]],[[1,2],[],[0]],[[2],[1],[0]],[[2],[0,1],[]],[[],[0,1],[2]],[[0],[1],[2]],[[0],[],[1,2]],[[],[],[0,1,2]]]
Related
I'm new to haskell and I'm trying to create an expression, that gives a list of integers from 0 to n, which are divisible by 3. The script I wrote doesn't work and I'm not sure for what reason.
zeroto :: Int -> [Int]
zeroto n = [x | x <- [0..n]]
where
x "mod" 3 == 0
where doesn't work like that. It's not a filter -- it's locally-scoped definitions.
However, a list comprehension does allow for filters, you've just not put it in the right place.
zeroto :: Int -> [Int]
zeroto n = [x | x <- [0..n], x `mod` 3 == 0]
Alternatively, you could define a filter function in the where block and filter afterwards, but this is kind of silly.
zeroto :: Int -> [Int]
zeroto n = divisibleByThree [0..n]
where divisibleByThree = filter (\x -> x `mod` 3 == 0)
This is not the best way but using simple recursion it can be done as
mod3Arr :: Int -> [Int]
mod3Arr 0 = [0]
mod3Arr n | nmod3 == 0 = smallerArr ++ [n]
| otherwise = smallerArr
where smallerArr = mod3Arr ( n - 1)
The following code with any real-logic "hollowed out" still runs out of memory when compiled on GHC 7.10.3 with the -O flag. I do not understand why a simple tree recursion with at-most a stack-depth of 52 (number of cards in a standard deck) needs so much memory. I tried using seq on the result variables, but that did not help. Could someone take a look and let me know why the memory usage is so high, and what can I do to avoid it?
import qualified Data.Map.Strict as M
type Card = (Int, Char)
compute_rank_multiplicity_map :: [Card] -> M.Map Int Int
compute_rank_multiplicity_map cards = M.fromList [(x, x) | (x, _) <- cards]
determine_hand :: [Card] -> (Int, [(Int, Int)])
determine_hand [] = error "Card list is empty!"
determine_hand cards = (0, mult_rank_desc_list)
where rank_mult_map = compute_rank_multiplicity_map cards
mult_rank_desc_list = M.toDescList rank_mult_map
check_kicker_logic :: [Card] -> (Int, Int)
check_kicker_logic cards =
let first_cards = take 5 cards
second_cards = drop 5 cards
first_hand#(f_h, f_mrdl) = determine_hand first_cards
second_hand#(s_h, s_mrdl) = determine_hand second_cards
in if (first_hand > second_hand) || (first_hand < second_hand) -- is there a clear winner?
then if (f_h == s_h) && (head f_mrdl) == (head s_mrdl) -- do we need kicker logic?
then (1, 1)
else (0, 1)
else (0, 0)
card_deck :: [Card]
card_deck = [(r, s) | r <- [2 .. 14], s <- ['C', 'D', 'H', 'S']]
need_kicker_logic :: [Card] -> (Int, Int)
need_kicker_logic cards = visit_subset cards (length cards) [] 0 (0, 0)
where visit_subset a_cards num_a_cards picked_cards num_picked_cards result#(num_kicker_logic, num_clear_winners)
| num_cards_needed == 0 = (num_kicker_logic + nkl, num_clear_winners + ncw)
| num_cards_needed > num_a_cards = result
| otherwise = let result_1 = visit_subset (tail a_cards)
(num_a_cards - 1)
picked_cards
num_picked_cards
result
result_2 = visit_subset (tail a_cards)
(num_a_cards - 1)
((head a_cards) : picked_cards)
(num_picked_cards + 1)
result_1
in result_2
where num_cards_needed = 10 - num_picked_cards
(nkl, ncw) = check_kicker_logic picked_cards
main :: IO ()
main =
do
putStrLn $ show $ need_kicker_logic card_deck
I'm trying to transform my recursive Fibonacci function into an iterative solution. I tried the following:
fib_itt :: Int -> Int
fib_itt x = fib_itt' x 0
where
fib_itt' 0 y = 0
fib_itt' 1 y = y + 1
fib_itt' x y = fib_itt' (x-1) (y + ((x - 1) + (x - 2)))
I want to save the result into variable y and return it when the x y matches with 1 y, but it doesn't work as expected. For fib_itt 0 and fib_itt 1, it works correctly, but for n > 1, it doesn't work. For example, fib_rek 2 returns 1 and fib_rek 3 returns 2.
Your algorithm is wrong: in y + (x-1) + (x-2) you only add up consecutive numbers - not the numbers in the fib.series.
It seems like you tried some kind of pair-approach (I think) - and yes it's a good idea and can be done like this:
fib :: Int -> Int
fib k = snd $ fibIt k (0, 1)
fibIt :: Int -> (Int, Int) -> (Int, Int)
fibIt 0 x = x
fibIt k (n,n') = fibIt (k-1) (n',n+n')
as you can see: this passes the two needed parts (the last and second-to-last number) around as a pair of numbers and keeps track of the iteration with k.
Then it just gives back the second part of this tuple in fib (if you use the first you will get 0,1,1,2,3,... but of course you can adjust the initial tuple as well if you like (fib k = fst $ fibIt k (1, 1)).
by the way this idea directly leeds to this nice definition of the fib.sequence if you factor the iteration out to iterate ;)
fibs :: [Int]
fibs = map fst $ iterate next (1,1)
where
next (n,n') = (n',n+n')
fib :: Int -> Int
fib k = fibs !! k
Below I have defined a function that converts a list of base-3 digits to the corresponding numerical value. For example:
f "201" = (2 * 3^2) + (0 * 3^1) + (1 * 3^0) = 19
f "12" = 5
f "1202" = 47
f "120221" = 430
Here is a definition using comprehension:
f :: String -> Int
f str = sum (listToFinal (stringToTuples str))
Helper functions:
-- 1) converts "201" to "102"
reverse "str"
-- 2) converts "102" to 102
stringToInt :: String -> Int
stringToInt str = read str :: Int
-- 3) converts 102 to ['1','0','2']
intToList :: Int -> [Int]
intToList 0 = []
intToList x = intToList (x `div` 10) ++ [x `mod` 10]
-- 4) converts "201" to [(1,0),(0,1),(2,2)] using reverse, stringToInt, intToList
stringToTuples :: String -> [(Int,Int)]
stringToTuples str = zip (intToList (stringToInt (reverse str))) [0..]
-- 5) converts [(1,0),(0,1),(2,2)] to [1*3^0, 0*3^1, 2*3^2]
listToFinal :: [(Int,Int)] -> [Int]
listToFinal list = [ x * (3^y) | (x,y) <- list ]
Now I'd like to do it with recursion only (well, using basic & library functions too, of course).
An idea: I was thinking of taking the head of each element in the list and simply multiplying it with 3^(length of string - 1). The only problem is, with each recursive call the power of three would have to decrease by 1, e.g. given:
recursive_version "201" = (2 * 3^2) + (0 * 3^1) + (1 * 3^0)
How to implement this?
Here is a much simpler approach; note that, through the use of foldl, it's only "implicitly" recursive, though. For information, digitToInt is exported by Data.Char.
import Data.Char
import Data.List ( foldl' )
--- horner x xs : the value of polynomial 'xs' at point 'x'
horner :: Int -> [Int] -> Int
horner x = foldl' (\c1 c0 -> c1 * x + c0) 0
-- f s : the integer whose representation in base 3 is string 's'
f :: String -> Int
f = horner 3 . map digitToInt
When you define it recursively, the natural way to decrement the length is trimming the array from the head. For example:
base3 x = base3' x 0 where
base3' (d:ds) v = base3' ds $ v + d * 3 ^ length ds
base3' [] v = v
I am doing another Project Euler problem and I need to find when the result of these 3 lists is equal (we are given 40755 as the first time they are equal, I need to find the next:
hexag n = [ n*(2*n-1) | n <- [40755..]]
penta n = [ n*(3*n-1)/2 | n <- [40755..]]
trian n = [ n*(n+1)/2 | n <- [40755..]]
I tried adding in the other lists as predicates of the first list, but that didn't work:
hexag n = [ n*(2*n-1) | n <- [40755..], penta n == n, trian n == n]
I am stuck as to where to to go from here.
I tried graphing the function and even calculus but to no avail, so I must resort to a Haskell solution.
Your functions are weird. They get n and then ignore it?
You also have a confusion between function's inputs and outputs. The 40755th hexagonal number is 3321899295, not 40755.
If you really want a spoiler to the problem (but doesn't that miss the point?):
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch func low high
| low == high = low
| func mid = search low mid
| otherwise = search (mid + 1) high
where
search = binarySearch func
mid = (low+high) `div` 2
infiniteBinarySearch :: Integral a => (a -> Bool) -> a
infiniteBinarySearch func =
binarySearch func ((lim+1) `div` 2) lim
where
lim = head . filter func . lims $ 0
lims x = x:lims (2*x+1)
inIncreasingSerie :: (Ord a, Integral i) => (i -> a) -> a -> Bool
inIncreasingSerie func val =
val == func (infiniteBinarySearch ((>= val) . func))
figureNum :: Integer -> Integer -> Integer
figureNum shape index = (index*((shape-2)*index+4-shape)) `div` 2
main :: IO ()
main =
print . head . filter r $ map (figureNum 6) [144..]
where
r x = inIncreasingSerie (figureNum 5) x && inIncreasingSerie (figureNum 3) x
Here's a simple, direct answer to exactly the question you gave:
*Main> take 1 $ filter (\(x,y,z) -> (x == y) && (y == z)) $ zip3 [1,2,3] [4,2,6] [8,2,9]
[(2,2,2)]
Of course, yairchu's answer might be more useful in actually solving the Euler question :)
There's at least a couple ways you can do this.
You could look at the first item, and compare the rest of the items to it:
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [4,5,6] ]
False
Prelude> (\x -> all (== (head x)) $ tail x) [ [1,2,3], [1,2,3], [1,2,3] ]
True
Or you could make an explicitly recursive function similar to the previous:
-- test.hs
f [] = True
f (x:xs) = f' x xs where
f' orig (y:ys) = if orig == y then f' orig ys else False
f' _ [] = True
Prelude> :l test.hs
[1 of 1] Compiling Main ( test.hs, interpreted )
Ok, modules loaded: Main.
*Main> f [ [1,2,3], [1,2,3], [1,2,3] ]
True
*Main> f [ [1,2,3], [1,2,3], [4,5,6] ]
False
You could also do a takeWhile and compare the length of the returned list, but that would be neither efficient nor typically Haskell.
Oops, just saw that didn't answer your question at all. Marking this as CW in case anyone stumbles upon your question via Google.
The easiest way is to respecify your problem slightly
Rather than deal with three lists (note the removal of the superfluous n argument):
hexag = [ n*(2*n-1) | n <- [40755..]]
penta = [ n*(3*n-1)/2 | n <- [40755..]]
trian = [ n*(n+1)/2 | n <- [40755..]]
You could, for instance generate one list:
matches :: [Int]
matches = matches' 40755
matches' :: Int -> [Int]
matches' n
| hex == pen && pen == tri = n : matches (n + 1)
| otherwise = matches (n + 1) where
hex = n*(2*n-1)
pen = n*(3*n-1)/2
tri = n*(n+1)/2
Now, you could then try to optimize this for performance by noticing recurrences. For instance when computing the next match at (n + 1):
(n+1)*(n+2)/2 - n*(n+1)/2 = n + 1
so you could just add (n + 1) to the previous tri to obtain the new tri value.
Similar algebraic simplifications can be applied to the other two functions, and you can carry all of them in accumulating parameters to the function matches'.
That said, there are more efficient ways to tackle this problem.