[Haskell-cafe] Code critique request

Michael Litchard michael at schmong.org
Fri May 6 21:21:15 UTC 2016


Thank you David, for taking all that time on my project. I got so much more
than I was expecting. I take it my concern was focused in the wrong place?
Time-space complexity of

mapM fibb is okay?



On Fri, May 6, 2016 at 1:37 PM, David McBride <toad3k at gmail.com> wrote:

> A lot of your functions return Either FizError a when they obviously can't
> have an error?  I prefer to keep the functions as pure as they can be, and
> then lift them into Either in the few cases where I'd need them to be in
> that type.
>
> How about fibb :: Integer -> Integer, fizzbuzz :: Integer -> Text,  then
> in the above code:
>    mapM (Right <$> fizzbuzz) =<< ... =<< mapM (Right <$> fibb) =<< ...
>
> This also greatly simplifies many of your tests and benchmarks.  For
> example src-test/PropTests/Fibonacci.hs, testfib changes from
>
>     testfib n =
>       case (fibb n) of
>         Left _ -> False
>         Right n' -> isFib n'
>
> to
>
>     testfib = isFib . fibb
>
> in src-test/UnitTests/Fibonacci.hs, fibs changes from
>
>     fibs = [Right 1,Right 1,Right 2,Right 3,Right 5,Right 8,Right 13,Right
> 21,Right 34,Right 55]
>
> to
>
>     fibs = [1,1,2,3,5,8,13,21,34,55]
>
> among others.
>
> In fizzbuzz, I would, instead of converting it to maybe and then using
> fromMaybe, use the option function from semigroups which is the option
> equivalent to maybe, and contains all the functionality of fromMaybe.
>     fizzbuzz :: Integer -> Text
>     fizzbuzz i = option (show i) id fizzbuzz'
>
> Your type annotation on c = 2 and subsequent comments are unnecessary if
> fibb has a type annotation, which it does.  I would also recommend adding
> types for divs and fib' as the types are non obvious and I had to use
> typeholes to find them.
>
> In fibb, I would change map (toEnum . fromIntegral) to map (>0) (or /=
> 0).  It is easier to understand, faster, and will  not blow up on negative
> numbers (I realize there can't be, but it was not obvious to me).
>
> You wrote an unfoldl, but I'm pretty sure you could replace that with
> reverse (unfoldr ...).  Due to the fact that you are appending with (++) in
> your implementation anyways, it is much more efficient.  My final version
> of fibb looks like this, and passes your tests.
>    fibb = snd . foldl' fib' (1, 0) . map (>0) . reverse . unfoldr divs
>
> boolToEither can be written with an if statement instead of case
>     boolToEither bool a b = if bool then Right b else Left a
>
> Stylistically, I would put argument validation into src-exe and into the
> main function, allowing it to bail with an argument error before ever
> getting to your fizzbuzz code, which should not concern itself with program
> argument validation.  I realize you are intending to demonstrate monads
> using either in your blog, so carry on if that's the case.
>
> Some general advice I would give, is that if a function isn't doing as
> little as it can, try pulling out some of the stuff it doesn't need to do
> out into a shallower part of your program.
>
> For example, when I look at the fibb where fib' function, fib' :: (a, a)
> -> Bool -> (a, a), where depending on the bool, and nothing else, it does
> two completely different things.  Maybe it should be two different
> functions, with the bool checking outside?  I'm not familiar enough with
> what you are trying to do to say that that can be done, but that is my
> first instinct.
>
> As to the structure of your project, it looks great.  I may have learned a
> few things...
>
>
> On Fri, May 6, 2016 at 2:29 PM, Michael Litchard <michael at schmong.org>
> wrote:
>
>> I've got this fizzbuzz project I am using for a blog series, among other
>> things. In this version, the fizzbuzz function is fed from a Fibonacci
>> generator. I'm particularly concerned with the efficiency of the Fibonacci
>> generator, but all scrutiny is welcomed.
>>
>> I'll included a link to the entire project, but below are the parts I
>> think would be sufficient to spot trouble with how I am generating
>> Fibonacci numbers.
>>
>> -- Driver function performs following-- (1) checks that input is proper-- (2) creates integer list for fibonacci generator-- (3) calculates first x in fibonnaci sequence-- (4) generates fizzbuzz output using (3)
>>
>> fizzBuzzFib :: [Text] -> Either FizzError [Text]
>> fizzBuzzFib str =
>> mapM fizzbuzz          =<<
>> mapM fibb              =<< -- Possible problem here(\x -> Right [1 .. x]) =<<
>> convertToPInt          =<<
>> mustHaveOne str
>>
>> fibb :: Integer -> Either FizzError Integer
>> fibb n = Right $ snd . foldl' fib' (1, 0) . map (toEnum . fromIntegral) $ unfoldl divs n
>>   where
>>     unfoldl f x =
>>       case f x of
>>         Nothing     -> []
>>         Just (u, v) -> unfoldl f v ++ [u]
>>
>>     divs 0 = Nothing
>>     divs k = Just (uncurry (flip (,)) (k `divMod` 2))
>>
>>     fib' (f, g) p
>>       | p = (f*(f+c*g), f^c + g^c)
>>       | otherwise = (f^c+g^c, g*(c*f-g))
>>       where
>>         c :: Integer -- See codebase for reasons
>>         c = 2
>>
>> The whole project, for your critiquing eye:https://github.com/mlitchard/swiftfizz
>>
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20160506/2a06f647/attachment.html>


More information about the Haskell-Cafe mailing list