I am trying to get a function that returns a list of lists of zeros or ones, obviously in a random way.
Example:
getBinaryRandomList::Int->Int->[[Int]]
Prelude> getBinaryRandomList 4 3
[[1,0,0,1],[1,1,0,1],[0,0,0,1], [0,1,0,1]]
So far, i have done this functions:
--tuns an `Int` into a `[Int]`. The [Int] would represent a binary number
int2bin :: Int -> [Int]
int2bin 0 = []
int2bin n = mod n 2 : int2bin (div n 2)
I have got stuck here, it throws an error at compilation time:
--returns a random number
import System.Random
randomInt::(Int,Int)->Int
randomInt x y = do
newStdGen
randomR(x, y) getStdGen
Compiling...
[1 of 1] Compiling Main ( ag.hs, interpreted )
ag.hs:8:25: parse error on input `randomR'
The "main" function would be like this:
--n lists number
--d digit number
getBinaryRandomList::Int->Int->[[Int]]
getBinaryRandomList d 0 = []
getBinaryRandomList d n = take d (int2bin(randomInt(0,50))) : getBinaryRandomList(n-1)
My approach is the next:
Coding a function that creates an aleatory Int number between 0 an n.
randomInt::(Int,Int)->Int
Coding a function that converts those aleatory numbers into a list of binaries.
int2bin::Int->[Int] % Already done
Forming a list with those numbers
getBinaryRandomList::Int->Int->[[Int]]
How could I implement that in Haskell?
As it was pointed out in a comment, you can't create a StdGen without IO, but you can create one in your main function and pass it along in a parameter to your randomInt function, in this way:
import System.Random
main = do
a <- newStdGen
putStrLn . show . randomInt 0 1 $ a
randomInt:: Int -> Int -> StdGen -> (Int, StdGen)
randomInt x y s = do
randomR (x, y) s
The error message that you got about RandomR was caused by not importing System.Random.
I hope this helps.
Related
Haskell Code Problem
Description: Code is supposed to return how many digits in the number divide the number as a whole.
For example, 12 has two digits [1, 2], both of which divide 2 (12%2 and 12%1 are both 0) so 2 is returned as there are two digits that divide the number.
For 102, 2 is returned as 1 and 2 both divide 102, division by 0 is undefined.
However, with this code I get errors with numbers containing 0s in the middle of the number (e.g. 1001020)
I get "Program Error: Prelude.read: no parse"
Any help will be greatly appreciated. Many thanks.
import Control.Monad
import Data.Array
import Data.Bits
import Data.Char
import Data.List
import Data.Set
import Debug.Trace
import System.Environment
import System.IO
import System.IO.Unsafe
findDigits :: Int -> Int
findDigits n = digits n n 0 (lengths n)
where
digits n on count endCheck
| endCheck == 0 = count
| header n == 0 = digits (tailer n) on count (endCheck-1)
| on `mod` header n == 0 = digits (tailer n) on (count+1) (endCheck-1)
| otherwise = digits (tailer n) on count (endCheck-1)
header :: Int -> Int
header x = digitToInt . head . show $ x
tailer :: Int -> Int
tailer x = read . tail . show $ x
lengths :: Int -> Int
lengths x = length . show $ x
I think you are trying to do too much in a function. Uually it is better to work with small functions that each solve a simple task, and then combine these in functions that are small as well, and perform a (slightly) more sophisticated task.
For example we can make a function digits :: Int -> [Int] that returns a list of digits:
digits :: Int -> [Int]
digits x | x >= 10 = r : digits q
| otherwise = [x]
where (q,r) = quotRem x 10
For example:
Prelude> digits 102
[2,0,1]
We can then filter these digits to check that the digits are not zero (since then it is not dividable), and that the number is dividable by that digit:
dividableDigits :: Int -> [Int]
dividableDigits n = filter (\x -> x /= 0 && mod n x == 0) (digits n)
Now it is a matter of counting the numbers that match. I leave that as an exercise.
i'm trying to write a function that for n gives matrix n*n with unique rows and columns (latin square).
I got function that gives my list of strings "1" .. "2" .. "n"
numSymbol:: Int -> [String]
I tried to generate all permutations of this, and them all n-length tuples of permutations, and them check if it is unique in row / columns. But complexity (n!)^2 works perfect for 2 and 3, but with n > 3 it takes forever. It is possible to build latin square from permutations directly, for example from
permutation ( numSymbol 3) = [["1","2","3"],["1","3","2"],["2","1","3"],["2","3","1"],["3","1","2"],["3","2","1"]]
get
[[["1","2","3",],["2","1","3"],["3","1","2"]] , ....]
without generating list like [["1",...],["1",...],...], when we know first element disqualify it ?
Note: since we can easily take a Latin square that's been filled with numbers from 1 to n and re-label it with anything we want, we can write code that uses integer symbols without giving anything away, so let's stick with that.
Anyway, the stateful backtracking/nondeterministic monad:
type StateList s = StateT s []
is helpful for this sort of problem.
Here's the idea. We know that every symbol s is going to appear exactly once in each row r, so we can represent this with an urn of all possible ordered pairs (r,s):
my_rs_urn = [(r,s) | r <- [1..n], s <- [1..n]]
Similarly, as every symbol s appears exactly once in each column c, we can use a second urn:
my_cs_urn = [(c,s) | c <- [1..n], s <- [1..n]]
Creating a Latin square is matter of filling in each position (r,c) with a symbol s by removing matching balls (r,s) and (c,s) (i.e., removing two balls, one from each urn) so that every ball is used exactly once. Our state will be the content of the urns.
We need backtracking because we might reach a point where for a particular position (r,c), there is no s such that (r,s) and (c,s) are both still available in their respective urns. Also, a pleasant side-effect of list-based backtracking/nondeterminism is that it'll generate all possible Latin squares, not just the first one it finds.
Given this, our state will look like:
type Urn = [(Int,Int)]
data S = S
{ size :: Int
, rs :: Urn
, cs :: Urn }
I've included the size in the state for convenience. It won't ever be modified, so it actually ought to be in a Reader instead, but this is simpler.
We'll represent a square by a list of cell contents in row-major order (i.e., the symbols in positions [(1,1),(1,2),...,(1,n),(2,1),...,(n,n)]):
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
Now, the monadic action to generate latin squares will look like this:
type M = StateT S []
latin :: M Square
latin = do
n <- gets size
-- for each position (r,c), get a valid symbol `s`
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
pairs :: Int -> [(Int,Int)]
pairs n = -- same as [(x,y) | x <- [1..n], y <- [1..n]]
(,) <$> [1..n] <*> [1..n]
The worker function getS picks an s so that (r,s) and (c,s) are available in the respective urns, removing those pairs from the urns as a side effect. Note that getS is written non-deterministically, so it'll try every possible way of picking an s and associated balls from the urns:
getS :: Int -> Int -> M Int
getS r c = do
-- try each possible `s` in the row
s <- pickSFromRow r
-- can we put `s` in this column?
pickCS c s
-- if so, `s` is good
return s
Most of the work is done by the helpers pickSFromRow and pickCS. The first, pickSFromRow picks an s from the given row:
pickSFromRow :: Int -> M Int
pickSFromRow r = do
balls <- gets rs
-- "lift" here non-determinstically picks balls
((r',s), rest) <- lift $ choices balls
-- only consider balls in matching row
guard $ r == r'
-- remove the ball
modify (\st -> st { rs = rest })
-- return the candidate "s"
return s
It uses a choices helper which generates every possible way of pulling one element out of a list:
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
The second, pickCS checks if (c,s) is available in the cs urn, and removes it if it is:
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
-- only continue if the required ball is available
guard $ (c,s) `elem` balls
-- remove the ball
modify (\st -> st { cs = delete (c,s) balls })
With an appropriate driver for our monad:
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n p p)
where p = pairs n
this can generate all 12 Latin square of size 3:
λ> runM 3 latin
[Square 3 [1,2,3,2,3,1,3,1,2],Square 3 [1,2,3,3,1,2,2,3,1],...]
or the 576 Latin squares of size 4:
λ> length $ runM 4 latin
576
Compiled with -O2, it's fast enough to enumerate all 161280 squares of size 5 in a couple seconds:
main :: IO ()
main = print $ length $ runM 5 latin
The list-based urn representation above isn't very efficient. On the other hand, because the lengths of the lists are pretty small, there's not that much to be gained by finding more efficient representations.
Nonetheless, here's complete code that uses efficient Map/Set representations tailored to the way the rs and cs urns are used. Compiled with -O2, it runs in constant space. For n=6, it can process about 100000 Latin squares per second, but that still means it'll need to run for a few hours to enumerate all 800 million of them.
{-# OPTIONS_GHC -Wall #-}
module LatinAll where
import Control.Monad.State
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map, (!))
import qualified Data.Map as Map
data S = S
{ size :: Int
, rs :: Map Int [Int]
, cs :: Set (Int, Int) }
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
type M = StateT S []
-- Get Latin squares
latin :: M Square
latin = do
n <- gets size
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
-- All locations in row-major order [(1,1),(1,2)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [1..n] <*> [1..n]
-- Get a valid `s` for position `(r,c)`.
getS :: Int -> Int -> M Int
getS r c = do
s <- pickSFromRow r
pickCS c s
return s
-- Get an available `s` in row `r` from the `rs` urn.
pickSFromRow :: Int -> M Int
pickSFromRow r = do
urn <- gets rs
(s, rest) <- lift $ choices (urn ! r)
modify (\st -> st { rs = Map.insert r rest urn })
return s
-- Remove `(c,s)` from the `cs` urn.
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
guard $ (c,s) `Set.member` balls
modify (\st -> st { cs = Set.delete (c,s) balls })
-- Return all ways of removing one element from list.
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where rs0 = Map.fromAscList $ zip [1..n] (repeat [1..n])
cs0 = Set.fromAscList $ pairs n
main :: IO ()
main = do
print $ runM 3 latin
print $ length (runM 4 latin)
print $ length (runM 5 latin)
Somewhat remarkably, modifying the program to produce only reduced Latin squares (i.e., with symbols [1..n] in order in both the first row and the first column) requires changing only two functions:
-- All locations in row-major order, skipping first row and column
-- i.e., [(2,2),(2,3)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [2..n] <*> [2..n]
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where -- skip balls [(1,1)..(n,n)] for first row
rs0 = Map.fromAscList $ map (\r -> (r, skip r)) [2..n]
-- skip balls [(1,1)..(n,n)] for first column
cs0 = Set.fromAscList $ [(c,s) | c <- [2..n], s <- skip c]
skip i = [1..(i-1)]++[(i+1)..n]
With these modifications, the resulting Square will include symbols in row-major order but skipping the first row and column. For example:
λ> runM 3 latin
[Square 3 [3,1,1,2]]
means:
1 2 3 fill in question marks 1 2 3
2 ? ? =====================> 2 3 1
3 ? ? in row-major order 3 1 2
This is fast enough to enumerate all 16,942,080 reduced Latin squares of size 7 in a few minutes:
$ stack ghc -- -O2 -main-is LatinReduced LatinReduced.hs && time ./LatinReduced
[1 of 1] Compiling LatinReduced ( LatinReduced.hs, LatinReduced.o )
Linking LatinReduced ...
16942080
real 3m9.342s
user 3m8.494s
sys 0m0.848s
I worked my way through Mike Vanier's monad tutorial (which is excellent) and I'm working on a few of the exercises in his post on how to use a "State" monad.
In particular, he suggests an exercise which consists of writing functions for factorial and fibonacci using a State monad. I gave it a shot and came up with the answers below. (I find do notation pretty confusing, hence my choice of syntax).
Neither of my implementations look particularly "Haskell-y" and, in the interest of not internalizing bad practices, I thought I'd ask folks for input on how they would've gone about implementing these functions (using the state monad). Is it possibly to write this code far more simply (aside from switching to do notation)? I strongly suspect this is the case.
I'm aware that it's a bit impractical to use a state monad for this purpose but this is purely a learning exercise - pun most certainly intended.
That said, the performance is not that much worse: in order to calc the factorial of 100000 (the answer is ~21k digits long), the unfoldr version took ~1.2 sec (in GHCi) vs. ~1.5 sec for the state monad version.
import Control.Monad.State (State, get, put, evalState)
import Data.List (unfoldr)
fibonacci :: Integer -> Integer
fibonacci 0 = 0
fibonacci n = evalState fib_state (1,0,1,n)
fib_state :: State (Integer,Integer,Integer,Integer) Integer
fib_state = get >>=
\s ->
let (p1,p2,ctr,n) = s
in case compare ctr n of
LT -> put (p1+p2, p1, ctr+1, n) >> fib_state
_ -> return p1
factorial :: Integer -> Integer
factorial n = evalState fact_state (n,1)
fact_state :: State (Integer,Integer) Integer
fact_state = get >>=
\s ->
let (n,f) = s
in case n of
0 -> return f
_ -> put (n-1,f*n) >> fact_state
-------------------------------------------------------------------
--Functions below are used only to test output of functions above
factorial' :: Integer -> Integer
factorial' n = product [1..n]
fibonacci' :: Int -> Integer
fibonacci' 0 = 1
fibonacci' 1 = 1
fibonacci' n =
let getFst (a,b,c) = a
in getFst
$ last
$ unfoldr (\(p1,p2,cnt) ->
if cnt == n
then Nothing
else Just ((p1,p2,cnt)
,(p1+p2,p1,cnt+1))
) (1,1,1)
Your functions seem to be a bit more complicated than they need to be, but you have the right idea. For the factorial, all you need to keep track of is the current number you're multiplying by and the number that you've accumulated so far. So, we'll say that State Int Int is a computation that operates on the current number on the state and returns the number that you've multiplied up until now:
fact_state :: State Int Int
fact_state = get >>= \x -> if x <= 1
then return 1
else (put (x - 1) >> fmap (*x) fact_state)
factorial :: Int -> Int
factorial = evalState fact_state
Prelude Control.Monad.State.Strict Control.Applicative> factorial <$> [1..10]
[1,2,6,24,120,720,5040,40320,362880,3628800]
The fibonacci sequence is similar. You need to keep the last two numbers in order to know what you're going to be adding together, and how far you've gone so far:
fibs_state :: State (Int, Int, Int) Int
fibs_state = get >>= \(x1, x2, n) -> if n == 0
then return x1
else (put (x2, x1+x2, n-1) >> fibs_state)
fibonacci n = evalState fibs_state (0, 1, n)
Prelude Control.Monad.State.Strict Control.Applicative> fibonacci <$> [1..10]
[1, 1, 2, 3, 5, 8, 13, 21, 34, 55]
Two stylistic suggestions:
\s ->
let (p1,p2,ctr,n) = s
in ...
is equivalent to:
\(p1,p2,ctr,n) -> ...
and your case statement for fib_state may be written with an if statement:
if ctr < n
then put (p1+p2, p1, ctr+1, n) >> fib_state
else return p1
Here's a simple function. It takes an input Int and returns a (possibly empty) list of (Int, Int) pairs, where the input Int is the sum of the cubed elements of any of the pairs.
cubeDecomposition :: Int -> [(Int, Int)]
cubeDecomposition n = [(x, y) | x <- [1..m], y <- [x..m], x^3 + y^3 == n]
where m = truncate $ fromIntegral n ** (1/3)
-- cubeDecomposition 1729
-- [(1,12),(9,10)]
I want to test the property that the above is true; if I cube each element and sum any of the return tuples, then I get my input back:
import Control.Arrow
cubedElementsSumToN :: Int -> Bool
cubedElementsSumToN n = all (== n) d
where d = map (uncurry (+) . ((^3) *** (^3))) (cubeDecomposition n)
For runtime considerations, I'd like to limit the input Ints to a certain size when testing this with QuickCheck. I can define an appropriate type and Arbitrary instance:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Test.QuickCheck
newtype SmallInt = SmallInt Int
deriving (Show, Eq, Enum, Ord, Num, Real, Integral)
instance Arbitrary SmallInt where
arbitrary = fmap SmallInt (choose (-10000000, 10000000))
And then I guess I have to define versions of the function and property that use SmallInt rather than Int:
cubeDecompositionQC :: SmallInt -> [(SmallInt, SmallInt)]
cubeDecompositionQC n = [(x, y) | x <- [1..m], y <- [x..m], x^3 + y^3 == n]
where m = truncate $ fromIntegral n ** (1/3)
cubedElementsSumToN' :: SmallInt -> Bool
cubedElementsSumToN' n = all (== n) d
where d = map (uncurry (+) . ((^3) *** (^3))) (cubeDecompositionQC n)
-- cubeDecompositionQC 1729
-- [(SmallInt 1,SmallInt 12),(SmallInt 9,SmallInt 10)]
This works fine, and the standard 100 tests pass as expected. But it seems unnecessary to define a new type, instance, and function when all I really need is a custom generator. So I tried this:
smallInts :: Gen Int
smallInts = choose (-10000000, 10000000)
cubedElementsSumToN'' :: Int -> Property
cubedElementsSumToN'' n = forAll smallInts $ \m -> all (== n) (d m)
where d = map (uncurry (+) . ((^3) *** (^3)))
. cubeDecomposition
Now, the first few times I ran this, everything worked fine, and all tests pass. But on subsequent runs I observed failures. Bumping up the test size reliably finds one:
*** Failed! Falsifiable (after 674 tests and 1 shrink):
0
8205379
I'm a bit confused here due to the presence of two shrunken inputs - 0 and 8205379 - returned from QuickCheck, where I would intuitively expect one. Also, those inputs work as predicted (on my show-able property, at least):
*Main> cubedElementsSumToN 0
True
*Main> cubedElementsSumToN 8205379
True
So it seems like obviously there's a problem in the property that uses the custom Gen I defined.
What have I done wrong?
I quickly realized that the property as I've written it is obviously incorrect. Here's the proper way to do it, using the original cubedElementsSumToN property:
quickCheck (forAll smallInts cubedElementsSumToN)
which reads quite naturally.
I get the following error when trying to compile
$ ghc --make -O2 -Wall -fforce-recomp
[1 of 1] Compiling Main (
isPrimeSmart.hs, isPrimeSmart.o )
SpecConstr
Function `$wa{v s2we} [lid]'
has two call patterns, but the limit is 1
Use -fspec-constr-count=n to set the bound
Use -dppr-debug to see specialisations Linking isPrimeSmart
...
My code is:
{-# OPTIONS_GHC -O2 -optc-O2 #-}
import qualified Data.ByteString.Lazy.Char8 as StrL -- StrL is STRing Library
import Data.List
-- read in a file. First line tells how many cases. Each case is on a separate
-- line with the lower an upper bounds separated by a space. Print all primes
-- between the lower and upper bound. Separate results for each case with
-- a blank line.
main :: IO ()
main = do
let factors = takeWhile (<= (ceiling $ sqrt (1000000000::Double))) allPrimes
(l:ls) <- StrL.lines `fmap` StrL.getContents
let numCases = readInt l
let cases = (take numCases ls)
sequence_ $ intersperse (putStrLn "") $ map (doLine factors) cases
-- get and print all primes between the integers specified on a line.
doLine :: [Integer] -> StrL.ByteString -> IO ()
doLine factors l = mapM_ print $ primesForLine factors l
---------------------- pure code below this line ------------------------------
-- get all primes between the integers specified on a line.
primesForLine :: [Integer] -> StrL.ByteString -> [Integer]
primesForLine factors l = getPrimes factors range
where
range = rangeForLine l
-- Generate a list of numbers to check, store it in list, and then check them...
getPrimes :: [Integer] -> (Integer, Integer) -> [Integer]
getPrimes factors range = filter (isPrime factors) (getCandidates range)
-- generate list of candidate values based on upper and lower bound
getCandidates :: (Integer, Integer) -> [Integer]
getCandidates (propStart, propEnd) = list
where
list = if propStart < 3
then 2 : oddList
else oddList
oddList = [listStart, listStart + 2 .. propEnd]
listStart = if cleanStart `rem` 2 == 0
then cleanStart + 1
else cleanStart
cleanStart = if propStart < 3
then 3
else propStart
-- A line always has the lower and upper bound separated by a space.
rangeForLine :: StrL.ByteString -> (Integer, Integer)
rangeForLine caseLine = start `seq` end `seq` (start, end)
where
[start, end] = (map readInteger $ StrL.words caseLine)::[Integer]
-- read an Integer from a ByteString
readInteger :: StrL.ByteString -> Integer
readInteger x =
case StrL.readInteger x of Just (i,_) -> i
Nothing -> error "Unparsable Integer"
-- read an Int from a ByteString
readInt :: StrL.ByteString -> Int
readInt x =
case StrL.readInt x of Just (i,_) -> i
Nothing -> error "Unparsable Int"
-- generates all primes in a lazy way.
allPrimes :: [Integer]
allPrimes = ps (2:[3,5 .. ])
where
ps (np:candidates) = -- np stands for New Prime
np : ps (filter (\n -> n `rem` np /= 0) candidates)
ps [] = error "this can't happen but is shuts up the compiler"
-- Check to see if it is a prime by comparing against the factors.
isPrime :: [Integer] -> Integer -> Bool
isPrime factors val = all (\f -> val `rem` f /= 0) validFactors
where
validFactors = takeWhile (< ceil) factors
ceil = ((ceiling $ sqrt $ ((fromInteger val)::Double))) :: Integer
I have no idea how to fix this warning. How do I start? Do I compile to assembly and match the error up? What does the warning even mean?
These are just (annoying) warnings, indicating that GHC could do further specializations to your code if you really want to. Future versions of GHC will likely not emit this data by default, since there's nothing you can do about it anyway.
They are harmless, and are not errors. Don't worry about them.
To directly address the problem, you can use -w (suppress warnings) instead of -Wall.
E.g. in a file {-# OPTIONS_GHC -w #-} will disable warnings.
Alternately, increasing the specialization threshold will make the warning go away, e.g. -fspec-constr-count=16