1
\$\begingroup\$

I am working through UPenn CIS 194: Introduction to Haskell (Spring 2013). Since I am not able to take the course for real I am asking for CR (feedback) as it could be from teacher in that course.

HW4 - Higher-order programming - Full description

import Data.List

-- Exercise 1
-- Reimplement each of the following functions in a more idiomatic Haskell style

fun1 :: [Integer] -> Integer
fun1 [] = 1
fun1 (x:xs)
  | even x = (x - 2) * fun1 xs
  | otherwise = fun1 xs

fun1' :: [Integer] -> Integer
fun1' = product . map (\x -> x - 2) . filter even

fun2 :: Integer -> Integer
fun2 1 = 0
fun2 n | even n = n + fun2 (n `div` 2)
       | otherwise = fun2 (3 * n + 1)

fun2' :: Integer -> Integer
fun2' = sum . filter even . takeWhile (\x -> x > 1) . iterate (\x -> if (even x) then div x 2 else 3 * x + 1)

-- Exercise 2
-- Generates a balanced binary tree from a list of values using foldr

data Tree a = Leaf
            | Node Integer (Tree a) a (Tree a)
  deriving (Show, Eq)

foldTree :: [a] -> Tree a
foldTree = foldr makeTree Leaf

makeTree :: a -> Tree a -> Tree a
makeTree a Leaf = Node 0 Leaf a Leaf
makeTree a (Node h l m r)
   | height l <= height r = Node (height (makeTree a l) + 1) (makeTree a l) m r
   | otherwise = Node (height (makeTree a r) + 1) l m (makeTree a r)
  where
    height Leaf = -1
    height (Node h _ _ _) = h

-- Exercise 3
-- More folds:

-- implement a function which returns True if and only if there are a odd number of True values contained in the input list
xor :: [Bool] -> Bool
xor = odd . foldr (\x s -> if (x) then 1 + s else s) 0

-- map’ should behave identically to the standard map function
map' :: (a -> b) -> [a] -> [b]
map' f = foldr (\x xs -> (f x) : xs) []

-- implement foldl using foldr
myFoldl :: (a -> b -> a) -> a -> [b] -> a
myFoldl f base xs = foldr (\x s -> f s x) base (reverse xs)

-- Exercise 4
-- Implement the Sieve of Sundaram algorithm using function composition

sieveSundaram :: Integer -> [Integer]
sieveSundaram n = map (\x -> 2 * x + 1) (genSieve n)
  where
    valid x = (i <= j) && (i + j + 2 * i * j <= n) where (i, j) = x
    genCrossed m = map (\(i, j) -> (i + j + 2 * i * j)) (filter valid (cartProd [1..m] [1..m]))
    genSieve n = (\\) [1..n] (genCrossed n)


cartProd :: [a] -> [b] -> [(a, b)]
cartProd xs ys = [(x,y) | x <- xs, y <- ys]
\$\endgroup\$
  • \$\begingroup\$ As I've previously mentioned, I think that each exercise should be asked as a separate question. It's hard to write a coherent review of unrelated code, and to vote on such omnibus answers. \$\endgroup\$ – 200_success Sep 28 '15 at 9:46
  • 1
    \$\begingroup\$ @200_success I got your point. From the next questions I will separate tasks from one week on few questions if they are not closely related. \$\endgroup\$ – drets Sep 28 '15 at 10:15
3
\$\begingroup\$

hlint

hlint is a great tool for improving your mastery of Haskell idioms and syntax.

For example, here is one thing (of several) it found in your code:

input.hs:20:40: Warning: Avoid lambda
Found:
  \ x -> x > 1
Why not:
  (> 1)

I would study the output of hlint.

fun1'

Looks fine.

fun2'

Stylistically I like to avoid long inline expressions. Use let and where to define meaningful subexpressions. I find this more readable (also combining the hlint suggestion):

fun2' = sum . filter even . takeWhile (> 1) . iterate collatz
  where collatz x = if (even x) then div x 2 else 3 * x + 1

collatz could even be a top-level function because it is generally useful.

makeTree

You are repeating the expressions makeTree a l and makeTree a r. GHC might be able to detect the common sub-expression and unify the two so that they are only evaluated once.

ghci doesn't do any CSE, so the same call will be executed twice.

In most cases it's best to use a where or let to ensure the expression is only evaluated once:

| height l <= height r =
    let left = makeTree a l
    in  Node (height left + 1) left m r         

More info on GHC and CSE: https://wiki.haskell.org/GHC/FAQ#Does_GHC_do_common_subexpression_elimination.3F

Also, height looks like it would be generally useful - why not expose it at the top level?

xor

Looks like it will work, but since you are not specifying a type for s it will likely default to being an Integer.

But you don't need a whole Integer to keep track of the parity of a number. In fact, you can get by with simply a Bool.

As a extension to this exercise, try to write xor without using addition.

myFoldl

Try to write it without using reverse.

Hint: You have to build up a higher-order function.

Your answer will look like:

foldl f a xs =  (some big function) a

where (some big function) will be a foldr (\g x -> ...) g0 xs.

Another hint: With a fold like:

foldr h y xs

you know that y = foldr h y [], so use this to determine what g0 is.

Sundram

Stylistically I would use list comprehensions as much as possible - replacing map and filter.

Instead of:

sieveSundaram n = map (\x -> 2 * x + 1) (genSieve n)

I would write:

sieveSundaram n = [ 2*x+1 | x <- genSieve n]

and instead of:

genCrossed m = map (\(i, j) -> (i + j + 2 * i * j)) (filter valid (cartProd [1..m] [1..m]))

I would write:

genCrossed m = [ i+j+2*i*j | (i,j) <- cartProd [1..m] [1..m], valid (i,j) ]

Also, you are computing the expression i + j + 2 * i * j twice. Can you think of a way of organizing your code so that it is only computed once?

valid

The where clause in the valid function can be dropped if you define it this way:

valid (i,j) = ...

Given a value for m, how many pairs is valid examining? Can you think of a way to reduce that number by about half?

\$\endgroup\$
  • \$\begingroup\$ Thank you! Updated version of the code in public gist file, but wo myFoldl since it was optional :-) \$\endgroup\$ – drets Sep 30 '15 at 16:35
  • \$\begingroup\$ Looks good, but you are still missing an easy optimization in the definition of genCrossed. \$\endgroup\$ – ErikR Sep 30 '15 at 17:27
  • \$\begingroup\$ It's somewhere here: [1..(div m 2)] [1..(div m 2)] :-) \$\endgroup\$ – drets Sep 30 '15 at 17:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.