From newhoggy at gmail.com Sun Apr 3 13:11:24 2016 From: newhoggy at gmail.com (John Ky) Date: Sun, 03 Apr 2016 13:11:24 +0000 Subject: [Haskell-beginners] How to write faster ByteString/Conduit code Message-ID: Hello Haskellers, I?ve been trying to squeeze as much performance out of my code as possible and I?ve come to a point where can?t figure out what more I can do. Here is some example code: blankEscapedChars :: MonadThrow m => Conduit BS.ByteString m BS.ByteString blankEscapedChars = blankEscapedChars' "" blankEscapedChars' :: MonadThrow m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString blankEscapedChars' rs = do mbs <- await case mbs of Just bs -> do let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs let ds = fst (unfoldrN (BS.length cs) unescapeByteString (False, cs)) yield ds blankEscapedChars' (BS.drop (BS.length ds) cs) Nothing -> when (BS.length rs > 0) (yield rs) where unescapeByteString :: (Bool, ByteString) -> Maybe (Word8, (Bool, ByteString)) unescapeByteString (wasEscaped, bs) = case BS.uncons bs of Just (_, cs) | wasEscaped -> Just (wUnderscore, (False, cs)) Just (c, cs) | c /= wBackslash -> Just (c, (False, cs)) Just (c, cs) -> Just (c, (True, cs)) Nothing -> Nothing The above function blankEscapedChars will go find all \ characters and convert the following character to a _. For a 1 MB in memory JSON ByteString, it benches at about 6.6 ms In all my code the basic strategy is the same. await for the next byte string, then use and unfoldrN to produce a new ByteString for yielding. Anyone know of a way to go faster? Cheers, -John ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From newhoggy at gmail.com Sun Apr 3 13:55:41 2016 From: newhoggy at gmail.com (John Ky) Date: Sun, 03 Apr 2016 13:55:41 +0000 Subject: [Haskell-beginners] How to write faster ByteString/Conduit code In-Reply-To: References: Message-ID: Hi Haskellers, I just rewrote the code to a state-machine in the hope that I can eventually collapse several stages in a pipeline into one, but this simple state-machine version turns out to be about 3 times slower even though it does the same thing: newtype Blank = Blank { blank :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) } escapeChar :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) escapeChar bs = case BS.uncons bs of Just (c, cs) -> Just (c, (cs, Blank (if c /= wBackslash then escapeChar else escapedChar))) Nothing -> Nothing escapedChar :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) escapedChar bs = case BS.uncons bs of Just (_, cs) -> Just (wUnderscore, (cs, Blank escapeChar)) Nothing -> Nothing fastBlank :: MonadThrow m => Conduit BS.ByteString m BS.ByteString fastBlank = fastBlank' escapeChar fastBlank' :: MonadThrow m => (BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank))) -> Conduit BS.ByteString m BS.ByteString fastBlank' blank = do mbs <- await case mbs of Just bs -> do let (cs, Just (_, Blank newBlank)) = unfoldrN (BS.length bs) (\(bs, Blank f) -> f bs) (bs, Blank blank) yield cs fastBlank' newBlank Nothing -> return () I worry that if I go this approach, just the cost of the state-machine might mean I only break-even. Is there any reason why this version should be slower? Cheers, -John ? On Sun, 3 Apr 2016 at 23:11 John Ky wrote: > Hello Haskellers, > > I?ve been trying to squeeze as much performance out of my code as possible > and I?ve come to a point where can?t figure out what more I can do. > > Here is some example code: > > blankEscapedChars :: MonadThrow m => Conduit BS.ByteString m BS.ByteString > blankEscapedChars = blankEscapedChars' "" > > blankEscapedChars' :: MonadThrow m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString > blankEscapedChars' rs = do > mbs <- await > case mbs of > Just bs -> do > let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs > let ds = fst (unfoldrN (BS.length cs) unescapeByteString (False, cs)) > yield ds > blankEscapedChars' (BS.drop (BS.length ds) cs) > Nothing -> when (BS.length rs > 0) (yield rs) > where > unescapeByteString :: (Bool, ByteString) -> Maybe (Word8, (Bool, ByteString)) > unescapeByteString (wasEscaped, bs) = case BS.uncons bs of > Just (_, cs) | wasEscaped -> Just (wUnderscore, (False, cs)) > Just (c, cs) | c /= wBackslash -> Just (c, (False, cs)) > Just (c, cs) -> Just (c, (True, cs)) > Nothing -> Nothing > > The above function blankEscapedChars will go find all \ characters and > convert the following character to a _. For a 1 MB in memory JSON > ByteString, it benches at about 6.6 ms > > In all my code the basic strategy is the same. await for the next byte > string, then use and unfoldrN to produce a new ByteString for yielding. > > Anyone know of a way to go faster? > > Cheers, > > -John > ? > -------------- next part -------------- An HTML attachment was scrubbed... URL: From newhoggy at gmail.com Mon Apr 4 09:37:27 2016 From: newhoggy at gmail.com (John Ky) Date: Mon, 04 Apr 2016 09:37:27 +0000 Subject: [Haskell-beginners] How to write faster ByteString/Conduit code In-Reply-To: References: Message-ID: It turns out that using a simple enum type to implement a state machine instead of a function avoids the performance penalty and allows me to collapse a four stage conduit pipeline into one with 4 x performance improvement. blankStrings :: MonadThrow m => Conduit BS.ByteString m BS.ByteString blankStrings = blankStrings' InJson blankStrings' :: MonadThrow m => FastState -> Conduit BS.ByteString m BS.ByteString blankStrings' lastState = do mbs <- await case mbs of Just bs -> do let (!cs, Just (!nextState, _)) = unfoldrN (BS.length bs) blankByteString (lastState, bs) yield cs blankStrings' nextState Nothing -> return () where blankByteString :: (FastState, ByteString) -> Maybe (Word8, (FastState, ByteString)) blankByteString (InJson, bs) = case BS.uncons bs of Just (!c, !cs) | isLeadingDigit c -> Just (w1 , (InNumber , cs)) Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (InString , cs)) Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) Just (!c, !cs) -> Just (c , (InJson , cs)) Nothing -> Nothing blankByteString (InString, bs) = case BS.uncons bs of Just (!c, !cs) | c == wBackslash -> Just (wSpace , (Escaped , cs)) Just (!c, !cs) | c == wDoubleQuote -> Just (wCloseParen, (InJson , cs)) Just (_ , !cs) -> Just (wSpace , (InString , cs)) Nothing -> Nothing blankByteString (Escaped, bs) = case BS.uncons bs of Just (_, !cs) -> Just (wSpace, (InString, cs)) Nothing -> Nothing blankByteString (InNumber, bs) = case BS.uncons bs of Just (!c, !cs) | isTrailingDigit c -> Just (w0 , (InNumber , cs)) Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (InString , cs)) Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) Just (!c, !cs) -> Just (c , (InJson , cs)) Nothing -> Nothing blankByteString (InIdent, bs) = case BS.uncons bs of Just (!c, !cs) | isAlphabetic c -> Just (wUnderscore, (InIdent , cs)) Just (!c, !cs) | isLeadingDigit c -> Just (w1 , (InNumber , cs)) Just (!c, !cs) | c == wDoubleQuote -> Just (wOpenParen , (InString , cs)) Just (!c, !cs) -> Just (c , (InJson , cs)) Nothing -> Nothing I?m quite please with this, but any further suggestions are still welcome. Cheers, -John On Sun, 3 Apr 2016 at 23:55 John Ky newhoggy at gmail.com wrote: Hi Haskellers, > > I just rewrote the code to a state-machine in the hope that I can > eventually collapse several stages in a pipeline into one, but this simple > state-machine version turns out to be about 3 times slower even though it > does the same thing: > > newtype Blank = Blank > { blank :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) > } > > escapeChar :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) > escapeChar bs = case BS.uncons bs of > Just (c, cs) -> Just (c, (cs, Blank (if c /= wBackslash then escapeChar else escapedChar))) > Nothing -> Nothing > > escapedChar :: BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank)) > escapedChar bs = case BS.uncons bs of > Just (_, cs) -> Just (wUnderscore, (cs, Blank escapeChar)) > Nothing -> Nothing > > fastBlank :: MonadThrow m => Conduit BS.ByteString m BS.ByteString > fastBlank = fastBlank' escapeChar > > fastBlank' :: MonadThrow m => (BS.ByteString -> Maybe (Word8, (BS.ByteString, Blank))) -> Conduit BS.ByteString m BS.ByteString > fastBlank' blank = do > mbs <- await > case mbs of > Just bs -> do > let (cs, Just (_, Blank newBlank)) = unfoldrN (BS.length bs) (\(bs, Blank f) -> f bs) (bs, Blank blank) > yield cs > fastBlank' newBlank > Nothing -> return () > > I worry that if I go this approach, just the cost of the state-machine > might mean I only break-even. > > Is there any reason why this version should be slower? > > Cheers, > > -John > ? > > On Sun, 3 Apr 2016 at 23:11 John Ky wrote: > >> Hello Haskellers, >> >> I?ve been trying to squeeze as much performance out of my code as >> possible and I?ve come to a point where can?t figure out what more I can do. >> >> Here is some example code: >> >> blankEscapedChars :: MonadThrow m => Conduit BS.ByteString m BS.ByteString >> blankEscapedChars = blankEscapedChars' "" >> >> blankEscapedChars' :: MonadThrow m => BS.ByteString -> Conduit BS.ByteString m BS.ByteString >> blankEscapedChars' rs = do >> mbs <- await >> case mbs of >> Just bs -> do >> let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs >> let ds = fst (unfoldrN (BS.length cs) unescapeByteString (False, cs)) >> yield ds >> blankEscapedChars' (BS.drop (BS.length ds) cs) >> Nothing -> when (BS.length rs > 0) (yield rs) >> where >> unescapeByteString :: (Bool, ByteString) -> Maybe (Word8, (Bool, ByteString)) >> unescapeByteString (wasEscaped, bs) = case BS.uncons bs of >> Just (_, cs) | wasEscaped -> Just (wUnderscore, (False, cs)) >> Just (c, cs) | c /= wBackslash -> Just (c, (False, cs)) >> Just (c, cs) -> Just (c, (True, cs)) >> Nothing -> Nothing >> >> The above function blankEscapedChars will go find all \ characters and >> convert the following character to a _. For a 1 MB in memory JSON >> ByteString, it benches at about 6.6 ms >> >> In all my code the basic strategy is the same. await for the next byte >> string, then use and unfoldrN to produce a new ByteString for yielding. >> >> Anyone know of a way to go faster? >> >> Cheers, >> >> -John >> ? >> > ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.s.sumant at gmail.com Wed Apr 6 05:33:20 2016 From: r.s.sumant at gmail.com (rohan sumant) Date: Wed, 6 Apr 2016 11:03:20 +0530 Subject: [Haskell-beginners] Queues in Haskell Message-ID: Hello, According to http://rafal.io/posts/haskell-queues.html (++) cant be used to implement queues in Haskell. The reason being that a push operation takes linear time which is indeed very valid given that (++) operates in linear time. However, since Haskell is lazy shouldn't (++) be implemented only when the need occurs? In head ([1..] ++ [10]) I sincerely doubt the the [10] is concatenated before evaluating the head of the list. Please note that this question is focused upon the internals of Haskell. I am aware that there are other approaches to implementing queues in Haskell. Rohan Sumant -------------- next part -------------- An HTML attachment was scrubbed... URL: From rahulmutt at gmail.com Wed Apr 6 05:56:45 2016 From: rahulmutt at gmail.com (Rahul Muttineni) Date: Wed, 6 Apr 2016 11:26:45 +0530 Subject: [Haskell-beginners] Queues in Haskell In-Reply-To: References: Message-ID: Hi Rohan, The definition of Prelude.head is head :: [a] -> a head (x:_) = x head [] = undefined -- not exactly true but the details are irrelevant here This is the same as head :: [a] -> a head xs = case xs of (x : xs) -> x [] -> undefined (Remeber that a list type can be thought of as data [a] = x : xs | [], hence (:) and [] are both data constructors.) A case expression forces the evaluation of the scrutinee (xs in this case) and since xs = ([1..] ++ [10]), the expression is forced to evaluate to Weak Head Normal Form, which means it evaluates until it hits a data constructor or function. So this requires us to lookup the definition of (++) as well. (++) [] ys = ys (++) (x:xs) ys = x : xs ++ ys This is the same as (++) xs ys = case xs of [] -> ys x:xs -> x : (xs ++ ys) Hence, evaluting ([1..] ++ [10]) will give 1 : ([2..] + [10]) which is in WHNF, hence head ([1..] ++ [10]) = 1. So yes, you are correct, adding the (++) won't add the list until the evaluation "gets there", it will be stored as a thunk (suspended state). I suppose you can effectively consider that as "adding in constant time". But do note that it will consume quite a bit of memory over time to store the appends and the singleton lists. Yes, list concatenation is O(n), but pushing to the end of the queue is not due to nature of laziness. This is precisely why it's hard to do running time analysis in the context of laziness. But due note that in your particular example, appending to [1..] is futile since it's an infinite list, so that 10 will never actually get "seen" no matter how far you go in the list. Hope that helps! Rahul Muttineni -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.s.sumant at gmail.com Wed Apr 6 06:19:39 2016 From: r.s.sumant at gmail.com (rohan sumant) Date: Wed, 6 Apr 2016 11:49:39 +0530 Subject: [Haskell-beginners] Queues in Haskell In-Reply-To: References: Message-ID: Thank you Rahul. This is very helpful. Rohan Sumant On Wed, Apr 6, 2016 at 11:26 AM, Rahul Muttineni wrote: > Hi Rohan, > > The definition of Prelude.head is > > head :: [a] -> a > head (x:_) = x > head [] = undefined -- not exactly true but the details are irrelevant here > > This is the same as > > head :: [a] -> a > head xs = case xs of > (x : xs) -> x > [] -> undefined > > (Remeber that a list type can be thought of as data [a] = x : xs | [], > hence (:) and [] are both data constructors.) > > A case expression forces the evaluation of the scrutinee (xs in this case) > and since xs = ([1..] ++ [10]), the expression is forced to evaluate to > Weak Head Normal Form, which means it evaluates until it hits a data > constructor or function. So this requires us to lookup the definition of > (++) as well. > > (++) [] ys = ys > (++) (x:xs) ys = x : xs ++ ys > > This is the same as > > (++) xs ys = case xs of > [] -> ys > x:xs -> x : (xs ++ ys) > > Hence, evaluting ([1..] ++ [10]) will give 1 : ([2..] + [10]) which is in > WHNF, hence head ([1..] ++ [10]) = 1. > > So yes, you are correct, adding the (++) won't add the list until the > evaluation "gets there", it will be stored as a thunk (suspended state). I > suppose you can effectively consider that as "adding in constant time". But > do note that it will consume quite a bit of memory over time to store the > appends and the singleton lists. > > Yes, list concatenation is O(n), but pushing to the end of the queue is > not due to nature of laziness. This is precisely why it's hard to do > running time analysis in the context of laziness. > > But due note that in your particular example, appending to [1..] is futile > since it's an infinite list, so that 10 will never actually get "seen" no > matter how far you go in the list. > > Hope that helps! > Rahul Muttineni > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 8 21:42:37 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 8 Apr 2016 23:42:37 +0200 Subject: [Haskell-beginners] does this function exist already? (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) Message-ID: [Note, total newbie to mailing lists in general, and beginner in haskell as one might have surmised ^^ hopefully I'm doing the right thing here with this mail...] All, or virtually all in the title, but I'll develop. I wrote some useful function (which i rather awkwardly called "point2", for "(.) operator applied at the level of the second argument of the first function"). Here is its def: point2 :: (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) -- the double parentheses, totally optional and syntactically pointless, are just there to imply that the function is seen by we users as 'outputting' another function, even though said outputted function can be applied right away, of course, outputting then possibly c, or (d -> c) if partial application. -- I named the variables in the pattern like their respective types, for 'clarity' point2 f g a d = f a (g d) -- i originally wrote it in point free style using flip, from Data.Function (well, my own rebuilt wheel actually); so, alternate definition using flip == (\f y x -> f x y) point2 f g = flip (flip f . g) -- proof by decomposition: (or is it "composition", as we don't actually decompose?) -- f :: a -> b -> c -- flip f :: b -> a -> c -- flip f . g :: d -> a -> c -- flip (flip f . g) == f `point2` g :: a -> d -> c anyways, it's pretty useful if you wanna combine f and g but g is meant to output the *second* argument of f, not the first, that is: (f a) . g == (f `point2` g) a in the first expression, "a" must necessarily be known and given to combine f and g in point-free style, whereas in the second one, "a" can be omitted, hence then we could write "foo = f `point2` g", which is way closer to the point-free style, way simpler to understand too in my opinion once you got the picture. If you got all I said above, my question is then to know if this point2 function already exists officially, coz I don't really wanna reinvent the wheel, plus I wonder how they called it ^^ I'm not really satisfied of "point2" as variable name. I'd love (.2) but it's not compatible with Haskell. ^^ Also, same question for the following function (does it already exists?), again a sibling of (.), here, the purpose being to write h(a, b) = f (g(a, b)) in point-free style: after2 :: (c -> d) -> (a -> b -> c) -> (( a -> b -> d )) after2 f g a b = f (g a b) -- its name implies an infix use, for example: h = f `after2` g basically, if you know about Data.Function(on), it's a bit (one of) its opposite: `on` applies g to both arguments of f independently, before giving both results to the 2-ary function f, ie (f `on` g) a b == f (g a) (g b) I'm not entirely sure, but I think we could write: f `after2` g == curry (f . (uncurry g)) -- since: uncurry g :: (a,b) -> c f . uncurry g :: (a,b) -> d curry (f . uncurry g) :: a -> b -> d un/curry functions' defs, if needed: curry :: ((a,b) -> c) -> a -> b -> c curry f a b = f (a,b) -- curry f :: a -> b -> c when f :: (a,b) -> c uncurry :: (a -> b -> c) -> (a,b) -> c uncurry g (a,b) = g a b -- uncurry g :: (a,b) -> c when g :: a -> b -> c -------------- next part -------------- An HTML attachment was scrubbed... URL: From sumit.sahrawat.apm13 at iitbhu.ac.in Fri Apr 8 21:48:09 2016 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Sat, 9 Apr 2016 03:18:09 +0530 Subject: [Haskell-beginners] does this function exist already? (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) In-Reply-To: References: Message-ID: Hi, you might wanna take a look at Hoogle and Hayoo. They allow you to search for functions using names or type signatures. Hope this helps. -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 8 22:04:52 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sat, 9 Apr 2016 00:04:52 +0200 Subject: [Haskell-beginners] does this function exist already? (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) In-Reply-To: References: Message-ID: Hoogle was my first stop, didn't find anything, but Hayoo is much more complete, found all of it! "My" after2 has no less than 4 different synonymous: (oo), (.:), (comp2), (dot). and i checked my curry theory as correct. I found "point2" too right beside (.:), dubbed (.^). Those two inside a "pointlessfun" package (?) ^^ Hence, thanks, I found what I needed. :) Do I need to close or mark the discussion as "solved" or something, somehow? Le vendredi 8 avril 2016, Sumit Sahrawat, Maths & Computing, IIT (BHU) < sumit.sahrawat.apm13 at iitbhu.ac.in> a ?crit : > Hi, you might wanna take a look at Hoogle and Hayoo. They allow you to search for functions using names or type signatures. > > Hope this helps. -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 8 22:48:38 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sat, 9 Apr 2016 00:48:38 +0200 Subject: [Haskell-beginners] does this function exist already? (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) In-Reply-To: References: Message-ID: Ok thanks! By the way, I didn't know the formatting (especially, code/noncode distinction) was erased in the process of archiving my mail, sorry for the unfortunate, probable, unreadability of my first message. Actually, I have another question that somewhat is in continuity, as regards one definition I found for after2 (with another name of course, though here it's irrelevant): > after2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d > after2 f = ((f .) .) I checked by recursion, mostly to actually understand why/how it works, and it's pretty cool, if I may. > f :: c -> d > (f .) :: (b -> c) -> (b -> d) > ((f .) .) :: (a -> (b -> c)) -> (a -> (b -> d)) == (a -> b -> c) -> (a -> b -> d) Or seen from another angle: > f (g a b) :: d > (f .) (g a) :: b -> d > ((f .) .) g :: (a -> b -> d) >From there, I had the idea and desire to check if we could build a generalization of this operation, in this fashion: > testOp :: Int -> (c -> d) -> ? --Here i'm stuck since it looks like it should basically be a sort of recursive type of function, or something?? > testOp 0 f = f > testOp n f = ((testOp (n-1) f) .) hence with this definition, (testOp 2) == after2 and (testOp 1) == (.) Is this "testOp" writable? If so, what would it need? Thanks in advance! :) 2016-04-09 0:09 GMT+02:00 Sumit Sahrawat, Maths & Computing, IIT (BHU) < sumit.sahrawat.apm13 at iitbhu.ac.in>: > No need to do anything. On the list you can only send and receive emails. > 2016-04-09 0:04 GMT+02:00 Silent Leaf : > Hoogle was my first stop, didn't find anything, but Hayoo is much more > complete, found all of it! > > "My" after2 has no less than 4 different synonymous: (oo), (.:), (comp2), > (dot). and i checked my curry theory as correct. > I found "point2" too right beside (.:), dubbed (.^). > Those two inside a "pointlessfun" package (?) ^^ > > Hence, thanks, I found what I needed. :) > Do I need to close or mark the discussion as "solved" or something, > somehow? > > > Le vendredi 8 avril 2016, Sumit Sahrawat, Maths & Computing, IIT (BHU) < > sumit.sahrawat.apm13 at iitbhu.ac.in> a ?crit : > > Hi, you might wanna take a look at Hoogle and Hayoo. They allow you to > search for functions using names or type signatures. > > > > Hope this helps. > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 8 23:52:03 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sat, 9 Apr 2016 01:52:03 +0200 Subject: [Haskell-beginners] does this function exist already? (a -> b -> c) -> (d -> b) -> (( a -> d -> c )) In-Reply-To: References: Message-ID: Thanks! I'll definitely look into it. :) > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Sun Apr 10 16:16:24 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Sun, 10 Apr 2016 17:16:24 +0100 Subject: [Haskell-beginners] function application Message-ID: Hi, I?m looking at mc :: (Integral a) => a -> a mc x | x > 100 = x - 10 | otherwise = mc ( mc ( x + 11 ) ) the mc ( mc ( x + 11 ) ) can also be written as mc . mc $ x + 11 and I expected it could also be written as mc . mc ( x + 11 ) but the compiler error starts off with Couldn't match expected type ?a? with actual type ?a0 -> c0? so that is telling me, isn?t it (?) , that using parens is making the argument to the second mc into a function ?a0 -> c0? So is mc . mc $ x + 11 the only correct way to write this particular function in ?.? style ? Many Thanks Mike From r.s.sumant at gmail.com Sun Apr 10 16:59:51 2016 From: r.s.sumant at gmail.com (rohan sumant) Date: Sun, 10 Apr 2016 22:29:51 +0530 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) Message-ID: Suppose I have a list of distinct integers and I wish to generate all possible unordered pairs (a,b) where a/=b. Ex: [1,2,3,0] --> [(1,2),(1,3),(1,0),(2,3),(2,0),(3,0)] The approach I am following is this :- mkpairs [] = [] mkpairs (x:xs) = (map (fn x) xs) ++ (mkpairs xs) fn x y = (x,y) It is generating the desired output but I am a bit unsure about the time complexity of the function mkpairs. In an imperative language a nested triangular for loop would do the trick in O(n^2) or more precisely (n*(n-1)/2) operations. Does my code follow the same strategy? I am particularly worried about the (++) operator. I think that (++) wouldn't add to the time complexity since the initial code fragment (map (fn x) xs) is to be computed anyway. Am I wrong here? Is this implementation running O(n^2)? If not, could you please show me how to write a nested triangular loop in Haskell? Rohan Sumant -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Apr 10 17:11:55 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 10 Apr 2016 19:11:55 +0200 Subject: [Haskell-beginners] function application In-Reply-To: References: Message-ID: <20160410171155.GA14340@casa.casa> On Sun, Apr 10, 2016 at 05:16:24PM +0100, mike h wrote: > So is > mc . mc $ x + 11 > > the only correct way to write this particular function in ?.? style ? Hello Mike, (mc . mc) (x + 11) would do too. Remember, function application (white-space) takes precedence over *everything*, so: mc . mc ( x + 11 ) ^ ^ | +------- whitespace | +----------- operator is the same as: mc . (mc ( x + 11 )) From sumit.sahrawat.apm13 at iitbhu.ac.in Sun Apr 10 17:18:12 2016 From: sumit.sahrawat.apm13 at iitbhu.ac.in (Sumit Sahrawat, Maths & Computing, IIT (BHU)) Date: Sun, 10 Apr 2016 22:48:12 +0530 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: Haskell is a declarative language. The primary means of programming in a declarative language is to provide definitions for stuff, similar to mathematics. e.g. inc x = x + 1 If you want to define a value using an explicit sequence of steps, then you have to use monads. The Haskell wikibook has a good tutorial on using the state monad to generate random numbers. This allows mutation, preventing which is one of Haskell's prime features, so I wouldn't recommend wiring code like this. Complexity analysis is usually tricky in Haskell. You can refer to the book 'purely functional days structures' to know more. Regards, Sumit -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Sun Apr 10 18:12:56 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sun, 10 Apr 2016 20:12:56 +0200 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: Dunno if that's what you're interested in, or if it's best in terms of efficiency, but there's syntax inside the language made just for this kind of thing, called list comprehension. It comes from math's definition of sets by comprehension, and since it's part of the language I'd have a tendency to trust its efficiency, but I might be entirely wrong on this aspect. Anyways, for your problem, say I want to create the set of pairs of your example: let result = [(x,y) | let xs = [1,2,3,0], (x,ix) <- zip xs [1,2..], y <- drop ix xs, x /= y] in result == [(1,2),(1,3),(1,0),(2,3),(2,0),(3,0)] Basically the syntax is: [ parameterized result element | conditions on the parameters] the conditions being a sequence of comma-separated items that are either: local variable declarations without the 'in', example being (let input = [1,2,3,0]), pattern-accepting generation of values from a list, or conditions on the parameters (here x and y). In order to build y's list I decided to zip xs with a list of indexes starting to 1, thereby ensuring no pair is twice in, considering the order doesn't matter. I'd bet the syntax is monad/do related, with all those right-to left arrows. Plus it fits the bill of what's actually happening here. Of course if you want a function, you can still write thereafter mkpairs :: Integral a => a -> [(a,a)] mkpairs n = [(x,y) | let xs = [1..n] ++ [0], (x,ix) <- zip xs [1,2..], y <- drop ix xs, x /= y] If you don't care about the order, I guess xs = [0..n] will be much more efficient, relatively speaking. Pretty sure the function even works for n == 0, since y <- drop 1 [0] won't have a thing to yield, hence, result = []. If that interests you: https://wiki.haskell.org/List_comprehension -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Sun Apr 10 21:29:27 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sun, 10 Apr 2016 23:29:27 +0200 Subject: [Haskell-beginners] function application In-Reply-To: <20160410171155.GA14340@casa.casa> References: <20160410171155.GA14340@casa.casa> Message-ID: Mike: If you seek as I think you do, to write the function mc (partially) in point-free style, you must know this style implies no arguments, or at least not all arguments, mentioned, that is for example here: mc x | x < 100 = x - 10 mc = mc . mc . (+ 11) The second line will only be checked for pattern matching if the first one fails, so it amounts to the "otherwise" guard as here there's no pattern, so it's a bit like the pattern that always matches (mc _ = ...) You'll remark I did write (mc =) and not (mc x =). Point free style amounts to describing a function through a composition of other functions, in an arguments-free way, here for example, (mc . mc . (+11)) being the composition of mc twice, with the "partially-applied" function (+11) == (\x -> x + 11) == (11+). This partially applied notation works for all operators by the way. And for the record, the whitespace operator is a pure myth. First you can remove all whitespace, it still works. Second, try using the same whitespace-induced universal right-associativity with (f a b): does it amount to (f (a b))? The reason for this right-associativity interpretation in (mc . mc (x + 11)) is because (.) itself is right associative: right-directed greediness could we say, in the vocabulary of regular expression. It's also the case of ($), and that's why we use it to counter the natural left associativity of function application: f $ g a == f $ (g a) == ($) f (g a) == f (g a) -- (using the definition of ($) here) instead of f g a == (f g) a without using ($). The whitespace is just a meaningless character (I guess, a set of characters) used to separate juxtaposed meaningful tokens of the language when we have either (symbol,symbol) or (nonsymbol,nonsymbol), for example respectively (!! $ /= !!$) and (f g /= fg). whenever it's a nonsymbol and a symbol, whitespace is not necessary (a+, +a). Then there's the automatic, implicit function application between two juxtaposed non-symbolic tokens. But the whitespace has never been an operator of any kind, and is totally meaningless (and optional) in (mc . mc (x + 11)). Especially too, it's clear no whitespace survives the tokenization during the lexical phase of the (pre?) compilation, contrarily to all real operators like (+). -------------- next part -------------- An HTML attachment was scrubbed... URL: From r.s.sumant at gmail.com Mon Apr 11 02:05:08 2016 From: r.s.sumant at gmail.com (rohan sumant) Date: Mon, 11 Apr 2016 07:35:08 +0530 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: @Silent Leaf I am indeed familiar with the list comprehension syntax indeed. I agree with you that it certainly is the better alternative to writing handcrafted functions especially when they involve (++). However the code you have mentioned doesn't get the job done correctly. Your approach implements a square nested loop which makes it at least twice as inefficient than the one I am rooting for. The problem lies with the dropWhile function. It will begin from the start of the list for every new (x,ix). This is particularly bad in Haskell because the garbage collector cannot do away with unnecessary prefixes of the input string, thereby wasting a lot of memory. Rohan Sumant On Sun, Apr 10, 2016 at 11:42 PM, Silent Leaf wrote: > Dunno if that's what you're interested in, or if it's best in terms of > efficiency, but there's syntax inside the language made just for this kind > of thing, called list comprehension. It comes from math's definition of > sets by comprehension, and since it's part of the language I'd have a > tendency to trust its efficiency, but I might be entirely wrong on this > aspect. > > Anyways, for your problem, say I want to create the set of pairs of your > example: > > let result = [(x,y) | let xs = [1,2,3,0], (x,ix) <- zip xs [1,2..], y <- > drop ix xs, x /= y] > in result == [(1,2),(1,3),(1,0),(2,3),(2,0),(3,0)] > > Basically the syntax is: [ parameterized result element | conditions on > the parameters] > the conditions being a sequence of comma-separated items that are either: > local variable declarations without the 'in', example being (let input = > [1,2,3,0]), pattern-accepting generation of values from a list, or > conditions on the parameters (here x and y). > > In order to build y's list I decided to zip xs with a list of indexes > starting to 1, thereby ensuring no pair is twice in, considering the order > doesn't matter. > I'd bet the syntax is monad/do related, with all those right-to left > arrows. Plus it fits the bill of what's actually happening here. > > Of course if you want a function, you can still write thereafter > mkpairs :: Integral a => a -> [(a,a)] > mkpairs n = [(x,y) | let xs = [1..n] ++ [0], (x,ix) <- zip xs [1,2..], y > <- drop ix xs, x /= y] > > If you don't care about the order, I guess xs = [0..n] will be much more > efficient, relatively speaking. > Pretty sure the function even works for n == 0, since y <- drop 1 [0] > won't have a thing to yield, hence, result = []. > > If that interests you: > https://wiki.haskell.org/List_comprehension > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Mon Apr 11 02:45:01 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Mon, 11 Apr 2016 04:45:01 +0200 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: Ah, from that I gather I probably won't think about anything you wouldn't, then ^^ But I'll try because it's fun anyway! If dropping incessantly from the start of the list at each iteration is the problem (is that it? or did I not understand correctly?), could we not manage the problem with memoization, using a recursive function of the like: f 1 = drop 1 xs f n = drop 1 (f (n-1)) I can't be sure at all, so I'll ask: would haskell remember the result of each f 1, f 2, f 3, instead of recalculating them all the time? it would allow for only one "drop" operation per iteration, and i guess it's the best we can get with the general path I tried... but it seems obvious from you both messages, there must be better ones no matter what, efficiently speaking. :P it could be naive, but one way to manage mere lists of integral numbers, would be to transform them into one big number, and instead of dropping, we do integral divisions/recuperation of remainders. i bet *if* that's more efficient, there's a library to do that already. one only has to to write the number that serves as list as a juxtaposition of n-sized clusters of digits, n being the biggest power of ten reached by the biggest number of the list. smaller numbers, tha have not enough digits could be written with zeroes to fill in the rest: "0010" for example, and of course so as to not lose trailing zeroes of the number at the leftest, one has to start (from the right) with the smaller numbers: 123...010...002001. But who knows if it's really more efficient? I'd have a tendency to say, arithmetic is just numbers, the computer can do it way quicker and with much less memory, but maybe not. Just an idea off the top of my head. I bet no matter the technique we use, handling one big number could end up being faster than a big list, and with the right set of functions, it could be just as easy, but i could be totally wrong. And if too big numbers are problematic, we can still attempt intermediary solutions, like lists of clustered numbers ^^ Sorry for the stupid ideas, hopefully soon my wild imagination will be better handled by what i'll learn when i get a little less newbie. :P -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Mon Apr 11 05:06:21 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Mon, 11 Apr 2016 07:06:21 +0200 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) Message-ID: I'm sorry to hear, no implicit memoization (but then is there an explicit approach?). in a pure language, this seems hardly logical, considering the functional "to one output always the same result" and the language's propensity to use recursion that uses then previous values already calculated. Really hope for an explicit memoization! and i don't mean a manual one ^^ if that is even possible? Anyway, i just don't get your function f. you did get that in mine, xs was the value of my comprehension list, aka [.s1..n] ++ [0] >From there, if I'm not wrong, your function creates a list of all truncated lists, I supposed to be used with a call for the nth element? True, it memorizes all needed things, and in theory only "drops" once per element of the list. As for incorporating it, i'm thinking, local variable? ^^ the function itself could be outside the comprehension list, in a let or where, or completely out of everything, I don't really see the problem. then it's just a matter of it being called onto xs inside the comprehension list, like that: result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, (x,i) <- zip xs [1,2..], y <- yss !! i, x /= y] The remaining possible issue is the call to !!... dunno if that's costy or not. The best way to go through the list I suppose would be by recursion... oh wait, I'm writing as I'm thinking, and I'm thinking: result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, x <- xs, ys <- yss, y <- ys, x /= y] after all, why not use the invisible internal recursion? What do you think? As for the number-instead-of-number-list, the crucial point i mentioned was to determine the maximum number of digit (biggest power of ten reached), and fill up the holes of the smaller numbers with zeroes, so your examples would be: [1,2,3] = 123 --maximum size of a number = 1, no need to fill up [12,3] = 1203 --maximum size of a number = 2 digits, thus the hole beside 3 gets filled with a zero, just like on good old digital watches ^^ Do you think extraction of clusters of digits from numbers would be advantageous, efficiently speaking? -------------- next part -------------- An HTML attachment was scrubbed... URL: From sgf.dma at gmail.com Mon Apr 11 11:32:30 2016 From: sgf.dma at gmail.com (Dmitriy Matrosov) Date: Mon, 11 Apr 2016 14:32:30 +0300 Subject: [Haskell-beginners] Type depending on value Message-ID: > {-# LANGUAGE DataKinds, KindSignatures, GADTs, StandaloneDeriving #-} Hi. Here is natural numbers and its singleton definition, which i take from "Part I: Dependent Types in Haskell" article by Hiromi ISHII [1]: > data Nat = Z | S Nat > deriving (Show) > > data SNat :: Nat -> * where > SZ :: SNat 'Z > SN :: SNat n -> SNat ('S n) > deriving instance Show (SNat n) But i can't figure out how may i define function returning SNat value depending on Nat value: f :: Nat -> SNat n f Z = SZ f (S n) = SN (f n) This does not typecheck, because, as i understand, ghc can't infer type n. Is it possible to do this at all? [1]: https://www.schoolofhaskell.com/user/konn/prove-your-haskell-for-great-safety/dependent-types-in-haskell#ordinals -------------- next part -------------- An HTML attachment was scrubbed... URL: From marcin.jan.mrotek at gmail.com Mon Apr 11 13:59:09 2016 From: marcin.jan.mrotek at gmail.com (Marcin Mrotek) Date: Mon, 11 Apr 2016 15:59:09 +0200 Subject: [Haskell-beginners] Type depending on value In-Reply-To: References: Message-ID: Hello, In your function, the type `n`, and thus also the value of the argument, would have to be known at compile time. I'm not sure if you could make it to work. However, you can use the reflection package (https://hackage.haskell.org/package/reflection) where you can find a `reifyNat` function ( https://hackage.haskell.org/package/reflection-2.1.2/docs/Data-Reflection.html#g:1 ) that lets you create a "temporary" type that never escapes the callback you give to it, and so it doesn't have to be known at compile time: reifyNat :: forall r. Integer -> (forall n. KnownNat n => Proxy n -> r) -> r The only requirement is that type `r` doesn't depend in any way on `n` (but the computation itself can use it, it just has to return the same type every time). Best regards, Marcin Mrotek From mike_k_houghton at yahoo.co.uk Mon Apr 11 14:16:18 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 11 Apr 2016 14:16:18 +0000 (UTC) Subject: [Haskell-beginners] function application In-Reply-To: References: Message-ID: <1127397352.1387433.1460384178443.JavaMail.yahoo@mail.yahoo.com> Hi, Thanks for the comprehensive and considered answers.?Maybe I'm missing something but defining the original function to have two definitions with a different number of args in each? causes a compiler error ie. doing mc :: (Integral a) => a -> amc x | x < 100 = x - 10????? -- 1 arg mc = mc . mc . (+ 11)?????? --? no args Thanks On Sunday, 10 April 2016, 22:29, Silent Leaf wrote: Mike: If you seek as I think you do, to write the function mc (partially) in point-free style, you must know this style implies no arguments, or at least not all arguments, mentioned, that is for example here: mc x | x < 100 = x - 10 mc = mc . mc . (+ 11) The second line will only be checked for pattern matching if the first one fails, so it amounts to the "otherwise" guard as here there's no pattern, so it's a bit like the pattern that always matches (mc _ = ...) You'll remark I did write (mc =) and not (mc x =). Point free style amounts to describing a function through a composition of other functions, in an arguments-free way, here for example, (mc . mc . (+11)) being the composition of mc twice, with the "partially-applied" function (+11) == (\x -> x + 11) == (11+). This partially applied notation works for all operators by the way. And for the record, the whitespace operator is a pure myth. First you can remove all whitespace, it still works. Second, try using the same whitespace-induced universal right-associativity with (f a b): does it amount to (f (a b))? The reason for this right-associativity interpretation in (mc . mc (x + 11)) is because (.) itself is right associative: right-directed greediness could we say, in the vocabulary of regular expression. It's also the case of ($), and that's why we use it to counter the natural left associativity of function application: f $ g a == f $ (g a) == ($) f (g a) == f (g a)?? -- (using the definition of ($) here) instead of f g a == (f g) a without using ($). The whitespace is just a meaningless character (I guess, a set of characters) used to separate juxtaposed meaningful tokens of the language when we have either (symbol,symbol) or (nonsymbol,nonsymbol), for example respectively (!! $ /= !!$) and (f g /= fg). whenever it's a nonsymbol and a symbol, whitespace is not necessary (a+, +a). Then there's the automatic, implicit function application between two juxtaposed non-symbolic tokens. But the whitespace has never been an operator of any kind, and is totally meaningless (and optional) in (mc . mc (x + 11)). Especially too, it's clear no whitespace survives the tokenization during the lexical phase of the (pre?) compilation, contrarily to all real operators like (+). _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Mon Apr 11 21:10:44 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Mon, 11 Apr 2016 21:10:44 +0000 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: Compilers generally don't provide memoization optimizations because there isn't a single dominating strategy: it varies on a case-by-case basis. (For example, memoization of some functions can take advantage of structures with sub-linear indexing, but this can't be done generically.) When you can implement your own memoization yourself within the language with exactly the properties you desire (and a number of libraries have already done so for many common strategies ([1], [2], [3], [4])), there has been little motivation to add an implementation to GHC which is either inferior by way of its generality or extremely complex by way of its many special cases. [1]: https://hackage.haskell.org/package/MemoTrie [2]: https://hackage.haskell.org/package/memoize [3]: http://hackage.haskell.org/package/data-memocombinators [4]: https://hackage.haskell.org/package/representable-tries On Sun, Apr 10, 2016 at 10:06 PM Silent Leaf wrote: > I'm sorry to hear, no implicit memoization (but then is there an explicit > approach?). in a pure language, this seems hardly logical, considering the > functional "to one output always the same result" and the language's > propensity to use recursion that uses then previous values already > calculated. Really hope for an explicit memoization! and i don't mean a > manual one ^^ if that is even possible? > > Anyway, i just don't get your function f. you did get that in mine, xs was > the value of my comprehension list, aka [.s1..n] ++ [0] > From there, if I'm not wrong, your function creates a list of all > truncated lists, I supposed to be used with a call for the nth element? > True, it memorizes all needed things, and in theory only "drops" once per > element of the list. > > As for incorporating it, i'm thinking, local variable? ^^ the function > itself could be outside the comprehension list, in a let or where, or > completely out of everything, I don't really see the problem. then it's > just a matter of it being called onto xs inside the comprehension list, > like that: > result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, (x,i) <- zip xs > [1,2..], y <- yss !! i, x /= y] > The remaining possible issue is the call to !!... dunno if that's costy or > not. > > The best way to go through the list I suppose would be by recursion... oh > wait, I'm writing as I'm thinking, and I'm thinking: > result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, x <- xs, ys <- yss, > y <- ys, x /= y] > after all, why not use the invisible internal recursion? What do you think? > > As for the number-instead-of-number-list, the crucial point i mentioned > was to determine the maximum number of digit (biggest power of ten > reached), and fill up the holes of the smaller numbers with zeroes, so your > examples would be: > [1,2,3] = 123 --maximum size of a number = 1, no need to fill up > [12,3] = 1203 --maximum size of a number = 2 digits, thus the hole beside > 3 gets filled with a zero, just like on good old digital watches ^^ > Do you think extraction of clusters of digits from numbers would be > advantageous, efficiently speaking? > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From rein.henrichs at gmail.com Mon Apr 11 21:12:23 2016 From: rein.henrichs at gmail.com (Rein Henrichs) Date: Mon, 11 Apr 2016 21:12:23 +0000 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: I should also mention that many times when you think you want memoization in Haskell, what you actually want is to restructure your computation to take better advantage of laziness (and especially sharing). On Mon, Apr 11, 2016 at 2:10 PM Rein Henrichs wrote: > Compilers generally don't provide memoization optimizations because there > isn't a single dominating strategy: it varies on a case-by-case basis. (For > example, memoization of some functions can take advantage of structures > with sub-linear indexing, but this can't be done generically.) > > When you can implement your own memoization yourself within the language > with exactly the properties you desire (and a number of libraries have > already done so for many common strategies ([1], [2], [3], [4])), there has > been little motivation to add an implementation to GHC which is either > inferior by way of its generality or extremely complex by way of its many > special cases. > > [1]: https://hackage.haskell.org/package/MemoTrie > [2]: https://hackage.haskell.org/package/memoize > [3]: http://hackage.haskell.org/package/data-memocombinators > [4]: https://hackage.haskell.org/package/representable-tries > > On Sun, Apr 10, 2016 at 10:06 PM Silent Leaf > wrote: > >> I'm sorry to hear, no implicit memoization (but then is there an explicit >> approach?). in a pure language, this seems hardly logical, considering the >> functional "to one output always the same result" and the language's >> propensity to use recursion that uses then previous values already >> calculated. Really hope for an explicit memoization! and i don't mean a >> manual one ^^ if that is even possible? >> >> Anyway, i just don't get your function f. you did get that in mine, xs >> was the value of my comprehension list, aka [.s1..n] ++ [0] >> From there, if I'm not wrong, your function creates a list of all >> truncated lists, I supposed to be used with a call for the nth element? >> True, it memorizes all needed things, and in theory only "drops" once per >> element of the list. >> >> As for incorporating it, i'm thinking, local variable? ^^ the function >> itself could be outside the comprehension list, in a let or where, or >> completely out of everything, I don't really see the problem. then it's >> just a matter of it being called onto xs inside the comprehension list, >> like that: >> result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, (x,i) <- zip xs >> [1,2..], y <- yss !! i, x /= y] >> The remaining possible issue is the call to !!... dunno if that's costy >> or not. >> >> The best way to go through the list I suppose would be by recursion... oh >> wait, I'm writing as I'm thinking, and I'm thinking: >> result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, x <- xs, ys <- yss, >> y <- ys, x /= y] >> after all, why not use the invisible internal recursion? What do you >> think? >> >> As for the number-instead-of-number-list, the crucial point i mentioned >> was to determine the maximum number of digit (biggest power of ten >> reached), and fill up the holes of the smaller numbers with zeroes, so your >> examples would be: >> [1,2,3] = 123 --maximum size of a number = 1, no need to fill up >> [12,3] = 1203 --maximum size of a number = 2 digits, thus the hole beside >> 3 gets filled with a zero, just like on good old digital watches ^^ >> Do you think extraction of clusters of digits from numbers would be >> advantageous, efficiently speaking? >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Mon Apr 11 23:52:46 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Tue, 12 Apr 2016 01:52:46 +0200 Subject: [Haskell-beginners] function application In-Reply-To: <1127397352.1387433.1460384178443.JavaMail.yahoo@mail.yahoo.com> References: <1127397352.1387433.1460384178443.JavaMail.yahoo@mail.yahoo.com> Message-ID: true! no it's totally my fault, i forgot about that. I'm not exactly sure why is that, it seems slightly absurd, limiting, to me but I guess it must be something on the inside. In that case, from what I know to this day, you'll have to choose either, and I know no easy way to integrate a point-free conditional choice (in other terms, to replace the guards in a pointfree manner) on one of the parameters, so I'd go for the non-pointfree style, aka your original implementation, with the guards. of course we can merrily cheat: test1arg :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b test1arg cond thenF elseF x | cond x = thenF x | otherwise = elseF x then: mc :: Integral a => a -> a mc = test1arg (<100) (-10) (mc . mc . (+11)) it amounts to moving the guards into another function. the "if then else" expression is very similar of course, but doesn't allow, as far as I know, point-free style. Anyway... all this becomes a pointless (pun unintended) search for the point-free style at all costs. I'm not sure it's generally speaking, a very good idea. Non-point-free style is perfectly good style in itself, and pointfree should be in my opinion reserved to cases where it comes naturally, where, when perhaps looking at one's definition for a function, one realizes the presence of the argument is pointless; one very random last-minute example: f xs = zip [0..] xs ---> f = zip [0..] also to the cases when the very definition of a function comes to one as combination of other functions. beyond that, I'd say it's mostly wasted time. I think the question is to balance the style, to always prefer clarity to "coolness" at any rate. Sure, in many cases, a pointfree style is in my opinion much quicker to understand, much clearer. Also, pointfree style is also a very good exercise I think, that permits beginners (i put myself in it needless to say) to get a better understanding of haskell's syntax, and of the whole function paradigm in general. As long as exercises in pointfree feats aren't hindering real programming, I'd say there's no problem in trying to go for it whenever it's possible. Plus in my opinion it can be fun. 2016-04-11 16:16 GMT+02:00 mike h : > Hi, > > Thanks for the comprehensive and considered answers. > Maybe I'm missing something but defining the original function to have two > definitions with a different number of args in each causes a compiler > error ie. doing > > mc :: (Integral a) => a -> amc x | x < 100 = x - 10 -- 1 arg > mc = mc . mc . (+ 11) -- no args > > Thanks > > > > > On Sunday, 10 April 2016, 22:29, Silent Leaf > wrote: > > > Mike: If you seek as I think you do, to write the function mc (partially) > in point-free style, you must know this style implies no arguments, or at > least not all arguments, mentioned, that is for example here: > mc x | x < 100 = x - 10 > mc = mc . mc . (+ 11) > > The second line will only be checked for pattern matching if the first one > fails, so it amounts to the "otherwise" guard as here there's no pattern, > so it's a bit like the pattern that always matches (mc _ = ...) > You'll remark I did write (mc =) and not (mc x =). Point free style > amounts to describing a function through a composition of other functions, > in an arguments-free way, here for example, (mc . mc . (+11)) being the > composition of mc twice, with the "partially-applied" function (+11) == (\x > -> x + 11) == (11+). This partially applied notation works for all > operators by the way. > > And for the record, the whitespace operator is a pure myth. First you can > remove all whitespace, it still works. Second, try using the same > whitespace-induced universal right-associativity with (f a b): does it > amount to (f (a b))? > > The reason for this right-associativity interpretation in (mc . mc (x + > 11)) is because (.) itself is right associative: right-directed greediness > could we say, in the vocabulary of regular expression. It's also the case > of ($), and that's why we use it to counter the natural left associativity > of function application: > f $ g a == f $ (g a) == ($) f (g a) == f (g a) -- (using the definition > of ($) here) > instead of > f g a == (f g) a > without using ($). > > The whitespace is just a meaningless character (I guess, a set of > characters) used to separate juxtaposed meaningful tokens of the language > when we have either (symbol,symbol) or (nonsymbol,nonsymbol), for example > respectively (!! $ /= !!$) and (f g /= fg). whenever it's a nonsymbol and a > symbol, whitespace is not necessary (a+, +a). > Then there's the automatic, implicit function application between two > juxtaposed non-symbolic tokens. But the whitespace has never been an > operator of any kind, and is totally meaningless (and optional) in (mc . mc > (x + 11)). > > Especially too, it's clear no whitespace survives the tokenization during > the lexical phase of the (pre?) compilation, contrarily to all real > operators like (+). > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From jon.surrell at gmail.com Tue Apr 12 07:57:41 2016 From: jon.surrell at gmail.com (Jon Surrell) Date: Tue, 12 Apr 2016 07:57:41 +0000 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: Rein's comment about taking advantage of laziness and sharing over memoization made an impact with me. Seeing it stated like that, it seems obvious. Does anyone know of resources that explain this type of restructuring, preferably with practical examples? Thanks, Jon On Mon, Apr 11, 2016 at 11:12 PM Rein Henrichs wrote: > I should also mention that many times when you think you want memoization > in Haskell, what you actually want is to restructure your computation to > take better advantage of laziness (and especially sharing). > > On Mon, Apr 11, 2016 at 2:10 PM Rein Henrichs > wrote: > >> Compilers generally don't provide memoization optimizations because there >> isn't a single dominating strategy: it varies on a case-by-case basis. (For >> example, memoization of some functions can take advantage of structures >> with sub-linear indexing, but this can't be done generically.) >> >> When you can implement your own memoization yourself within the language >> with exactly the properties you desire (and a number of libraries have >> already done so for many common strategies ([1], [2], [3], [4])), there has >> been little motivation to add an implementation to GHC which is either >> inferior by way of its generality or extremely complex by way of its many >> special cases. >> >> [1]: https://hackage.haskell.org/package/MemoTrie >> [2]: https://hackage.haskell.org/package/memoize >> [3]: http://hackage.haskell.org/package/data-memocombinators >> [4]: https://hackage.haskell.org/package/representable-tries >> >> On Sun, Apr 10, 2016 at 10:06 PM Silent Leaf >> wrote: >> >>> I'm sorry to hear, no implicit memoization (but then is there an >>> explicit approach?). in a pure language, this seems hardly logical, >>> considering the functional "to one output always the same result" and the >>> language's propensity to use recursion that uses then previous values >>> already calculated. Really hope for an explicit memoization! and i don't >>> mean a manual one ^^ if that is even possible? >>> >>> Anyway, i just don't get your function f. you did get that in mine, xs >>> was the value of my comprehension list, aka [.s1..n] ++ [0] >>> From there, if I'm not wrong, your function creates a list of all >>> truncated lists, I supposed to be used with a call for the nth element? >>> True, it memorizes all needed things, and in theory only "drops" once per >>> element of the list. >>> >>> As for incorporating it, i'm thinking, local variable? ^^ the function >>> itself could be outside the comprehension list, in a let or where, or >>> completely out of everything, I don't really see the problem. then it's >>> just a matter of it being called onto xs inside the comprehension list, >>> like that: >>> result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, (x,i) <- zip xs >>> [1,2..], y <- yss !! i, x /= y] >>> The remaining possible issue is the call to !!... dunno if that's costy >>> or not. >>> >>> The best way to go through the list I suppose would be by recursion... >>> oh wait, I'm writing as I'm thinking, and I'm thinking: >>> result = [(x,y) | let xs = [1,2,3,0], let yss = f xs, x <- xs, ys <- >>> yss, y <- ys, x /= y] >>> after all, why not use the invisible internal recursion? What do you >>> think? >>> >>> As for the number-instead-of-number-list, the crucial point i mentioned >>> was to determine the maximum number of digit (biggest power of ten >>> reached), and fill up the holes of the smaller numbers with zeroes, so your >>> examples would be: >>> [1,2,3] = 123 --maximum size of a number = 1, no need to fill up >>> [12,3] = 1203 --maximum size of a number = 2 digits, thus the hole >>> beside 3 gets filled with a zero, just like on good old digital watches ^^ >>> Do you think extraction of clusters of digits from numbers would be >>> advantageous, efficiently speaking? >>> _______________________________________________ >>> Beginners mailing list >>> Beginners at haskell.org >>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >>> >> _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Tue Apr 12 08:36:28 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 12 Apr 2016 08:36:28 +0000 (UTC) Subject: [Haskell-beginners] function application In-Reply-To: References: Message-ID: <1000143001.2119445.1460450188744.JavaMail.yahoo@mail.yahoo.com> I agree. I'm just seeing how far point free can be taken under different circumstances. Thanks for all your comments, much appreciated. Mike On Tuesday, 12 April 2016, 0:52, Silent Leaf wrote: true! no it's totally my fault, i forgot about that. I'm not exactly sure why is that, it seems slightly absurd, limiting, to me but I guess it must be something on the inside. In that case, from what I know to this day, you'll have to choose either, and I know no easy way to integrate a point-free conditional choice (in other terms, to replace the guards in a pointfree manner) on one of the parameters, so I'd go for the non-pointfree style, aka your original implementation, with the guards. of course we can merrily cheat: test1arg :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b test1arg cond thenF elseF x ??? | cond x = thenF x ??? | otherwise = elseF x then: mc :: Integral a => a -> a mc = test1arg (<100) (-10) (mc . mc . (+11)) it amounts to moving the guards into another function. the "if then else" expression is very similar of course, but doesn't allow, as far as I know, point-free style. Anyway... all this becomes a pointless (pun unintended) search for the point-free style at all costs. I'm not sure it's generally speaking, a very good idea. Non-point-free style is perfectly good style in itself, and pointfree should be in my opinion reserved to cases where it comes naturally, where, when perhaps looking at one's definition for a function, one realizes the presence of the argument is pointless; one very random last-minute example: f xs = zip [0..] xs? ---> f = zip [0..] also to the cases when the very definition of a function comes to one as combination of other functions. beyond that, I'd say it's mostly wasted time. I think the question is to balance the style, to always prefer clarity to "coolness" at any rate. Sure, in many cases, a pointfree style is in my opinion much quicker to understand, much clearer. Also, pointfree style is also a very good exercise I think, that permits beginners (i put myself in it needless to say) to get a better understanding of haskell's syntax, and of the whole function paradigm in general. As long as exercises in pointfree feats aren't hindering real programming, I'd say there's no problem in trying to go for it whenever it's possible. Plus in my opinion it can be fun. 2016-04-11 16:16 GMT+02:00 mike h : Hi, Thanks for the comprehensive and considered answers.?Maybe I'm missing something but defining the original function to have two definitions with a different number of args in each? causes a compiler error ie. doing mc :: (Integral a) => a -> amc x | x < 100 = x - 10????? -- 1 arg mc = mc . mc . (+ 11)?????? --? no args Thanks On Sunday, 10 April 2016, 22:29, Silent Leaf wrote: Mike: If you seek as I think you do, to write the function mc (partially) in point-free style, you must know this style implies no arguments, or at least not all arguments, mentioned, that is for example here: mc x | x < 100 = x - 10 mc = mc . mc . (+ 11) The second line will only be checked for pattern matching if the first one fails, so it amounts to the "otherwise" guard as here there's no pattern, so it's a bit like the pattern that always matches (mc _ = ...) You'll remark I did write (mc =) and not (mc x =). Point free style amounts to describing a function through a composition of other functions, in an arguments-free way, here for example, (mc . mc . (+11)) being the composition of mc twice, with the "partially-applied" function (+11) == (\x -> x + 11) == (11+). This partially applied notation works for all operators by the way. And for the record, the whitespace operator is a pure myth. First you can remove all whitespace, it still works. Second, try using the same whitespace-induced universal right-associativity with (f a b): does it amount to (f (a b))? The reason for this right-associativity interpretation in (mc . mc (x + 11)) is because (.) itself is right associative: right-directed greediness could we say, in the vocabulary of regular expression. It's also the case of ($), and that's why we use it to counter the natural left associativity of function application: f $ g a == f $ (g a) == ($) f (g a) == f (g a)?? -- (using the definition of ($) here) instead of f g a == (f g) a without using ($). The whitespace is just a meaningless character (I guess, a set of characters) used to separate juxtaposed meaningful tokens of the language when we have either (symbol,symbol) or (nonsymbol,nonsymbol), for example respectively (!! $ /= !!$) and (f g /= fg). whenever it's a nonsymbol and a symbol, whitespace is not necessary (a+, +a). Then there's the automatic, implicit function application between two juxtaposed non-symbolic tokens. But the whitespace has never been an operator of any kind, and is totally meaningless (and optional) in (mc . mc (x + 11)). Especially too, it's clear no whitespace survives the tokenization during the lexical phase of the (pre?) compilation, contrarily to all real operators like (+). _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Wed Apr 13 19:33:48 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Wed, 13 Apr 2016 21:33:48 +0200 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? Message-ID: Hi! say I wanna use "?" as new infix operator: it's the big dash used a bit like parenthesis, especially at the end of sentences ?like this. in ghci directly: Prelude> let (?) a b = a + b No problem, is accepted and usable. Same in files. Now I try using (?), a French (amongst others) punctuation sign, typically replaces the quote-ends, ? like this ?. Doesn't work: :2:6: lexical error at character '\187' I thought Haskell was Unicode-friendly? Why some symbols but not others? :'( -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim.v2.0 at gmail.com Wed Apr 13 23:50:47 2016 From: tim.v2.0 at gmail.com (Tim Perry) Date: Wed, 13 Apr 2016 16:50:47 -0700 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? In-Reply-To: References: Message-ID: I think it has something to do with which unicode symbols are punctuation. Check out this StackOverflow answer: http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators On Wed, Apr 13, 2016 at 12:33 PM, Silent Leaf wrote: > Hi! > > say I wanna use "?" as new infix operator: it's the big dash used a bit > like parenthesis, especially at the end of sentences ?like this. > > in ghci directly: > Prelude> let (?) a b = a + b > > No problem, is accepted and usable. Same in files. > > Now I try using (?), a French (amongst others) punctuation sign, typically > replaces the quote-ends, ? like this ?. > Doesn't work: > :2:6: lexical error at character '\187' > > I thought Haskell was Unicode-friendly? Why some symbols but not others? > :'( > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim.v2.0 at gmail.com Thu Apr 14 00:02:36 2016 From: tim.v2.0 at gmail.com (Tim Perry) Date: Wed, 13 Apr 2016 17:02:36 -0700 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? In-Reply-To: References: Message-ID: And to see if a character is punctuation, use the handy isPunctuation function https://hackage.haskell.org/package/base-4.8.2.0/docs/Data-Char.html#v:isPunctuation On Wed, Apr 13, 2016 at 4:50 PM, Tim Perry wrote: > I think it has something to do with which unicode symbols are punctuation. > > Check out this StackOverflow answer: > > http://stackoverflow.com/questions/10548170/what-characters-are-permitted-for-haskell-operators > > > On Wed, Apr 13, 2016 at 12:33 PM, Silent Leaf > wrote: > >> Hi! >> >> say I wanna use "?" as new infix operator: it's the big dash used a bit >> like parenthesis, especially at the end of sentences ?like this. >> >> in ghci directly: >> Prelude> let (?) a b = a + b >> >> No problem, is accepted and usable. Same in files. >> >> Now I try using (?), a French (amongst others) punctuation sign, >> typically replaces the quote-ends, ? like this ?. >> Doesn't work: >> :2:6: lexical error at character '\187' >> >> I thought Haskell was Unicode-friendly? Why some symbols but not others? >> :'( >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> >> > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Thu Apr 14 01:30:58 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Thu, 14 Apr 2016 03:30:58 +0200 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? In-Reply-To: References: Message-ID: Well the problem is, the function you point out returns "true" for both symbols. And yet, one of them is refused as part of an operator, or anywhere for that matter, except between quotes of course. The function isn't true, both symbols are officially Unicode punctuation. That's really weird, and a bit sad, it could have been really useful to me :/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From tim.v2.0 at gmail.com Thu Apr 14 04:28:55 2016 From: tim.v2.0 at gmail.com (Tim Perry) Date: Wed, 13 Apr 2016 21:28:55 -0700 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? In-Reply-To: References: Message-ID: I'm sorry to hear that. I guess the answer is more complicated than I thought. If I were you I'd post the question on Stack Overflow, there are quite a few experienced Haskell programmers on there that have always sorted my issues out quickly and thoroughly. If you do post on Stack Overflow, please post the link here. Good luck and sorry my info wasn't helpful. Tim On Wed, Apr 13, 2016 at 6:30 PM, Silent Leaf wrote: > Well the problem is, the function you point out returns "true" for both > symbols. And yet, one of them is refused as part of an operator, or > anywhere for that matter, except between quotes of course. > The function isn't true, both symbols are officially Unicode punctuation. > That's really weird, and a bit sad, it could have been really useful to me > :/ > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Thu Apr 14 04:33:49 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Thu, 14 Apr 2016 06:33:49 +0200 Subject: [Haskell-beginners] Unicode characters in function names: some don't work? In-Reply-To: References: Message-ID: Good idea, that was gonna be my next stop; Will do, thanks for trying to help me. Le jeudi 14 avril 2016, Tim Perry a ?crit : > I'm sorry to hear that. I guess the answer is more complicated than I thought. If I were you I'd post the question on Stack Overflow, there are quite a few experienced Haskell programmers on there that have always sorted my issues out quickly and thoroughly. If you do post on Stack Overflow, please post the link here. > > Good luck and sorry my info wasn't helpful. > Tim > > On Wed, Apr 13, 2016 at 6:30 PM, Silent Leaf wrote: >> >> Well the problem is, the function you point out returns "true" for both symbols. And yet, one of them is refused as part of an operator, or anywhere for that matter, except between quotes of course. >> The function isn't true, both symbols are officially Unicode punctuation. That's really weird, and a bit sad, it could have been really useful to me :/ >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From atomly at gmail.com Thu Apr 14 22:31:18 2016 From: atomly at gmail.com (atomly) Date: Thu, 14 Apr 2016 17:31:18 -0500 Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) In-Reply-To: References: Message-ID: https://wiki.haskell.org/99_questions/Solutions/26 :: atomly :: [ atomly at atomly.com : www.atomly.com : http://blog.atomly.com/ ... [ atomiq records : new york city : +1.347.692.8661 ... [ e-mail atomly-news-subscribe at atomly.com for atomly info and updates ... On Sun, Apr 10, 2016 at 11:59 AM, rohan sumant wrote: > Suppose I have a list of distinct integers and I wish to generate all > possible unordered pairs (a,b) where a/=b. > > Ex: [1,2,3,0] --> [(1,2),(1,3),(1,0),(2,3),(2,0),(3,0)] > > The approach I am following is this :- > > mkpairs [] = [] > mkpairs (x:xs) = (map (fn x) xs) ++ (mkpairs xs) > > fn x y = (x,y) > > It is generating the desired output but I am a bit unsure about the time > complexity of the function mkpairs. In an imperative language a nested > triangular for loop would do the trick in O(n^2) or more precisely > (n*(n-1)/2) operations. Does my code follow the same strategy? I am > particularly worried about the (++) operator. I think that (++) wouldn't > add to the time complexity since the initial code fragment (map (fn x) xs) > is to be computed anyway. Am I wrong here? Is this implementation running > O(n^2)? If not, could you please show me how to write a nested triangular > loop in Haskell? > > Rohan Sumant > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gmane at otterhall.com Fri Apr 15 23:06:04 2016 From: gmane at otterhall.com (=?UTF-8?Q?Albin_Otterh=c3=a4ll?=) Date: Sat, 16 Apr 2016 01:06:04 +0200 Subject: [Haskell-beginners] Trying to install "Craft3e" from Hackage using stack Message-ID: I'm currently reading "Haskell: the Craft of Functional Programming", by Simon Thompson and I'm trying to download and install the package books code. But when I run "stack build Craft3e" I get the following error message: > Run from outside a project, using implicit global project config > Using resolver: lts-5.12 from implicit global project's config file: > /home/dumbl3d0re/.stack/global-project/stack.yaml > While constructing the BuildPlan the following exceptions were encountered: > > -- Failure when adding dependencies: > HUnit: needed (==1.2.*), 1.3.1.1 found (latest applicable is 1.2.5.2) > mtl: needed (>=1.1 && <2.2), 2.2.1 found (latest applicable is 2.1.3.1) > needed for package Craft3e-0.1.0.10 How should I go about to install "Craft3e"? Thanks in advance! Regards, Albin From simon.jakobi at googlemail.com Sat Apr 16 00:36:31 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sat, 16 Apr 2016 02:36:31 +0200 Subject: [Haskell-beginners] Trying to install "Craft3e" from Hackage using stack In-Reply-To: References: Message-ID: Assuming that you would keep any book-related code in a local project, here's how you'd create a local project with a dependency on Craft3e: # Create a new project using ghc-7.8 (due to Craft3e's dependency on mtl <2.2) $ stack --resolver ghc-7.8 new craft $ cd craft # Edit the library section of craft.cabal to contain a dependency on Craft3e: # # build-depends: base >= 4.7 && < 5 # , Craft3e # # Calculate a consistent set of packages to use in the project: $ stack solver --update-config Now you can write exercises etc. as library modules in the src directory and use them interactively with stack repl. If you haven't used stack before, you might also want to take a look at the stack guide: http://docs.haskellstack.org/en/stable/GUIDE/ Cheers, Simon From gmane at otterhall.com Sat Apr 16 08:28:07 2016 From: gmane at otterhall.com (=?UTF-8?Q?Albin_Otterh=c3=a4ll?=) Date: Sat, 16 Apr 2016 10:28:07 +0200 Subject: [Haskell-beginners] Trying to install "Craft3e" from Hackage using stack In-Reply-To: References: Message-ID: On 2016-04-16 02:36, Simon Jakobi wrote: > Assuming that you would keep any book-related code in a local project, > here's how you'd create a local project with a dependency on Craft3e: > > # Create a new project using ghc-7.8 (due to Craft3e's dependency on mtl <2.2) > $ stack --resolver ghc-7.8 new craft > $ cd craft > # Edit the library section of craft.cabal to contain a dependency on Craft3e: > # > # build-depends: base >= 4.7 && < 5 > # , Craft3e > # > # Calculate a consistent set of packages to use in the project: > $ stack solver --update-config > > Now you can write exercises etc. as library modules in the src > directory and use them interactively with stack repl. > > If you haven't used stack before, you might also want to take a look > at the stack guide: > http://docs.haskellstack.org/en/stable/GUIDE/ > > Cheers, > Simon > I don't know if it's possible with the method you described, but I need to be able to import some files into GHCi. They contain function definitions that I have to be able to use in GHCi. Regards, Albin From simon.jakobi at googlemail.com Sat Apr 16 14:15:20 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sat, 16 Apr 2016 16:15:20 +0200 Subject: [Haskell-beginners] Trying to install "Craft3e" from Hackage using stack In-Reply-To: References: Message-ID: > I don't know if it's possible with the method you described, but I need > to be able to import some files into GHCi. They contain function > definitions that I have to be able to use in GHCi. Sorry, I should have taken a look at the package description before writing a response. That should work: $ stack unpack Craft3e $ cd Craft3e-0.1.0.10 $ stack init $ stack build You can then use stack ghci (stack's wrapper around ghci) and ?> import Chapter1 -- for example Cheers, Simon From gmane at otterhall.com Sat Apr 16 17:00:22 2016 From: gmane at otterhall.com (=?UTF-8?Q?Albin_Otterh=c3=a4ll?=) Date: Sat, 16 Apr 2016 19:00:22 +0200 Subject: [Haskell-beginners] Trying to install "Craft3e" from Hackage using stack In-Reply-To: References: Message-ID: On 2016-04-16 16:15, Simon Jakobi wrote: >> I don't know if it's possible with the method you described, but I need >> to be able to import some files into GHCi. They contain function >> definitions that I have to be able to use in GHCi. > > Sorry, I should have taken a look at the package description before > writing a response. > That should work: > > $ stack unpack Craft3e > $ cd Craft3e-0.1.0.10 > $ stack init > $ stack build > > You can then use stack ghci (stack's wrapper around ghci) and > > ?> import Chapter1 -- for example > > Cheers, > Simon > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > Thank, it works! For ev. readers with the same problem: Do note that you have to use `stack exec ghci [file]` for it to work. Regards, Albin From mike_k_houghton at yahoo.co.uk Mon Apr 18 08:35:19 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 18 Apr 2016 08:35:19 +0000 (UTC) Subject: [Haskell-beginners] Parsec and Parsing References: <1492553946.3587393.1460968519503.JavaMail.yahoo.ref@mail.yahoo.com> Message-ID: <1492553946.3587393.1460968519503.JavaMail.yahoo@mail.yahoo.com> Hi, I have two types, Tag = String Val = String and I want to creat expressions based on equality,? t = v? (where t is Tag, v is Val) and containment ie t IN v1, v2, v3, v4 ie a tag equals a value or a tag is contained in a list of values. Furthyermore I would like to apply AND and OR, i.e. (t1 = v OR t1 IN v1, v2, v3) AND (t2 = v2) ect etc I want to use Parsec and I'm ok with basic combinators but I want to get as far as making this a simple DSL but I don't want to use buildExpressionParser? - at least not initially. I want to do this from first principles, understand what I'm doing and then maybe use buildExpressionParser. Any help would be really appreciated. Thanks Mike -------------- next part -------------- An HTML attachment was scrubbed... URL: From exitconsole at gmail.com Tue Apr 19 08:14:22 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Tue, 19 Apr 2016 10:14:22 +0200 Subject: [Haskell-beginners] Help refactor monster function Message-ID: Hi guys, Here is my solution to Problem 50 from Ninety-Nine Haskell Problems: https://github.com/nilthehuman/H-99/blob/master/Logic.hs#L75 (`consume' is defined here: https://github.com/nilthehuman/H-99/blob/master/Lists.hs#L107 ) I'm not satisfied with the code quality. I feel like especially `go', `group' and `min2' should be more succint and readable. How to refactor? Maybe there are some combinators that could help? Thanks, Daniel From doug at cs.dartmouth.edu Tue Apr 19 19:31:07 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Tue, 19 Apr 2016 15:31:07 -0400 Subject: [Haskell-beginners] ghci :load vs import Message-ID: <201604191931.u3JJV705008632@coolidge.cs.Dartmouth.EDU> I have module Powser stored in haskell/Powser.hs. There is no file ./Powser*. This loads the module shellprompt> ghci -ihaskell Prelude> :load Powser But this can't find it shellprompt> ghci -ihaskell Prelude> import Powser What might cause the difference? (I am running ghci 7.8.4.) Doug From doug at cs.dartmouth.edu Tue Apr 19 19:34:49 2016 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Tue, 19 Apr 2016 15:34:49 -0400 Subject: [Haskell-beginners] ghci :load vs import Message-ID: <201604191934.u3JJYnAr008654@coolidge.cs.Dartmouth.EDU> I have module Powser stored in haskell/Powser.hs. There is no file ./Powser*. This loads the module shellprompt> ghci -ihaskell Prelude> :load Powser But this can't find it shellprompt> ghci -ihaskell Prelude> import Powser What might cause the difference? (I am running ghci 7.8.4.) Doug From silent.leaf0 at gmail.com Tue Apr 19 19:43:03 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Tue, 19 Apr 2016 21:43:03 +0200 Subject: [Haskell-beginners] ghci :load vs import In-Reply-To: <201604191931.u3JJV705008632@coolidge.cs.Dartmouth.EDU> References: <201604191931.u3JJV705008632@coolidge.cs.Dartmouth.EDU> Message-ID: I'm a true beginner, so maybe what I say is false or useless, but from the few I know, I think the statement "import" is asking for the name of a module, not just the name of a file. So, is your file starting with the module declaration statement "module Powser (...) where" ? Le mardi 19 avril 2016, Doug McIlroy a ?crit : > I have module Powser stored in haskell/Powser.hs. > There is no file ./Powser*. > > This loads the module > shellprompt> ghci -ihaskell > Prelude> :load Powser > But this can't find it > shellprompt> ghci -ihaskell > Prelude> import Powser > > What might cause the difference? > (I am running ghci 7.8.4.) > > Doug > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Tue Apr 19 19:51:36 2016 From: imantc at gmail.com (Imants Cekusins) Date: Tue, 19 Apr 2016 21:51:36 +0200 Subject: [Haskell-beginners] ghci :load vs import In-Reply-To: References: <201604191931.u3JJV705008632@coolidge.cs.Dartmouth.EDU> Message-ID: interesting. I just found this: https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/interactive-evaluation.html#ghci-import-decl 2.4.5.5. :module and :load ... You can add a module to the scope (via :module or import) only if either (a) it is loaded, or (b) it is a module from a package that GHCi knows about. Using :module or import to try bring into scope a non-loaded module may result in the message ?module M is not loaded?. ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Tue Apr 19 20:00:07 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Tue, 19 Apr 2016 22:00:07 +0200 Subject: [Haskell-beginners] ghci :load vs import In-Reply-To: References: <201604191931.u3JJV705008632@coolidge.cs.Dartmouth.EDU> Message-ID: Interesting indeed. Logical too, in my personal view, since otherwise, to merely import a module could have triggered an unwanted, unpredictable (re)compilation of some other file. One must be able to control this, it seems fitting the internal statement "import" doesn't have such an external effect of (re)compilation of other modules, it's definitely not its role nor "right" in my view. Le mardi 19 avril 2016, Imants Cekusins a ?crit : > interesting. I just found this: > https://downloads.haskell.org/~ghc/7.8.4/docs/html/users_guide/interactive-evaluation.html#ghci-import-decl > 2.4.5.5. :module and :load > ... > You can add a module to the scope (via :module or import) only if either (a) it is loaded, or (b) it is a module from a package that GHCi knows about. Using :module or import to try bring into scope a non-loaded module may result in the message ?module M is not loaded?. > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From gesh at gesh.uni.cx Thu Apr 21 06:29:58 2016 From: gesh at gesh.uni.cx (Gesh hseG) Date: Thu, 21 Apr 2016 09:29:58 +0300 Subject: [Haskell-beginners] Help refactor monster function In-Reply-To: References: Message-ID: On Tue, Apr 19, 2016 at 11:14 AM, D?niel Arat? wrote: > Hi guys, > > Here is my solution to Problem 50 from Ninety-Nine Haskell Problems: > https://github.com/nilthehuman/H-99/blob/master/Logic.hs#L75 > > (`consume' is defined here: > https://github.com/nilthehuman/H-99/blob/master/Lists.hs#L107 ) > > I'm not satisfied with the code quality. I feel like especially `go', > `group' and `min2' should be more succint and readable. > D?niel, Looking at your code, there are several things that I note immediately. First, your 'consume' combinator can be rewritten as > consume f g a = foldl f a . chunk g > chunk g = unfoldr (fmap g . (\xs -> if null xs then Nothing else Just xs)) Second, you may want to reconsider your data model. As it is, your code is inefficient, since you are simulating priority queues using lists. Not everything can be solved naturally with lists. Assume we proceed anyway with your model, despite these misgivings. Note that any operation on your symbols is most naturally expressed in terms of sets of symbols with a common root. Hence, you may want to use > gatherRoots = chunk (partition (compare `on` root)) to split your queue into these sets. Note that this also gives you an easier way of expressing 'done' as > done = (<=1) . length . gatherRoots Once that is obtained, you want the minimal two sets by weight. Hence: > (x:y:xs) = map fst . sortBy (compare `on` snd) . map (id &&& flatten) > where flatten = sum . map weight > weight (_,w,_,_) = w Finally, you want to > go xs = map (update '0') x ++ map (update '1') y ++ xs > where update p (c,w,ps,_) = (c,w,p:ps, rn) > rn = rNext xs Note that this also avoids the ugly nested-if you had there. I played around with your code and refactored it to my taste. I extracted the main priority-queue simulation code into a typeclass instance so that you can see that the majority of the complexity of your code comes from simulating priority queues using lists. The completed code is here [0]. Note that I've taken some liberties with the naming and refactoring, and this may not all be to your taste. YMMV. I hope this helps, and that the criticism I gave was correct and will be well-received. Regards, Gesh P.S. You would be correct in claiming that this rewrite is too distant from the original to be of use. My apologies if this is the case. [0] - https://gist.github.com/anonymous/cd4e21105676894dcd579fcf8d4c4b41 -------------- next part -------------- An HTML attachment was scrubbed... URL: From wntuwntu at gmail.com Fri Apr 22 03:33:33 2016 From: wntuwntu at gmail.com (Eunsu Kim) Date: Thu, 21 Apr 2016 22:33:33 -0500 Subject: [Haskell-beginners] I have question about Haskell Message-ID: <796B2363-7D2A-4B26-9FB7-0C785E17417D@gmail.com> Hi i have a problem in my code! here is my code: -- Baic I/O and Loop (50 Points) evalpoly = do putStr "What is the degree of polynomial: " degree <- getLine coeffs <- (funcOfCoeff ((read degree::Int)+1) []) putStr "What value do you want to evaluate at: " value <- getLine putStr "The value of the polynomial is: " putStr (show (polyEvaluate (coeffs) (read value :: Float) )) putStr "\n" --function loop to get coefficient-- funcOfCoeff 0 coeffs = do --to check the degree of 0 return coeffs --return list of coefficient funcOfCoeff degree coeffs = do putStr ("What is the x^" ++ show(degree-1)) putStr " coefficient: " coeff <- getLine loop <- funcOfCoeff (degree-1) ((read coeff :: Int) : coeffs) return loop polyEvaluate (coeffs) x = do powers <- zip coeffs (iterate (+1) 0) result <- map (\(a,b)-> a+b) powers ?PROBLEM IS HERE!!!! return result here is error message: in very bottom function (polyEvaluate), why is not working ?result <- map (\(a,b) -> a+b) powers? ??? in Prelude, it is working Thanks! -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.11.29 PM.png Type: image/png Size: 25586 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.12.30 PM.png Type: image/png Size: 12203 bytes Desc: not available URL: From wangbj at gmail.com Fri Apr 22 05:44:28 2016 From: wangbj at gmail.com (Baojun Wang) Date: Fri, 22 Apr 2016 05:44:28 +0000 Subject: [Haskell-beginners] I have question about Haskell In-Reply-To: <796B2363-7D2A-4B26-9FB7-0C785E17417D@gmail.com> References: <796B2363-7D2A-4B26-9FB7-0C785E17417D@gmail.com> Message-ID: putStr (show (polyEvaluate (coeffs) (read value :: Float) )) Here ``polyEvaluate`` is inferred as a Show(able), However, ``polyEvaluate`` definition on the bottom returns a monad. (In haskell, meaning of return is quite different than imperative programming language). It's encouraged to write pure functions without effects, don't use monad unless it's really necessary. rewrite ``polyEvaluate`` as below should make the example compile. polyEvaluate (coeffs) x = map (\(a, b) -> a+b) . zip coeffs . iterate (+1) $ 0 Thanks baojun On Thu, Apr 21, 2016 at 8:33 PM Eunsu Kim wrote: > Hi > > i have a problem in my code! > > here is my code: > > -- Baic I/O and Loop (50 Points) > > evalpoly = do putStr "What is the degree of polynomial: " > degree <- getLine > coeffs <- (funcOfCoeff ((read degree::Int)+1) []) > putStr "What value do you want to evaluate at: " > value <- getLine > putStr "The value of the polynomial is: " > putStr (show (polyEvaluate (coeffs) (read value :: Float) )) > putStr "\n" > > --function loop to get coefficient-- > > funcOfCoeff 0 coeffs = do --to check the degree of 0 > return coeffs --return list of coefficient > > funcOfCoeff degree coeffs = do > putStr ("What is the x^" ++ show(degree-1)) > putStr " coefficient: " > coeff <- getLine > loop <- funcOfCoeff (degree-1) ((read coeff :: Int) : coeffs) > return loop > > > polyEvaluate (coeffs) x = do > powers <- zip coeffs (iterate (+1) 0) > result <- map (\(a,b)-> a+b) powers ?PROBLEM IS HERE!!!! > return result > > here is error message: > > > in very bottom function (polyEvaluate), why is not working ?result <- map > (\(a,b) -> a+b) powers? ??? > > in Prelude, it is working > > > Thanks! > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.11.29 PM.png Type: image/png Size: 25586 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.12.30 PM.png Type: image/png Size: 12203 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.12.30 PM.png Type: image/png Size: 12203 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.11.29 PM.png Type: image/png Size: 25586 bytes Desc: not available URL: From cwyang at aranetworks.com Fri Apr 22 05:57:55 2016 From: cwyang at aranetworks.com (Chul-Woong Yang) Date: Fri, 22 Apr 2016 14:57:55 +0900 Subject: [Haskell-beginners] I have question about Haskell In-Reply-To: <796B2363-7D2A-4B26-9FB7-0C785E17417D@gmail.com> References: <796B2363-7D2A-4B26-9FB7-0C785E17417D@gmail.com> Message-ID: Do you intend to use list monad? Since you bind the result of zip into powers, powers has type (a,b). try changing that line: > let powers = zip coeffs (iterate (+1) 0) As Baojun says, you'd better to write pure function and isolate I/O from it. 2016-04-22 12:33 GMT+09:00 Eunsu Kim : > Hi > > i have a problem in my code! > > here is my code: > > -- Baic I/O and Loop (50 Points) > > evalpoly = do putStr "What is the degree of polynomial: " > degree <- getLine > coeffs <- (funcOfCoeff ((read degree::Int)+1) []) > putStr "What value do you want to evaluate at: " > value <- getLine > putStr "The value of the polynomial is: " > putStr (show (polyEvaluate (coeffs) (read value :: Float) )) > putStr "\n" > > --function loop to get coefficient-- > > funcOfCoeff 0 coeffs = do --to check the degree of 0 > return coeffs --return list of coefficient > > funcOfCoeff degree coeffs = do > putStr ("What is the x^" ++ show(degree-1)) > putStr " coefficient: " > coeff <- getLine > loop <- funcOfCoeff (degree-1) ((read coeff :: Int) : coeffs) > return loop > > > polyEvaluate (coeffs) x = do > ?? > powers <- zip coeffs (iterate (+1) 0) > result <- map (\(a,b)-> a+b) powers ?PROBLEM IS HERE!!!! > return result > > here is error message: > > > in very bottom function (polyEvaluate), why is not working ?result <- map > (\(a,b) -> a+b) powers? ??? > > in Prelude, it is working > > > Thanks! > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.11.29 PM.png Type: image/png Size: 25586 bytes Desc: not available URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: Screen Shot 2016-04-21 at 10.12.30 PM.png Type: image/png Size: 12203 bytes Desc: not available URL: From matt.williams45.mw at gmail.com Fri Apr 22 21:20:19 2016 From: matt.williams45.mw at gmail.com (Matt Williams) Date: Fri, 22 Apr 2016 22:20:19 +0100 Subject: [Haskell-beginners] Applying a function to two lists Message-ID: <571A9593.1040502@gmail.com> Dear List, I am stuck. I have a function that needs to apply each item of one list to every element of the second list in turn. So far, I have this function: checkNum :: Int -> [Int] -> (Int,[Int]) checkNum a b = (a,filter (check a) $ b) which implements what I need, but I now need to apply it to every element of the first list. I am looking for something like: list1 = [1,2,3,4,5,6] list2 = [1,2,3,4,5,6] map checkNum list1 list2 to return: [(1,[1]),(2[3,4,5]),(6,[3]) (I have tried to simplify this a little, so my apologies if it looks pointless - the real function is useful) Any help would be appreciated. Matt From fa-ml at ariis.it Fri Apr 22 21:26:40 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 22 Apr 2016 23:26:40 +0200 Subject: [Haskell-beginners] Applying a function to two lists In-Reply-To: <571A9593.1040502@gmail.com> References: <571A9593.1040502@gmail.com> Message-ID: <20160422212640.GA24042@casa.casa> On Fri, Apr 22, 2016 at 10:20:19PM +0100, Matt Williams wrote: > I am looking for something like: > > list1 = [1,2,3,4,5,6] > list2 = [1,2,3,4,5,6] > > map checkNum list1 list2 > > to return: > > [(1,[1]),(2[3,4,5]),(6,[3]) > > (I have tried to simplify this a little, so my apologies if it looks > pointless - the real function is useful) > > Any help would be appreciated. > > Matt Hey Matt, if what you want is [checkNum 1 list2, checkNum 2 list2, etc.] then map (flip checknum list2) list1 is what you want (flip signature being :: (a -> b -> c) -> b -> a -> c) From wntuwntu at gmail.com Sat Apr 23 00:18:52 2016 From: wntuwntu at gmail.com (Eunsu Kim) Date: Fri, 22 Apr 2016 19:18:52 -0500 Subject: [Haskell-beginners] i have questions about Haskell Message-ID: Hi when outputting the polynomial value, actually write out the polynomial, but: - skipping any missing monomials - not including any extraneous signs -not showing the constant term for the above example, the final line would be: The value of 1.0 x^3 - 2.0 x^2 + 10.0 evaluated at -1.0 is 7.0 how can I do this??? i have no idea now?. here is my code: evalpoly = do putStr "What is the degree of polynomial: " degree <- getLine coeffs <- (funcOfCoeff ((read degree::Int)+1) [] ) putStr "What value do you want to evaluate at: " value <- getLine putStr "The value of the polynomial is: " putStrLn (show (getResult (coeffs) (read value :: Float) )) --function loop to get coefficient-- funcOfCoeff 0 coeffs = do --to check the degree of 0 return coeffs --return list of coefficient funcOfCoeff degree coeffs = do putStr ("What is the x^" ++ show(degree-1)) putStr " coefficient: " coeff <- getLine loop <- funcOfCoeff (degree-1) ((read coeff :: Float) : coeffs) return loop getResult (coeffs) x = sum(map(\(a,b) -> a*x^b).zip coeffs.iterate (+1)$0) this is my output so far: > evalpoly What is the degree of the polynomial: 3 What is the x^3 coefficient: 1.0 What is the x^2 coefficient: - 2.0 What is the x^1 coefficient: 0 What is the x^0 coefficient: 10.0 What value do you want to evaluate at: -1.0 The value of the polynomial is 7.0 -------------- next part -------------- An HTML attachment was scrubbed... URL: From anthony_clayden at clear.net.nz Sat Apr 23 00:20:58 2016 From: anthony_clayden at clear.net.nz (AntC) Date: Sat, 23 Apr 2016 00:20:58 +0000 (UTC) Subject: [Haskell-beginners] Haskell triangular loop (correct use of (++)) References: Message-ID: > rohan sumant gmail.com> writes: > > ?The approach I am following is this :- > mkpairs [] = [] > > mkpairs (x:xs) = (map (fn x) xs) ++ (mkpairs xs) > fn x y = (x,y) > > It is generating the desired output ... Good! You've got the right approach for triangular loops. That is a form mkpairs (x:xs) = {- stuff -} $ mkpairs xs A couple of things look non-idiomatic. So before I get on to your main question: As well as an empty list being a special case, neither can you make any pairs from a singleton ;-). I suggest: mkpairs [x] = [] The auxiliary `fn` is messy. I would put explicit lambda: mkpairs (x:xs) = map (\x' -> (x, x') ) xs ++ mkpairs xs Or even switch on tuple sections https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ syntax-extns.html#tuple-sections mkpairs (x:xs) = map (x, ) xs ++ mkpairs xs > but I am a bit unsure about the time complexity of the function mkpairs. ... > I am particularly worried about the (++) operator. ... You are spot-on! (++) has terrible time complexity. Use the showS trick for constant-time concatenation. Look in the Prelude for class Show a/method showsPrec, explained in the Haskell 2010 report section 6.3.3. To get that to work, you need a 'worker' function to hand across the successor for each list. It's conventional to call that `go`, and because everyone uses `go`, wrap it inside mkpairs using a `where`. Complete code: mkPairs [] = [] mkPairs [x] = [] mkPairs (x:xs) = go xs $ mkPairs xs where go [] s = s go (x':xs') s = (x, x') : go xs' s Now is that any faster in practice? Probably not until you get to a list with thousands of elements. HTH From wntuwntu at gmail.com Sat Apr 23 03:55:48 2016 From: wntuwntu at gmail.com (Eunsu Kim) Date: Fri, 22 Apr 2016 22:55:48 -0500 Subject: [Haskell-beginners] I have simple question about Haskell Message-ID: Hi THIS IS MY CODE: evalpoly = do putStr "What is the degree of polynomial: " degree <- getLine coeffs <- (funcOfCoeff ((read degree::Int)+1) [] ) putStr "What value do you want to evaluate at: " value <- getLine putStr "the value of " putStr (printChar coeffs) putStr (" evaluated at "++ value ++" is ") putStrLn (show (getResult (coeffs) (read value :: Float) )) printChar coeffs =parser([x | x <-reverse (zip coeffs (iterate (+1) 0)), fst x /= 0]) parser []="" parser (a:as)=show(fst a) ++ "x^" ++show(snd a) ++ " " ++(parser as) ?PROBLEM IS HERE!!! ---function loop to get coefficient-- funcOfCoeff 0 coeffs = do --to check the degree of 0 return coeffs --return list of coefficient funcOfCoeff degree coeffs = do putStr ("What is the x^" ++ show(degree-1)) putStr " coefficient: " coeff <- getLine loop <- funcOfCoeff (degree-1) ((read coeff :: Float) : coeffs) return loop getResult (coeffs) x = sum(map(\(a,b) -> a*x^b).zip coeffs.iterate (+1)$0) --evaluate polynomial with value HERE IS MY OUTPUT: *Main> evalpoly What is the degree of polynomial: 2 What is the x^2 coefficient: 3 What is the x^1 coefficient: 2 What is the x^0 coefficient: 1 What value do you want to evaluate at: 7 the value of 3.0x^2 2.0x^1 1.0x^0 evaluated at 7 is 162.0 in output, on the very bottom part, there should be + or - sign there like this: 3.0x^2 + 2.0x^1 - 1.0x^0 what should I do? I have no idea now?.. thanks -------------- next part -------------- An HTML attachment was scrubbed... URL: From simon.jakobi at googlemail.com Sat Apr 23 03:58:30 2016 From: simon.jakobi at googlemail.com (Simon Jakobi) Date: Sat, 23 Apr 2016 05:58:30 +0200 Subject: [Haskell-beginners] i have questions about Haskell In-Reply-To: References: Message-ID: Hi! > when outputting the polynomial value, actually write out the polynomial, > but: > - skipping any missing monomials > - not including any extraneous signs > -not showing the constant term > > for the above example, the final line would be: > > The value of 1.0 x^3 - 2.0 x^2 + 10.0 evaluated at -1.0 is 7.0 Because this is apparently a homework problem that you're supposed to solve yourself, I'll only give you a few pointers: What the problem description hints at is a function with type Polynomial -> String. So in a first step you should define that data type Polynomial (or whatever you want to call it). So far you seem to have been using a list of coefficients to represent polynomials, so you might just build on that existing representation, either by creating a type alias or creating a separate "real" type with a constructor. In a second step you need to write a function Polynomial -> String with an appropriate definition. I'd recommend that you start by generating a simpler string representation like "1.0 x^3 + -2.0 x^2 + 0.0 x^1 + 10.0" and refine your definition iteratively. Cheers, Simon From matt.williams45.mw at gmail.com Sat Apr 23 08:50:32 2016 From: matt.williams45.mw at gmail.com (Matt Williams) Date: Sat, 23 Apr 2016 08:50:32 +0000 Subject: [Haskell-beginners] Applying a function to two lists In-Reply-To: <20160422212640.GA24042@casa.casa> References: <571A9593.1040502@gmail.com> <20160422212640.GA24042@casa.casa> Message-ID: Thanks a lot for this. Just to clarify (and ignoring the flip, which I can solve by rewriting the checkNum function) - is this an example of currying? M On Fri, 22 Apr 2016 22:30 Francesco Ariis, wrote: > On Fri, Apr 22, 2016 at 10:20:19PM +0100, Matt Williams wrote: > > I am looking for something like: > > > > list1 = [1,2,3,4,5,6] > > list2 = [1,2,3,4,5,6] > > > > map checkNum list1 list2 > > > > to return: > > > > [(1,[1]),(2[3,4,5]),(6,[3]) > > > > (I have tried to simplify this a little, so my apologies if it looks > > pointless - the real function is useful) > > > > Any help would be appreciated. > > > > Matt > > Hey Matt, > if what you want is > > [checkNum 1 list2, checkNum 2 list2, etc.] > > then > > map (flip checknum list2) list1 > > is what you want (flip signature being :: (a -> b -> c) -> b -> a -> c) > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sat Apr 23 13:42:06 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 23 Apr 2016 15:42:06 +0200 Subject: [Haskell-beginners] Applying a function to two lists In-Reply-To: References: <571A9593.1040502@gmail.com> <20160422212640.GA24042@casa.casa> Message-ID: <20160423134206.GA1654@casa.casa> On Sat, Apr 23, 2016 at 08:50:32AM +0000, Matt Williams wrote: > Thanks a lot for this. > > Just to clarify (and ignoring the flip, which I can solve by rewriting the > checkNum function) - is this an example of currying? Example of partial application! Currying is when you have a function like: f :: (a, b) -> c and transform it to: g :: a -> b -> c Open ghci and play a bit with `curry` and `uncurry` to get the idea! From matt.williams45.mw at gmail.com Sat Apr 23 20:59:10 2016 From: matt.williams45.mw at gmail.com (Matt Williams) Date: Sat, 23 Apr 2016 21:59:10 +0100 Subject: [Haskell-beginners] Handling failed output Message-ID: <571BE21E.6050202@gmail.com> Dear All, I am trying to work out how to handle a function that might return different types of output. I assume I need to use either Maybe or Either, but I can't quite get it to work. At the moment, I have some function: checkNum3 :: Int -> Int -> (Int,Int) checkNum3 a b = if check a b then (a,b) else (a,-1) checkLists :: [Int] -> Int -> [(Int,Int)] checkLists a b = map (checkNum3 b) a checkAll3 :: [Int] -> [Int] -> [(Int,Int)] checkAll3 a b = concat (map (checkLists a) b) However, I know that checkNum3 isn't a good function - it uses setting the second element of the tuple to -1 to signal failure, which is obviously a recipe for problems later on. However, I want to return either a pair of integers, or a single integer. Any advice would be appreciated. Thanks, Matt From imantc at gmail.com Sat Apr 23 21:05:05 2016 From: imantc at gmail.com (Imants Cekusins) Date: Sat, 23 Apr 2016 23:05:05 +0200 Subject: [Haskell-beginners] Handling failed output In-Reply-To: References: <571BE21E.6050202@gmail.com> Message-ID: Hello Matt, Either Int (Int,Int) might work. Left ... by convention indicates 'other' result. -------------- next part -------------- An HTML attachment was scrubbed... URL: From newhoggy at gmail.com Sun Apr 24 13:55:08 2016 From: newhoggy at gmail.com (John Ky) Date: Sun, 24 Apr 2016 13:55:08 +0000 Subject: [Haskell-beginners] cabal install zlib failing Message-ID: Hello Haskellers, Does anyone know what to do in this situation? cabal install zlib Resolving dependencies... Notice: installing into a sandbox located at /home/ubuntu/hw-files/.cabal-sandbox/7.10.3 Downloading zlib-0.6.1.1... Configuring zlib-0.6.1.1... Failed to install zlib-0.6.1.1 Build log ( /home/ubuntu/hw-files/.cabal-sandbox/7.10.3/logs/zlib-0.6.1.1.log ): Configuring zlib-0.6.1.1... setup-Simple-Cabal-1.22.5.0-x86_64-linux-ghc-7.10.3: Missing dependency on a foreign library: * Missing (or bad) header file: zlib.h * Missing C library: z This problem can usually be solved by installing the system package that provides this library (you may need the "-dev" version). If the library is already installed but in a non-standard location then you can use the flags --extra-include-dirs= and --extra-lib-dirs= to specify where it is. If the header file does exist, it may contain errors that are caught by the C compiler at the preprocessing stage. In this case you can re-run configure with the verbosity flag -v3 to see the error messages. cabal: Error: some packages failed to install: zlib-0.6.1.1 failed during the configure step. The exception was: ExitFailure 1 This is what I have in my environment: ubuntu at box1179:~/hw-files$ dpkg -l | grep zlib ii zlib1g 1:1.2.3.4.dfsg-3ubuntu4 compression library - runtime ii zlib1g:i386 1:1.2.3.4.dfsg-3ubuntu4 compression library - runtime iU zlib1g-dev 1:1.2.8.dfsg-1ubuntu1 compression library - development And this: ubuntu at box1179:~/hw-files$ nix-env -q cabal-install-1.22.9.0 ghc-7.10.3 nix-1.11.2 zlib-1.2.8 Cheers, -John ? -------------- next part -------------- An HTML attachment was scrubbed... URL: From exitconsole at gmail.com Sun Apr 24 14:41:00 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Sun, 24 Apr 2016 16:41:00 +0200 Subject: [Haskell-beginners] Help refactor monster function In-Reply-To: References: Message-ID: >> consume f g a = foldl f a . chunk g >> chunk g = unfoldr (fmap g . (\xs -> if null xs then Nothing else Just xs)) Wow, nice. I figured there must be a better way to express that. >> gatherRoots = chunk (partition (compare `on` root)) That doesn't typecheck. I think you meant > gatherRoots = chunk $ \ l@(x:_) -> partition (\y -> root x == root y) l > P.S. You would be correct in claiming that this rewrite is too distant from > the original to be of use. My apologies if this is the case. No, this helps a lot, thanks! Reading pro Haskell like this helps me improve. It's way more advanced than what I could possibly come up with though. I'm still working my way through it. Daniel From gesh at gesh.uni.cx Sun Apr 24 17:38:37 2016 From: gesh at gesh.uni.cx (Gesh) Date: Sun, 24 Apr 2016 20:38:37 +0300 Subject: [Haskell-beginners] Help refactor monster function In-Reply-To: References: Message-ID: On April 24, 2016 5:41:00 PM GMT+03:00, "D?niel Arat?" wrote: >>> gatherRoots = chunk (partition (compare `on` root)) > >That doesn't typecheck. I think you meant >> gatherRoots = chunk $ \ l@(x:_) -> partition (\y -> root x == root y) >l > You are correct, that was an error in transcription. >> P.S. You would be correct in claiming that this rewrite is too >distant from >> the original to be of use. My apologies if this is the case. > >No, this helps a lot, thanks! Reading pro Haskell like this helps me >improve. It's way more advanced than what I could possibly come up >with though. I'm still working my way through it. I'm glad it helped. Gesh From newhoggy at gmail.com Mon Apr 25 03:41:48 2016 From: newhoggy at gmail.com (John Ky) Date: Mon, 25 Apr 2016 03:41:48 +0000 Subject: [Haskell-beginners] cabal install zlib failing In-Reply-To: References: Message-ID: Hi Haskellers, I found that this works for me: nix-shell -p zlib --run 'cabal install zlib' Cheers, -John ? On Sun, 24 Apr 2016 at 23:55 John Ky wrote: > Hello Haskellers, > > Does anyone know what to do in this situation? > > cabal install zlib > Resolving dependencies... > Notice: installing into a sandbox located at > /home/ubuntu/hw-files/.cabal-sandbox/7.10.3 > Downloading zlib-0.6.1.1... > Configuring zlib-0.6.1.1... > Failed to install zlib-0.6.1.1 > Build log ( /home/ubuntu/hw-files/.cabal-sandbox/7.10.3/logs/zlib-0.6.1.1.log ): > Configuring zlib-0.6.1.1... > setup-Simple-Cabal-1.22.5.0-x86_64-linux-ghc-7.10.3: Missing dependency on a > foreign library: > * Missing (or bad) header file: zlib.h > * Missing C library: z > This problem can usually be solved by installing the system package that > provides this library (you may need the "-dev" version). If the library is > already installed but in a non-standard location then you can use the flags > --extra-include-dirs= and --extra-lib-dirs= to specify where it is. > If the header file does exist, it may contain errors that are caught by the C > compiler at the preprocessing stage. In this case you can re-run configure > with the verbosity flag -v3 to see the error messages. > cabal: Error: some packages failed to install: > zlib-0.6.1.1 failed during the configure step. The exception was: > ExitFailure 1 > > This is what I have in my environment: > > ubuntu at box1179:~/hw-files$ dpkg -l | grep zlib > ii zlib1g 1:1.2.3.4.dfsg-3ubuntu4 compression library - runtime > ii zlib1g:i386 1:1.2.3.4.dfsg-3ubuntu4 compression library - runtime > iU zlib1g-dev 1:1.2.8.dfsg-1ubuntu1 compression library - development > > And this: > > ubuntu at box1179:~/hw-files$ nix-env -q > cabal-install-1.22.9.0 > ghc-7.10.3 > nix-1.11.2 > zlib-1.2.8 > > Cheers, > > -John > ? > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ojd2 at st-andrews.ac.uk Mon Apr 25 17:06:51 2016 From: ojd2 at st-andrews.ac.uk (Oliver Dean) Date: Mon, 25 Apr 2016 17:06:51 +0000 Subject: [Haskell-beginners] 'No such file' - ghc Parsec Package Error Message-ID: Hello All, Silly question, I cannot seem to compile an additional .hs file using the ?package parsec ?o command? It has to be something to do with my directory locations no doubt. I?ve tried numerous attempts and still no luck. I have a program called simple_parser which was compiled using the ?parser.hs' file. Now I wish to run and compile with the parsec package using the file ?parsec.hs?? Both my .hs files are located in the same folder: 8afbc4c1:HS_Parser homefolder$ ls parsec.hs parser.hi parser.hs parser.o simple_parser Then when I try the following (and I have tried many different path routes ../../ and vice versa), I get the following: 8afbc4c1:HS_Parser homefolder$ ghc -package parsec -o simple_parser [..parsec.hs parsec.hs] : can't find file: [..parsec.hs Sorry to be such a newbie! Any helpful direction would be greatly appreciated. Not sure if I am doing something wrong or my code is?? PS - Both .hs files have slightly differing lines of code (based on the Wiki Book Scheme -> Haskell tutorial). -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Mon Apr 25 18:45:09 2016 From: imantc at gmail.com (Imants Cekusins) Date: Mon, 25 Apr 2016 20:45:09 +0200 Subject: [Haskell-beginners] 'No such file' - ghc Parsec Package Error In-Reply-To: References: Message-ID: Can cabal be used to compile? -------------- next part -------------- An HTML attachment was scrubbed... URL: From joseph.d.melfi at gmail.com Mon Apr 25 19:29:29 2016 From: joseph.d.melfi at gmail.com (Joseph Melfi) Date: Mon, 25 Apr 2016 12:29:29 -0700 Subject: [Haskell-beginners] 'No such file' - ghc Parsec Package Error In-Reply-To: References: Message-ID: <571e6fc3921adc0000723cf8@polymail.io> cabal build can be used to build the binary in bin. stack can also do the build command to do this as well. Joseph Melfi On Mon, Apr 25, 2016 at 11:45 AM Imants Cekusins < mailto:Imants Cekusins > wrote: Can cabal be used to compile? _______________________________________________ Beginners mailing list mailto:Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From masonmlai at gmail.com Mon Apr 25 19:47:25 2016 From: masonmlai at gmail.com (Mason Lai) Date: Mon, 25 Apr 2016 12:47:25 -0700 Subject: [Haskell-beginners] Handling failed output In-Reply-To: References: <571BE21E.6050202@gmail.com> Message-ID: I know you're asking for a function that will either return an Int or a (Int, Int). However, in my limited experience, I haven't seen Ints used as error codes in Haskell. Typically, I see something like the following: checkNum3 :: Int -> Int -> Either String (Int,Int) checkNum3 a b = if check a b then Right (a, b) else Left "Error: something happened" Then you can use a function like (either error id) to either extract the (Int, Int) value or to raise the error with the message. The (either error id) function will look at an Either value. If it's a Left value, it will call error on that value -- so (error "Error: something happened"). If it's a Right value, it will call id on that value -- so id (a, b) which evaluates to (a, b). I usually use this setup if I lazily parse a huge file of text data, where each line has some constraint that makes the file "valid" or "invalid". I end up with a long list of Either String (Int, Int)s, and I then map (either error id) over the list. On Sat, Apr 23, 2016 at 2:05 PM, Imants Cekusins wrote: > Hello Matt, > > Either Int (Int,Int) might work. > > Left ... by convention indicates 'other' result. > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From ojd2 at st-andrews.ac.uk Tue Apr 26 12:32:14 2016 From: ojd2 at st-andrews.ac.uk (Oliver Dean) Date: Tue, 26 Apr 2016 12:32:14 +0000 Subject: [Haskell-beginners] {Disarmed} Re: 'No such file' - ghc Parsec Package Error In-Reply-To: <571e6fc3921adc0000723cf8@polymail.io> References: <571e6fc3921adc0000723cf8@polymail.io> Message-ID: Thank you for the information. Will give this a go. Should do the trick hopefully. Ollie From: Beginners on behalf of Joseph Melfi Reply-To: The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Date: Monday, 25 April 2016 20:29 To: Imants Cekusins, The Haskell-Beginners Mailing List - Discussion of primarily beginner-level topics related to Haskell Subject: {Disarmed} Re: [Haskell-beginners] 'No such file' - ghc Parsec Package Error cabal build can be used to build the binary in bin. stack can also do the build command to do this as well. Joseph Melfi On Mon, Apr 25, 2016 at 11:45 AM Imants Cekusins > > wrote: Can cabal be used to compile? _______________________________________________ Beginners mailing list Beginners at haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From masonmlai at gmail.com Tue Apr 26 23:17:02 2016 From: masonmlai at gmail.com (Mason Lai) Date: Tue, 26 Apr 2016 16:17:02 -0700 Subject: [Haskell-beginners] approximate string search Message-ID: Hi, I'm writing a Haskell program which is looking for whether or not a string (needle) exists within a larger string (haystack) given a Levenshtein distance. Note that it shouldn't calculate the Levenshtein distance between the needle and haystack. For example, needle: AAA haystack: TTTTTAATTTTT The needle would be "found" if the Levenshtein distance is set at 1, because dist("AAT", "AAA") == 1. The following almost works: distance(needle, haystack) - (len(haystack) - len(needle)) But it does not handle deletions correctly. I've previously written a program which does this approximate search in Java with the Wu-Manber extension of the Bitap, or shift-or, algorithm. The same strategy seems difficult to code up in Haskell because it's very "stateful" and involves a lot of bit-fiddling. (Maybe it's actually quite simple, but I'm not sure how I would go about doing this.) As a further complication, I'd prefer to keep the data packed as ByteStrings, as I'll be dealing with around 200 GiBs of data (split and parallelized over a cluster, but still a lot). I don't really know how to deal with ByteStrings without using the functions that come along in the ByteString module or unpacking the ByteString. I've been using the language-spelling package, which has a module which can calculate the Levenshtein distance between two ByteStrings. I see that it uses ListLike. I'm not really sure how it works, but I assume it makes ByteString an instance of ListLike, and then you have access to all of the ListLike methods? Does anyone have any advice on how I should proceed with this? I don't mind learning new things, but I don't really know what the best strategy is or where to look. -- Mason -------------- next part -------------- An HTML attachment was scrubbed... URL: From cwyang at aranetworks.com Tue Apr 26 23:53:34 2016 From: cwyang at aranetworks.com (Chul-Woong Yang) Date: Wed, 27 Apr 2016 08:53:34 +0900 Subject: [Haskell-beginners] Array update and `seq` Message-ID: Hi, all When I fold a list to update Data.Array, memory usage is very high. Consider following source, which counts occurence of each element in a list (1): import Data.Array import Data.List import Control.DeepSeq go :: [Int] -> [Int] go = elems . foldl' update (array (0,99) [(i,0) | i <- [0..99]]) where update acc x = acc // [(x, acc ! x + 1)] main = putStrLn . unwords . map show . go . concat . replicate 5000 $ [0..99] Above program uses about 350MB at heap. Memory usage is same if I try to force strictness in array update with `seq` (2) : where update acc x = let v = acc ! x + 1 a' = acc // [(x,v `seq` v)] in a' `seq` a' However, when I use `deepseq`, memory usage is gone (around 35Kbyte) (3): where update acc x = let v = acc ! x + 1 a' = acc // [(x,v `seq` v)] in a' `deepseq` a' What's the missing part in (2)? At (2), evaluation of updated array a' is forced and the value of array cell is also evaluated forcefully with `seq`. Any help would be appreciated deeply. -- Regards, Chul-Woong Yang From pearman.sm at gmail.com Wed Apr 27 00:57:43 2016 From: pearman.sm at gmail.com (shane pearman) Date: Tue, 26 Apr 2016 17:57:43 -0700 Subject: [Haskell-beginners] Feedback on Maybe+State+IO code Message-ID: I just read the M.P. Jones paper on the topic of monad transformers and have been playing a bit with some simple examples combining `Maybe` and `State` with `IO`: http://lpaste.net/6702944292505124864 I have the same "stuff" function defined 3 ways: two recursive methods, one of which takes the "maybe" function as an argument which is used to break the recursion, and a non-recursive method which is 'looped' using `iterateM_`. The functionality is that an integer is given as initial `State` and it is decremented until 0 is reached, printing each iteration and breaking by the result of the "maybe" function. I also wanted to ensure that no negative integer could enter into the `State` so the same "maybe" function is used in main to restrict entry into the "stuff" function, either using `for_` over the result or injecting the `Maybe` before the "stuff" function. The iterative calls are a little bit harder to read but the second (2) recursive call is fairly concise and readable. Basically I'm just looking for any suggestions if anything looks out of place or can be refined before I go on to do more involved error handling or logging. * There are also a couple helper functions at the bottom below "main" that I ended up not using but was wondering if they are defined somewhere. -------------- next part -------------- An HTML attachment was scrubbed... URL: From sylvain at haskus.fr Wed Apr 27 03:50:04 2016 From: sylvain at haskus.fr (Sylvain Henry) Date: Wed, 27 Apr 2016 05:50:04 +0200 Subject: [Haskell-beginners] approximate string search In-Reply-To: References: Message-ID: <5adfa2d6-a00b-ddf9-aa0a-9517bcd8b486@haskus.fr> Hi, The ListLike instance for ByteString is defined here: https://hackage.haskell.org/package/ListLike-3.1.7.1/docs/src/Data-ListLike-Instances.html The implementation of Levenshtein distance in language-spelling is here: https://hackage.haskell.org/package/language-spelling-0.3.2/docs/src/Language-Distance.html#levenshtein It seems to use only O(1) operations on the Bytestring: length and index (!!). It uses an unboxed mutable vector in the ST monad. It is specialized for ByteString. So I think it should be quite efficient already. If you want you can use the same approach to implement the other algorithm, with Data.Bits for the bit-fiddling: https://hackage.haskell.org/package/base-4.8.2.0/docs/Data-Bits.html Cheers, Sylvain On 27/04/2016 01:17, Mason Lai wrote: > Hi, > > I'm writing a Haskell program which is looking for whether or not a > string (needle) exists within a larger string (haystack) given a > Levenshtein distance. Note that it shouldn't calculate the Levenshtein > distance between the needle and haystack. For example, > > needle: AAA > haystack: TTTTTAATTTTT > > The needle would be "found" if the Levenshtein distance is set at 1, > because dist("AAT", "AAA") == 1. > > The following almost works: > > distance(needle, haystack) - (len(haystack) - len(needle)) > > But it does not handle deletions correctly. > > I've previously written a program which does this approximate search > in Java with the Wu-Manber extension of the Bitap, or shift-or, > algorithm. The same strategy seems difficult to code up in Haskell > because it's very "stateful" and involves a lot of bit-fiddling. > (Maybe it's actually quite simple, but I'm not sure how I would go > about doing this.) > > As a further complication, I'd prefer to keep the data packed as > ByteStrings, as I'll be dealing with around 200 GiBs of data (split > and parallelized over a cluster, but still a lot). I don't really know > how to deal with ByteStrings without using the functions that come > along in the ByteString module or unpacking the ByteString. > > I've been using the language-spelling package, which has a module > which can calculate the Levenshtein distance between two ByteStrings. > I see that it uses ListLike. I'm not really sure how it works, but I > assume it makes ByteString an instance of ListLike, and then you have > access to all of the ListLike methods? > > Does anyone have any advice on how I should proceed with this? I don't > mind learning new things, but I don't really know what the best > strategy is or where to look. > > -- Mason > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners -------------- next part -------------- An HTML attachment was scrubbed... URL: From wangbj at gmail.com Wed Apr 27 06:12:02 2016 From: wangbj at gmail.com (Baojun Wang) Date: Wed, 27 Apr 2016 06:12:02 +0000 Subject: [Haskell-beginners] Array update and `seq` In-Reply-To: References: Message-ID: Immutable array update creates a new array for each call to update (//), thus if you need frequent update, it is recommended to use MArray (such as ST or IO variant) instead. i.e: the loop can be rewrite as: update_ u x = readArray u x >>= \old -> writeArray u x (1+old) array100 = runSTUArray $ do stu <- newArray (0, 99) 0 :: ST s (STUArray s Int Int) mapM_ (update_ stu) (concat . replicate 5000 $ [0..99]) return stu - baojun On Tue, Apr 26, 2016 at 4:53 PM Chul-Woong Yang wrote: > Hi, all > > When I fold a list to update Data.Array, > memory usage is very high. > Consider following source, which counts occurence of > each element in a list (1): > > import Data.Array > import Data.List > import Control.DeepSeq > go :: [Int] -> [Int] > go = elems . foldl' update (array (0,99) [(i,0) | i <- [0..99]]) > where update acc x = acc // [(x, acc ! x + 1)] > main = putStrLn . unwords . map show . go . concat . > replicate 5000 $ [0..99] > > Above program uses about 350MB at heap. > Memory usage is same if I try to force strictness in array update > with `seq` (2) : > > where update acc x = let v = acc ! x + 1 > a' = acc // [(x,v `seq` v)] > in a' `seq` a' > > However, when I use `deepseq`, memory usage is gone > (around 35Kbyte) (3): > > where update acc x = let v = acc ! x + 1 > a' = acc // [(x,v `seq` v)] > in a' `deepseq` a' > > What's the missing part in (2)? At (2), evaluation of > updated array a' is forced and the value of array cell > is also evaluated forcefully with `seq`. > > Any help would be appreciated deeply. > -- > Regards, > Chul-Woong Yang > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From cwyang at aranetworks.com Wed Apr 27 06:36:07 2016 From: cwyang at aranetworks.com (Chul-Woong Yang) Date: Wed, 27 Apr 2016 15:36:07 +0900 Subject: [Haskell-beginners] Array update and `seq` In-Reply-To: References: Message-ID: Thank you for your answer. I'll look into MArray. However, I want to know whether `seq` forces evaluation of array update (//) or not. My prior experimen shows that `deepseq` forces evaluation while `seq` does not force. Is it right? And, is there no way to force evaluation of array update with `seq`? 2016-04-27 15:12 GMT+09:00 Baojun Wang : > Immutable array update creates a new array for each call to update (//), > thus if you need frequent update, it is recommended to use MArray (such as > ST or IO variant) instead. > > i.e: the loop can be rewrite as: > > update_ u x = readArray u x >>= \old -> writeArray u x (1+old) > array100 = runSTUArray $ do > stu <- newArray (0, 99) 0 :: ST s (STUArray s Int Int) > mapM_ (update_ stu) (concat . replicate 5000 $ [0..99]) > return stu > > - baojun > > On Tue, Apr 26, 2016 at 4:53 PM Chul-Woong Yang > wrote: >> >> Hi, all >> >> When I fold a list to update Data.Array, >> memory usage is very high. >> Consider following source, which counts occurence of >> each element in a list (1): >> >> import Data.Array >> import Data.List >> import Control.DeepSeq >> go :: [Int] -> [Int] >> go = elems . foldl' update (array (0,99) [(i,0) | i <- [0..99]]) >> where update acc x = acc // [(x, acc ! x + 1)] >> main = putStrLn . unwords . map show . go . concat . >> replicate 5000 $ [0..99] >> >> Above program uses about 350MB at heap. >> Memory usage is same if I try to force strictness in array update >> with `seq` (2) : >> >> where update acc x = let v = acc ! x + 1 >> a' = acc // [(x,v `seq` v)] >> in a' `seq` a' >> >> However, when I use `deepseq`, memory usage is gone >> (around 35Kbyte) (3): >> >> where update acc x = let v = acc ! x + 1 >> a' = acc // [(x,v `seq` v)] >> in a' `deepseq` a' >> >> What's the missing part in (2)? At (2), evaluation of >> updated array a' is forced and the value of array cell >> is also evaluated forcefully with `seq`. >> >> Any help would be appreciated deeply. >> -- >> Regards, >> Chul-Woong Yang >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From wangbj at gmail.com Wed Apr 27 06:43:13 2016 From: wangbj at gmail.com (Baojun Wang) Date: Wed, 27 Apr 2016 06:43:13 +0000 Subject: [Haskell-beginners] Array update and `seq` In-Reply-To: References: Message-ID: seq only force to WHNF (https://wiki.haskell.org/Weak_head_normal_form), while deepseq could force elements in the data structure (hence the name) list1 :: [Int] list1 = [undefined] list1' = length (list1 `seq` list1) -- OK list1'' = length (list1 `deepseq` list1) -- error I'd expect something similar happened in IArray. On Tue, Apr 26, 2016 at 11:36 PM Chul-Woong Yang wrote: > Thank you for your answer. > I'll look into MArray. > > However, I want to know whether `seq` forces evaluation > of array update (//) or not. > My prior experimen shows that `deepseq` forces evaluation > while `seq` does not force. Is it right? > And, is there no way to force evaluation of array update > with `seq`? > > 2016-04-27 15:12 GMT+09:00 Baojun Wang : > > Immutable array update creates a new array for each call to update (//), > > thus if you need frequent update, it is recommended to use MArray (such > as > > ST or IO variant) instead. > > > > i.e: the loop can be rewrite as: > > > > update_ u x = readArray u x >>= \old -> writeArray u x (1+old) > > array100 = runSTUArray $ do > > stu <- newArray (0, 99) 0 :: ST s (STUArray s Int Int) > > mapM_ (update_ stu) (concat . replicate 5000 $ [0..99]) > > return stu > > > > - baojun > > > > On Tue, Apr 26, 2016 at 4:53 PM Chul-Woong Yang > > wrote: > >> > >> Hi, all > >> > >> When I fold a list to update Data.Array, > >> memory usage is very high. > >> Consider following source, which counts occurence of > >> each element in a list (1): > >> > >> import Data.Array > >> import Data.List > >> import Control.DeepSeq > >> go :: [Int] -> [Int] > >> go = elems . foldl' update (array (0,99) [(i,0) | i <- [0..99]]) > >> where update acc x = acc // [(x, acc ! x + 1)] > >> main = putStrLn . unwords . map show . go . concat . > >> replicate 5000 $ [0..99] > >> > >> Above program uses about 350MB at heap. > >> Memory usage is same if I try to force strictness in array update > >> with `seq` (2) : > >> > >> where update acc x = let v = acc ! x + 1 > >> a' = acc // [(x,v `seq` v)] > >> in a' `seq` a' > >> > >> However, when I use `deepseq`, memory usage is gone > >> (around 35Kbyte) (3): > >> > >> where update acc x = let v = acc ! x + 1 > >> a' = acc // [(x,v `seq` v)] > >> in a' `deepseq` a' > >> > >> What's the missing part in (2)? At (2), evaluation of > >> updated array a' is forced and the value of array cell > >> is also evaluated forcefully with `seq`. > >> > >> Any help would be appreciated deeply. > >> -- > >> Regards, > >> Chul-Woong Yang > >> _______________________________________________ > >> Beginners mailing list > >> Beginners at haskell.org > >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 29 09:14:15 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 11:14:15 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc Message-ID: Hi, well aware it's trivial so I'll be terse: do we have?: > fmap = <*> . pure So we could write for example > liftA2 f fa fb = f <$> fa <*> fb this way?: > liftA2 f fa fb = pure f <*> fa <*> fb <*> Incidentally, do we have?: > liftA == liftM == fmap Thanks! -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 29 09:20:15 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 11:20:15 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: Oh, and by the way, is it enough then to create an instance of Applicative or Monad to automatically get an instance of the respective superclasses? And the generalization for any superclass/subclass? Would be great... If not why so? -------------- next part -------------- An HTML attachment was scrubbed... URL: From exitconsole at gmail.com Fri Apr 29 09:23:23 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Fri, 29 Apr 2016 11:23:23 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: Applicative is actually a *sub*class of Functor. :) > Hi, well aware it's trivial so I'll be terse: do we have?: >> fmap = <*> . pure That's right. You have to wrap the "<*>" in parantheses though. > So we could write for example >> liftA2 f fa fb = f <$> fa <*> fb > this way?: >> liftA2 f fa fb = pure f <*> fa <*> fb <*> You don't need the last "<*>", but other than that yeah, that's exactly right. > Incidentally, do we have?: >> liftA == liftM == fmap Correct. The Prelude defines liftM in terms of do notation though for reasons that escape me. But it's basically just fmap. Daniel From exitconsole at gmail.com Fri Apr 29 09:31:56 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Fri, 29 Apr 2016 11:31:56 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: > Oh, and by the way, is it enough then to create an instance of Applicative > or Monad to automatically get an instance of the respective superclasses? > And the generalization for any superclass/subclass? Would be great... If > not why so? I think the latest GHC should be able to give you the superclass instances like you said. Before GHC 7.10 the class hierarchy was a bit disjointed: a Monad was not necessarily an Applicative (even though it should be). https://wiki.haskell.org/Functor-Applicative-Monad_Proposal Daniel From silent.leaf0 at gmail.com Fri Apr 29 10:16:57 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 12:16:57 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: Yes true, subclass, mixed up the terms. ^^ Ah true, I heard about this D?niel. But then it would be generalized to all classes, or just those three ones? Anyway, trying the same with Applicative and its *sub*class Monad: > pure = return > (<*>) :: Monad m => m (a -> b) -> m a -> m b > mf <*> ma = let mg = mf >>= \f -> return (return . f) in mg >>= \g -> (ma >>= g) As: > f :: a -> b > return . f :: Monad m => a -> m b > mg :: Monad m => m (a -> m b) Is there an easier solution? It's easy enough, but not as trivial as for Applicative => Functor. Which leads me to one question I have for a long now. I haven't found my answer, but perhaps did I not search at the right place... Why do we write constraints like that: > Functor f => (a -> b) -> f a -> f b or: > Functor f => Applicative f I'm far from an expert in Math, but I'm used to reading (=>) as an implication, but maybe is it completely different? At any rate, if it were an implication, i'd expect it to be written for example (Applicative f => Functor f), to denote maybe that anything being an Applicative should also be a functor (everything in the first is (= must be, in declarative terms) in the second). I mean if we see a class as a set of types (can we btw?) then if A(pplicative) is superclass of M(onad), A is a superset of M, because (m in M) => (m in A), hence the direction of the implication arrow, Monad => Applicative. Same thing for types of function (and other values), eg (a -> b => Num a), the type of the function would imply some constraint, which would therefore imply that no type that doesn't respect the implied term (constraint) can pretend to be "part" of the type of the function/value. Maybe I'm misinterpreting the purpose or meaning, but I still wonder what is the actual meaning then of those (=>) arrows as they don't *seem* to be implications in the mathematical meaning I'd intuitively imagine. Thanks both for your answers! Le vendredi 29 avril 2016, D?niel Arat? a ?crit : >> Oh, and by the way, is it enough then to create an instance of Applicative >> or Monad to automatically get an instance of the respective superclasses? >> And the generalization for any superclass/subclass? Would be great... If >> not why so? > > I think the latest GHC should be able to give you the superclass > instances like you said. Before GHC 7.10 the class hierarchy was a bit > disjointed: a Monad was not necessarily an Applicative (even though it > should be). > https://wiki.haskell.org/Functor-Applicative-Monad_Proposal > > Daniel > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 29 10:18:15 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 12:18:15 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: Lol, well I said "thanks both" but actually there's only one person. Don't mind me I'm drunk. Le vendredi 29 avril 2016, Silent Leaf a ?crit : > Yes true, subclass, mixed up the terms. ^^ > > Ah true, I heard about this D?niel. But then it would be generalized to all classes, or just those three ones? > > Anyway, trying the same with Applicative and its *sub*class Monad: >> pure = return >> (<*>) :: Monad m => m (a -> b) -> m a -> m b >> mf <*> ma = > let mg = mf >>= \f -> return (return . f) > in mg >>= \g -> (ma >>= g) > As: >> f :: a -> b >> return . f :: Monad m => a -> m b >> mg :: Monad m => m (a -> m b) > > Is there an easier solution? It's easy enough, but not as trivial as for Applicative => Functor. > > Which leads me to one question I have for a long now. I haven't found my answer, but perhaps did I not search at the right place... > > Why do we write constraints like that: >> Functor f => (a -> b) -> f a -> f b > or: >> Functor f => Applicative f > I'm far from an expert in Math, but I'm used to reading (=>) as an implication, but maybe is it completely different? At any rate, if it were an implication, i'd expect it to be written for example (Applicative f => Functor f), to denote maybe that anything being an Applicative should also be a functor (everything in the first is (= must be, in declarative terms) in the second). I mean if we see a class as a set of types (can we btw?) then if A(pplicative) is superclass of M(onad), A is a superset of M, because (m in M) => (m in A), hence the direction of the implication arrow, Monad => Applicative. > > Same thing for types of function (and other values), eg (a -> b => Num a), the type of the function would imply some constraint, which would therefore imply that no type that doesn't respect the implied term (constraint) can pretend to be "part" of the type of the function/value. > > Maybe I'm misinterpreting the purpose or meaning, but I still wonder what is the actual meaning then of those (=>) arrows as they don't *seem* to be implications in the mathematical meaning I'd intuitively imagine. > > Thanks both for your answers! > > Le vendredi 29 avril 2016, D?niel Arat? a ?crit : >>> Oh, and by the way, is it enough then to create an instance of Applicative >>> or Monad to automatically get an instance of the respective superclasses? >>> And the generalization for any superclass/subclass? Would be great... If >>> not why so? >> >> I think the latest GHC should be able to give you the superclass >> instances like you said. Before GHC 7.10 the class hierarchy was a bit >> disjointed: a Monad was not necessarily an Applicative (even though it >> should be). >> https://wiki.haskell.org/Functor-Applicative-Monad_Proposal >> >> Daniel >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From exitconsole at gmail.com Fri Apr 29 10:51:43 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Fri, 29 Apr 2016 12:51:43 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: For a drunk person you're getting these equivalences surprisingly right. :) >> Ah true, I heard about this D?niel. But then it would be generalized to > all classes, or just those three ones? It would make sense for it to work for any class hierarchy, but honestly I just don't know and I've got an old GHC on my laptop so I can't check. Maybe someone who actually knows will come along and enlighten us. ?\_(?)_/? >> Anyway, trying the same with Applicative and its *sub*class Monad: >>> pure = return That's right. >>> mf <*> ma = >> let mg = mf >>= \f -> return (return . f) >> in mg >>= \g -> (ma >>= g) >> Is there an easier solution? It's easy enough, but not as trivial as for > Applicative => Functor. I've got (an alpha-equivalent of) the following on a scrap piece of paper: mf <*> mx = mf >>= \f -> mx >>= \x -> return . f $ x It reads nice and fluent. >> Why do we write constraints like that: >>> Functor f => (a -> b) -> f a -> f b >> or: >>> Functor f => Applicative f That's a very good question. I agree that it would make a bit more sense if the arrows were reversed. I think it helps to read "Functor f => Applicative f where ..." as "if you've got a Functor then you can have an Applicative if you just implement these functions" as opposed to "if f is a Functor that implies that f is an Applicative" (wrong). Daniel From silent.leaf0 at gmail.com Fri Apr 29 12:43:08 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 14:43:08 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: I didn't get this version of ghc already existed! it seems I have it, i'll thus check all that ASAP. Technical question: class constraints should not be written in definitions of instances too, right? Wouldn't be "parametric" anymore and all: > instance Applicative Maybe => Monad Maybe where ... I don't think I've ever seen something like that but I'm asking just in case, esp as it might precisely be the way to write implied superclasses in the latest ghc(?) Indeed, your definition of (<*>) in terms of monads is much simpler to read! I think I was too much centered on finding a way to replicate the types, to more simply find a way to replicate directly what does the function. Obviously, my def can become yours by some simple operations. Mine: > let left = mf >>= \f -> return $ return . f > right = \mg -> ma >>= mg > in left >>= right Here with mg = return . f eventually (when called). Two things bound together, the wrapped value of left (== return.f) being the parameter of the function right. It's clear that the wrapped result is just wrapped so it can be unwrapped immediately after. Might as well not wrap it at all in the first place, and do everything in the first bind operation: > mf >>= \f -> let mg = return . f in ma >>= mg and of course, (mg == \a -> return $ f a). Anyway, yeah that's also how I read (=>) arrows, obviously, how else to do? ^^ It's just, as most of the syntax and terminology of haskell is based on what looks like very solid math roots, I imagined the syntax for constraints was also justified mathematically somehow. Le vendredi 29 avril 2016, D?niel Arat? a ?crit : > For a drunk person you're getting these equivalences surprisingly right. :) > >>> Ah true, I heard about this D?niel. But then it would be generalized to >> all classes, or just those three ones? > > It would make sense for it to work for any class hierarchy, but > honestly I just don't know and I've got an old GHC on my laptop so I > can't check. Maybe someone who actually knows will come along and > enlighten us. ?\_(?)_/? > >>> Anyway, trying the same with Applicative and its *sub*class Monad: >>>> pure = return > > That's right. > >>>> mf <*> ma = >>> let mg = mf >>= \f -> return (return . f) >>> in mg >>= \g -> (ma >>= g) > >>> Is there an easier solution? It's easy enough, but not as trivial as for >> Applicative => Functor. > > I've got (an alpha-equivalent of) the following on a scrap piece of paper: > mf <*> mx = mf >>= \f -> mx >>= \x -> return . f $ x > > It reads nice and fluent. > >>> Why do we write constraints like that: >>>> Functor f => (a -> b) -> f a -> f b >>> or: >>>> Functor f => Applicative f > > That's a very good question. I agree that it would make a bit more > sense if the arrows were reversed. > I think it helps to read > "Functor f => Applicative f where ..." > as > "if you've got a Functor then you can have an Applicative if you just > implement these functions" > as opposed to > "if f is a Functor that implies that f is an Applicative" (wrong). > > Daniel > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From silent.leaf0 at gmail.com Fri Apr 29 12:54:02 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 14:54:02 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: Well, I think it didn't work. From: > data Foo a = Foo a > instance Monad Foo where > return = Foo > (Foo a) >>= f = f a I got: No instance for (Applicative Foo) arising from the superclasses of an instance declaration In the instance declaration for ?Monad Foo? Doesn't seem to build 'em automatically. :( Le vendredi 29 avril 2016, Silent Leaf a ?crit : > I didn't get this version of ghc already existed! it seems I have it, i'll thus check all that ASAP. > Technical question: class constraints should not be written in definitions of instances too, right? Wouldn't be "parametric" anymore and all: >> instance Applicative Maybe => Monad Maybe where ... > I don't think I've ever seen something like that but I'm asking just in case, esp as it might precisely be the way to write implied superclasses in the latest ghc(?) > > Indeed, your definition of (<*>) in terms of monads is much simpler to read! I think I was too much centered on finding a way to replicate the types, to more simply find a way to replicate directly what does the function. > Obviously, my def can become yours by some simple operations. > Mine: >> let left = mf >>= \f -> return $ return . f >> right = \mg -> ma >>= mg >> in left >>= right > Here with mg = return . f eventually (when called). > > Two things bound together, the wrapped value of left (== return.f) being the parameter of the function right. It's clear that the wrapped result is just wrapped so it can be unwrapped immediately after. Might as well not wrap it at all in the first place, and do everything in the first bind operation: >> mf >>= \f -> let mg = return . f in ma >>= mg > and of course, (mg == \a -> return $ f a). > > Anyway, yeah that's also how I read (=>) arrows, obviously, how else to do? ^^ It's just, as most of the syntax and terminology of haskell is based on what looks like very solid math roots, I imagined the syntax for constraints was also justified mathematically somehow. > > Le vendredi 29 avril 2016, D?niel Arat? a ?crit : >> For a drunk person you're getting these equivalences surprisingly right. :) >> >>>> Ah true, I heard about this D?niel. But then it would be generalized to >>> all classes, or just those three ones? >> >> It would make sense for it to work for any class hierarchy, but >> honestly I just don't know and I've got an old GHC on my laptop so I >> can't check. Maybe someone who actually knows will come along and >> enlighten us. ?\_(?)_/? >> >>>> Anyway, trying the same with Applicative and its *sub*class Monad: >>>>> pure = return >> >> That's right. >> >>>>> mf <*> ma = >>>> let mg = mf >>= \f -> return (return . f) >>>> in mg >>= \g -> (ma >>= g) >> >>>> Is there an easier solution? It's easy enough, but not as trivial as for >>> Applicative => Functor. >> >> I've got (an alpha-equivalent of) the following on a scrap piece of paper: >> mf <*> mx = mf >>= \f -> mx >>= \x -> return . f $ x >> >> It reads nice and fluent. >> >>>> Why do we write constraints like that: >>>>> Functor f => (a -> b) -> f a -> f b >>>> or: >>>>> Functor f => Applicative f >> >> That's a very good question. I agree that it would make a bit more >> sense if the arrows were reversed. >> I think it helps to read >> "Functor f => Applicative f where ..." >> as >> "if you've got a Functor then you can have an Applicative if you just >> implement these functions" >> as opposed to >> "if f is a Functor that implies that f is an Applicative" (wrong). >> >> Daniel >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> -------------- next part -------------- An HTML attachment was scrubbed... URL: From bergey at alum.mit.edu Fri Apr 29 13:03:20 2016 From: bergey at alum.mit.edu (Daniel Bergey) Date: Fri, 29 Apr 2016 09:03:20 -0400 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: Message-ID: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> My understanding is that both the -> and => arrows represent implication, in the Curry-Howard view of types as proofs. Maybe someone else can provide better examples of translating back and forth this way. I'd interpret fmap in English as something like: `fmap g fa` is a proof that for all f, g, fa, given that f is a Functor and given g is a function from a to b, and given fa has type `f a`, there is a value of type `f b`. You can shuffle things around in other ways, like: ... for all f, g, ... there is a function from `f a` to `f b`. The => in instance definitions plays a similar role: Num a => Num (V2 a) where ... means: For all types a, given that a is a Num, it follows that `V2 a` is a Num (as proven by the following definitions ...) A class definition with a superclass requirement means something like: Functor f => Applicative f where ... You can show that a type f is an Applicative by providing a proof (type class instance) that f is a Functor, and proofs (definitions) of the following class functions. I hope this helps, and that I've gotten it right. bergey On 2016-04-29 at 06:16, Silent Leaf wrote: > Which leads me to one question I have for a long now. I haven't found my answer, but perhaps did I not search at the right place... > > Why do we write constraints like that: >> Functor f => (a -> b) -> f a -> f b > or: >> Functor f => Applicative f > I'm far from an expert in Math, but I'm used to reading (=>) as an implication, but maybe is it completely different? At any rate, if > it were an implication, i'd expect it to be written for example (Applicative f => Functor f), to denote maybe that anything being an > Applicative should also be a functor (everything in the first is (= must be, in declarative terms) in the second). I mean if we see a > class as a set of types (can we btw?) then if A(pplicative) is superclass of M(onad), A is a superset of M, because (m in M) => (m in > A), hence the direction of the implication arrow, Monad => Applicative. > > Same thing for types of function (and other values), eg (a -> b => Num a), the type of the function would imply some constraint, which > would therefore imply that no type that doesn't respect the implied term (constraint) can pretend to be "part" of the type of the > function/value. > > Maybe I'm misinterpreting the purpose or meaning, but I still wonder what is the actual meaning then of those (=>) arrows as they > don't *seem* to be implications in the mathematical meaning I'd intuitively imagine. From exitconsole at gmail.com Fri Apr 29 15:44:44 2016 From: exitconsole at gmail.com (=?UTF-8?B?RMOhbmllbCBBcmF0w7M=?=) Date: Fri, 29 Apr 2016 17:44:44 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> References: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: Excellent answer. I kind of suspected the same but I couldn't quite find an appropriate translation for "=>". It's not really implication though. At least not in the same sense as "->". :( On 29/04/2016, Daniel Bergey wrote: > My understanding is that both the -> and => arrows represent > implication, in the Curry-Howard view of types as proofs. Maybe someone > else can provide better examples of translating back and forth this way. (snip) > A class definition with a superclass requirement means something like: > > Functor f => Applicative f where ... > > You can show that a type f is an Applicative by providing a proof (type > class instance) that f is a Functor, and proofs (definitions) of the > following class functions. > > I hope this helps, and that I've gotten it right. > > bergey From silent.leaf0 at gmail.com Fri Apr 29 17:18:23 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Fri, 29 Apr 2016 19:18:23 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: I'm very interested in your definition of (->) based on the idea of implication? -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Sat Apr 30 03:58:18 2016 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Fri, 29 Apr 2016 20:58:18 -0700 Subject: [Haskell-beginners] audio generation Message-ID: I'm writing a program that will use functions to generate audio. The Haskell code will write the audio samples to disk---no need for real time playback. I see some useful libraries for writing audio files. My question concerns efficiency when generating several million to 20 million samples (or even many times more than that if I use high-resolution sampling rates). They can be generated one at a time in sequence, so there's no need to occupy a lot of memory or postpone thunk evaluation. I'm going to need efficient disk writing. Note that I may need some pseudorandom numbers in my calculations, so I might want to calculate samples by state monadic computations to carry the generator state. What is my general strategy going to be for memory and time efficiency? I am pretty confused by Haskell "strictness" and normal head form and all that, which often doesn't seem to be very strict. Or bang patterns, etc. Is it going to be simple to understand what I need? Dennis -------------- next part -------------- An HTML attachment was scrubbed... URL: From jeffbrown.the at gmail.com Sat Apr 30 05:05:34 2016 From: jeffbrown.the at gmail.com (Jeffrey Brown) Date: Fri, 29 Apr 2016 22:05:34 -0700 Subject: [Haskell-beginners] audio generation In-Reply-To: References: Message-ID: Interesting question! I don't know but I'm excited to read the responses. If you don't find an answer here, this question seems to me easily difficult enough to be appropriate on haskell cafe. On Fri, Apr 29, 2016 at 8:58 PM, Dennis Raddle wrote: > I'm writing a program that will use functions to generate audio. The > Haskell code will write the audio samples to disk---no need for real time > playback. I see some useful libraries for writing audio files. > > My question concerns efficiency when generating several million to 20 > million samples (or even many times more than that if I use high-resolution > sampling rates). They can be generated one at a time in sequence, so > there's no need to occupy a lot of memory or postpone thunk evaluation. I'm > going to need efficient disk writing. Note that I may need some > pseudorandom numbers in my calculations, so I might want to calculate > samples by state monadic computations to carry the generator state. What is > my general strategy going to be for memory and time efficiency? I am pretty > confused by Haskell "strictness" and normal head form and all that, which > often doesn't seem to be very strict. Or bang patterns, etc. Is it going to > be simple to understand what I need? > > Dennis > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > -- Jeffrey Benjamin Brown -------------- next part -------------- An HTML attachment was scrubbed... URL: From dennis.raddle at gmail.com Sat Apr 30 09:31:26 2016 From: dennis.raddle at gmail.com (Dennis Raddle) Date: Sat, 30 Apr 2016 02:31:26 -0700 Subject: [Haskell-beginners] audio generation In-Reply-To: References: Message-ID: Oh a related question is---do any of the linear algebra packages for Haskell use hardware acceleration for vector arithmetic? I have a Windows PC with a gamer-class video card, so maybe I could speed things up manyfold. -------------- next part -------------- An HTML attachment was scrubbed... URL: From anfelor at posteo.de Sat Apr 30 12:18:20 2016 From: anfelor at posteo.de (Anton Felix Lorenzen) Date: Sat, 30 Apr 2016 14:18:20 +0200 Subject: [Haskell-beginners] audio generation In-Reply-To: References: Message-ID: <5724A28C.9090705@posteo.de> AFAIK, graphic card programming is usually done with accelerate. Packages that depend on accelerate can be found here: http://packdeps.haskellers.com/reverse/accelerate From bergey at alum.mit.edu Sat Apr 30 18:00:11 2016 From: bergey at alum.mit.edu (Daniel Bergey) Date: Sat, 30 Apr 2016 14:00:11 -0400 Subject: [Haskell-beginners] audio generation In-Reply-To: References: Message-ID: <878tzvrn84.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> The entire topic of space use in Haskell is not simple, but the part you need here may be. As long as GHC can tell that values already written to disk may be garbage collected, memory use is quite reasonable. For example, here's a short program that prints a long-ish list: xs :: [Double] xs = map cos [1..1e7] main :: IO () main = traverse_ print $ map sin xs It runs in constant space, of less than 1 MB. (I ran it on a few smaller cases to confirm that max residency stays the same order of magnitude.) Note the difference between "bytes allocated" and "total memory in use". $ ./laziness +RTS -sstderr > /dev/null 181,493,398,808 bytes allocated in the heap 414,623,400 bytes copied during GC 131,736 bytes maximum residency (2 sample(s)) 23,520 bytes maximum slop 1 MB total memory in use (0 MB lost due to fragmentation) This next program generates random numbers. You could use the State monad; here I've just used the infinite list generator in System.Random. main = do g <- newStdGen let xs = take 100000 (randoms g) :: [Int] traverse_ print xs This one also runs in constant space: $ ./.cabal-sandbox/bin/lazyRandom +RTS -sstderr > /dev/null 380,128,240 bytes allocated in the heap 238,472 bytes copied during GC 44,312 bytes maximum residency (2 sample(s)) 21,224 bytes maximum slop 1 MB total memory in use (0 MB lost due to fragmentation) Based on these tests, I'd recommend trying to structure your program as a map or fold over a (lazy) list. If that structure makes sense for your problem, I'd expect managing memory usage to be as simple as the cases above. I expect that memory usage will be constant in the number of samples, although higher than my examples because each sample is bigger than the Int or Double I used. Let me know if you want me to elaborate on any of this. bergey On 2016-04-29 at 23:58, Dennis Raddle wrote: > I'm writing a program that will use functions to generate audio. The Haskell code will > write the audio samples to disk---no need for real time playback. I see some useful > libraries for writing audio files.? > > My question concerns efficiency when generating several million to 20 million samples > (or even many times more than that if I use high-resolution sampling rates). They can be > generated one at a time in sequence, so there's no need to occupy a lot of memory or > postpone thunk evaluation. I'm going to need efficient disk writing. Note that I may > need some pseudorandom numbers in my calculations, so I might want to calculate samples > by state monadic computations to carry the generator state. What is my general strategy > going to be for memory and time efficiency? I am pretty confused by Haskell "strictness" > and normal head form and all that, which often doesn't seem to be very strict. Or bang > patterns, etc. Is it going to be simple to understand what I need?? > > Dennis > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From silent.leaf0 at gmail.com Sat Apr 30 19:14:03 2016 From: silent.leaf0 at gmail.com (Silent Leaf) Date: Sat, 30 Apr 2016 21:14:03 +0200 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: I think I got what exactly was the change of ghc 7.10. basically it only adds a constraint Applicative on the Monad class, and same with Functor/Applicative. it doesn't automatically write implied instances, but just forces one to actually write said instances of those superclasses. In short you can't anymore make monads without making Applicatives, "beforehand" (even though order is not important). In my opinion it's pretty shitty. I totally agree that it's (partially) more mathematically correct, and that's great. yet in my opinion, given superclasses can always be derived from their subclasses, it should be mathematically automatic to prove superclass instances by proving any subclass thereof. Otherwise it's forcing the programmer to do even more possibly-useless work (we don't always need applicative and functors for every use of a new monad, do we?) without gaining anything in return but a very abstract idea of "correctness". in short i think if they wanted mathematical correctness they should have added automatic instanciation of superclasses, with possibility to override the default definitions, like they do so with some superfluous methods. Not that write functors or applicative functor instances is actually heavywork, of course, thankfully. I kinda wonder, can we define Applicative methods in function of Monad methods, even though those latter can only be type-valid if the Applicative instance is already created and checked? or maybe we can write a class-neutral version (without constraints)? Say something like that: > -------- version one, with constraints > mkAp :: (Monad m, Applicative m) => m (a -> b) -> m a -> m b > mkAp mf ma = mf >>= \f -> ma >>= \a -> return $ f a > -- (not entirely sure on the necessary constraints of this type signature...) > instance Functor f => Applicative f where > <*> = mkAp > -- the value is automatically different depending on the instance right? > pure = return course, I'm pretty sure mkAp == ap, aka the monad equivalent of (<*>) is automatically defined at instanciation of the monad. But i think to remember it uses fmap, and in theory the idea is that neither instances of Functor or Applicative would yet exist. All depends on the possibility to define a superclass instance in terms of a subclass instance. > -------- version two, without class -- can we use type constructors in signature without classes? > mkAp :: (**signature of bind**) -> (a -> m a) -> (( m (a -> b) -> m a -> m b )) > mkAp bind return mf ma = ... -- defined in terms of those given class-independent functions I'mma check myself but if it fails i wonder if anyone knows a way around? -------------- next part -------------- An HTML attachment was scrubbed... URL: From bergey at alum.mit.edu Sat Apr 30 21:18:44 2016 From: bergey at alum.mit.edu (Daniel Bergey) Date: Sat, 30 Apr 2016 17:18:44 -0400 Subject: [Haskell-beginners] Trying to prove Applicative is superclass of Functor, etc In-Reply-To: References: <87inz0sh2f.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> Message-ID: <8760uyssln.fsf@chladni.i-did-not-set--mail-host-address--so-tickle-me> On 2016-04-30 at 15:14, Silent Leaf wrote: > I think I got what exactly was the change of ghc 7.10. basically it only adds a > constraint Applicative on the Monad class, and same with > Functor/Applicative. 7.10 adds the constraint on the Monad class. Prior to 7.10, both Monads and Applicatives already needed to be Functors. > Otherwise it's forcing the programmer to do even more possibly-useless > work (we don't always need applicative and functors for every use of a > new monad, do we?) The practical advantage comes when I want to write some code that is generic over Monads. If I can't assume that every Monad is Applicative, my choices are: 1) Write (Applicative m, Monad m) =>, and not work for those Monads 2) Write `ap` everywhere I mean <*>, which for some instances is less efficient 3) Write two versions, one like (1) and one like (2) None of these are very appealing, and orphan instances are a pain, so there's already strong social pressure that any Monad instance on Hackage should have the corresponding Applicative instance defined. > in short i think if they wanted mathematical correctness they should > have added automatic instanciation of superclasses, with possibility > to override the default definitions, like they do so with some > superfluous methods. Several ways of automatically defining superclasses were discussed as part of the AMP changes. Maybe we'll get one in some future GHC. I don't know the details, but some of the discussion: https://ghc.haskell.org/trac/ghc/wiki/IntrinsicSuperclasses https://ghc.haskell.org/trac/ghc/wiki/DefaultSuperclassInstances https://ghc.haskell.org/trac/ghc/wiki/InstanceTemplates > Not that write functors or applicative functor instances is actually heavywork, of > course, thankfully. You know that if the instances are all in the same module, you can use the Monad functions, right? So the extra work is just pasting in: instance Functor m where fmap = liftM instance Applicative m where pure = return (<*>) = ap