Related
I have to make a function that takes list a list and returns list of pairs of first and last element,2nd and 2nd last and so forth It doesn't matter if the list has even or odd number of elements because if its odd i will just ignore the middle element.The idea i have is that make a new rec fun that takes old list and its revers as input i think i finished the code but i get Syntax error for ;;
let lip l =
if [] then []
else let l1=l l2=List.rev l in
let rec lp l1 l2 = match l1,l2 with
| [],[] ->[]
| [],h2::t2->[]
| h1::_,h2::_ ->
if (List.length l -2) >= 0 then [(h1,h2)]# lp(List.tl l1) t2
else [] ;;
There are quite a few errors in your code.
I think the specific error you're seeing is caused by the fact that there is no in after let rec lp ....
Every let that's not at the top level of a module needs to be followed by in. One way to think of it is that it's a way of declaring a local variable for use in the expression that appears after in. But you need to have the in expr.
Another way to look at it is that you're defining a function named lp but you're not calling it anywhere.
As #lambda.xy.x points out, you can't say if [] then ... because [] isn't of type bool. And you can't say let x = e1 y = e2 in .... The correct form for this is let x = e1 in let y = e2 in ...
(Or you can write let x, y = e1, e2 in ..., which looks nicer for defining two similar variables to two similar values.)
The following code should at least compile:
let lip list1 =
if list1 = [] then []
else
let list2=List.rev list1 in
let rec lp l1 l2 = match l1,l2 with
| [], [] ->[]
| [], _::_->[]
| h1::_::_, h2::t2 -> (* l1 length >= 2*)
(h1,h2) :: lp(List.tl l1) t2
| h1::_,h2::t2 -> (* l1 length = 1 *)
[]
in
[]
I have made the following changes:
renamed the arguments of lip to make clear they are different from the arguments of lp
removed the alias let l1 = l
changed the if condition to a term of type boolean -- there's not much to compare, so I assume you are checking list1
replaced the list length condition by a pattern match against two heads
the else path is the second match - it might be better to rewrite that one to | [h1, _] -> ...
the definition of lp needs to be followed with the actual body of lip - to make it compile, we just return [] at the moment but you probably would like something else there
As #Jeffrey Scofield already mentioned, you are not using lp in your code. It could help if you added a comment that explains what you'd like to achieve and what the intended role of lp is.
I want to perform an arithmetic operation (e.g. doubling the value) on a list of integers, every n places.
For example, given the list [1,2,3,4,5,6,7], I want to double values every three places. In that case, we would have [1,2,6,4,5,12,7].
How can I do it?
applyEvery :: Int -> (a -> a) -> [a] -> [a]
applyEvery n f = zipWith ($) (cycle (replicate (n-1) id ++ [f]))
The cycle subexpression builds a list of functions [id,id,...,id,f] with the correct number of elements and repeats it ad nauseam, while the zipWith ($) applies that list of functions to the argument list.
Since you asked for it, more detail! Feel free to ask for more explanation.
The main idea is maybe best explained with an ASCII picture (which won't stop me from writing a thousand a lot of ASCII words!):
functions : [ id, id, f , id, id, f , id, id, f, ...
input list: [ 1, 2, 3, 4, 5, 6, 7 ]
-----------------------------------------------------
result : [ 1, 2, f 3, 4, 5, f 6, 7 ]
Just like there's no reason to hardcode the fact that you want to double every third element in the list, there's nothing special about f (which in your example is doubling), except that it should have the same result type as doing nothing. So I made these the parameters of my function. It's even not important that you operate on a list of numbers, so the function works on lists of a, as long as it's given an 'interval' and an operation. That gives us the type signature applyEvery :: Int -> (a -> a) -> [a] -> [a]. I put the input list last, because then a partial application like doubleEveryThird = applyEvery 3 (*2) is something that returns a new list, a so-called combinator. I picked the order of the other two arguments basically at random :-)
To build the list of functions, we first assemble the basic building block, consisting of n-1 ids, followed by an f as follows: replicate (n-1) id ++ [f]. replicate m x makes a list containing m repetitions of the xargument, e.g. replicate 5 'a' = "aaaaa", but it also works for functions. We have to append the f wrapped in a list of its own, instead of using : because you can only prepend single elements at the front - Haskell's lists are singly-linked.
Next, we keep on repeating the basic building block with cycle (not repeat as I first had mistakenly). cycle has type [a] -> [a] so the result is a list of "the same level of nested-ness". Example cycle [1,2,3] evaluates to [1,2,3,1,2,3,1,2,3,...]
[ Side note: the only repeat-y function we haven't used is repeat itself: that forms an infinite list consisting of its argument ]
With that out of the way, the slightly tricky zipWith ($) part. You might already know the plain zip function, which takes two lists and puts elements in the same place in a tuple in the result, terminating when either list runs out of elements. Pictorially:
xs : [ a , b , c , d, e]
ys: [ x, y , z ]
------------------------------
zip xs ys: [(a,x),(b,y),(c,z)]
This already looks an awful lot like the first picture, right? The only thing is that we don't want to put the individual elements together in a tuple, but apply the first element (which is a function) to the second instead. Zipping with a custom combining function is done with zipWith. Another picture (the last one, I promise!):
xs : [ a , b , c , d, e]
ys: [ x, y, z ]
----------------------------------------
zipWith f xs ys: [ f a x, f b y, f c z ]
Now, what should we choose to zipWith with? Well, we want to apply the first argument to the second, so (\f x -> f x) should do the trick. If lambdas make you uncomfortable, you can also define a top-level function apply f x = f x and use that instead. However, this already a standard operator in the Prelude, namely $! Since you can't use a infix operator as a standalone function, we have to use the syntactic sugar ($) (which really just means (\f x -> f $ x))
Putting all of the above together, we get:
applyEvery :: Int -> (a -> a) -> [a] -> [a]
applyEvery n f xs = zipWith ($) (cycle (replicate (n-1) id ++ [f])) xs
But we can get rid of the xs at the end, leading to the definition I gave.
A common way to get indexes for values in a list is to zip the list into tuples of (value, index).
ghci > let zipped = zip [1,2,3,4,5,6,7] [1..]
ghci > zipped
[(1,1),(2,2),(3,3),(4,4),(5,5),(6,6),(7,7)]
Then you just need to map over that list and return a new one. If index is divisible by 3 (index `rem` 3 == 0), we'll double the value, otherwise we'll return the same value:
ghci > map (\(value, index) -> if index `rem` 3 == 0 then value*2 else value) zipped
[1,2,6,4,5,12,7]
Tell me if that all makes sense—I can add more detail if you aren't familiar with zip and map and such.
Zip
You can find documentation on zip by looking at its Haddocks, which say: "zip takes two lists and returns a list of corresponding pairs." (Docs are hosted in several places, but I went to https://www.stackage.org and searched for zip).
Map
The map function applies a function to each item in a list, generating a new value for each element.
Lambdas
Lambdas are just functions without a specific name. We used one in the first argument to map to say what we should do to each element in the list. You may have seen these in other languages like Python, Ruby, or Swift.
This is the syntax for lambdas:
(\arg1, arg2 -> functionBodyHere)
We could have also written it without a lambda:
ghci > let myCalculation (value, index) = if index `rem` 3 == 0 then value*2 else value
ghci > map myCalculation zipped
[1,2,6,4,5,12,7]
Note: this code is not yet tested.
In lens land, this is called a Traversal. Control.Lens gives you these:
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
type Traversal s t a b =
forall f . Applicative f => (a -> f b) -> s -> f t
type Traversal' s a = Traversal s s a a
We can use lens's itraverse from Control.Lens.Indexed:
-- everyNth :: (TraversableWithIndex i t, Integral i)
=> i -> Traversal' (t a) a
everyNth :: (TraversableWithIndex i t, Integral i, Applicative f)
=> i -> (a -> f a) -> t a -> f (t a)
everyNth n f = itraverse f where
g i x | i `rem` n == n - 1 = f x
| otherwise = pure x
This can be specialized to your specific purpose:
import Data.Profunctor.Unsafe
import Data.Functor.Identity
everyNthPureList :: Int -> (a -> a) -> [a] -> [a]
everyNthPureList n f = runIdentity #. everyNth n (Identity #. f)
mapIf :: (Int -> Bool) -> (a -> a) -> [a] -> [a]
mapIf pred f l = map (\(value,index) -> if (pred index) then f value else value) $ zip l [1..]
mapEveryN :: Int -> (a -> a) -> [a] -> [a]
mapEveryN n = mapIf (\x -> x `mod` n == 0)
Live on Ideone.
A simple recursive approach:
everyNth n f xs = igo n xs where
igo 1 (y:ys) = f y : igo n ys
igo m (y:ys) = y : igo (m-1) ys
igo _ [] = []
doubleEveryThird = everyNth 3 (*2)
Basically, igo starts at n, counts down until it reaches 1, where it will apply the function, and go back up to n. doubleEveryThird is partially applied: everyNth expects three arguments, but we only gave it two, so dougleEveryThird will expect that final argument.
I have a simple function (used for some problems of project Euler, in fact). It turns a list of digits into a decimal number.
fromDigits :: [Int] -> Integer
fromDigits [x] = toInteger x
fromDigits (x:xs) = (toInteger x) * 10 ^ length xs + fromDigits xs
I realized that the type [Int] is not ideal. fromDigits should be able to take other inputs like e.g. sequences, maybe even foldables ...
My first idea was to replace the above code with sort of a "fold with state". What is the correct (= minimal) Haskell-category for the above function?
First, folding is already about carrying some state around. Foldable is precisely what you're looking for, there is no need for State or other monads.
Second, it'd be more natural to have the base case defined on empty lists and then the case for non-empty lists. The way it is now, the function is undefined on empty lists (while it'd be perfectly valid). And notice that [x] is just a shorthand for x : [].
In the current form the function would be almost expressible using foldr. However within foldl the list or its parts aren't available, so you can't compute length xs. (Computing length xs at every step also makes the whole function unnecessarily O(n^2).) But this can be easily avoided, if you re-thing the procedure to consume the list the other way around. The new structure of the function could look like this:
fromDigits' :: [Int] -> Integer
fromDigits' = f 0
where
f s [] = s
f s (x:xs) = f (s + ...) xs
After that, try using foldl to express f and finally replace it with Foldable.foldl.
You should avoid the use of length and write your function using foldl (or foldl'):
fromDigits :: [Int] -> Integer
fromDigits ds = foldl (\s d -> s*10 + (fromIntegral d)) 0 ds
From this a generalization to any Foldable should be clear.
A better way to solve this is to build up a list of your powers of 10. This is quite simple using iterate:
powersOf :: Num a => a -> [a]
powersOf n = iterate (*n) 1
Then you just need to multiply these powers of 10 by their respective values in the list of digits. This is easily accomplished with zipWith (*), but you have to make sure it's in the right order first. This basically just means that you should re-order your digits so that they're in descending order of magnitude instead of ascending:
zipWith (*) (powersOf 10) $ reverse xs
But we want it to return an Integer, not Int, so let's through a map fromIntegral in there
zipWith (*) (powersOf 10) $ map fromIntegral $ reverse xs
And all that's left is to sum them up
fromDigits :: [Int] -> Integer
fromDigits xs = sum $ zipWith (*) (powersOf 10) $ map fromIntegral $ reverse xs
Or for the point-free fans
fromDigits = sum . zipWith (*) (powersOf 10) . map fromIntegral . reverse
Now, you can also use a fold, which is basically just a pure for loop where the function is your loop body, the initial value is, well, the initial state, and the list you provide it is the values you're looping over. In this case, your state is a sum and what power you're on. We could make our own data type to represent this, or we could just use a tuple with the first element being the current total and the second element being the current power:
fromDigits xs = fst $ foldr go (0, 1) xs
where
go digit (s, power) = (s + digit * power, power * 10)
This is roughly equivalent to the Python code
def fromDigits(digits):
def go(digit, acc):
s, power = acc
return (s + digit * power, power * 10)
state = (0, 1)
for digit in digits:
state = go(digit, state)
return state[0]
Such a simple function can carry all its state in its bare arguments. Carry around an accumulator argument, and the operation becomes trivial.
fromDigits :: [Int] -> Integer
fromDigits xs = fromDigitsA xs 0 # 0 is the current accumulator value
fromDigitsA [] acc = acc
fromDigitsA (x:xs) acc = fromDigitsA xs (acc * 10 + toInteger x)
If you're really determined to use a right fold for this, you can combine calculating length xs with the calculation like this (taking the liberty of defining fromDigits [] = 0):
fromDigits xn = let (x, _) = fromDigits' xn in x where
fromDigits' [] = (0, 0)
fromDigits' (x:xn) = (toInteger x * 10 ^ l + y, l + 1) where
(y, l) = fromDigits' xn
Now it should be obvious that this is equivalent to
fromDigits xn = fst $ foldr (\ x (y, l) -> (toInteger x * 10^l + y, l + 1)) (0, 0) xn
The pattern of adding an extra component or result to your accumulator, and discarding it once the fold returns, is a very general one when you're re-writing recursive functions using folds.
Having said that, a foldr with a function that is always strict in its second parameter is a really, really bad idea (excessive stack usage, maybe a stack overflow on long lists) and you really should write fromDigits as a foldl as some of the other answers have suggested.
If you want to "fold with state", probably Traversable is the abstraction you're looking for. One of the methods defined in Traversable class is
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
Basically, traverse takes a "stateful function" of type a -> f b and applies it to every function in the container t a, resulting in a container f (t b). Here, f can be State, and you can use traverse with function of type Int -> State Integer (). It would build an useless data structure (list of units in your case), but you can just discard it. Here's a solution to your problem using Traversable:
import Control.Monad.State
import Data.Traversable
sumDigits :: Traversable t => t Int -> Integer
sumDigits cont = snd $ runState (traverse action cont) 0
where action x = modify ((+ (fromIntegral x)) . (* 10))
test1 = sumDigits [1, 4, 5, 6]
However, if you really don't like building discarded data structure, you can just use Foldable with somewhat tricky Monoid implementation: store not only computed result, but also 10^n, where n is count of digits converted to this value. This additional information gives you an ability to combine two values:
import Data.Foldable
import Data.Monoid
data Digits = Digits
{ value :: Integer
, power :: Integer
}
instance Monoid Digits where
mempty = Digits 0 1
(Digits d1 p1) `mappend` (Digits d2 p2) =
Digits (d1 * p2 + d2) (p1 * p2)
sumDigitsF :: Foldable f => f Int -> Integer
sumDigitsF cont = value $ foldMap (\x -> Digits (fromIntegral x) 10) cont
test2 = sumDigitsF [0, 4, 5, 0, 3]
I'd stick with first implementation. Although it builds unnecessary data structure, it's shorter and simpler to understand (as far as a reader understands Traversable).
type a = [(Int,Int,Int,Int)]
fun:: a -> Int
func [a,b,c,d] = ?
I have a list of tuples like this what i required is to apply list comprehensions or pattern matching .. example taking sum or filter only divide 2 numbers ... i just want a start how to access values and or a list comprehension to this List of Tuples
To sum up the as, use something like this:
type A = [(Int, Int, Int, Int)]
func :: A -> Int
func tuples = sum [a | (a, b, c, d) <- tuples]
Also note that a type alias must begin with an upper case letter. Lower case letters are used for type variables.
hammar's answer covered list comprehensions, the basic schema for recursive functions using pattern matching is:
f [] = ..
f ((a,b,c,d):xs) = ..
So you need to specify a base case for a list containing no 4-tuples, and a recursive case for when the list consists of a 4-tuple (a,b,c,d) followed by a (possibly empty, possibly non-empty) list of 4-tuples xs. The pattern on the second line is a nested pattern: it first matches the list against a pattern like (x:xs), i.e. element x followed by rest of list xs; and then it matches x against the 4-tuple structure.
Below, I'll give some basic examples. Note that you can also write this with standard higher-order functions, such as filter and map, and I'm deliberaty not mentioning things like #-patterns and strictness. I do not recommend doing it like this, but it's just to give you an idea!
When you want to sum the first part of the tuples, you could do it like this:
sum4 :: [(Int,Int,Int,Int)] -> Int
sum4 [] = 0
sum4 ((a,b,c,d):xs) = a + sum4 xs
If you want to filter out the tuples where all of a,b,c and d are even:
filter4allEven :: [(Int,Int,Int,Int)] -> [(Int,Int,Int,Int)]
filter4allEven [] = []
filter4allEven ((a,b,c,d):xs)
| all even [a,b,c,d] = (a,b,c,d) : filter4AllEven xs
| otherwise = filter4AllEven xs
(If the use of all confuses you, just read even a && even b && even c && even d)
And finally, here's a function that returns all the even tuple components (tuples themselves can't be even!) in the same order as they appear in the argument list:
evenTupleComponents :: [(Int,Int,Int,Int)] -> [Int]
evenTupleComponents [] = []
evenTupleComponents ((a,b,c,d):xs) = [x | x <- [a,b,c,d], even x] ++ evenTupleComponents
Once you do a couple of exercises like these, you'll see why using standard functions is a good idea, since they all follow similar patterns, like applying a function to each tuple separately, including or excluding a tuple when it has some property or, more generally, giving a base value for the empty list and a combining function for the recursive case. For instance, I would write evenTupleComponents as evenTupleComponents = filter even . concatMap (\(a,b,c,d) -> [a,b,c,d]), but that's a different story :)
Consider the following code I wrote:
import Control.Monad
increasing :: Integer -> [Integer]
increasing n
| n == 1 = [1..9]
| otherwise = do let ps = increasing (n - 1)
let last = liftM2 mod ps [10]
let next = liftM2 (*) ps [10]
alternateEndings next last
where alternateEndings xs ys = concat $ zipWith alts xs ys
alts x y = liftM2 (+) [x] [y..9]
Where 'increasing n' should return a list of n-digit numbers whose numbers increase (or stay the same) from left-to-right.
Is there a way to simplify this? The use of 'let' and 'liftM2' everywhere looks ugly to me. I think I'm missing something vital about the list monad, but I can't seem to get rid of them.
Well, as far as liftM functions go, my preferred way to use those is the combinators defined in Control.Applicative. Using those, you'd be able to write last = mod <$> ps <*> [10]. The ap function from Control.Monad does the same thing, but I prefer the infix version.
What (<$>) and (<*>) goes like this: liftM2 turns a function a -> b -> c into a function m a -> m b -> m c. Plain liftM is just (a -> b) -> (m a -> m b), which is the same as fmap and also (<$>).
What happens if you do that to a multi-argument function? It turns something like a -> b -> c -> d into m a -> m (b -> c -> d). This is where ap or (<*>) come in: what they do is turn something like m (a -> b) into m a -> m b. So you can keep stringing it along that way for as many arguments as you like.
That said, Travis Brown is correct that, in this case, it seems you don't really need any of the above. In fact, you can simplify your function a great deal: For instance, both last and next can be written as single-argument functions mapped over the same list, ps, and zipWith is the same as a zip and a map. All of these maps can be combined and pushed down into the alts function. This makes alts a single-argument function, eliminating the zip as well. Finally, the concat can be combined with the map as concatMap or, if preferred, (>>=). Here's what it ends up:
increasing' :: Integer -> [Integer]
increasing' 1 = [1..9]
increasing' n = increasing' (n - 1) >>= alts
where alts x = map ((x * 10) +) [mod x 10..9]
Note that all refactoring I did to get to that version from yours was purely syntactic, only applying transformations that should have no impact on the result of the function. Equational reasoning and referential transparency are nice!
I think what you are trying to do is this:
increasing :: Integer -> [Integer]
increasing 1 = [1..9]
increasing n = do p <- increasing (n - 1)
let last = p `mod` 10
next = p * 10
alt <- [last .. 9]
return $ next + alt
Or, using a "list comprehension", which is just special monad syntax for lists:
increasing2 :: Integer -> [Integer]
increasing2 1 = [1..9]
increasing2 n = [next + alt | p <- increasing (n - 1),
let last = p `mod` 10
next = p * 10,
alt <- [last .. 9]
]
The idea in the list monad is that you use "bind" (<-) to iterate over a list of values, and let to compute a single value based on what you have so far in the current iteration. When you use bind a second time, the iterations are nested from that point on.
It looks very unusual to me to use liftM2 (or <$> and <*>) when one of the arguments is always a singleton list. Why not just use map? The following does the same thing as your code:
increasing :: Integer -> [Integer]
increasing n
| n == 1 = [1..9]
| otherwise = do let ps = increasing (n - 1)
let last = map (flip mod 10) ps
let next = map (10 *) ps
alternateEndings next last
where alternateEndings xs ys = concat $ zipWith alts xs ys
alts x y = map (x +) [y..9]
Here's how I'd write your code:
increasing :: Integer -> [Integer]
increasing 1 = [1..9]
increasing n = let allEndings x = map (10*x +) [x `mod` 10 .. 9]
in concatMap allEndings $ increasing (n - 1)
I arrived at this code as follows. The first thing I did was to use pattern matching instead of guards, since it's clearer here. The next thing I did was to eliminate the liftM2s. They're unnecessary here, because they're always called with one size-one list; in that case, it's the same as calling map. So liftM2 (*) ps [10] is just map (* 10) ps, and similarly for the other call sites. If you want a general replacement for liftM2, though, you can use Control.Applicative's <$> (which is just fmap) and <*> to replace liftMn for any n: liftMn f a b c ... z becomes f <$> a <*> b <*> c <*> ... <*> z. Whether or not it's nicer is a matter of taste; I happen to like it.1 But here, we can eliminate that entirely.
The next place I simplified the original code is the do .... You never actually take advantage of the fact that you're in a do-block, and so that code can become
let ps = increasing (n - 1)
last = map (`mod` 10) ps
next = map (* 10) ps
in alternateEndings next last
From here, arriving at my code essentially involved writing fusing all of your maps together. One of the only remaining calls that wasn't a map was zipWith. But because you effectively have zipWith alts next last, you only work with 10*p and p `mod` 10 at the same time, so we can calculate them in the same function. This leads to
let ps = increasing (n - 1)
in concat $ map alts ps
where alts p = map (10*p +) [y `mod` 10..9]
And this is basically my code: concat $ map ... should always become concatMap (which, incidentally, is =<< in the list monad), we only use ps once so we can fold it in, and I prefer let to where.
1: Technically, this only works for Applicatives, so if you happen to be using a monad which hasn't been made one, <$> is `liftM` and <*> is `ap`. All monads can be made applicative functors, though, and many of them have been.
I think it's cleaner to pass last digit in a separate parameter and use lists.
f a 0 = [[]]
f a n = do x <- [a..9]
k <- f x (n-1)
return (x:k)
num = foldl (\x y -> 10*x + y) 0
increasing = map num . f 1