Applying functions to lists with substitution - haskell

I was trying to make a function that quickly calculates fractions. In my particular case there a factorials, so it s kinda easy. I wrote a make_coprime function which makes two numbers coprime (and returns a pair, which bothers me a little: it sounds a bit too complicated, is there no way to make it return 2 numbers? Looks like there isn't, but just to be sure)
Now it is something like frac{numbers]/{numbers} and I want to make all of the upper ones coprime with all the lower ones.
So I have two lists and I want to apply my function to all possible pairs with substitution after that. This is where I failed. I couldn't even do it with one element and a list, my best was
f a [] = (a, [1])
f a x:xs = ((fst (make_coprime a x)), ((snd (make_coprime a x)):(snd (f (fst (make_coprime a x)) xs))))
(there is a parse error somewhere here, but I can't find it at all)
But I feel like I overcomplicate things. It sounds way simplier than it looks when I write it. Is there an elegant way to do this?

The parsing error is that you've not used parens around x:xs.
Before saying any more: Haskell functions should always come with a type signature, which makes it hugely easier to reason what we're talking about and where any. I'm not sure what you want, but likely
makeCoprime :: Integer -> Integer -> (Integer,Integer)
and
f :: Integer -> [Integer] -> (Integer, [Integer])
Apart from that (and to find other parse errors, which occur before the type system ever takes action), I'd first try to write it as readable as possible. First align everything meaningfully:
f a (x:xs) = ( (fst (make_coprime a x))
, ( (snd (make_coprime a x))
: (snd (f (fst (make_coprime a x)) xs))
)
)
ok, now there are a couple of parens that are not necessary and should be omitted: the , always seperates everything, so you never need to write e.g. (1, (2)): just make it (1,2). And function application binds more tightly than any infix operator, so you also never need to write (f x) : y, just do f x : y. That makes your code
f a (x:xs) = ( fst (make_coprime a x)
, snd (make_coprime a x)
: snd (f (fst (make_coprime a x)) xs)
)
which is already a good deal easier to understand. You could get rid of more parens by using the $ and . operators, but I'll leave that.
What I would definitely not leave, as chepner suggests, are these multiple invokations of make_coprime a x. This kind of duplication is not only code-noise, it can also make your program run very slow.
f a (x:xs) = ( fst axCoprimes
, snd axCoprimes
: snd (f (fst axCoprimes) xs)
)
where axCoprimes = make_coprime a x
Now, all you ever do with axCoprimes is eval the fst and snd components separately. Thus instead of giving the tuple one name, you should immediately match the components:
f a (x:xs) = (p₀, p₁ : snd (f p₀ xs))
where (p₀,p₁) = make_coprime a x
and there you go, that looks very clear IMO.

You only need to call coprime a x once; you can assign its return value to a name using a let statement:
f a (x:xs) = let pair = make_coprime a x
in ((fst pair), ((snd pair):(snd (f (fst pair) xs))))
(Your parse error is likely due to the missing parentheses around x:xs.)
You can simplify it more by unpacking the pair immediately instead of calling fst and snd repeatedly.
f a (x:xs) = let (n1,n2) = make_coprime a x
in (n1, (n2:(snd (f n1 xs))))

Related

Rendering values into items and intermediate items in Haskell

While doing user interface programming I often encounter the need to render a list of values and add some related information between the rendered values. In the following code example I'm rendering numerical values into strings where they appear in parenthesis and render the distance of two values into a string that gets placed between the renders of the values. The code works but I'm wondering if an implementation of the mystery function is available as part of the Haskell standard library. I'm also interested in names used for this function in other libraries, as using human readable words makes googling easier.
mystery :: (a -> b) -> (a -> a -> b) -> [a] -> [b]
mystery n d [] = []
mystery n d [x] = [n x]
mystery n d (x:xs) = (n x) : (d x (head xs)) : mystery n d xs
node x = "(" ++ show x ++ ")"
distance x y = "-" ++ (show $ abs $ x - y) ++ "-"
render xs = concat $ mystery node distance xs
-- render [25, 68, 54, 15] == "(25)-43-(68)-14-(54)-39-(15)"
Your mystery function is actually doing a couple things at once, and if you separate out the behaviors, it may be a little easier to see what's going on.
First, you're mapping n on all the elements. We can write that as fmap n xs. Next, you're constructing new elements d x y for all pairs of adjacent elements x and y. We can write that as zipWith d xs (tail xs).
The last step is taking these two constructions and making a new list with elements that alternate back and forth between them. Interestingly, this was a question asked 9 years ago, but still doesn't have a super satisfying answer. Probably the simplest answer is to define your own function:
alternate [] ys = ys
alternate (x:xs) ys = x : alternate ys xs
Then, we can define mystery as a one-liner:
mystery n d x = alternate (fmap n x) (zipWith d x (tail x))
If you really want it to be a one-liner, the best I could come up with was using concat and transpose in a bit of a funky way:
mystery n d x = concat $ transpose $ (pure $ fmap n x) <> (pure $ zipWith d x (tail x))
Basically, we're making singleton lists out of the two components using pure, fusing them together with <>, then transposeing this "list of lists" to get the elements properly interspersed, and concating the result.

What is the best way to do "replace-if"?

I'm thinking of a function that can replace the value x with z when x is y, and do nothing otherwise, that is:
\x -> if x == y then z else x
It's only used once in my program and it's in the middle of a function chain so I don't want to define it as a named function and I think the lambda expression looks unnecessarily verbose. Instead, I'm trying to compose it from other functions. However, so far I have only come up with this cryptic (and cring-y) one:
(ap . flip . bool id $ const z) (== y)
Are there better point-free forms for such a simple function?
I don't know of anything very readable. Shortest I can get is
bool z <*> (/= y)
Further silly ways:
execState (gets (==y) >>= flip when (put z))
fromMaybe <*> flip lookup [(y, z)]
I don't approve of this very much, but a quick Hayoo search led me to the (?|) operator in the data-easy package. This package is full of such functions (with a bunch of disclaimers about "non-idiomatic haskell"). Looks like you could have
\x -> if x == y then z else x -- the cluttered Haskell form
\x -> x ?| (/= y) $ z -- the "Pythonic" form
(?| (/= y)) z -- Haskell-sections-galore of the "Pythonic" form
Jokes aside, there is also the much more reasonable fromBoolC that you will probably like:
fromBoolC z (/= y)
From lens:
import Control.Lens
f = (^. non z) . (non y # ) -- for some z and y
The if then else version is definitely better though.
You can use the Python trick of replacing a case statement with a lookup.
import Data.Map
\x -> findWithDefault x x (singleton y z)
which according to pointfree.io can be reduced to
flip (join findWithDefault) (singleton y z)
It's not exactly clear, but at the same time it separates the functional parts from the arguments. flip (join findWithDefault) does what you want, and singleton y z is a DSL-like way of specifying the exception. Stick a idExcept = flip (join findWithDefault) and exception = singleton earlier in your code, and your chain is almost readable.
my . awesome . (idExcept (exception y z)) . function . chain $ val

getting rid of unnecessary parenthesis

I wrote a function for evaluating a polynomial at a given number. The polynomial is represented as a list of coefficients (e.g. [1,2,3] corresponds to x^2+2x+3).
polyEval x p = sum (zipWith (*) (iterate (*x) 1) (reverse p))
As you can see, I first used a lot of parenthesis to group which expressions should be evaluated. For better readability I tried to eliminate as many parenthesis using . and $. (In my opinion more than two pairs of nested parenthesis are making the code more and more difficult to read.) I know that function application has highest priority and is left associative. The . and $are both right associative but . has priority 9, while $ has priority 0.
So it seemed to me that following expression cannot be written with even fewer parenthesis
polyEval x p = sum $ zipWith (*) (iterate (*x) 1) $ reverse p
I know that we need parenthesis for (*) and (*x) to convert them to prefix functions, but is it possible to somehow remove the parenthesis around iterate (*x) 1?
Also what version would you prefer for readability?
I know that there are many other ways to achieve the same, but I'd like to discuss my particular example, as it has a function evaluated in two arguments (iterate (*x) 1) as middle argument of another function that takes three arguments.
As usual with this sort of question I prefer the OP's version to any of the alternatives that have been proposed so far. I would write
polyEval x p = sum $ zipWith (*) (iterate (* x) 1) (reverse p)
and leave it at that. The two arguments of zipWith (*) play symmetric roles in the same way that the two arguments of * do, so eta-reducing is just obfuscation.
The value of $ is that it makes the outermost structure of the computation clear: the evaluation of a polynomial at a point is the sum of something. Eliminating parentheses should not be a goal in itself.
So it might be a little puerile, but I actually really like to think of Haskell’s rules in terms of food. I think of Haskell’s left-associative function application f x y = (f x) y as a sort of aggressive nom or greedy nom, in that the function f refuses to wait for the y to come around and immediately eats the f, unless you take the time to put these things in parentheses to make a sort of "argument sandwich" f (x y) (at which point the x, being uneaten, becomes hungry and eats the y.) The only boundaries are the operators and the special forms.
Then within the boundaries of the special forms, the operators consume whatever is around them; finally the special forms take their time to digest the expressions around them. This is the only reason that . and $ are able to save some parentheses.
Finally this we can see that iterate (* x) 1 is probably going to need to be in a sandwich because we don't want something to just eat iterate and stop. So there is no great way to do that without changing that code, unless we can somehow do away with the third argument to zipWith -- but that argument contains a p so that requires writing something to be more point-free.
So, one solution is to change your approach! It makes a little more sense to store a polynomial as a list of coefficients in the already-reversed direction, so that your x^2 + 2 * x + 3 example is stored as [3, 2, 1]. Then we don't need to perform this complicated reverse operation. It also makes the mathematics a little simpler as the product of two polynomials can be rewritten recursively as (a + x * P(x)) * (b + x * Q(x)) which gives the straightforward algorithm:
newtype Poly f = Poly [f] deriving (Eq, Show)
instance Num f => Num (Poly f) where
fromInteger n = Poly [fromInteger n]
negate (Poly ps) = Poly (map negate ps)
Poly f + Poly g = Poly $ summing f g where
summing [] g = g
summing f [] = f
summing (x:xs) (y:ys) = (x + y) : summing xs ys
Poly (x : xs) * Poly (y : ys) = prefix (x*y) (y_p + x_q) + r where
y_p = Poly $ map (y *) xs
x_q = Poly $ map (x *) ys
prefix n (Poly m) = Poly (n : m)
r = prefix 0 . prefix 0 $ Poly xs * Poly ys
Then your function
evaluatePoly :: Num f => Poly f -> f -> f
evaluatePoly (Poly p) x = eval p where
eval = (sum .) . zipWith (*) $ iterate (x *) 1
lacks parentheses around iterate because the eval is written in pointfree style, so $ can be used to consume the rest of the expression. As you can see it unfortunately leaves some new parentheses around (sum .) to do this, though, so it might not be totally worth your while. I find the latter less readable than, say,
evaluatePoly (Poly coeffs) x = sum $ zipWith (*) powersOfX coeffs where
powersOfX = iterate (x *) 1
I might even prefer to write the latter, if performance on high powers is not super-critical, as powersOfX = [x^n | n <- [0..]] or powersOfX = map (x^) [0..], but I think iterate is not too hard to understand in general.
Perhaps breaking it down to more elementary functions will simplify further. First define a dot product function to multiply two arrays (inner product).
dot x y = sum $ zipWith (*) x y
and change the order of terms in polyEval to minimize the parenthesis
polyEval x p = dot (reverse p) $ iterate (* x) 1
reduced to 3 pairs of parenthesis.

Having trouble with function in Haskell

I wrote a function to check if a list matches a condition, and if it does, it prints that value twice. However, in ghc it gives me an error, and i don't understand why...
verifyList f xs = foldl(\x acc -> if f x then x:x:acc else acc) [] xs
Any Help?
Looks like you meant foldr instead of foldl. If I make that change then it works for me.
You could also have done this without folds as
verifyList f xs = concatMap (\x -> [x, x]) $ filter f xs
which I would say more clearly indicates your intent. First filter the list to find all that satisfy f, then duplicate each element.
– bheklilr
Another option based on a comment by leftaroundabout:
verifyList f xs = [y | x <- xs, f x, y <- [x, x]]
My own spin on bheklilr's approach, because I feel like it:
verifyList f xs = filter f xs <**> [id, id]

Avoid pattern matching in recursion

Consider this code which I used to solve Euler Problem 58:
diagNums = go skips 2
where go (s:skips) x = let x' = x+s
in x':go skips (x'+1)
squareDiagDeltas = go diagNums
where go xs = let (h,r) = splitAt 4 xs
in h:go r
I don't like the pattern matching in the second function. It looks more complicated than necessary! This is something that arises pretty frequently for me. Here, splitAt returns a tuple, so I have to destructure it first before I can recurse. The same pattern arises perhaps even more annoyingly when my recursion itself returns a tuple I want to modify. Consider:
f n = go [1..n]
where go [] = (0,0)
go (x:xs) = let (y,z) = go xs
in (y+x, z-x)
compared to the nice and simple recursion:
f n = go [1..n]
where go [] = 0
go (x:xs) = x+go xs
Of course the functions here are pure nonsense and could be written in a wholly different and better way. But my point is that the need for pattern matching arises every time I need to thread more than one value back through the recursion.
Are there any ways to avoid this, perhaps by using Applicative or anything similar? Or would you consider this style idiomatic?
First of all, that style is actually rather idiomatic. Since you're doing two things to two different values, there is some irreducible complexity; the actual pattern match does not introduce much on its own. Besides, I personally find the explicit style very readable most of the time.
However, there is an alternative. Control.Arrow has a bunch of functions for working with tuples. Since the function arrow -> is an Arrow as well, all these work for normal functions.
So you could rewrite your second example using (***) to combine two functions to work over tuples. This operator has the following type:
(***) :: a b c -> a b' c' -> a (b, b') (c, c')
If we replace a with ->, we get:
(***) :: (b -> c) -> (b' -> c') -> ((b, b') -> (c, c'))
So you could combine (+ x) and (- x) into a single function with (+ x) *** (- x). This would be equivalent to:
\ (a, b) -> (a + x, b - x)
Then you could use it in your recursion. Unfortunately, the - operator is stupid and doesn't work in sections, so you would have to write it with a lambda:
(+ x) *** (\ a -> a - x) $ go xs
You can obviously imagine using any other operator, all of which aren't quite as stupid :).
Honestly, I think this version is less readable than the original. However, in other cases, the *** version can be more readable, so it's useful to know about it. In particular, if you were passing (+ x) *** (- x) into a higher-order function instead of applying it immediately, I think the *** version would be better than an explicit lambda.
I agree with Tikhon Jelvis that there is nothing wrong with your version. Like he said, using combinators from Control.Arrow can be useful with higher order functions. You can write f using a fold:
f n = foldr (\x -> (+ x) *** subtract x) (0,0) [1..n]
And if you really want to get rid of the let in squareDiagDeltas (I'm not sure I would), you can use second, because you are only modifying the second element of the tuple:
squareDiagDeltas = go diagNums
where go = uncurry (:) . second go . splitAt 4
I agree with hammar, unfoldr is the way to go here.
You can also get rid of the pattern matching in diagNums:
diagNums = go skips 2
where go (s:skips) x = let x' = x+s
in x':go skips (x'+1)
The recursion makes it a little difficult to tell what's going on here, so let's
examine it in depth.
Suppose skips = s0 : s1 : s2 : s3 : ..., then we have:
diagNums = go skips 2
= go (s0 : s1 : s2 : s3 : ...) 2
= s0+2 : go (s1 : s2 : s3 : ... ) (s0+3)
= s0+2 : s0+s1+3 : go (s2 : s3 : ... ) (s0+s1+4)
= s0+2 : s0+s1+3 : s0+s1+s2+4 : go (s3 : ... ) (s0+s1+s2+5)
= s0+2 : s0+s1+3 : s0+s1+s2+4 : s0+s1+s2+s3+5 : go (...) (s0+s1+s2+s3+6)
This makes it much clearer what's going on, we've got the sum of two sequences, which is easy to compute using zipWith (+):
diagNums = zipWith (+) [2,3,4,5,...] [s0, s0+s1, s0+s1+s2, s0+s1+s2+s3,...]
So now we just need to find a better way to compute the partial sums of skips, which is a great use for scanl1:
scanl1 (+) skips = s0 : s0+s1 : s0+s1+s2 : s0+s1+s2+s3 : ...
Leaving a (IMO) much easier to understand definition for diagNums:
diagNums = zipWith (+) [2..] $ scanl1 (+) skips

Resources