For practising Haskell, I have implemented Fermat's factorization method (see https://en.wikipedia.org/wiki/Fermat%27s_factorization_method). However when I run my program, Haskell keeps telling me:
$ ./fermat 7
fermat: <<loop>>
so it seems, that there's an endless loop in my Code (cmp. http://www.haskell.org/pipermail/haskell-cafe/2013-June/108826.html). Can anyone give me a hint, what I'm doing wrong?
Also I would like to extend the question How to debug Haskell code? for tips on how this particular exception can be debugged.
import Data.List
import System.Environment
import Debug.Trace
isQuad :: Integer -> Bool
isQuad x = a == b
where
a = ceiling $ s
b = floor $ s
s = sqrt (fromIntegral x :: Double)
test :: Integer -> Integer -> Integer -> Bool
test nr n s = trace(show nr ++ " " ++ show n ++ " " ++ show s)
isQuad(
(+)
( (\j -> j * j) s + nr )
(-n)
)
fermat :: Integer -> (Integer, Integer)
fermat n = (s + x, s - x)
where
s = ceiling $ sqrt (fromIntegral x :: Double)
r = trace
(show s ++ " " ++ show n)
(\(Just i) -> i) $
find
(\nr -> test nr n s)
[0..n]
x = floor $ sqrt (fromIntegral r :: Double)
fact :: Integer -> (Integer, Integer)
fact x
| x == 1 = (1, 1)
| even x = (2, x `div` 2)
| otherwise = fermat x
f :: String -> String
f x = x ++ " = " ++ show a ++ " x " ++ show b
where
(a, b) = fact $ (read x :: Integer)
main = do
args <- getArgs
putStrLn $ unlines $ map f args
In fermat, s depends on x, x depends on r, and r depends on s.
Sometimes laziness might make this kind of cyclic dependency ok, but in this case all the dependencies seem to be strict.
This is just from inspection and I don't have any particular advice on how to debug the problem in general beyond that in the linked post.
I would say that <<loop>> implies that the run-time system has been able to detect an infinite loop, which means that a value depends on itself, e.g. let x = x + 1 in x. So that's a bit of a clue for tracking down the problem.
If you wrote an infinite loop in function calls, e.g. let f x = f x + 1 in f 1, it typically would just run forever. Sometimes the optimizer might turn these function calls into values, but it can't do so in general.
Related
I want to convert an enum into Int or vice verse, i.e. implement an bidirectional mapping between the tag of sum type and Int. I have tried fromEnum but it seems not fast enough, and then I tried unsafeCoerce but it doesn't works as expected:
import Data.Time.Clock
import Data.Int
import Unsafe.Coerce
import Control.Monad (replicateM_)
data Color = R | G | B
deriving (Enum)
main = do
printT 1 $ (unsafeCoerce R :: Int8)
printT 1000 $ (unsafeCoerce G :: Int8)
printT 1000000 $ (unsafeCoerce B :: Int8)
printT 1000000000 $ (unsafeCoerce R :: Int8)
printT 1 $ (fromEnum R)
printT 1000 $ (fromEnum G)
printT 1000000 $ (fromEnum B)
printT 1000000000 $ (fromEnum B)
---------- profile tools ------------
printT :: Show a => Int -> a -> IO ()
printT n x = print =<< timeIt n (pure x)
timeIt :: Int -> IO a -> IO a
timeIt n _ | n <= 0 = error "timeIt n | n <= 0"
timeIt n proc = do
t0 <- getCurrentTime
replicateM_ (n-1) proc
x <- proc
t1 <- getCurrentTime
putStrLn ("-- Time Used (repeat " ++ show n ++ " times): " ++ show (t1 `diffUTCTime` t0))
return x
So what is the fastest way to do this?
Is the Enum you actually care about your type, or someone else's? If it's someone else's, then you're not guaranteed any methods you can use besides fromEnum, so you're out of luck. If it's your own type, then you can reimplement it with a newtype and pattern synonyms instead of deriving, so that fromEnum is literally free (provided the compiler can specialize it wherever you use it):
{-# LANGUAGE PatternSynonyms #-}
module ColorEnum (Color(R,G,B)) where
import Data.Coerce (coerce)
newtype Color = UnsafeColor Int
pattern R, G, B :: Color
pattern R = UnsafeColor 0
pattern G = UnsafeColor 1
pattern B = UnsafeColor 2
maxColor :: Int
maxColor = 2
instance Enum Color where
succ (UnsafeColor a)
| a == maxColor = error "succ{Color}: tried to take `succ' of last tag in enumeration"
| otherwise = UnsafeColor (a + 1)
pred (UnsafeColor a)
| a == 0 = error "pred{Color}: tried to take `pred' of first tag in enumeration"
| otherwise = UnsafeColor (a - 1)
toEnum a
| a >= 0 && a <= maxColor = UnsafeColor a
| otherwise = error $ "toEnum{Color}: tag (" ++ show a ++ ") is outside of enumeration's range (0," ++ show maxColor ++ ")"
enumFrom (UnsafeColor a) = coerce [a..maxColor]
enumFromThen (UnsafeColor a) (UnsafeColor b) = coerce [a,b..if a > b then 0 else maxColor]
fromEnum = coerce
Caveats:
This is not an endorsement of how you did your benchmark (in fact, it probably is wrong, as commenters pointed out)
There's a good chance that things other than fromEnum will be made slower by this change
All of that code is just to replace data Color = R | G | B deriving (Enum)
I'm trying to debug an issue with an implementation of a threshold encryption scheme. I've posted this question on crypto to get some help with the actual scheme but was hoping to get a sanity check on the simplified code I am using.
Essentially the the crypto system uses Shamir's Secret Sharing to combine the shares of a key. The polynomial is each member of the list 'a' multiplied by a increasing power of the parameter of the polynomial. I've left out the mod by prime to simplify the code as the actual implementation uses PBC via a Haskell wrapper.
I have for the polynomial
poly :: [Integer] -> Integer -> Integer
poly as xi = (f 1 as)
where
f _ [] = 0
f 0 _ = 0
f s (a:as) = (a * s) + f (s * xi) as
The Lagrange interpolation is:
interp0 :: [(Integer, Integer)] -> Integer
interp0 xys = round (sum $ zipWith (*) ys $ fmap (f xs) xs)
where
xs = map (fromIntegral .fst) xys
ys = map (fromIntegral .snd) xys
f :: (Eq a, Fractional a) => [a] -> a -> a
f xs xj = product $ map (p xj) xs
p :: (Eq a, Fractional a) => a -> a -> a
p xj xm = if xj == xm then 1 else negate (xm / (xj - xm))
and the split and combination code is
execPoly as#(a0:_) = do
let xs = zipWith (,) [0..] (fmap (poly as) [0..100])
let t = length as + 1
let offset = 1
let shares = take t (drop offset xs)
let sm2 = interp0 shares
putText ("poly and interp over " <> show as <> " = " <> show sm2 <> ". Should be " <> show a0)
main :: IO ()
main = do
execPoly [10,20,30,40,50,60,70,80,90,100,110,120,130,140,150] --1
execPoly [10,20,30,40,50,60,70,80] -- 2
execPoly(1) fails to combine to 10 but execPoly(2) combines correctly. The magic threshold seems to be 8.
Is my code correct? I am missing something in the implementation that limits the threshold size to 8?
As MathematicalOrchid said it was a precision problem.
Updated the code to:
f :: (Eq a, Integral a) => [a] -> a -> Ratio a
f xs xj = product $ map (p xj) xs
p :: (Eq a, Integral a)=> a -> a -> Ratio a
p xj xm = if xj == xm then (1 % 1) else (negate xm) % (xj - xm)
And it works as expected.
I am learning Haskell and for an assignment I have to print a Snakes and Ladders game. Starting out, I am trying to print the board and this is what I've done.
import Data.List
aRow :: Int -> String
aRow n = "+" ++ take (4*n) (intercalate "" (repeat "---+")) ++ "\n|" ++ take (4*n) (intercalate "" (repeat " |")) ++ "\n"
board :: Int -> Int -> IO()
board 1 y = putStrLn (aRow y)
I would like another instance of board such that it takes arguments x and y
board x y = putStrLn (aRow y)
board (x-1) y
I know that I can't just call multiple statements like this, but can anyone provide some insight about how I can go along with this? I want to call aRow with argument 'y' and do that 'x' times.
Thanks.
Also: when I call board 1 y I get this as output:
board 1 5
+---+---+---+---+---+
| | | | | |
I think the cleanest way is to create the board without doing any IO and then at the end only to print it out using IO.
You can use concat and replicate to achieve this:
board :: Int -> Int -> String
board x y = concat (replicate y (aRow x))
You are probably missing a line at the bottom but I'll let you figure this out!
By the way, take (4*n) (intercalate "" (repeat "---+")) is the same as concat (replicate n "---+") so you could write aRow as:
aRow :: Int -> String
aRow n = '+' : concat (replicate n "---+")
++ "\n|" ++ concat (replicate n " |")
++ "\n"
Edit: I would use unlines :: [String] -> String to concatenate several Strings on multiple lines:
aRow :: Int -> String
aRow n = unlines
[ '+' : concat (replicate n "---+")
, '|' : concat (replicate n " |")
]
So you want to execute an IO (), and then yet another IO () action. Together they should be an IO () as well. So you're looking for a combinator with signature IO () -> IO () -> IO (). You can ask Hoogle about this... oh dear, that gives quite a lot of irrelevant results. But also the right one, namely
(>>) :: Monad m => m a -> m b -> m b
Your IO () -> IO () -> IO () is a special case of this signature, obtained by setting m ~ IO and a ~ b ~ (). So, you can write
board x y = putStrLn (aRow y)
>> board (x-1) y
Because these monadic sequencing operators are quite often used in Haskell, it has special syntactic-sugar syntax for them, namely
board x y = do
putStrLn (aRow y)
board (x-1) y
Ok so this works, but it's not really idiomatic. Manual recursion “loops” with a “counter variable” x are awkward and rather error-prone (you need to get the initial, termination and stepping conditions right). Really, all you're doing there is execute the same action x times in a row. So really you're interested in Int -> IO () -> IO (). Again ask Hoogle; this time the right result comes up a bit earlier...
replicateM_ :: Applicative m => Int -> m a -> m ()
so
board :: Int -> Int -> IO ()
board x y = replicateM_ x $ putStrLn (aRow y)
Even better, as Boomerang remarks, is to avoid IO looping altogether.
You just need to sequence the two monadic functions:
board x y = putStrLn (aRow y) >> board (x - 1) y
or with do notation
board x y = do
putStrLn (aRow y)
board (x - 1) y
Note that x == 0 makes a more natural base case:
board 0 y = return ()
board x y = do
putStrLn (aRow y)
board (x - 1) (aRow y)
See Boomerang's answer for a more idiomatic way of writing the function, though.
module Main where
import System.Random
import Data.Foldable
import Control.Monad
import qualified Data.Map as M
import qualified Data.Vector as V
import Debug.Trace
import Data.Maybe
import Data.Ord
-- Represents the maximal integer. maxBound is no good because it overflows.
-- Ideally should be something like a billion.
maxi = 1000
candies :: V.Vector Int -> Int --M.Map (Int, Int) Int
candies ar = ff [l (V.length ar - 1) x | x <- [0..maxi]]
where
go :: Int -> Int -> Int
go _ 0 = maxi
go 0 j = j
go i j =
case compare (ar V.! (i-1)) (ar V.! i) of
LT -> ff [l (i-1) x + j | x <- [0..j-1]]
GT -> ff [l (i-1) x + j | x <- [j+1..maxi]]
EQ -> ff [l (i-1) x + j | x <- [0..maxi]]
l :: Int -> Int -> Int
l i j = fromMaybe maxi (M.lookup (i,j) cs)
ff l = --minimum l
case l of
l:ls -> if l < maxi then l else ff ls
[] -> maxi
-- I need to make this lazy somehow.
cs :: M.Map (Int, Int) Int
cs = M.fromList [((i,j), go i j) | i <- [0..V.length ar - 1], j <- [0..maxi]]
main :: IO ()
main = do
--ar <- fmap (V.fromList . map read . tail . words) getContents
g <- fmap (V.fromList . take 5 . randomRs (1,50)) getStdGen
print $ candies g
The above code is for the HackerRank Candies challenge. I think the code is correct in essence even though it gives me runtime errors on submission. HackerRank does not say what those errors are, but most likely it is because I ran out allotted memory.
To make the above work, I need to rewrite the above so the fromList gets lazily evaluated or something to that effect. I like the above form and rewriting the functions so they pass along the map as a parameter is something I would very much like to avoid.
I know Haskell has various memoization libraries on Hackage, but the online judge does not allow their use.
I might have coded myself into a hole due to Haskell's purity.
Edit:
I did some experimenting in order to figure out how those folds and lambda's work. I think this is definitely linked to continuation passing after all, as the continuations are being built up along the fold. To show what I mean, I'll demonstrate it with a simple program.
module Main where
trans :: [Int] -> [Int]
trans m =
foldr go (\_ -> []) m 0 where
go x f y = (x + y) : f x
main = do
s <- return $ trans [1,2,3]
print s
One thing that surprised me was that when I inserted a print, it got executed in a reverse manner, from left to right, which made me think at first that I misunderstood how foldr works. That turned out to not be the case.
What the above does is print out [1,3,5].
Here is the explanation how it executes. Trying to print out f x in the above will not be informative and will cause it to just all around the place.
It starts with something like this. The fold obviously executes 3 go functions.
go x f y = (x + y) : f x
go x f y = (x + y) : f x
go x f y = (x + y) : f x
The above is not quite true. One has to keep in mind that all fs are separate.
go x f'' y = (x + y) : f'' x
go x f' y = (x + y) : f' x
go x f y = (x + y) : f x
Also for clarity one it should also be instructive to separate out the lambdas.
go x f'' = \y -> (x + y) : f'' x
go x f' = \y -> (x + y) : f' x
go x f = \y -> (x + y) : f x
Now the fold starts from the top. The topmost statement gets evaluated as...
go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) 3
This reduces to:
go 3 (\_ -> []) = (\y -> (3 + y) : [])
The result is the unfinished lambda above. Now the fold evaluates the second statement.
go 2 (\y -> (3 + y) : []) = \y -> (2 + y) : (\y -> (3 + y) : []) 2
This reduces to:
go 2 (\y -> (3 + y) : []) = (\y -> (2 + y) : 5 : [])
The the fold goes to the last statement.
go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : (\y -> (2 + y) : 5 : []) 1
This reduces to:
go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : 3 : 5 : []
The the 0 outside the fold gets applied and the final lambda gets reduced to
1 : 3 : 5 : []
This is just the start of it. The case gets more interesting when f x is replaced with f y.
Here is a similar program to the previous.
module Main where
trans :: [Int] -> [Int]
trans m =
foldr go (\_ -> []) m 1 where
go x f y = (x + y) : f (2*y+1)
main = do
s <- return $ trans [1,2,3]
print s
Let me once again go from top to bottom.
go x f'' = \y -> (x + y) : f'' (2*y+1)
go x f' = \y -> (x + y) : f' (2*y+1)
go x f = \y -> (x + y) : f (2*y+1)
The top statement.
go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) (2*y+1)
The middle statement:
go 2 (\y -> (3 + y) : (\_ -> []) (2*y+1)) = \y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)
The last statement:
go 1 (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) = \y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1
Notice how the expressions build up because ys cannot be applied. Only after the 0 gets inserted can the whole expression be evaluated.
(\y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1) 1
2 : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 3
2 : 5 : (\y -> (3 + y) : (\_ -> []) (2*y+1)) 7
2 : 5 : 10 : (\_ -> []) 15
2 : 5 : 10 : []
There is a buildup due to the order of evaluation.
Edit: So...
go (candy, score) f c s = (candy', score): f candy' score
where candy' = max candy $ if s < score then c + 1 else 1
The above in fact does 3 passes across the list in each iteration.
First foldr has to travel to back of the list before it can begin. Then as candi' depends on s and c variables which cannot be applied immediately this necessitates building up the continuations as in that last example.
Then when the two 0 0 are fed into at the end of the fold, the whole thing only then gets evaluated.
It is a bit hard to reason about.
The problem you have linked to has a clean Haskell solution using right folds. In other words, you can skip worrying about lazy fromList, memoization and all that by just using a more functional style.
The idea is that you maintain a list of (candy, score) pairs where candy is zero initially for all (repeat 0 in bellow code). Then you go once from left to right and bump up candy values if this item score exceeds the one before:
-- s is the score and c is the candy of the guy before
-- if s < score then this guy should get at least c + 1 candies
candy' = max candy $ if s < score then c + 1 else 1
and do the same thing again going in the other direction:
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
solve :: [Int] -> Int
solve = sum . map fst . loop . reverse . loop . zip (repeat 0)
where
loop cs = foldr go (\_ _ -> []) cs 0 0
go (candy, score) f c s = (candy', score): f candy' score
where candy' = max candy $ if s < score then c + 1 else 1
main = do
n <- read <$> getLine
solve . fmap read <$> replicateM n getLine >>= print
This performs linearly, and passes all tests on HackerRank.
Well, regarding my own question at the top, probably the way to make the thing lazy would be to just use a list (a list of lists or a vector of lists.) The reason why the above is impossible to make lazy is because the Map type is lazy in the values and strict in the keys.
More importantly, my analysis that the fold is doing essentially two passes was completely right. The way those built up continuations are being executed in reverse completely tripped me up at first, but I've adapted #behzad.nouri code to work with only a single loop.
module Main where
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Debug.Trace
solve :: [Int] -> Int
solve = sum . loop
where
loop :: [Int] -> [Int]
loop = (\(_,_,x) -> x 0 0) . foldr go (0, 0, \_ _ -> [])
go :: Int -> (Int, Int, Int -> Int -> [Int]) -> (Int, Int, Int -> Int -> [Int])
go score (candyP,scoreP,f) =
let
candyP' = if scoreP < score then candyP + 1 else 1
in
(candyP', score,
\candyN scoreN ->
let
candy' = max candyP' $ if scoreN < score then candyN + 1 else 1
in candy' : f candy' score) -- This part could be replaced with a sum
main = do
n <- read <$> getLine
solve . fmap read <$> replicateM n getLine >>= print
The above passes all tests, no problem, and that is convincing proof that the above analysis is correct.
I have a problem with built a function with a monad-list
> multab 4
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
So I want to start like :
multab :: Integer -> [String]
for the rest, would you like give any suggestions?
Thanks in advance.
Basically you want to generate a list of entries and then print them.
Let's start with the entries. These consists of two integers and their product. So let us define a type synonym to hold the two integers
type Entry = (Integer, Integer)
and an evaluation function that computes the product of these integers,
eval :: Entry -> Integer
eval = uncurry (*)
Then, we define a function for generating the entries:
gen :: Integer -> [Entry]
gen n = [(i, j) | i <- [1 .. n], j <- [i .. n]]
For example:
> gen 4
[(1,1),(1,2),(1,3),(1,4),(2,2),(2,3),(2,4),(3,3),(3,4),(4,4)]
Next, we need to be able to print an entry:
showEntry :: Entry -> String
showEntry e#(i, j) = show i ++ "*" ++ show j ++ "=" ++ show (eval e)
For example:
> showEntry (2, 3)
"2*3=6"
Finally, let's glue these pieces together:
multab :: Integer -> [String]
multab = map showEntry . gen
Here we go:
> multab 4
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
Here is some scratch solution based on Karolis answer.
> let nonDec xs = and $ zipWith (>=) (drop 1 xs) xs
nonDec :: Ord b => [b] -> Bool
> let getSets s n = filter nonDec $ replicateM n s
getSets :: Ord b => [b] -> Int -> [[b]]
> getSets [1,2,3,4] 2
[[1,1],[1,2],[1,3],[1,4],[2,2],[2,3],[2,4],[3,3],[3,4],[4,4]]
> let showExp = \[i,j] -> show i ++ "*" ++ show j ++ "=" ++ show (i*j)
showExp :: [Integer] -> [Char]
> map showExp $ getSets [1,2,3,4] 2
["1*1=1","1*2=2","1*3=3","1*4=4","2*2=4","2*3=6","2*4=8","3*3=9","3*4=12","4*4=16"]
So, multab is \n -> map showExp $ getSets [1..n] 2.
The natural way to do this is to generate a list of all pairs (i, j) with i < or = j and then map (\(i, j) -> show i ++ "*" ++ show j ++ "=" ++ show (i*j)) on it. The most obvious way to generate such list would be to write [(i, j) | i <- [1..n], j <- [1..n], i <= j]. Although it might be better to do [1..n] >>= list where list i = map (\k -> (i, k)) [i..n] as this does not do any filtering (because it doesn't generate unwanted pairs).
Just as an alternative to the other answers one which uses the List as a Monad.
multab :: Integer -> [String]
multab n = do
i <- [1..n]
j <- [i..n]
return $ show i ++ "*" ++ show j ++ "=" ++ show (i*j)
Where the first two rules bind every pair of integers (i,j) with j <= i <= n. The last rule returns the printed value.
More practical is perhaps the list comprehension version
multab2 :: Integer -> [String]
multab2 n =
[ show i ++ "*" ++ show j ++ "=" ++ show (i*j)
| i <- [1..n]
, j <- [i..n] ]
Which could be directly translated to the monad version as the structure suggests, though this is not the most efficient translation. Additionally this is equivalent to what you would get when you inline all the functions from dblhelix's answer.