Cartesian plane for 3 cards and 4cards of deck in Haskell - haskell

The following code runs for 2cards of a deck and gives cartesian plane such that no duplicates are there.
allcards = [minBound..maxBound] :: [Card]
cartesianplane=[ [x ,y] | x <- allcards, y <- allcards, x < y ]
How can I do the same for 3 cards and 4cards such that no duplicates are there.

Here's a way to recursively generate the sets:
-- an example set of cards:
data Card = A | T | J | Q | K
deriving (Show, Read, Eq, Ord, Bounded, Enum)
next intv a
| a == maxBound = []
| otherwise = intv (succ a)
interval a = [ a .. ]
interval2 a = [ [x,y] | x <- interval a, y <- next interval x ]
interval3 a = [ x:y | x <- interval a, y <- next interval2 x ]
interval4 a = [ x:y | x <- interval a, y <- next interval3 x ]
interval5 a = [ x:y | x <- interval a, y <- next interval4 x ]
E.g.:
interval A = [A,T,J,Q,K]
interval2 A = [[A,T],[A,J],[A,Q],[A,K],[T,J],[T,Q],[T,K],[J,Q],[J,K],[Q,K]]
interval3 A = [[A,T,J],[A,T,Q],[A,T,K],[A,J,Q],[A,J,K],[A,Q,K],[T,J,Q],[T,J,K],[T,Q,K],[J,Q,K]]
interval4 A = [[A,T,J,Q],[A,T,J,K],[A,T,Q,K],[A,J,Q,K],[T,J,Q,K]]
interval5 A = [[A,T,J,Q,K]]

Related

I/O how can i put somehing in screen withouth being string?

So im doing this function and i need her to display on the screen the result of (premio ap x) , the problem is that (premio ap x)::Maybe Int , so its not a string.
joga :: Aposta -> IO ()
joga x= do
ap <- leAposta;
let arroz = (premio ap x)
putStr ^^^^^^^^^^
return ()
How can i convert this to a string? Or there is another way to display on the screen things that are not strings.
update :full code
comuns :: Aposta -> Aposta -> (Int,Int)
comuns (Ap a (b,c)) (Ap k (l,ç)) = (cnum a k, cnum [b,c] [l,ç])
cnum::[Int]->[Int]->Int
cnum [] l2 = 0
cnum (x:xs) l2 | elem x l2 = 1 + cnum xs l2
|otherwise = cnum xs l2
premio :: Aposta -> Aposta -> Maybe Int
premio l1 l2 | x == (5,2)= Just 1
| x == (5,1)= Just 2
| x == (5,0)= Just 3
| x == (4,2)= Just 4
| x == (4,1)= Just 5
| x == (4,0)= Just 6
| x == (3,2)= Just 7
| x == (2,2)= Just 8
| x == (3,1)= Just 9
| x == (3,0)= Just 10
| x == (1,2)= Just 11
| x == (2,1)= Just 12
| x == (2,0)= Just 13
|otherwise = Nothing
where
x = comuns l1 l2
leAposta :: IO Aposta
leAposta = do
putStrLn "Insira como lista as 5 estrelas"
num <-getLine
putStrLn "Insira em par as 2 estrelas"
es<-getLine
let ap = (Ap (read num) (read es))
if (valida ap)
then return ap
else do
putStrLn "Aposta invalida"
leAposta
Since arroz is premio ap x which has type Maybe Int, you can simply print arroz.
print works on any type that can be printed, i.e. on those types in class Show.
(You probably don't want to use print on values that are already strings, though, since that will print the escaped string, with quotes around. Use putStr and putStrLn for strings.)

Clean way to do rewrite rules

I have the following toy language:
module Lang where
data Op = Move Int -- Move the pointer N steps
| Add Int -- Add N to the value under the pointer
| Skip -- Skip next op if the value under the pointer is 0
| Halt -- End execution
deriving (Show, Eq)
type Program = [Op]
The language has a finite tape of memory cells that wraps around, and a pointer that points at some cell. All the cells are initially zero. The program is executed repeatedly until the halt instruction is read.
Now I would like to write a function that optimizes a given program. Here is the optimizations that I would like to perform:
| Original code | Optimization |
|---------------------|----------------|
| Move a : Move b : x | Move (a+b) : x |
| Add a : Add b : x | Add (a+b) : x |
| Move 0 : x | x |
| Add 0 : x | x |
| Skip : Skip : x : y | x : y |
| Halt : _ | Halt |
Additionally, I can only do an optimization on code that is not directly after a skip, because doing that would change the meaning of the program.
Is repeatedly pattern matching on the list until no more optimizations can be performed really the best/cleanest way to do this?
What if I decide that I also want to perform more advanced rewrites like these:
| Original code | Optimization |
|--------------------------------------------------------|------------------------------------------------|
| if the program begins with (Skip : a) | move it to the end of the program |
| Move x ++ no_skips : Move -x ++ no_skips' : Move w : q | Move x ++ no_skips ++ no_skips' : Move w-x : q |
Use Maybe's!
#user2407038 told me that I could use Maybe in a comment
module MaybeProg where
import Lang
import Control.Monad
type Opt = Program -> Maybe Program
optimize = untilFail step
where step p | p' <- atEveryButSkipNextWhen (==Skip) rewrite
. atEvery delNopSkip
$ untilFail moveSkips p
, p /= p' = Just p'
| otherwise = Nothing
rewrite = tryAll [joinMoves, joinAdds, delNopMov, delNopAdd, termHalt, reorder]
joinMoves p = do (Move a : Move b : x) <- pure p; Just $ Move (a+b) : x
joinAdds p = do (Add a : Add b : x) <- pure p; Just $ Add (a+b) : x
delNopMov p = do (Move 0 : x) <- pure p; Just x
delNopAdd p = do (Add 0 : x) <- pure p; Just x
delNopSkip p = do (Skip : Skip : x) <- pure p; Just x
termHalt p = do (Halt : _) <- pure p; Just [Halt]
moveSkips p = do (Skip : x : y : z) <- pure p; Just $ y : z ++ [Skip, x]
reorder p = do
(Move x : rst) <- pure p
(as, Move y : rst') <- break' isMove rst
guard $ x == -y && all (/=Skip) as
(bs, Move w : q ) <- break' isMove rst'
guard $ all (/=Skip) bs
return $ Move x : as ++ bs ++ Move (w-x) : q
where isMove (Move _) = True
isMove _ = False
--------
untilFail :: Opt -> Program -> Program
untilFail o p | Just p' <- o p = untilFail o p'
| otherwise = p
atEvery :: Opt -> Program -> Program
atEvery o p | (x:xs) <- untilFail o p = x : atEvery o xs
| otherwise = []
atEveryButSkipNextWhen c o p#(h:_)
| not $ c h
, (x:xs) <- untilFail o p = x : atEveryButSkipNextWhen c o xs
| (p1:p2:ps) <- p = p1:p2:atEveryButSkipNextWhen c o ps
| otherwise = p
atEveryButSkipNextWhen _ _ [] = []
tryAll :: [Opt] -> Opt
tryAll os p = do
Just x : _ <- pure . dropWhile (==Nothing) $ ($p) <$> os
return x
break' f p | (x, y) <- break f p
, not $ null y = Just (x, y)
| otherwise = Nothing
Use pattern matching!
This is what I wanted to avoid, I am posting it for reference
module Pattern where
import Lang
optimize :: Program -> Program
optimize p
| p' <- reorder $ rewrite $ moveSkip p
, p /= p' = optimize p'
| otherwise = p
rewrite :: Program -> Program
rewrite (Move a : Move b : x) = rewrite $ Move (a+b) : x
rewrite (Add a : Add b : x) = rewrite $ Add (a+b) : x
rewrite (Move 0 : x) = rewrite x
rewrite (Add 0 : x) = rewrite x
rewrite (Skip : Skip : x) = rewrite x
rewrite (Halt : _) = [Halt]
rewrite (Skip : x : xs) = Skip : x : rewrite xs
rewrite (x : xs) = x : rewrite xs
rewrite [] = []
moveSkip :: Program -> Program
moveSkip (Skip : a : x) = x ++ [Skip, a]
moveSkip x = x
reorder :: Program -> Program
reorder (Move x : xs)
| (no_skips , Move y : xs') <- break isMove xs
, (no_skips' , Move w : q ) <- break isMove xs'
, x == -y
, all (/=Skip) no_skips
, all (/=Skip) no_skips'
= Move x : no_skips ++ no_skips' ++ Move (w-x) : reorder q
| otherwise = Move x : reorder xs
reorder (Skip : x : xs) = Skip : x : reorder xs
reorder (x:xs) = x : reorder xs
reorder [] = []
isMove (Move _) = True
isMove _ = False

Haskell program that gives pretty prime numbers

I've made a haskell program that computes pretty prime numbers. Pretty primes are primes that are very close to a power of 2. You give 2 numbers for example: 10 and 20 then it returns 17 because 17 is the closest to a power of 2. 17 - 16 = 1 so it is the closest.
I've made this:
EDIT: I've rewrote the primefunction like this and e verw function but still getting -1.
-- Geeft priemgetallen terug tussen de 2 grenzen
-- English: Gives primenumbers between 2 numbers
priemgetallen :: Int->[Int]
priemgetallen b = take b (zeef [2..])
where zeef (p:xs) = p : zeef [x | x<-xs, (mod x p) /= 0]
-- Geeft machten terug tussen de 2 grenzen
-- English: Gives powers of 2 between 2 numbers
machten :: Int->Int->[Int]
machten a b
| a <= 2 = 2:[2^x| x<-[2..b], (2^x) `mod` 2 == 0, 2^x < b, 2^x > a]
| otherwise = [2^x| x<-[2..b], (2^x) `mod` 2 == 0, 2^x < b, 2^x > a]
-- English: the start of the function
prettyprime :: Int->Int->Int
prettyprime a b = vergelijk ( verw a (priemgetallen b)) (machten a b)
-- Filter the list
verw :: Int->[Int]->[Int]
verw _ [] = []
verw k (x:xs)
| x > k = [x] ++ verw k xs
| otherwise = verw k xs
-- Vergelijkt alle priemgetallen en geeft welke korste bij het ander ligt
-- English this function must see what primenumber is the closest to a power of 2 but I can't fix it
vergelijk :: [Int]->[Int]->Int
vergelijk [] _ = -1
vergelijk _ [] = -1
vergelijk (x:xs) (y:ys)
| x - y < vergelijk (x:xs) ys = x
| x - y > vergelijk (x:xs) ys = vergelijk xs (y:ys)
| x - y == vergelijk (x:xs) ys = x
main = do
print $ prettyprime 14 20
Can someone help me?
Kind regards,
The incomplete pattern is because you've omitted the case when x - y == vergelijk (x:xs) ys. The compiler is capable of warning you about this if you add -fwarn-incomplete-patterns and convert your guards into a real case:
vergelijk (x:xs) (y:ys) = case compare (x - y) (vergelijk (x:xs) ys) of
LT -> x
-- you will get a warning about having no case for EQ
GT -> vergelijk xs (y:ys)
As a bonus, this version is much less likely to recompute the recursive call, especially on low optimization levels.

How to check that I'm dealing with a list in Haskell?

I'm learning Haskell, and I'm trying to add preconditions to a (trivial, as an exercise) element_at function (code below). I've created a "helper" elem_at_r because otherwise, len x fails at some point (when x is a 'literal' rather than a list? - I still have trouble parsing ghci's error messages). elem_at now has all the error checking, and elem_at_r does the work. In elem_at, I'd like to add a check that x is indeed a list (and not a 'literal'). How can I do that?
len x = sum [ 1 | a <- x]
elem_at_r x n | n == 0 = head x
| 0 < n = elem_at_r (tail x) (n-1)
elem_at x n | x == [] = error "Need non-empty list"
| len x <= n = error "n too large " ++ show (len x)
| n < 0 = error "Need positive n"
| otherwise = elem_at_r x n
Thanks!
Frank
Due to Haskell's type system, elem_at can only take a list as its first argument (x); if you try to pass a non-list, GHC will detect this and give an error at compile time (or interpretation time in GHCi). I don't know why len would "fail"; could you post the error message that GHCi gives you?
It looks like you were getting errors because of the "x == []" line. The code below pattern matches for that condition and adds a few signatures. Otherwise it is the same. Hope it helps.
len x = sum [ 1 | a <- x]
elem_at_r :: [a] -> Int -> a
elem_at_r x n | n == 0 = head x
| 0 < n = elem_at_r (tail x) (n-1)
elem_at :: [a] -> Int -> a
elem_at [] _ = error "Need non-empty list"
elem_at x n | len x <= n = error ("n too large " ++ show (len x))
| n < 0 = error "Need positive n"
| otherwise = elem_at_r x n
You could also make your helper functions part of this function using a where clause:
elem_at :: [a] -> Int -> a
elem_at [] _ = error "Need non-empty list"
elem_at x n | len x <= n = error ("n too large " ++ show (len x))
| n < 0 = error "Need positive n"
| otherwise = elem_at_r x n
where
len :: [a] -> Int
len x = sum [ 1 | a <- x]
elem_at_r :: [a] -> Int -> a
elem_at_r x n | n == 0 = head x
| 0 < n = elem_at_r (tail x) (n-1)

Detecting cyclic behaviour in Haskell

I am doing yet another projecteuler question in Haskell, where I must find if the sum of the factorials of each digit in a number is equal to the original number. If not repeat the process until the original number is reached. The next part is to find the number of starting numbers below 1 million that have 60 non-repeating units. I got this far:
prob74 = length [ x | x <- [1..999999], 60 == ((length $ chain74 x)-1)]
factorial n = product [1..n]
factC x = sum $ map factorial (decToList x)
chain74 x | x == 0 = []
| x == 1 = [1]
| x /= factC x = x : chain74 (factC x)
But what I don't know how to do is to get it to stop once the value for x has become cyclic. How would I go about stopping chain74 when it gets back to the original number?
When you walk through the list that might contain a cycle your function needs to keep track of the already seen elements to be able to check for repetitions. Every new element is compared against the already seen elements. If the new element has already been seen, the cycle is complete, if it hasn't been seen the next element is inspected.
So this calculates the length of the non-cyclic part of a list:
uniqlength :: (Eq a) => [a] -> Int
uniqlength l = uniqlength_ l []
where uniqlength_ [] ls = length ls
uniqlength_ (x:xs) ls
| x `elem` ls = length ls
| otherwise = uniqlength_ xs (x:ls)
(Performance might be better when using a set instead of a list, but I haven't tried that.)
What about passing another argument (y for example) to the chain74 in the list comprehension.
Morning fail so EDIT:
[.. ((length $ chain74 x x False)-1)]
chain74 x y not_first | x == y && not_first = replace_with_stop_value_:-)
| x == 0 = []
| x == 1 = [1]
| x == 2 = [2]
| x /= factC x = x : chain74 (factC x) y True
I implemented a cycle-detection algorithm in Haskell on my blog. It should work for you, but there might be a more clever approach for this particular problem:
http://coder.bsimmons.name/blog/2009/04/cycle-detection/
Just change the return type from String to Bool.
EDIT: Here is a modified version of the algorithm I posted about:
cycling :: (Show a, Eq a) => Int -> [a] -> Bool
cycling k [] = False --not cycling
cycling k (a:as) = find 0 a 1 2 as
where find _ _ c _ [] = False
find i x c p (x':xs)
| c > k = False -- no cycles after k elements
| x == x' = True -- found a cycle
| c == p = find c x' (c+1) (p*2) xs
| otherwise = find i x (c+1) p xs
You can remove the 'k' if you know your list will either cycle or terminate soon.
EDIT2: You could change the following function to look something like:
prob74 = length [ x | x <- [1..999999], let chain = chain74 x, not$ cycling 999 chain, 60 == ((length chain)-1)]
Quite a fun problem. I've come up with a corecursive function that returns the list of the "factorial chains" for every number, stopping as soon as they would repeat themselves:
chains = [] : let f x = x : takeWhile (x /=) (chains !! factC x) in (map f [1..])
Giving:
take 4 chains == [[],[1],[2],[3,6,720,5043,151,122,5,120,4,24,26,722,5044,169,363601,1454]]
map head $ filter ((== 60) . length) (take 10000 chains)
is
[1479,1497,1749,1794,1947,1974,4079,4097,4179,4197,4709,4719,4790,4791,4907,4917
,4970,4971,7049,7094,7149,7194,7409,7419,7490,7491,7904,7914,7940,7941,9047,9074
,9147,9174,9407,9417,9470,9471,9704,9714,9740,9741]
It works by calculating the "factC" of its position in the list, then references that position in itself. This would generate an infinite list of infinite lists (using lazy evaluation), but using takeWhile the inner lists only continue until the element occurs again or the list ends (meaning a deeper element in the corecursion has repeated itself).
If you just want to remove cycles from a list you can use:
decycle :: Eq a => [a] -> [a]
decycle = dc []
where
dc _ [] = []
dc xh (x : xs) = if elem x xh then [] else x : dc (x : xh) xs
decycle [1, 2, 3, 4, 5, 3, 2] == [1, 2, 3, 4, 5]

Resources