Given two list of the form:
l1 = [k1, k2, k3]
l2 = [(k1, x1), (k2, x2), (k1, x3), (k2, x4), (k5, x5), ..)
I would like to group the x'es in a list with their respective key such that:
l = [(k1, [x1, x3]), (k2, [x2, x4]), (k5, [x5]), ..]
I have already googled the question and all the solutions use library code, I was however wondering how you implement this recursively. What I have so far is:
groupHelper [] l2 = []
groupHelper (k, value):tail1 (k1, values):tail2 | k == k1 = groupHelper tail1 (k1,(value:values)):tail2
| k /= k1 = (k1, values):groupHelper (k,value):tail1 tail2
groupHelper (k, value):tail1 [] = (k, value):groupHelper tail1 (k,value)
As you will notice my code makes absolutely no sense. I have been stuck on this problem for some time now, so I was wondering if adding a third accumulator parameter in case I've enumerated through l1 I can go back, would help.
I'm really confused right now, if anyone could point me in the right direction that would be appreciated.
Start with a simpler function: update :: (a, b) -> [(a, [b])] -> [(a, [b])], which takes a single pair and updates the in-progress grouping.
update (k, v) [] = ...
update (k, v) ((k1, vs):rest) = ...
Once you do that, it' s simple matter of folding your list of pairs using update.
groupby :: [(a, b)] -> [(a, [b])]
groupby = foldr update []
If you don't want to use foldr, it would be a good exercise to implement it from scratch.
foldr_ :: (a -> b -> b) -> b -> [a] -> b
foldr_ f z [] = ...
foldr_ f z (x:xs) = ...
There's little to be gained by ignoring the abstraction provided by foldr and trying to implement groupby entirely from first principles.
Not necessarily particularly elegant, but we can pattern match on the list, and then iterate over the tail to find all values with the same key, then cons the result onto the result of running the same function recursively on the remaining elements.
groupByFirst [] = []
groupByFirst ((k, v):tl) = (k, v:map snd s) : groupByFirst d
where
(s, d) = partition ((k ==) . fst) tl
ghci> l2 = [("k1", "x1"), ("k2", "x2"), ("k1", "x3"), ("k2", "x4"), ("k5", "x5")]
ghci> groupByFirst l2
[("k1",["x1","x3"]),("k2",["x2","x4"]),("k5",["x5"])]
The complexity of this is less than ideal, but it should be simple enough to understand. Effectively, evaluating this would look like:
groupByFirst [("k1", "x1"), ("k2", "x2"), ("k1", "x3"), ("k2", "x4"), ("k5", "x5")]
("k1", ["x1", "x3"]) : groupByFirst [("k2", "x2"), ("k2", "x4"), ("k5", "x5")]
("k1", ["x1", "x3"]) : ("k2", ["x2", "x4"]) : groupByFirst [("k5", "x5")]
("k1", ["x1", "x3"]) : ("k2", ["x2", "x4"]) : ("k5", ["x5"]) : groupByFirst []
("k1", ["x1", "x3"]) : ("k2", ["x2", "x4"]) : ("k5", ["x5"]) : []
[("k1", ["x1", "x3"]), ("k2", ["x2", "x4"]), ("k5", ["x5"])]
Related
Is there an algorithm to lead all possible combinations of given amount of three-valued logic values?
For example, F(2) should return this list:
t t
t u
t f
u t
u u
u f
f t
f u
f f
The function would look like this (in Haskell):
data Tril = FALSE | NULL | TRUE
all :: Int -> [[Tril]]
all amount = ???
all1 :: [Tril]
all1 = join (all 1)
all2 :: [(Tril, Tril)]
all2 = map (\[f, s] -> (f, s)) (all 2)
all3 :: [(Tril, Tril, Tril)]
all3 = map (\[f, s, t] -> (f, s, t)) (all 3)
You can do this very simply as a list comprehension:
all2 = [ (v1, v2) | v1 <- [FALSE, TRUE, NULL], v2 <- [FALSE, TRUE, NULL] ]
You can write it equivalently as a monadic do-block:
all2 = do
v1 <- [FALSE, TRUE, NULL]
v2 <- [FALSE, TRUE, NULL]
return (v1, v2)
And that gives us an idea for how we can write the variable-size one:
all 0 = [[]] -- Note: Empty list with one empty item.
all n = do
v <- [FALSE, TRUE, NULL]
vs <- all (n-1)
return (v:vs)
As it turns out — and this is slightly mind-bending — this is the net effect of the replicateM function. It takes a monadic action, does it N times, and gathers the results together.
all n = replicateM n [FALSE, TRUE, NULL]
replicateM does exactly that:
> import Control.Monad
> replicateM 2 [1,2,3]
[[1,1],[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]]
Hence,
all :: Int -> [[Tril]]
all amount = replicateM amount [FALSE,NULL,TRUE]
I'd suggest to pick anouther name, since all is already taken by Prelude.all.
For reference my code.
import Control.Monad.Par
makeGridx:: (Enum a,Num a)=>a->a->a->[a]
makeGridx start end h = [start,(start+h)..end]
makeGridt:: (Enum a, Num a)=>a->a->a->[a]
makeGridt start end h = [start,(start+h)..end]
generateBaseLine:: (Eq a,Num a)=>(a->a)-> [a] -> [(a,a,a)]
generateBaseLine f (x:xs) = if (null xs)
then [(x,0,0)]
else if(x==0)
then (x,0,0) : (generateBaseLine f xs)
else (x,0,(f x)) : (generateBaseLine f xs)
--fdm :: (Enum a,Num a) =>a->a->a->a->a->a->a->(a->a)->[(a,a,a)]
--fdm alpha startt endt startx endx dx dt bbFunction = start alpha (makeGridx startx endx dx) (makeGridt startt endt dt) (generateBaseLine bbFunction (makeGridx startx endx dx)) dx dt
--start:: Num a=>a->[a]->[a]->[(a,a,a)]->a->a->[(a,a,a)]
--start alpha (x:xs) (t:ts) (phi:phis) dx dt = (startPar alpha (x:xs) (ts) (phi:phis) dx dt [] [])
startPar:: Num a =>a->[a]->[a]->[(a,a,a)]->a->a->[(a,a,a)]
startPar alpha (x:xs) (t:ts) (phi1:(ph2:(ph3:phis))) dx dt = (phi1:(ph2:(ph3:phis))) ++ (buildPhiListIds alpha (x:xs) (t:ts) (phi1:(ph2:(ph3:phis))) dx dt [] [])
buildPhiListIds:: Num a=> a->[a]->[a]->[(a,a,a)]->a->a->[Par (IVar (a, a, a))]->[a]->[(a,a,a)]
buildPhiListIds alpha (x:xs) (t:ts) (phi1:(ph2:(ph3:phis))) dx dt phiIds newX = do
one<-third phi1
two<-third ph2
three<-third ph3
newSolId<- spawn( return (newPhi (x:xs) t (one,two,three,dx,dt,alpha) ))
buildPhiListIds alpha xs (t:ts) (ph2:(ph3:phis)) dx dt (phiIds ++ [newSolId]) (newX ++ [x])
buildPhiListIds alpha (0:xs) (t:ts) (phi1:(ph2:(ph3:phis))) dx dt phiIds newX = do
newSolId<-spawn (return (newPhi (0:xs) t (1,2,3,4,5,6)))
buildPhiListIds alpha xs (t:ts) (phi1:(ph2:(ph3:phis))) dx dt (phiIds ++ [newSolId]) (newX ++ [0])
buildPhiListIds alpha [] (t:ts) (phi1:(ph2:(ph3:phis))) dx dt phiIds newX = do
(getSolutions (getTuples(getSolutions phiIds))) ++ (buildPhiListIds alpha newX ts (getSolutions (getTuples(getSolutions phiIds))) dx dt [] [])
buildPhiListIds _ _ [] _ _ _ _ _ = []
getTuples::[IVar a]->[Par a]
getTuples (x:xs) = (get x) : (getSolutions xs)
getTuples [] = []
getSolutions:: [Par a]->[a]
getSolutions (x:xs) = (runPar x):(getTuples xs)
getSolutions [] = []
third (_,_,x)=x
ex f g x = runPar $ do
fx <- spawn (return (f x))
gx <- spawn (return (g x))
a <- get fx
b <- get gx
return (a,b)
newPhi:: (Eq a,Fractional a)=> [a]->a->(a,a,a,a,a,a)->(a,a,a)
newPhi (0:xs) t (phiL,phiC,phiR,dx,dt,alpha)= (0,t,0)
newPhi (x:[]) t (phiL,phiC,phiR,dx,dt,alpha)= (x,t,0)
newPhi (x:xs) t (phiL,phiC,phiR,dx,dt,alpha)= (x,t,(phiC + (alpha * (dt/(dx^2)))*(phiR -(2*phiC) + phiL)))
I get a bunch of errors, but one very much complexes me.
heateqpar.hs:28:156:
Couldn't match type `Par' with `[]'
Expected type: [IVar (a1, a1, a1)]
Actual type: Par (IVar (a1, a1, a1))
In a stmt of a 'do' block:
newSolId <- spawn
(return (newPhi (x : xs) t (one, two, three, dx, dt, alpha))) ::
Par (IVar (a, a, a))
In the expression:
do { one <- third phi1;
two <- third ph2;
three <- third ph3;
newSolId <- spawn
(return (newPhi (x : xs) t (one, two, three, dx, dt, alpha))) ::
Par (IVar (a, a, a));
.... }
In an equation for `buildPhiListIds':
buildPhiListIds
alpha
(x : xs)
(t : ts)
(phi1 : (ph2 : (ph3 : phis)))
dx
dt
phiIds
newX
= do { one <- third phi1;
two <- third ph2;
three <- third ph3;
.... }
The actual type of this is what i want it to be, but for some reason it is trying to enforce this type that isnt the return type of spawn? When i see this it seems like in my type declaration is trying to enforce this however i have the type as followed
buildPhiListIds:: Num a=> a->[a]->[a]->[(a,a,a)]->a->a->[Par (IVar (a, a, a))]->[a]->[(a,a,a)]
I see no type specifically of [IVar (a1, a1, a1)], which is really confusing me. If someone could lead me on the right road, it would be very much appreciated.
I get a bunch of errors, but one very much complexes me.
In a do expression, every monadic action must belong to the same monad. The return type of buildPhiListIds is [something], so the result of do has type [something]. Therefore, all your actions should be in the list monad, not in the Par monad. Now look at spawn again:
spawn :: NFData a => Par a -> Par (IVar a)
Compare what I mentioned above with your error: "Couldn't match type `Par' with `[]'". Aha! It expects a list, but you're using something of wrong type (Par)!
Now, extrapolating from your previous questions I suppose that you're new to Haskell and the concept of monads. There are many tutorials about them, including chapters in RWH or in LYAH, so I won't provide one in this answer (they're actually rather easy, don't be intimidated by the number of tutorials). Either way, your current usage is completely off.
That being said, you should refactor buildPhiListIds to have the following type:
buildPhiListIds:: Num a => ... -> Par [(a,a,a)]
Also, your definitions of getTuples and getSolutions don't make much sense. The following are much simpler and probably achieve what you actually want:
getTuples :: [IVar a] -> [Par a]
getTuples = map get
getSolutions :: [Par a] -> [a]
getSolutions = runPar . sequence
Also, you should try to keep the calls to runPar to a minimum:
The runPar function itself is relatively expensive [...]. So when using the Par monad, you should usually try to thread the Par monad around to all the places that need parallelism to avoid needing multiple runPar calls. [...] In particular, nested calls to runPar (where a runPar is evaluated during the course of executing another Par computation) usually give poor results.
I suggest you to write some simpler programs which actually compile, till you get both monads in general and Par.
I'm working on a pretty complicated (complicated for me, at least) function that I'd like to use to count the number of times a word in a list corresponds with a word in a database.
An example using random words:
let input = [("InputName", ["dog", "cat", "cat"...]), ...]
let database = ["dog", "cat", "badger"...]
After several hours of mental gymnastics, I came up with this hideous function that almost works. I've simplified it so it'll make sense in the context of this example:
findMatches input database = [ (snd x, wordCount (snd x)) | x <- input ]
where
wordCount ys = sum[ if y `elem` database then 1 else 0 | y <- ys ]
My goal, my hope, my wish would be to have an output that reads:
[("dog", 1), ("cat", 2), ("badger", 0)]
Any suggestions or nudges in the right direction would be appreciated.
EDIT
I finally made a function that works. catWordCount counts the number of times a database entry appears in an input. I'm working on a better implementation using fold.
let input = words "5 4 10 0 1 9 1"
let database = [("C1", words "1 2 3 4 5"), ("C2", words "6 7 8 9 10")]
catwordCount input database
catWordCount fs zs = [ (fst f, inputSearch (snd f)) | f <- fs ]
where
inputSearch gs = [ (g, wordCount [g]) | g <- gs ]
wordCount hs = sum[ if h == z then 1 else 0 | h <- hs, z <- zs ]
And the output:
(["C1", [("1",2),("2",0),("3",0),("4",1),("5",1)])
(["C2", [("6",0),("7",0),("8",0),("9",1),("10",1)])
You can keep a Map of counts that you update for each item. Since you don't want to include items from the input list that are not in the database, if I understood correctly,
alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
is a good way to do that. The supplied key k is looked up, and if it's present, the argument to the update function will we Just value, otherwise it will be Nothing. If the result of the update function is Nothing, the key will be deleted from the Map (or not added, if it wasn't present), if the result is Just something, the key will be associated with something in the altered Map.
So you start with a Map mapping every item to 0,
m0 :: Map String Int
m0 = fromList $ zip database (repeat 0)
to update, you want to increment the count if the item is in database, and not change anything otherwise,
incr :: Maybe Int -> Maybe Int
incr (Just n) = Just (n+1)
incr Nothing = Nothing
or, shorter, incr = fmap (+1) using the Functor instance of Maybe.
Then the resulting map is simply
finalMap :: Map String Int
finalMap = foldl (flip $ alter incr) m0 $ snd input
and if you want a list rather than a Map, just call assocs or toList on finalMap.
It might not be exactly what you are looking for, but try this:
import Data.List
countMatches :: [(String, [String])] -> [(String, Int)]
countMatches = map (\l -> (head l, length l)) . group . sort . concat . map snd
Hopefully the function compositions are not too confusing. I'll go over it step by step. Say you run this function with input
[("", ["a", "b"]), ("", ["b", "c", "x", "a"]), ("", ["y", "b", "z"])]
After map snd it is
[["a", "b"], ["b", "c", "x", "a"], ["y", "b", "z"]]
After concat,
["a", "b", "b", "c", "x", "a", "y", "b", "z"]
After sort,
["a", "a", "b", "b", "b", "c", "x", "y", "z"]
After group,
[["a", "a"], ["b", "b", "b"], ["c"], ["x"], ["y"], ["z"]]
And finally map (\l -> (head l, length l)) produces
[("a", 2), ("b", 3), ("c", 1), ("x", 1), ("y", 1), ("z", 1)]
How can I create a function which lazily makes permutations for the chars '_' and '*' like this:
For example:
Main> function 3
["___","*__","_*_","__*","**_","_**","*_*","***"]
First element is made only from _, the next 3 are permutations that lists: *__, the second 3 are permutations that lists **_, and the last element contains only *.
How can I do that?
Here's another "correct order" version:
function :: Int -> [String]
function c = concatMap helper $ zip (reverse [0..c]) [0..c]
helper :: (Int, Int) -> [String]
helper (c, 0) = [replicate c '_']
helper (0, c) = [replicate c '*']
helper (cUnderscores, cAsterisks) = map ('_' :) (helper (cUnderscores - 1, cAsterisks))
++ map ('*' :) (helper (cUnderscores, cAsterisks - 1))
You might want to look at replicateM.
let k = ["_", "*"]
let p = [ a ++ b ++ c | a <- k, b <- k, c <- k ]
The “correct order” version:
import Data.List
function k = concatMap (nub . permutations . pat) [0..k]
where pat x = replicate x '*' ++ replicate (k-x) '_'
I don’t know how to step from one permutation to another in constant time, though.
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.