From ovidiudeac at gmail.com Mon Dec 12 17:52:17 2016 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Mon, 12 Dec 2016 19:52:17 +0200 Subject: [Haskell-beginners] crypto random UUID generation Message-ID: I have to produce a crypto random UUID. I haven't found simple examples. and I used the one from hre (see type CRand) http://hackage.haskell.org/package/monadcryptorandom-0.7.0/docs/Control-Monad-CryptoRandom.html#v:getCRandomR My attempt is the following: cryptoRandomUUID :: IO UUID.UUID cryptoRandomUUID = do g <- newGenIO:: IO SystemRandom case runCRand impl g of Left err -> throwIO err Right (v, g') -> return v where impl = do w1 <- getCRandom w2 <- getCRandom w3 <- getCRandom w4 <- getCRandom return $ UUID.fromWords w1 w2 w3 w4 ...but the compilation fails miserably with: • Ambiguous type variable ‘e0’ arising from a use of ‘runCRand’ prevents the constraint ‘(ContainsGenError e0)’ from being solved. Relevant bindings include impl :: CRandT SystemRandom e0 Data.Functor.Identity.Identity UUID.UUID (bound at src/Party.hs:75:9) Probable fix: use a type annotation to specify what ‘e0’ should be. These potential instance exist: instance ContainsGenError GenError -- Defined in ‘Control.Monad.CryptoRandom’ • In the expression: runCRand impl g In a stmt of a 'do' block: case runCRand impl g of { Left err -> throwIO err Right (v, g') -> return v } In the expression: do { g <- newGenIO :: IO SystemRandom; case runCRand impl g of { Left err -> throwIO err Right (v, g') -> return v } } ... What's the problem here? Are there some good examples for generating crypto-randoms? Thanks! -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Mon Dec 12 18:15:09 2016 From: toad3k at gmail.com (David McBride) Date: Mon, 12 Dec 2016 13:15:09 -0500 Subject: [Haskell-beginners] crypto random UUID generation In-Reply-To: References: Message-ID: The problem is with Left err -> throwIO err Because of the type of 'runCRand', we know err is an instance of ContainsGenError e0, but which one? We need a concrete error type before we can run this code. Looking at the docs there seems to be only one instance of ContainsGenError, GenError, so a quick an dirty solution would be to change it to Left err -> throwIO (err :: GenError) -- should work But keep in mind, if there were any other ContainsGenError instances, like from an external library that is adding a new type of random generator to this library that fails in a new way, you would not be catching that. On Mon, Dec 12, 2016 at 12:52 PM, Ovidiu Deac wrote: > I have to produce a crypto random UUID. > > I haven't found simple examples. and I used the one from hre (see type > CRand) http://hackage.haskell.org/package/monadcryptorandom-0.7. > 0/docs/Control-Monad-CryptoRandom.html#v:getCRandomR > > My attempt is the following: > > cryptoRandomUUID :: IO UUID.UUID > cryptoRandomUUID = do > g <- newGenIO:: IO SystemRandom > case runCRand impl g of > Left err -> throwIO err > Right (v, g') -> return v > > where impl = do > w1 <- getCRandom > w2 <- getCRandom > w3 <- getCRandom > w4 <- getCRandom > return $ UUID.fromWords w1 w2 w3 w4 > > ...but the compilation fails miserably with: > > • Ambiguous type variable ‘e0’ arising from a use of ‘runCRand’ > prevents the constraint ‘(ContainsGenError e0)’ from being solved. > Relevant bindings include > impl :: CRandT > SystemRandom e0 Data.Functor.Identity.Identity UUID.UUID > (bound at src/Party.hs:75:9) > Probable fix: use a type annotation to specify what ‘e0’ should be. > These potential instance exist: > instance ContainsGenError GenError > -- Defined in ‘Control.Monad.CryptoRandom’ > • In the expression: runCRand impl g > In a stmt of a 'do' block: > case runCRand impl g of { > Left err -> throwIO err > Right (v, g') -> return v } > In the expression: > do { g <- newGenIO :: IO SystemRandom; > case runCRand impl g of { > Left err -> throwIO err > Right (v, g') -> return v } } > ... > > What's the problem here? > Are there some good examples for generating crypto-randoms? > > 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: From sgf.dma at gmail.com Tue Dec 13 09:24:32 2016 From: sgf.dma at gmail.com (Dmitriy Matrosov) Date: Tue, 13 Dec 2016 12:24:32 +0300 Subject: [Haskell-beginners] Parse file with existentials Message-ID: > {-# LANGUAGE GADTs #-} > {-# LANGUAGE DataKinds #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE StandaloneDeriving #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE DeriveDataTypeable #-} > > import Prelude hiding (getLine) > import Data.Maybe > import Data.List > import Data.Typeable > import Control.Monad.Identity > import Control.Monad.Trans.Identity > import Control.Monad.Writer > import Control.Applicative > import System.FilePath Hi. I ask for an opinion about interface (implemented below) for parsing `rsync` filter files. The parser does not parse full syntax, i wrote it for determining rsync filter dependencies, when installing them using `shake`. So, i distinguish two kinds of lines: include of another filter file, which looks like . file and any other. I want to distinguish them at type level, so e.g. a record function for one constructor can't be applied to another, etc. I know, that i can prevent this at runtime by exporting only smart constructor, but i want a type check. > data RsyncFilterT = IncludeT | LineT > type IncludeT = 'IncludeT > type LineT = 'LineT > > -- Particular rsync filters distinguishable at type-level. > data RsyncFilter :: RsyncFilterT -> * where > Include :: {getInclude :: FilePath} -> RsyncFilter 'IncludeT > Line :: {getLine :: String} -> RsyncFilter 'LineT > deriving instance Show (RsyncFilter a) > deriving instance Typeable RsyncFilter For accessing records i use lenses redefined here. I redefine them with `Applicative` instead of `Functor` to make modify/set work even if value does not have a required record (by returning original (unmodified) value using `pure`). > type LensA a b = forall f. Applicative f => (b -> f b) -> a -> f a > > viewA :: LensA a b -> a -> b > viewA l = fromJust . getLast . getConst . l (Const . Last . Just) > viewAmaybe :: LensA a b -> a -> Maybe b > viewAmaybe l = getLast . getConst . l (Const . Last . Just) > > modifyA :: LensA a b -> (b -> b) -> a -> a > modifyA l f = runIdentity . l (Identity . f) > > modifyAA :: Applicative t => LensA a b -> (b -> t b) -> a -> t a > modifyAA l f = runIdentityT . l (IdentityT . f) > > setA :: LensA a b -> b -> a -> a > setA l s = modifyA l (const s) Here're lenses for `RsyncFilter` (its constructors are distinguishable at type-level, so i don't really need `Applicative` lenses here): > includeL :: LensA (RsyncFilter 'IncludeT) FilePath > includeL f z at Include {getInclude = x} = > fmap (\x' -> z{getInclude = x'}) (f x) > lineL :: LensA (RsyncFilter 'LineT) FilePath > lineL f z at Line {getLine = x} = > fmap (\x' -> z{getLine = x'}) (f x) The order of lines (may) matter, so i need to store all `RsyncFilter a` values in a list in original file order. But now the values are of different type. So.. i use existential container: > -- Generic container for any type of rsync filter. > data AnyFilter = forall (a :: RsyncFilterT). Typeable a => > AnyFilter (RsyncFilter a) > deriving instance Show AnyFilter > deriving instance Typeable AnyFilter And still i want to work on values of certain type to have some guarantees against misuse, so i need to cast `AnyFilter` back into `RsyncFilter` value: > -- Extract rsync filter from AnyFilter. > getFilter :: (forall (a :: RsyncFilterT). Typeable a => > RsyncFilter a -> b) -> AnyFilter -> b > getFilter f (AnyFilter x) = f x and here i also want to use lenses, but now the value may be of different type, that the lens expect, so i really need `Applicative` lenses here: > rsyncIncludeL' :: LensA AnyFilter (RsyncFilter 'IncludeT) > rsyncIncludeL' f z = maybe (pure z) (fmap AnyFilter . f) (getFilter cast z) > rsyncIncludeL :: LensA AnyFilter FilePath > rsyncIncludeL = rsyncIncludeL' . includeL > > rsyncLineL' :: LensA AnyFilter (RsyncFilter 'LineT) > rsyncLineL' f z = maybe (pure z) (fmap AnyFilter . f) > (getFilter cast z) > rsyncLineL :: LensA AnyFilter String > rsyncLineL = rsyncLineL' . lineL Then i define another Read/Show class just to be able to keep default Read/Show instances: > class Serialize a where > fromString :: String -> Maybe a > toString :: a -> String > > instance Serialize (RsyncFilter 'LineT) where > fromString = Just . Line > toString (Line xs) = xs > > -- RULE and PATTERN separator is space (`_` not supported). > -- Only short rule names without modifiers are supported. > instance Serialize (RsyncFilter 'IncludeT) where > fromString = go . break (== ' ') > where > go :: (String, String) -> Maybe (RsyncFilter 'IncludeT) > go (r, _ : x : xs) > | r == "." = Just (Include (x : xs)) > go _ = Nothing > toString (Include xs) = ". " ++ xs > > instance Serialize AnyFilter where > fromString x = > fmap AnyFilter (fromString x :: Maybe (RsyncFilter 'IncludeT)) > <|> fmap AnyFilter (fromString x :: Maybe (RsyncFilter 'LineT)) > toString x = fromMaybe "" $ > fmap toString (viewAmaybe rsyncIncludeL' x) > <|> fmap toString (viewAmaybe rsyncLineL' x) and a lens from String to AnyFilter, which effectively parses file and writes it back: > rsyncAnyL :: LensA String AnyFilter > rsyncAnyL f z = maybe (pure z) (fmap toString . f) (fromString z) And here is how i use this: > -- | Replace path prefix, if matched. > replacePrefix :: FilePath -> FilePath -> FilePath -> FilePath > replacePrefix old new x = maybe x (combine new . joinPath) $ > -- For ensuring that path prefix starts and ends at path > -- components (directories) boundaries, i first split them. > stripPrefix (splitDirectories old) (splitDirectories x) > > -- | Rewrite path in rsync inlcude line @line@ from source path > -- @srcdir@ to install path @prefix@ > -- > -- > usedIncludes srcdir prefix line > -- > -- and collect (rewritten) rsync include pathes in @Writer@ monad. > -- Other lines return as is. > usedIncludes :: FilePath -- ^ Source path. > -> FilePath -- ^ Install path. > -> String -- ^ Line from rsync filter file. > -> Writer [FilePath] String > usedIncludes srcdir prefix = > modifyAA (rsyncAnyL . rsyncIncludeL) $ \x -> do > let x' = replacePrefix srcdir prefix x > tell [x'] > return x' and then a shake rule: -- | Add file rule for instaling rsync filters with extension -- @ext@, rewriting source path @srcdir@ to install path @prefix@ -- in any rsync includes: -- -- > rsyncFilter ext srcdir prefix -- rsyncFilter :: String -- ^ Extension. -> FilePath -- ^ Install path. -> FilePath -- ^ Source path. -> Rules () rsyncFilter ext prefix srcdir = prefix ++ "//*" <.> ext %> \out -> do let src = replacePrefix prefix srcdir out ls <- readFileLines src let (rs, incs) = runWriter $ mapM (usedIncludes srcdir prefix) ls need incs putNormal $ "> Write " ++ out writeFileChanged out . unlines $ rs I probably won't think too much about this API, if i haven't read [Luke Palmer's post about existentials][1] . And now i doubt, did i fall into the same trap with existentials and does not see an obvious solution with functions? [1]: https://lukepalmer.wordpress.com/2010/01/24/haskell-antipattern-existential-typeclass/ -- Dmitriy Matrosov From ovidiudeac at gmail.com Tue Dec 13 11:41:45 2016 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Tue, 13 Dec 2016 13:41:45 +0200 Subject: [Haskell-beginners] crypto random UUID generation In-Reply-To: References: Message-ID: Thanks! It works. Why is this a "quick and dirty" fix and what would be the "clean" fix? On Mon, Dec 12, 2016 at 8:15 PM, David McBride wrote: > The problem is with > Left err -> throwIO err > > Because of the type of 'runCRand', we know err is an instance of > ContainsGenError e0, but which one? We need a concrete error type before > we can run this code. Looking at the docs there seems to be only one > instance of ContainsGenError, GenError, so a quick an dirty solution would > be to change it to > > Left err -> throwIO (err :: GenError) -- should work > > But keep in mind, if there were any other ContainsGenError instances, like > from an external library that is adding a new type of random generator to > this library that fails in a new way, you would not be catching that. > > > On Mon, Dec 12, 2016 at 12:52 PM, Ovidiu Deac > wrote: > >> I have to produce a crypto random UUID. >> >> I haven't found simple examples. and I used the one from hre (see type >> CRand) http://hackage.haskell.org/package/monadcryptorandom-0.7.0/ >> docs/Control-Monad-CryptoRandom.html#v:getCRandomR >> >> My attempt is the following: >> >> cryptoRandomUUID :: IO UUID.UUID >> cryptoRandomUUID = do >> g <- newGenIO:: IO SystemRandom >> case runCRand impl g of >> Left err -> throwIO err >> Right (v, g') -> return v >> >> where impl = do >> w1 <- getCRandom >> w2 <- getCRandom >> w3 <- getCRandom >> w4 <- getCRandom >> return $ UUID.fromWords w1 w2 w3 w4 >> >> ...but the compilation fails miserably with: >> >> • Ambiguous type variable ‘e0’ arising from a use of ‘runCRand’ >> prevents the constraint ‘(ContainsGenError e0)’ from being solved. >> Relevant bindings include >> impl :: CRandT >> SystemRandom e0 Data.Functor.Identity.Identity UUID.UUID >> (bound at src/Party.hs:75:9) >> Probable fix: use a type annotation to specify what ‘e0’ should be. >> These potential instance exist: >> instance ContainsGenError GenError >> -- Defined in ‘Control.Monad.CryptoRandom’ >> • In the expression: runCRand impl g >> In a stmt of a 'do' block: >> case runCRand impl g of { >> Left err -> throwIO err >> Right (v, g') -> return v } >> In the expression: >> do { g <- newGenIO :: IO SystemRandom; >> case runCRand impl g of { >> Left err -> throwIO err >> Right (v, g') -> return v } } >> ... >> >> What's the problem here? >> Are there some good examples for generating crypto-randoms? >> >> Thanks! >> >> _______________________________________________ >> 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 toad3k at gmail.com Tue Dec 13 13:18:05 2016 From: toad3k at gmail.com (David McBride) Date: Tue, 13 Dec 2016 08:18:05 -0500 Subject: [Haskell-beginners] crypto random UUID generation In-Reply-To: References: Message-ID: I was hasty with my words. Exceptions in haskell have always been my cryptonite. If you are handling the only known exception properly then you are doing everything right. On Tue, Dec 13, 2016 at 6:41 AM, Ovidiu Deac wrote: > Thanks! It works. > > Why is this a "quick and dirty" fix and what would be the "clean" fix? > > On Mon, Dec 12, 2016 at 8:15 PM, David McBride wrote: > >> The problem is with >> Left err -> throwIO err >> >> Because of the type of 'runCRand', we know err is an instance of >> ContainsGenError e0, but which one? We need a concrete error type before >> we can run this code. Looking at the docs there seems to be only one >> instance of ContainsGenError, GenError, so a quick an dirty solution would >> be to change it to >> >> Left err -> throwIO (err :: GenError) -- should work >> >> But keep in mind, if there were any other ContainsGenError instances, >> like from an external library that is adding a new type of random generator >> to this library that fails in a new way, you would not be catching that. >> >> >> On Mon, Dec 12, 2016 at 12:52 PM, Ovidiu Deac >> wrote: >> >>> I have to produce a crypto random UUID. >>> >>> I haven't found simple examples. and I used the one from hre (see type >>> CRand) http://hackage.haskell.org/package/monadcryptorandom-0.7.0/d >>> ocs/Control-Monad-CryptoRandom.html#v:getCRandomR >>> >>> My attempt is the following: >>> >>> cryptoRandomUUID :: IO UUID.UUID >>> cryptoRandomUUID = do >>> g <- newGenIO:: IO SystemRandom >>> case runCRand impl g of >>> Left err -> throwIO err >>> Right (v, g') -> return v >>> >>> where impl = do >>> w1 <- getCRandom >>> w2 <- getCRandom >>> w3 <- getCRandom >>> w4 <- getCRandom >>> return $ UUID.fromWords w1 w2 w3 w4 >>> >>> ...but the compilation fails miserably with: >>> >>> • Ambiguous type variable ‘e0’ arising from a use of ‘runCRand’ >>> prevents the constraint ‘(ContainsGenError e0)’ from being solved. >>> Relevant bindings include >>> impl :: CRandT >>> SystemRandom e0 Data.Functor.Identity.Identity >>> UUID.UUID >>> (bound at src/Party.hs:75:9) >>> Probable fix: use a type annotation to specify what ‘e0’ should be. >>> These potential instance exist: >>> instance ContainsGenError GenError >>> -- Defined in ‘Control.Monad.CryptoRandom’ >>> • In the expression: runCRand impl g >>> In a stmt of a 'do' block: >>> case runCRand impl g of { >>> Left err -> throwIO err >>> Right (v, g') -> return v } >>> In the expression: >>> do { g <- newGenIO :: IO SystemRandom; >>> case runCRand impl g of { >>> Left err -> throwIO err >>> Right (v, g') -> return v } } >>> ... >>> >>> What's the problem here? >>> Are there some good examples for generating crypto-randoms? >>> >>> Thanks! >>> >>> _______________________________________________ >>> 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 guenter.fiebig at online.de Tue Dec 13 13:23:46 2016 From: guenter.fiebig at online.de (Arnim Fiebig) Date: Tue, 13 Dec 2016 14:23:46 +0100 Subject: [Haskell-beginners] Problem install Gtk Message-ID: <2baa189e-2214-f7a9-d7b9-465119c17a3c@online.de> The same happen on Win8.1 and another Pc with win7 1. install 'HaskellPlatform-8.0.1-full-x86_64-setup-a' ok 2. copy 'gtk+-bundle_3.6.4-20130513_win64' to C:\Gtk\ ok 3. 'cabal install gtk' failed Thanks for help Guenter -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: phjidiombkcgeenh.gif Type: image/gif Size: 8169 bytes Desc: not available URL: From mike_k_houghton at yahoo.co.uk Tue Dec 13 14:36:39 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 13 Dec 2016 14:36:39 +0000 Subject: [Haskell-beginners] Sorting Message-ID: <53CF400D-2321-4B29-A4DA-77D481D5F1E0@yahoo.co.uk> Hi, I’m trying to sort a list of tuples. A char and a count of that char (Char , Int) e.g. [ ('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] e.g. ‘r’ occurs twice etc. The order should be based on the count first and then ties broken by the natural ordering of char. So [ ('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] will sort as [('b',3),('a', 2), ('c',2),('f',2), ('r',2)] I initially tried variants on sortBy (compare `on` snd) and then made a type Tup = T (Char, Int) and defined Eq and then got to the point where I felt that this had become too difficult for a simple problem and concluded that I’m missing a point somewhere and need a bit of help! Many thanks M -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Tue Dec 13 14:42:30 2016 From: toad3k at gmail.com (David McBride) Date: Tue, 13 Dec 2016 09:42:30 -0500 Subject: [Haskell-beginners] Problem install Gtk In-Reply-To: <2baa189e-2214-f7a9-d7b9-465119c17a3c@online.de> References: <2baa189e-2214-f7a9-d7b9-465119c17a3c@online.de> Message-ID: GTK is a linux graphics toolkit. It does not run on windows. On Tue, Dec 13, 2016 at 8:23 AM, Arnim Fiebig wrote: > The same happen on Win8.1 and another Pc with win7 > > > 1. install 'HaskellPlatform-8.0.1-full-x86_64-setup-a' > ok > > 2. copy 'gtk+-bundle_3.6.4-20130513_win64' to C:\Gtk\ ok > > 3. 'cabal install gtk' > failed > > > Thanks for help > Guenter > > _______________________________________________ > 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: phjidiombkcgeenh.gif Type: image/gif Size: 8169 bytes Desc: not available URL: From fa-ml at ariis.it Tue Dec 13 15:23:29 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 13 Dec 2016 16:23:29 +0100 Subject: [Haskell-beginners] Sorting In-Reply-To: <53CF400D-2321-4B29-A4DA-77D481D5F1E0@yahoo.co.uk> References: <53CF400D-2321-4B29-A4DA-77D481D5F1E0@yahoo.co.uk> Message-ID: <20161213152329.GA10789@casa.casa> On Tue, Dec 13, 2016 at 02:36:39PM +0000, mike h wrote: > Hi, > > I’m trying to sort a list of tuples. A char and a count of that char (Char , Int) > e.g. > > [ ('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] > > e.g. ‘r’ occurs twice etc. > The order should be based on the count first and then ties broken by the > natural ordering of char. You should provide sortBy with an appropriate compare function, e.g. comp (a,b) (c,d) | a > c = GT | -- etc etc. or go with the manky but working hack: λ> :m Data.List λ> sortOn (\(a, b) -> b*(-100) + fromEnum a) [('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] [('b',3),('a',2),('c',2),('f',2),('r',2)] From mihai.maruseac at gmail.com Tue Dec 13 16:00:20 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Tue, 13 Dec 2016 08:00:20 -0800 Subject: [Haskell-beginners] Problem install Gtk In-Reply-To: References: <2baa189e-2214-f7a9-d7b9-465119c17a3c@online.de> Message-ID: It also runs on windows but needs proper setup before hand. That is, it needs to be installed outside of Haskell and then you can install the Haskell bindings. On Tue, Dec 13, 2016 at 6:42 AM, David McBride wrote: > GTK is a linux graphics toolkit. It does not run on windows. > > On Tue, Dec 13, 2016 at 8:23 AM, Arnim Fiebig > wrote: > >> The same happen on Win8.1 and another Pc with win7 >> >> >> 1. install 'HaskellPlatform-8.0.1-full-x86_64-setup-a' >> ok >> >> 2. copy 'gtk+-bundle_3.6.4-20130513_win64' to C:\Gtk\ ok >> >> 3. 'cabal install gtk' >> failed >> >> >> Thanks for help >> Guenter >> >> _______________________________________________ >> 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 > > -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya -------------- next part -------------- An HTML attachment was scrubbed... URL: -------------- next part -------------- A non-text attachment was scrubbed... Name: phjidiombkcgeenh.gif Type: image/gif Size: 8169 bytes Desc: not available URL: From erlend at hamberg.no Tue Dec 13 16:01:41 2016 From: erlend at hamberg.no (Erlend Hamberg) Date: Tue, 13 Dec 2016 16:01:41 +0000 Subject: [Haskell-beginners] Sorting In-Reply-To: <20161213152329.GA10789@casa.casa> References: <53CF400D-2321-4B29-A4DA-77D481D5F1E0@yahoo.co.uk> <20161213152329.GA10789@casa.casa> Message-ID: There is a really nice solution that takes advantage of Ordering's Monoid instance (see https://wiki.haskell.org/Monoid). The imports you need: import Data.List (sortBy) import Data.Ord (Down(..), comparing) import Data.Monoid ((<>)) -- the “mappend” operator You can then combine two calls to `comparing` sortBy (comparing (Down . snd) <> comparing fst) xs (`Down` is just a newtype that reverses the ordering, since you wanted the first element in descending order and the second in ascending order.) On Tue, 13 Dec 2016 at 16:30 Francesco Ariis wrote: > On Tue, Dec 13, 2016 at 02:36:39PM +0000, mike h wrote: > > Hi, > > > > I’m trying to sort a list of tuples. A char and a count of that char > (Char , Int) > > e.g. > > > > [ ('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] > > > > e.g. ‘r’ occurs twice etc. > > The order should be based on the count first and then ties broken by the > > natural ordering of char. > > You should provide sortBy with an appropriate compare function, e.g. > > comp (a,b) (c,d) | a > c = GT > | -- etc etc. > > or go with the manky but working hack: > > λ> :m Data.List > λ> sortOn (\(a, b) -> b*(-100) + fromEnum a) [('r',2), ('c',2),('a', 2), > ('b',3), ('f',2)] > [('b',3),('a',2),('c',2),('f',2),('r',2)] > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- Erlend Hamberg erlend at hamberg.no -------------- next part -------------- An HTML attachment was scrubbed... URL: From mike_k_houghton at yahoo.co.uk Tue Dec 13 16:15:18 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 13 Dec 2016 16:15:18 +0000 Subject: [Haskell-beginners] Sorting In-Reply-To: References: <53CF400D-2321-4B29-A4DA-77D481D5F1E0@yahoo.co.uk> <20161213152329.GA10789@casa.casa> Message-ID: <877CDEB9-E4A5-4DAA-B43E-C44BB1E6374B@yahoo.co.uk> Thanks folks. Francesco Cool - I just came to that conclusion too and did tupleOrder :: (Char, Int) -> (Char, Int) -> Ordering tupleOrder (c1, x1) (c2, x2) -- char compared by ord and a is less than b! | x1 == x2 && c1 <= c2 = GT | x1 == x2 && c1 >= c2 = LT | x1 < x2 = LT | x1 > x2 = GT and then did sortBy. Erlend I’ll try that - Monoids have such an understated elegance. :) > On 13 Dec 2016, at 16:01, Erlend Hamberg wrote: > > There is a really nice solution that takes advantage of Ordering's Monoid instance (see https://wiki.haskell.org/Monoid ). > > The imports you need: > > import Data.List (sortBy) > import Data.Ord (Down(..), comparing) > import Data.Monoid ((<>)) -- the “mappend” operator > > You can then combine two calls to `comparing` > > sortBy (comparing (Down . snd) <> comparing fst) xs > > (`Down` is just a newtype that reverses the ordering, since you wanted the first element in descending order and the second in ascending order.) > > On Tue, 13 Dec 2016 at 16:30 Francesco Ariis > wrote: > On Tue, Dec 13, 2016 at 02:36:39PM +0000, mike h wrote: > > Hi, > > > > I’m trying to sort a list of tuples. A char and a count of that char (Char , Int) > > e.g. > > > > [ ('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] > > > > e.g. ‘r’ occurs twice etc. > > The order should be based on the count first and then ties broken by the > > natural ordering of char. > > You should provide sortBy with an appropriate compare function, e.g. > > comp (a,b) (c,d) | a > c = GT > | -- etc etc. > > or go with the manky but working hack: > > λ> :m Data.List > λ> sortOn (\(a, b) -> b*(-100) + fromEnum a) [('r',2), ('c',2),('a', 2), ('b',3), ('f',2)] > [('b',3),('a',2),('c',2),('f',2),('r',2)] > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- > Erlend Hamberg > erlend at hamberg.no _______________________________________________ > 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 johnlusk4 at gmail.com Wed Dec 14 23:26:22 2016 From: johnlusk4 at gmail.com (John Lusk) Date: Wed, 14 Dec 2016 18:26:22 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph Message-ID: Hi, all, Here's my question: I thought, for grins, I'd try to turn some log output into a dependency graph (using GraphViz's dot(1)). I'm having difficulty forcing my stateful paradigm into a functional one, so I need some help. If I was to do this with an imperative (stateful) language, I'd build a set of edges (or a map to a frequency count, really, since I'll use freq > 1 to add some output text noting the repeated occurrences), and then dump out the set elements to a text file that would look something like this fragment: a -> q q -> d d -> e [color=red] d -> f [color=red My big problem now is that if I process a subtree that looks like: a b c d b d e my current plan is to proces the first b-c-d subtree and then process the b-d-e subtree, *BUT* I need to pass the updated edge set to the second processing call, which is pretty stateful. Do I need to just bite the bullet and find some succinct way to do that, or is my entire approach just wrong, stuck in my stateful mindset? My (awful) code looks like this: -- Emit to stdout a series of dot(1) edges specifying dependencies.-- "A -> B" means "A depends on B".---- Build with 'ghc dependency-graph.hs'-- -- Input is a text file containing lines as follows:-- (some indentation) (some extraneous text) (file-A) in (some directory)-- (some extra indentation) (some extraneous text) (file-B) in (some directory)-- (some indentation matching the first line above) (some extraneous text) (file-C) in (some directory)---- This means that file-A depends on file-B, but neither file-A nor file-B depend on file-C.---- Sample:-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.ViewModel.dll in C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Adding C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\SXA.Compass.Config.ViewModel.dll (IsPresent=true) to assemblyList at beginning of GetAssemblyListEx()-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.Utils.dll in C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\---- (Need to skip the line containing "Adding", and only process the ones containing "Processing".)-- -- Algorithm:-- Read first line, parse, remember indentation-- Repeat for other lines, but if indentation increases, store pair A -> B in hashset.-- At end, dump out hashset. -- import Debug.Trace-- import System.Environment-- import System.Console.GetOpt-- import Data.Maybe (fromMaybe)-- import Data.List.Splitimport Prelude -- hiding (readFile) -- Because we want the System.IO.Strict version-- import System.IO (hPutStr, hPutStrLn, stderr)-- import System.IO.Strict-- import Control.Monad-- import System.Directory-- import System.FilePathimport Text.Regex.TDFA-- import Text.Regex.TDFA.String-- import Text.Printf -- import qualified Data.Map.Lazy as Mapimport qualified Data.Map.Strict as Map ---------------------------------------------------------------- Test Datal1 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.ViewModel.dll\tin C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\"l2 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Adding C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\SXA.Compass.Config.ViewModel.dll\t(IsPresent=true)\tto assemblyList at beginning of GetAssemblyListEx()"l3 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.Utils.dll\tin C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\"---------------------------------------------------------------- Test Data Ends-- See http://stackoverflow.com/q/32149354/370611-- toRegex = makeRegexOpts defaultCompOpt{multiline=False} defaultExecOpt -- Escape parens?-- initialFillerRegex :: String-- initialFillerRegex = "Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList\\(\\) Information: 0 : Processing" -- Regex matching (marking) a line to be processed-- valuableLineRegex :: String-- valuableLineRegex = "\\bProcessing\\b" -- |Regex matching line to be parsedparseLineRegex :: StringparseLineRegex = "^(.* Information: 0 : Processing )([^ ]*)[ \t]+in (.*)" -- 3subexpressions main :: IO()main = do logContents <- getContents putStrLn $ unlines $ fst $ edges (parseIndent $ lines logContents) Map.empty ------------------------------------------------------------------ |Parses out the leading indentation of the given String into a string of spaces and the rest of the lineparseIndent :: String -> (String,String)parseIndent s = ((fourth $ (s =~ "^( *)(.*)" :: (String,String,String,[String]))) !! 0, (fourth $ (s =~ "^( *)(.*)" :: (String,String,String,[String]))) !! 1) ------------------------------------------------------------------ |Returns a list of strings describing edges in the form "a -> b /* comment */"edges :: [(String,String)] -- ^ Input tuples: (indent, restOfString) -> Map.Map String Int -- ^ Map of edges in form "a -> b" with a count of the number of times that edge occurs -> [String] -- ^ Output list of edge descriptions in form "a -> b optionalExtraText" edges [] edgeSet = (edgeDump $ Map.assocs edgeSet, 0) edges (lastLine:[]) edgeSet = (edgeDump $ Map.assocs edgeSet, 1) edges (fstLogLine:sndLogLine:[]) edgeSet = let fstFields = (snd fstLogLine) =~ parseLineRegex :: (String,String,String,[String]) sndFields = (snd sndLogLine) =~ parseLineRegex :: (String,String,String,[String]) in if length (fourth fstFields) == 0 then error ("Unmatched: " ++ (first fstFields)) -- First line must always match else if length (fourth sndFields) == 0 -- "Adding", not "Processing" then edges (fstLogLine:[]) edgeSet -- Skip useless line else if indentLength fstLogLine >= indentLength sndLogLine then edges (sndLogLine:[]) edgeSet -- Can't be an edge from first to second line; drop first line and keep going. else edges (sndLogLine:[]) (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) edges (fstLogLine:sndLogLine:thdLogLine:logLines) edgeSet = let fstFields = (snd fstLogLine) =~ parseLineRegex :: (String,String,String,[String]) sndFields = (snd sndLogLine) =~ parseLineRegex :: (String,String,String,[String]) thdFields = (snd thdLogLine) =~ parseLineRegex :: (String,String,String,[String]) in if length (fourth fstFields) == 0 then error ("Unmatched: " ++ (first fstFields)) -- First line must always match else if length (fourth sndFields) == 0 -- "Adding", not "Processing" then edges (fstLogLine:thdLogLine:logLines) edgeSet -- Skip useless line else if indentLength fstLogLine >= indentLength sndLogLine then [] -- Stop processing at outdent else -- Looking one of: -- 1 -- 2 -- process 1 -> 2, then process 2.. as subtree -- 3 -- Need to process as subtree rooted at 2, then drop subtree (zero or more lines at same level as 3) -- or -- 1 -- 2 -- processs, then drop this line (process 2.. as empty subtree?) -- 3 -- or -- 1 -- 2 -- process, then drop this line (drop entire subtree rooted at 1) (same as above, drop empty subtree? (2)) -- 3 -- or -- 1 -- 2 -- same as above? Drop empty subtree rooted at 2 -- 3 edges (sndLogLine:thdLogLine:logLines) (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) -- now what? I need to pass the UPDATED edgeSet on to the next call, after the subtree rooted at 2 is dropped. then edges (sndLogLine:logLines) edgeSet -- Can't be an edge from first to second line; drop first line and keep going. else edges (sndLogLine:(takeWhile (increasingIndent $ length $ fst fstLogLine) logLines)) (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) else ((fst $ edges (sndLogLine:logLines) edgeSet) ++ (fst $ edges (fstLogLine:(drop (snd $ edges (sndLogLine:logLines) edgeSet) -- # of lines processed logLines)) edgeSet), (snd $ edges (sndLogLine:logLines) edgeSet) + (snd $ edges (fstLogLine:(drop (snd $ edges (sndLogLine:logLines) edgeSet) -- # of lines processed logLines)) edgeSet) ) ----------------------------------------------------------------fullname :: (String,String,String,[String]) -> Stringfullname (_,_,_,[_,fileName,directoryName]) = directoryName ++ fileName ------------------------------------------------------------------ |Edges from the first line to all following linesedgesFrom :: String -- ^ First line -> [String] -- ^ Following lines -> Map.Map String Int -- ^ Set of edges built so far -> [String]edgesFrom a b c = [] ------------------------------------------------------------------ |Return length of indent or errorindentLength :: (String,String,String,[String]) -- ^ Regex match context -> Int -- ^ Length of indentindentLength (prefix,_,_,[]) = error $ "Not matched: " ++ prefixindentLength (_,_,_,subexprs) = length $ subexprs !! 0 ------------------------------------------------------------------ |Returns a list of edges, possibly with comments indicating occurrence counts > 1edgeDump :: [(String,Int)] -- ^ List of (edge,count) tuples -> [String] -- ^ List of edges, possibly w/commentsedgeDump [] = []edgeDump ((edge,count):rest) | count <= 1 = edge:(edgeDump rest) | otherwise = (edge ++ " /* " ++ (show count) ++ " occurrences */"):(edgeDump rest) ----------------------------------------------------------------first :: (a,b,c,d) -> afirst (x,_,_,_) = x fourth :: (a,b,c,d) -> dfourth (_,_,_,x) = x -------------- next part -------------- An HTML attachment was scrubbed... URL: From johnlusk4 at gmail.com Wed Dec 14 23:28:07 2016 From: johnlusk4 at gmail.com (John Lusk) Date: Wed, 14 Dec 2016 18:28:07 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: Message-ID: (Or you could find it here: https://github.com/JohnL4/DependencyGraph) On Wed, Dec 14, 2016 at 6:26 PM, John Lusk wrote: > Hi, all, > > Here's my question: > > I thought, for grins, I'd try to turn some log output into a dependency > graph (using GraphViz's dot(1)). I'm having difficulty forcing my > stateful paradigm into a functional one, so I need some help. > > If I was to do this with an imperative (stateful) language, I'd build a > set of edges (or a map to a frequency count, really, since I'll use freq > > 1 to add some output text noting the repeated occurrences), and then > dump out the set elements to a text file that would look something like > this fragment: > > a -> q > q -> d > d -> e [color=red] > d -> f [color=red > > My big problem now is that if I process a subtree that looks like: > > a > b > c > d > b > d > e > > my current plan is to proces the first b-c-d subtree and then process the > b-d-e subtree, *BUT* I need to pass the updated edge set to the second > processing call, which is pretty stateful. > > Do I need to just bite the bullet and find some succinct way to do that, > or is my entire approach just wrong, stuck in my stateful mindset? > > My (awful) code looks like this: > > -- Emit to stdout a series of dot(1) edges specifying dependencies.-- "A -> B" means "A depends on B".---- Build with 'ghc dependency-graph.hs'-- -- Input is a text file containing lines as follows:-- (some indentation) (some extraneous text) (file-A) in (some directory)-- (some extra indentation) (some extraneous text) (file-B) in (some directory)-- (some indentation matching the first line above) (some extraneous text) (file-C) in (some directory)---- This means that file-A depends on file-B, but neither file-A nor file-B depend on file-C.---- Sample:-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.ViewModel.dll in C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Adding C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\SXA.Compass.Config.ViewModel.dll (IsPresent=true) to assemblyList at beginning of GetAssemblyListEx()-- Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.Utils.dll in C:\Program Files (x86)\Allscripts Sunrise\Clinical Manager Client\7.2.5575.0\---- (Need to skip the line containing "Adding", and only process the ones containing "Processing".)-- -- Algorithm:-- Read first line, parse, remember indentation-- Repeat for other lines, but if indentation increases, store pair A -> B in hashset.-- At end, dump out hashset. > -- import Debug.Trace-- import System.Environment-- import System.Console.GetOpt-- import Data.Maybe (fromMaybe)-- import Data.List.Splitimport Prelude -- hiding (readFile) -- Because we want the System.IO.Strict version-- import System.IO (hPutStr, hPutStrLn, stderr)-- import System.IO.Strict-- import Control.Monad-- import System.Directory-- import System.FilePathimport Text.Regex.TDFA-- import Text.Regex.TDFA.String-- import Text.Printf > -- import qualified Data.Map.Lazy as Mapimport qualified Data.Map.Strict as Map > ---------------------------------------------------------------- Test Datal1 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.ViewModel.dll\tin C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\"l2 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Adding C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\SXA.Compass.Config.ViewModel.dll\t(IsPresent=true)\tto assemblyList at beginning of GetAssemblyListEx()"l3 = " Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList() Information: 0 : Processing SXA.Compass.Config.Utils.dll\tin C:\\Program Files (x86)\\Allscripts Sunrise\\Clinical Manager Client\\7.2.5575.0\\"---------------------------------------------------------------- Test Data Ends-- See http://stackoverflow.com/q/32149354/370611-- toRegex = makeRegexOpts defaultCompOpt{multiline=False} defaultExecOpt > -- Escape parens?-- initialFillerRegex :: String-- initialFillerRegex = "Helios.MigrationTool.Common.AssemblyUtils.GetAssemblyList\\(\\) Information: 0 : Processing" > -- Regex matching (marking) a line to be processed-- valuableLineRegex :: String-- valuableLineRegex = "\\bProcessing\\b" > -- |Regex matching line to be parsedparseLineRegex :: StringparseLineRegex = "^(.* Information: 0 : Processing )([^ ]*)[ \t]+in (.*)" -- 3subexpressions > main :: IO()main = do > logContents <- getContents > putStrLn $ unlines $ fst $ edges (parseIndent $ lines logContents) Map.empty > ------------------------------------------------------------------ |Parses out the leading indentation of the given String into a string of spaces and the rest of the lineparseIndent :: String -> (String,String)parseIndent s = ((fourth $ (s =~ "^( *)(.*)" :: (String,String,String,[String]))) !! 0, > (fourth $ (s =~ "^( *)(.*)" :: (String,String,String,[String]))) !! 1) > ------------------------------------------------------------------ |Returns a list of strings describing edges in the form "a -> b /* comment */"edges :: > [(String,String)] -- ^ Input tuples: (indent, restOfString) > -> Map.Map String Int -- ^ Map of edges in form "a -> b" with a count of the number of times that edge occurs > -> [String] -- ^ Output list of edge descriptions in form "a -> b optionalExtraText" > edges [] edgeSet = > (edgeDump $ Map.assocs edgeSet, 0) > edges (lastLine:[]) edgeSet = > (edgeDump $ Map.assocs edgeSet, 1) > edges (fstLogLine:sndLogLine:[]) edgeSet = > let fstFields = (snd fstLogLine) =~ parseLineRegex :: (String,String,String,[String]) > sndFields = (snd sndLogLine) =~ parseLineRegex :: (String,String,String,[String]) > in > if length (fourth fstFields) == 0 > then error ("Unmatched: " ++ (first fstFields)) -- First line must always match > else if length (fourth sndFields) == 0 -- "Adding", not "Processing" > then edges (fstLogLine:[]) edgeSet -- Skip useless line > else if indentLength fstLogLine >= indentLength sndLogLine > then edges (sndLogLine:[]) edgeSet -- Can't be an edge from first to second line; drop first line and keep going. > else edges (sndLogLine:[]) > (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) > edges (fstLogLine:sndLogLine:thdLogLine:logLines) edgeSet = > let fstFields = (snd fstLogLine) =~ parseLineRegex :: (String,String,String,[String]) > sndFields = (snd sndLogLine) =~ parseLineRegex :: (String,String,String,[String]) > thdFields = (snd thdLogLine) =~ parseLineRegex :: (String,String,String,[String]) > in > if length (fourth fstFields) == 0 > then error ("Unmatched: " ++ (first fstFields)) -- First line must always match > > else if length (fourth sndFields) == 0 -- "Adding", not "Processing" > then edges (fstLogLine:thdLogLine:logLines) edgeSet -- Skip useless line > > else if indentLength fstLogLine >= indentLength sndLogLine > then [] -- Stop processing at outdent > > else > -- Looking one of: > -- 1 > -- 2 -- process 1 -> 2, then process 2.. as subtree > -- 3 -- Need to process as subtree rooted at 2, then drop subtree (zero or more lines at same level as 3) > -- or > -- 1 > -- 2 -- processs, then drop this line (process 2.. as empty subtree?) > -- 3 > -- or > -- 1 > -- 2 -- process, then drop this line (drop entire subtree rooted at 1) (same as above, drop empty subtree? (2)) > -- 3 > -- or > -- 1 > -- 2 -- same as above? Drop empty subtree rooted at 2 > -- 3 > edges (sndLogLine:thdLogLine:logLines) (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) -- now what? I need to pass the UPDATED edgeSet on to the next call, after the subtree rooted at 2 is dropped. > > > > then edges (sndLogLine:logLines) edgeSet -- Can't be an edge from first to second line; drop first line and keep going. > else edges (sndLogLine:(takeWhile (increasingIndent $ length $ fst fstLogLine) logLines)) > (Map.insertWith (+) ((fullName fstFields) ++ (fullName sndFields)) 1) > else ((fst $ edges (sndLogLine:logLines) edgeSet) > ++ (fst $ edges (fstLogLine:(drop > (snd $ edges (sndLogLine:logLines) edgeSet) -- # of lines processed > logLines)) edgeSet), > (snd $ edges (sndLogLine:logLines) edgeSet) > + (snd $ edges (fstLogLine:(drop > (snd $ edges (sndLogLine:logLines) edgeSet) -- # of lines processed > logLines)) edgeSet) > ) > ----------------------------------------------------------------fullname :: (String,String,String,[String]) -> Stringfullname (_,_,_,[_,fileName,directoryName]) = directoryName ++ fileName > ------------------------------------------------------------------ |Edges from the first line to all following linesedgesFrom :: String -- ^ First line > -> [String] -- ^ Following lines > -> Map.Map String Int -- ^ Set of edges built so far > -> [String]edgesFrom a b c = [] > ------------------------------------------------------------------ |Return length of indent or errorindentLength :: (String,String,String,[String]) -- ^ Regex match context > -> Int -- ^ Length of indentindentLength (prefix,_,_,[]) = error $ "Not matched: " ++ prefixindentLength (_,_,_,subexprs) = > length $ subexprs !! 0 > ------------------------------------------------------------------ |Returns a list of edges, possibly with comments indicating occurrence counts > 1edgeDump :: [(String,Int)] -- ^ List of (edge,count) tuples > -> [String] -- ^ List of edges, possibly w/commentsedgeDump [] = []edgeDump ((edge,count):rest) > | count <= 1 = edge:(edgeDump rest) > | otherwise = (edge ++ " /* " ++ (show count) ++ " occurrences */"):(edgeDump rest) > ----------------------------------------------------------------first :: (a,b,c,d) -> afirst (x,_,_,_) = x > fourth :: (a,b,c,d) -> dfourth (_,_,_,x) = x > > > -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Thu Dec 15 10:17:53 2016 From: magnus at therning.org (Magnus Therning) Date: Thu, 15 Dec 2016 11:17:53 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: Message-ID: <87vaulh4xa.fsf@therning.org> John Lusk writes: > Hi, all, [.. cut ..] > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners If I understand you correctly you want to parse a set of lines and keep track of indentation. This is not entirely unlike parsing a programming language where indentation is significant, like Haskell :) Is that correct? A quick look at Hackage gives several libs with combinators dealing with indentaion-aware parsers. Have you looked at any of them? /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus For a successful technology, reality must take precedence over public relations, for nature cannot be fooled. — R.P. Feynman -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 832 bytes Desc: not available URL: From john-haskell at how-hard-can-it-be.com Thu Dec 15 13:44:08 2016 From: john-haskell at how-hard-can-it-be.com (John Lusk) Date: Thu, 15 Dec 2016 08:44:08 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: <87vaulh4xa.fsf@therning.org> References: <87vaulh4xa.fsf@therning.org> Message-ID: I have not, but I might. This was a little work project that I've now run out of time for. I was really hoping for a deeper discussion of state management than "just use this package." This seems kind of like receiving a stream of inputs from a user and needing to keep track of several items of state that are changing independently (as opposed to the neat problems usually used in basic FP education). Should I be taking a more monadic approach? On Thu, Dec 15, 2016 at 5:17 AM, Magnus Therning wrote: > > John Lusk writes: > > > Hi, all, > [.. cut ..] > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > If I understand you correctly you want to parse a set of lines and keep > track of indentation. This is not entirely unlike parsing a programming > language where indentation is significant, like Haskell :) Is that > correct? > > A quick look at Hackage gives several libs with combinators dealing with > indentaion-aware parsers. Have you looked at any of them? > > /M > > -- > Magnus Therning OpenPGP: 0x927912051716CE39 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > For a successful technology, reality must take precedence over public > relations, for nature cannot be fooled. > — R.P. Feynman > > _______________________________________________ > 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 Thu Dec 15 15:18:37 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 15 Dec 2016 16:18:37 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> Message-ID: > https://github.com/JohnL4/DependencyGraph A graph library of your choice + State monad would do the trick. e.g.: fgl Data-Graph-Inductive-Monad Or you could store Graph state in an MVar and work as you would with stateful approach ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Thu Dec 15 19:38:37 2016 From: magnus at therning.org (Magnus Therning) Date: Thu, 15 Dec 2016 20:38:37 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> Message-ID: <871sx9c79e.fsf@therning.org> John Lusk writes: > I have not, but I might. This was a little work project that I've now run > out of time for. > > I was really hoping for a deeper discussion of state management than > "just use this package." This seems kind of like receiving a stream of > inputs from a user and needing to keep track of several items of state > that are changing independently (as opposed to the neat problems > usually used in basic FP education). > > Should I be taking a more monadic approach? Well, we have to start somewhere :) Anyway, you don't necessarily have to resort to the state monad. I believe, based you your other code that you quite easily can go from your list of lines to a list of `(Int, String)`, where the integer indicates the indentation level. Then you can look at `Data.Tree` (in containers) and `Data.Tree.Zipper` (in rosezipper) to build your tree. This is my quick hack: ~~~ buildTree _ zipPos [] = zipPos buildTree n zipPos xx@((lvl, s):xs) | lvl > n = let newZipPos = children zipPos node = Node s [] in buildTree lvl (insert node newZipPos) xs | lvl == n = let newZipPos = nextSpace zipPos node = Node s [] in buildTree lvl (insert node newZipPos) xs | lvl < n = let (Just newZipPos) = parent zipPos in buildTree (n - 1) newZipPos xx ~~~ With the following definitions in place: ~~~ ils = [ (1, "The root") , (2, "Child 1") , (3, "Child 1.1") , (4, "Child 1.1.1") , (3, "Child 1.2") , (2, "Child 2") ] zipRoot = fromTree $ Node "absolute top" [] ~~~ I build the tree, and print it, like this: ~~~ putStrLn $ drawTree $ toTree $ buildTree 0 zipRoot ils top | `- The root | +- Child 1 | | | +- Child 1.1 | | | | | `- Child 1.1.1 | | | `- Child 1.2 | `- Child 2 ~~~ Whether this is usable for you depends a lot on how big your logs are, I suppose. If this was something that I'd keep around for a while I'd probably look into rewriting `buildTree` so that it would fit for use with `mapAccumL`. /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus The British have "the perfect temperament to be hackers—technically skilled, slightly disrespectful of authority, and just a touch of criminal behavior". — Mary Ann Davidson, Oracle's Security Chief -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 832 bytes Desc: not available URL: From john-haskell at how-hard-can-it-be.com Thu Dec 15 21:09:49 2016 From: john-haskell at how-hard-can-it-be.com (John Lusk) Date: Thu, 15 Dec 2016 16:09:49 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: <871sx9c79e.fsf@therning.org> References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: Thanks, all, that gives me something to chew on. It occurred to me (during my 45-minute commute to work) that all Haskell programs (listen to the noob ) have the following structure (modulo my fractured syntax): main :: IO() main = do inputs <- getInputs doOutput $ f inputs initialState f :: [input] -> state -> outputs f [] state = transformToOutputs state f (input:inputs) state = f inputs (newState state input) doOutput :: [output] -> IO() doOutput outputs = do putStr $ unlines outputs So all I have to do is write newState and I'm good! ^_^ (transformToOutputs will, of course, be a snap.) Right? John. On Thu, Dec 15, 2016 at 2:38 PM, Magnus Therning wrote: > > John Lusk writes: > > > I have not, but I might. This was a little work project that I've now run > > out of time for. > > > > I was really hoping for a deeper discussion of state management than > > "just use this package." This seems kind of like receiving a stream of > > inputs from a user and needing to keep track of several items of state > > that are changing independently (as opposed to the neat problems > > usually used in basic FP education). > > > > Should I be taking a more monadic approach? > > Well, we have to start somewhere :) > > Anyway, you don't necessarily have to resort to the state monad. I > believe, based you your other code that you quite easily can go from > your list of lines to a list of `(Int, String)`, where the integer > indicates the indentation level. Then you can look at `Data.Tree` (in > containers) and `Data.Tree.Zipper` (in rosezipper) to build your tree. > > This is my quick hack: > > ~~~ > buildTree _ zipPos [] = zipPos > buildTree n zipPos xx@((lvl, s):xs) > | lvl > n = > let newZipPos = children zipPos > node = Node s [] > in buildTree lvl (insert node newZipPos) xs > | lvl == n = > let newZipPos = nextSpace zipPos > node = Node s [] > in buildTree lvl (insert node newZipPos) xs > | lvl < n = > let (Just newZipPos) = parent zipPos > in buildTree (n - 1) newZipPos xx > ~~~ > > With the following definitions in place: > > ~~~ > ils = [ (1, "The root") > , (2, "Child 1") > , (3, "Child 1.1") > , (4, "Child 1.1.1") > , (3, "Child 1.2") > , (2, "Child 2") > ] > > zipRoot = fromTree $ Node "absolute top" [] > ~~~ > > I build the tree, and print it, like this: > > ~~~ > putStrLn $ drawTree $ toTree $ buildTree 0 zipRoot ils > top > | > `- The root > | > +- Child 1 > | | > | +- Child 1.1 > | | | > | | `- Child 1.1.1 > | | > | `- Child 1.2 > | > `- Child 2 > ~~~ > > Whether this is usable for you depends a lot on how big your logs are, I > suppose. > > If this was something that I'd keep around for a while I'd probably > look into rewriting `buildTree` so that it would fit for use with > `mapAccumL`. > > /M > > -- > Magnus Therning OpenPGP: 0x927912051716CE39 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > The British have "the perfect temperament to be hackers—technically > skilled, slightly disrespectful of authority, and just a touch of > criminal behavior". > — Mary Ann Davidson, Oracle's Security Chief > > _______________________________________________ > 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 Thu Dec 15 21:23:55 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 15 Dec 2016 22:23:55 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: > f :: [input] -> state -> outputs .. or with state monad m it could be a combination of f :: [input] -> m outputs f :: [input] -> outputs - for intermediate results where state is not R/W state + IO is not too difficult. here is a very good explanation I understood the last one - Use liftIO - best -------------- next part -------------- An HTML attachment was scrubbed... URL: From johnlusk4 at gmail.com Thu Dec 15 21:25:37 2016 From: johnlusk4 at gmail.com (John Lusk) Date: Thu, 15 Dec 2016 16:25:37 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: Thanks!! John. On Thu, Dec 15, 2016 at 4:23 PM, Imants Cekusins wrote: > > f :: [input] -> state -> outputs > > .. or with state monad m it could be a combination of > > f :: [input] -> m outputs > > f :: [input] -> outputs - for intermediate results where state is not R/W > > > state + IO is not too difficult. here is a very good explanation > > I understood the last one - Use liftIO - best > > _______________________________________________ > 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 johnlusk4 at gmail.com Fri Dec 16 21:54:39 2016 From: johnlusk4 at gmail.com (John Lusk) Date: Fri, 16 Dec 2016 16:54:39 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: Ha! Fixed! And committed to the GitHub repo mentioned previously, if anybody's interested. I spent too much time on it, but I couldn't let it go and now I have to brag. John. On Thu, Dec 15, 2016 at 4:25 PM, John Lusk wrote: > Thanks!! > > John. > > On Thu, Dec 15, 2016 at 4:23 PM, Imants Cekusins wrote: > >> > f :: [input] -> state -> outputs >> >> .. or with state monad m it could be a combination of >> >> f :: [input] -> m outputs >> >> f :: [input] -> outputs - for intermediate results where state is not R/W >> >> >> state + IO is not too difficult. here is a very good explanation >> >> I understood the last one - Use liftIO - best >> >> _______________________________________________ >> 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 magnus at therning.org Sat Dec 17 01:03:21 2016 From: magnus at therning.org (Magnus Therning) Date: Sat, 17 Dec 2016 02:03:21 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: <87pokrtlie.fsf@therning.org> John Lusk writes: > Thanks, all, that gives me something to chew on. > > It occurred to me (during my 45-minute commute to work) that all > Haskell programs (listen to the noob ) have the following > structure (modulo my fractured syntax): > > main :: IO() > main = do > inputs <- getInputs > doOutput $ f inputs initialState > > f :: [input] -> state -> outputs > > f [] state = > transformToOutputs state > > f (input:inputs) state = > f inputs (newState state input) > > doOutput :: [output] -> IO() > > doOutput outputs = do > putStr $ unlines outputs > > So all I have to do is write newState and I'm good! ^_^ > > (transformToOutputs will, of course, be a snap.) > > Right? Very many do, yes. One thing though, it is worth thinking about the order of arguments. I often order it f state [] = ... f state (x:xs) = ... because that fits better with `foldl` and `map` :) /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus The early bird may get the worm, but the second mouse gets the cheese. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 832 bytes Desc: not available URL: From magnus at therning.org Sat Dec 17 01:05:46 2016 From: magnus at therning.org (Magnus Therning) Date: Sat, 17 Dec 2016 02:05:46 +0100 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> Message-ID: <87oa0btled.fsf@therning.org> John Lusk writes: > Ha! Fixed! And committed to the GitHub repo mentioned previously, if > anybody's interested. > > I spent too much time on it, but I couldn't let it go and now I have > to brag. Excellent! If you have use for it in the future, but find that it's too slow or demanding on memory then I *think* it's possible to skip building the full tree and instead use a stack :) /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org jabber: magnus at therning.org twitter: magthe http://therning.org/magnus Finagle's Fourth Law: Once a job is fouled up, anything done to improve it only makes it worse. -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 832 bytes Desc: not available URL: From johnlusk4 at gmail.com Sat Dec 17 01:17:15 2016 From: johnlusk4 at gmail.com (John Lusk) Date: Fri, 16 Dec 2016 20:17:15 -0500 Subject: [Haskell-beginners] Noobie attempt to process log output into dependency graph In-Reply-To: <87oa0btled.fsf@therning.org> References: <87vaulh4xa.fsf@therning.org> <871sx9c79e.fsf@therning.org> <87oa0btled.fsf@therning.org> Message-ID: I'm actually already building a stack and using a set (disguised as a map) to coalesce duplicate edges, but I have a big file to process next week, so I'll let you know. I had actually thought that I could find an artful way to conceal the stack-as-data-structure as a stack-as-runtime-call-structure, but that was beyond my capabilities, alas. :( Maybe someday. On Fri, Dec 16, 2016 at 8:05 PM, Magnus Therning wrote: > > John Lusk writes: > > > Ha! Fixed! And committed to the GitHub repo mentioned previously, if > > anybody's interested. > > > > I spent too much time on it, but I couldn't let it go and now I have > > to brag. > > Excellent! > > If you have use for it in the future, but find that it's too slow or > demanding on memory then I *think* it's possible to skip building the > full tree and instead use a stack :) > > /M > > -- > Magnus Therning OpenPGP: 0x927912051716CE39 > email: magnus at therning.org jabber: magnus at therning.org > twitter: magthe http://therning.org/magnus > > Finagle's Fourth Law: > Once a job is fouled up, anything done to improve it only makes it > worse. > > _______________________________________________ > 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 Mon Dec 19 13:10:40 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 19 Dec 2016 13:10:40 +0000 Subject: [Haskell-beginners] Mutable grid Message-ID: Hi, I’m looking a problem where I have an NxN grid of ints. I need a function like setValue x y newVal I have tried using [[Int]] but it does become messy when splitting , dropping and then ++ back together. What other options are available to represent a mutable grid? Many thanks Mike From michael at orlitzky.com Mon Dec 19 15:27:56 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 19 Dec 2016 10:27:56 -0500 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: On 12/19/2016 08:10 AM, mike h wrote: > Hi, > > I’m looking a problem where I have an NxN grid of ints. I need a > function like setValue x y newVal > > I have tried using [[Int]] but it does become messy when splitting , > dropping and then ++ back together. > > What other options are available to represent a mutable grid? > Mutable vectors (from the vector[1] package) are an obvious choice. When I had to do something similar, I wound up going all the way to repa[2], which magically turns all of your grid operations into parallel ones. [1] https://hackage.haskell.org/package/vector [2] https://hackage.haskell.org/package/repa From mike_k_houghton at yahoo.co.uk Mon Dec 19 18:31:27 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Mon, 19 Dec 2016 18:31:27 +0000 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: Thanks for the pointers - I’ll take a look. The background to this is one of the puzzles on Advent Of Code 2016 Q.8. https://adventofcode.com/2016/day/8 There are (several hundred) sequential operations on a grid 50 x 6 - initially all zeroes e.g. rotate row y=0 by 4 rect 2x1 — sets sub grid from (0,0) to (2,1) to all 1s rotate column x=35 by 1 I’m fine about parsing the input to a data structure and executing them i.e. evalExpr :: Expr -> Screen -> Screen — screen is essentially [[Int]] evalExpr e s = case e of (Rect r c ) -> evalRect r c s (RotRow r by) -> evalRotRow r by s (RotCol c by) -> evalRotCol c by s (NOP ) -> id s rotating a row was simple enough, code to rotate column a bit untidy and not very nice. The evalRect - which sets values to one in the rectangle of size r x c starting at (0,0) top left - triggered the original question. At this point my knowledge of Haskell is being pushed (which is good) but I have a feeling that my approach is not ‘correct’ once it gets beyond the parsing. Should each of the evalRect, evalRotRow and evalRotCol be called with a Screen (i.e. the grid at the root of this question)? Is the state monad a fit for this problem? Should I change my approach or is using vector the way forward? Many thanks Mike > On 19 Dec 2016, at 15:27, Michael Orlitzky wrote: > > On 12/19/2016 08:10 AM, mike h wrote: >> Hi, >> >> I’m looking a problem where I have an NxN grid of ints. I need a >> function like setValue x y newVal >> >> I have tried using [[Int]] but it does become messy when splitting , >> dropping and then ++ back together. >> >> What other options are available to represent a mutable grid? >> > > Mutable vectors (from the vector[1] package) are an obvious choice. When > I had to do something similar, I wound up going all the way to repa[2], > which magically turns all of your grid operations into parallel ones. > > > [1] https://hackage.haskell.org/package/vector > [2] https://hackage.haskell.org/package/repa > > _______________________________________________ > 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 michael at orlitzky.com Mon Dec 19 20:12:05 2016 From: michael at orlitzky.com (Michael Orlitzky) Date: Mon, 19 Dec 2016 15:12:05 -0500 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: On 12/19/2016 01:31 PM, mike h wrote: > > There are (several hundred) sequential operations on a grid 50 x 6 > - initially all zeroes > ... > > At this point my knowledge of Haskell is being pushed (which is good) > but I have a feeling that > my approach is not ‘correct’ once it gets beyond the parsing. Should > each of the evalRect, evalRotRow and evalRotCol be called with a Screen > (i.e. the grid at the root of this question)? > Is the state monad a fit for this problem? > Should I change my approach or is using vector the way forward? > This is just plain difficult to do functionally, don't be discouraged. Using mutable vectors is going to speed things up, but it isn't going to simplify anything conceptually. If I were you, I would start by making everything work slowly-but-safely on a tiny grid, accessing (and checking) everything by indices. First, write yourself a function that can modify one entry on the screen. Then, using that, a function that can modify one row. Then implement the matrix "transpose", and you get column operations for free: transpose, do the thing for rows, and then transpose back. Rather than evaluate the expressions at the same time you parse them, I would convert them to functions instead. So the instruction "rect 3x2" would get converted into a function that takes a Screen and outputs a Screen. If you do that for all of the instructions, then you can just compose everything. If "rect 3x2" gives you the function `f1` and "rect 5x7" gives you the function `f2`, then `f1 . f2` does one followed by the other. Your program will wind up being one long composition of functions that you can construct from the list of expressions. You can compose an entire list of functions with a fold: ghci> let times n x = n*x ghci> let fs = [ times n | n <- [1..10] ] ghci> foldr (.) id fs 1 -- 10 times 9 times 8 times... times 1 3628800 If you need it to be fast, then you can switch the list of lists to a mutable vector of mutable vectors. All you should have to change is the function that modifies one entry, since the rest will be implemented in terms of that. On the other hand, if it's already fast enough, it would be very sexy to use something like fixed-vector to ensure that the row/column lengths are statically checked =) From mike_k_houghton at yahoo.co.uk Tue Dec 20 11:30:02 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 20 Dec 2016 11:30:02 +0000 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: <70D7B5A8-25C9-4CB0-A0CA-EB847CB7B764@yahoo.co.uk> Thanks Michael for you help. Very useful. Mike > On 19 Dec 2016, at 20:12, Michael Orlitzky wrote: > > On 12/19/2016 01:31 PM, mike h wrote: >> >> There are (several hundred) sequential operations on a grid 50 x 6 >> - initially all zeroes >> ... >> >> At this point my knowledge of Haskell is being pushed (which is good) >> but I have a feeling that >> my approach is not ‘correct’ once it gets beyond the parsing. Should >> each of the evalRect, evalRotRow and evalRotCol be called with a Screen >> (i.e. the grid at the root of this question)? >> Is the state monad a fit for this problem? >> Should I change my approach or is using vector the way forward? >> > > This is just plain difficult to do functionally, don't be discouraged. > Using mutable vectors is going to speed things up, but it isn't going to > simplify anything conceptually. > > If I were you, I would start by making everything work slowly-but-safely > on a tiny grid, accessing (and checking) everything by indices. First, > write yourself a function that can modify one entry on the screen. Then, > using that, a function that can modify one row. Then implement the > matrix "transpose", and you get column operations for free: transpose, > do the thing for rows, and then transpose back. > > Rather than evaluate the expressions at the same time you parse them, I > would convert them to functions instead. So the instruction "rect 3x2" > would get converted into a function that takes a Screen and outputs a > Screen. If you do that for all of the instructions, then you can just > compose everything. If "rect 3x2" gives you the function `f1` and "rect > 5x7" gives you the function `f2`, then `f1 . f2` does one followed by > the other. Your program will wind up being one long composition of > functions that you can construct from the list of expressions. You can > compose an entire list of functions with a fold: > > ghci> let times n x = n*x > ghci> let fs = [ times n | n <- [1..10] ] > ghci> foldr (.) id fs 1 -- 10 times 9 times 8 times... times 1 > 3628800 > > If you need it to be fast, then you can switch the list of lists to a > mutable vector of mutable vectors. All you should have to change is the > function that modifies one entry, since the rest will be implemented in > terms of that. > > On the other hand, if it's already fast enough, it would be very sexy to > use something like fixed-vector to ensure that the row/column lengths > are statically checked =) > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners From ovidiudeac at gmail.com Thu Dec 22 15:06:48 2016 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Thu, 22 Dec 2016 17:06:48 +0200 Subject: [Haskell-beginners] applicative default structure Message-ID: This code is using Applicative Maybe. The structure is provided by Maybe and the value 1 is wrapped in this structure. No surprises here. Prelude> pure 1 :: Maybe Int Just 1 Prelude> :t (pure 1 :: Maybe Int) (pure 1 :: Maybe Int) :: Maybe Int ...but can somebody explain the type of x below? Prelude> x = pure 1 Prelude> x 1 Prelude> :t x x :: (Applicative f, Num a) => f a What is f here? Thanks! -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Dec 22 15:13:37 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 22 Dec 2016 16:13:37 +0100 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: > What is f here? anything Applicative: Prelude> let a1 = pure 1 Prelude> let a2 = pure 1 Prelude> (a1::Maybe Int) == a2 True Prelude> (a1::Maybe Float) == a2 True Prelude> (a1::Either String Float) == a2 True ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From ovidiudeac at gmail.com Thu Dec 22 15:18:16 2016 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Thu, 22 Dec 2016 17:18:16 +0200 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: My understanding is that x can take any form required for type-inference. That's fine but what is the "default" structure if you don't specify any? On Thu, Dec 22, 2016 at 5:13 PM, Imants Cekusins wrote: > > What is f here? > > anything Applicative: > > Prelude> let a1 = pure 1 > Prelude> let a2 = pure 1 > > Prelude> (a1::Maybe Int) == a2 > True > Prelude> (a1::Maybe Float) == a2 > True > Prelude> (a1::Either String Float) == a2 > True > > > ​ > > _______________________________________________ > 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 toad3k at gmail.com Thu Dec 22 15:33:41 2016 From: toad3k at gmail.com (David McBride) Date: Thu, 22 Dec 2016 10:33:41 -0500 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: Rather than bailing with an instance error for both Applicative and Num, which is the technically the right way, and the way that it used to be in the dark ages of ghci. Instead it chooses types which are probably what you wanted. In this case it defaults f to IO and a to Int, and then runs it. You can read more about type defaulting in ghci here: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html On Thu, Dec 22, 2016 at 10:18 AM, Ovidiu Deac wrote: > My understanding is that x can take any form required for type-inference. > That's fine but what is the "default" structure if you don't specify any? > > On Thu, Dec 22, 2016 at 5:13 PM, Imants Cekusins wrote: > >> > What is f here? >> >> anything Applicative: >> >> Prelude> let a1 = pure 1 >> Prelude> let a2 = pure 1 >> >> Prelude> (a1::Maybe Int) == a2 >> True >> Prelude> (a1::Maybe Float) == a2 >> True >> Prelude> (a1::Either String Float) == a2 >> True >> >> >> ​ >> >> _______________________________________________ >> 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 imantc at gmail.com Thu Dec 22 15:38:09 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 22 Dec 2016 16:38:09 +0100 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: > what is the "default" structure if you don't specify any similar to: display::Show a => a -> String display = show fa::(Applicative f, Num a) => f a fa = pure 1 f and a are *bounded* by Applicative and Num, so to say. No default. Or, it is typed however type is a bit broader than * > ​ In this case it defaults f to IO and a to Int, does it though? Prelude> let a1 = pure 1 Prelude> let a2 = pure 1 Prelude> a1 == a2 :20:1: error: • Ambiguous type variable ‘a0’ arising from a use of ‘a1’ prevents the constraint ‘(Num a0)’ from being solved. -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Thu Dec 22 15:45:58 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 22 Dec 2016 16:45:58 +0100 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: > type is a bit broader than * ​ ignore this phrase. it is incorrect. -------------- next part -------------- An HTML attachment was scrubbed... URL: From toad3k at gmail.com Thu Dec 22 15:46:45 2016 From: toad3k at gmail.com (David McBride) Date: Thu, 22 Dec 2016 10:46:45 -0500 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: I get a Num ambiguous constraint error as well, but it is merely not giving you the rest of the errors. Prelude> let a1 = pure (1::Int) Prelude> let a2 = pure (1::Int) Prelude> a1 == a2 • Ambiguous type variable ‘f0’ arising from a use of ‘a1’ prevents the constraint ‘(Applicative f0)’ from being solved. Furthermore you can't compare an IO a with an IO a, so it will still cause an error. But if you go: Prelude>let a1 = 1 Prelude>let a2 = 1 Prelude>a1 == a2 True Then it is totally fine with that. On Thu, Dec 22, 2016 at 10:38 AM, Imants Cekusins wrote: > > what is the "default" structure if you don't specify any > > similar to: > > display::Show a => a -> String > display = show > > fa::(Applicative f, Num a) => f a > fa = pure 1 > > f and a are *bounded* by Applicative and Num, so to say. No default. Or, > it is typed however type is a bit broader than * > > > > ​ In this case it defaults f to IO and a to Int, > > does it though? > > > Prelude> let a1 = pure 1 > Prelude> let a2 = pure 1 > Prelude> a1 == a2 > > :20:1: error: > • Ambiguous type variable ‘a0’ arising from a use of ‘a1’ > prevents the constraint ‘(Num a0)’ from being solved. > > > _______________________________________________ > 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 ovidiudeac at gmail.com Fri Dec 23 12:48:31 2016 From: ovidiudeac at gmail.com (Ovidiu Deac) Date: Fri, 23 Dec 2016 14:48:31 +0200 Subject: [Haskell-beginners] applicative default structure In-Reply-To: References: Message-ID: So normally it should fail but the default typing in ghci is the one who makes our life easier. Thanks for the explanation! On Thu, Dec 22, 2016 at 5:33 PM, David McBride wrote: > Rather than bailing with an instance error for both Applicative and Num, > which is the technically the right way, and the way that it used to be in > the dark ages of ghci. Instead it chooses types which are probably what > you wanted. In this case it defaults f to IO and a to Int, and then runs > it. > > You can read more about type defaulting in ghci here: > https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/ghci.html > > On Thu, Dec 22, 2016 at 10:18 AM, Ovidiu Deac > wrote: > >> My understanding is that x can take any form required for type-inference. >> That's fine but what is the "default" structure if you don't specify any? >> >> On Thu, Dec 22, 2016 at 5:13 PM, Imants Cekusins >> wrote: >> >>> > What is f here? >>> >>> anything Applicative: >>> >>> Prelude> let a1 = pure 1 >>> Prelude> let a2 = pure 1 >>> >>> Prelude> (a1::Maybe Int) == a2 >>> True >>> Prelude> (a1::Maybe Float) == a2 >>> True >>> Prelude> (a1::Either String Float) == a2 >>> True >>> >>> >>> ​ >>> >>> _______________________________________________ >>> 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 magnus at therning.org Sat Dec 24 14:37:40 2016 From: magnus at therning.org (Magnus Therning) Date: Sat, 24 Dec 2016 15:37:40 +0100 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: How did it go? When I solved that AoC problem I ended up using the matrix package: http://hackage.haskell.org/package/matrix /M On 19 Dec 2016 7:31 pm, "mike h" wrote: > Thanks for the pointers - I’ll take a look. > > The background to this is one of the puzzles on Advent Of Code 2016 Q.8. > https://adventofcode.com/2016/day/8 > > There are (several hundred) sequential operations on a grid 50 x 6 > - initially all zeroes > e.g. > rotate row y=0 by 4 > rect 2x1 — sets sub grid from (0,0) to (2,1) to all 1s > rotate column x=35 by 1 > > I’m fine about parsing the input to a data structure and executing > them i.e. > > evalExpr :: Expr -> Screen -> Screen — screen is essentially [[Int]] > evalExpr e s = > case e of > (Rect r c ) -> evalRect r c s > (RotRow r by) -> evalRotRow r by s > (RotCol c by) -> evalRotCol c by s > (NOP ) -> id s > > rotating a row was simple enough, code to rotate column a bit untidy and > not very nice. The > evalRect - which sets values to one in the rectangle of size r x c > starting at (0,0) top left - triggered the original question. > > > At this point my knowledge of Haskell is being pushed (which is good) but > I have a feeling that > my approach is not ‘correct’ once it gets beyond the parsing. Should each > of the evalRect, evalRotRow and evalRotCol be called with a Screen (i.e. > the grid at the root of this question)? > Is the state monad a fit for this problem? > Should I change my approach or is using vector the way forward? > > Many thanks > > Mike > > > > > > On 19 Dec 2016, at 15:27, Michael Orlitzky wrote: > > On 12/19/2016 08:10 AM, mike h wrote: > > Hi, > > I’m looking a problem where I have an NxN grid of ints. I need a > function like setValue x y newVal > > I have tried using [[Int]] but it does become messy when splitting , > dropping and then ++ back together. > > What other options are available to represent a mutable grid? > > > Mutable vectors (from the vector[1] package) are an obvious choice. When > I had to do something similar, I wound up going all the way to repa[2], > which magically turns all of your grid operations into parallel ones. > > > [1] https://hackage.haskell.org/package/vector > [2] https://hackage.haskell.org/package/repa > > _______________________________________________ > 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 mihai.maruseac at gmail.com Sat Dec 24 19:18:53 2016 From: mihai.maruseac at gmail.com (Mihai Maruseac) Date: Sat, 24 Dec 2016 11:18:53 -0800 Subject: [Haskell-beginners] ANNOUNCE: Haskell Communities and Activities Report (31st ed., November 2016) Message-ID: On behalf of all the contributors, we are pleased to announce that the Haskell Communities and Activities Report (31st edition, November 2016) is now available, in PDF and HTML formats: http://haskell.org/communities/11-2016/report.pdf http://haskell.org/communities/11-2016/html/report.html All previous editions of HCAR can be accessed on the wiki at https://wiki.haskell.org/Haskell_Communities_and_Activities_Report Many thanks go to all the people that contributed to this report, both directly, by sending in descriptions, and indirectly, by doing all the interesting things that are reported. We hope you will find it as interesting a read as we did. If you have not encountered the Haskell Communities and Activities Reports before, you may like to know that the first of these reports was published in November 2001. Their goal is to improve the communication between the increasingly diverse groups, projects, and individuals working on, with, or inspired by Haskell. The idea behind these reports is simple: Every six months, a call goes out to all of you enjoying Haskell to contribute brief summaries of your own area of work. Many of you respond (eagerly, unprompted, and sometimes in time for the actual deadline) to the call. The editors collect all the contributions into a single report and feed that back to the community. When we try for the next update, six months from now, you might want to report on your own work, project, research area or group as well. So, please put the following into your diaries now: ======================================== End of February 2016: target deadline for contributions to the May 2017 edition of the HCAR Report ======================================== Unfortunately, many Haskellers working on interesting projects are so busy with their work that they seem to have lost the time to follow the Haskell related mailing lists and newsgroups, and have trouble even finding time to report on their work. If you are a member, user or friend of a project so burdened, please find someone willing to make time to report and ask them to "register" with the editors for a simple e-mail reminder in November (you could point us to them as well, and we can then politely ask if they want to contribute, but it might work better if you do the initial asking). Of course, they will still have to find the ten to fifteen minutes to draw up their report, but maybe we can increase our coverage of all that is going on in the community. Feel free to circulate this announcement further in order to reach people who might otherwise not see it. Enjoy! -- Mihai Maruseac (MM) "If you can't solve a problem, then there's an easier problem you can solve: find it." -- George Polya From fa-ml at ariis.it Tue Dec 27 07:49:11 2016 From: fa-ml at ariis.it (Francesco Ariis) Date: Tue, 27 Dec 2016 08:49:11 +0100 Subject: [Haskell-beginners] [Netwire] Problems constructing a simple Event Wire Message-ID: <20161227074911.GA15752@casa.casa> Hello list, I am learning netwire and decided to write a simple toy program to get to know the library better. The structure is extremely simple: 1. a MVar is created and an endless loop fills it with Char 2. a Wire is created (using mkGen_) to provide Events (from the source described in (1)) 3. the final Wire performs some basic filtering/merging on (2) and outputs a behaviour which is then printed on screen. [[[ I attach a commented .hs, `main` to test, 'x' and C-c to exit ]]] The final wire `testWire2 = hold . (keyQ &> keyA)` doesn't work as expected, i.e. it responds to Q keypresses but not to A ones. I suspect the problem lies in how I used `mkGen_` to create the 'source' wire, but I am not sure to fix it. Any help appreciated! -F -------------- next part -------------- A non-text attachment was scrubbed... Name: beginner-netwire.hs Type: text/x-haskell Size: 2331 bytes Desc: not available URL: From mike_k_houghton at yahoo.co.uk Tue Dec 27 10:38:34 2016 From: mike_k_houghton at yahoo.co.uk (mike h) Date: Tue, 27 Dec 2016 10:38:34 +0000 Subject: [Haskell-beginners] Mutable grid In-Reply-To: References: Message-ID: <99DB1C0E-0778-4305-8B89-FE48D06439FE@yahoo.co.uk> Hi, In the end I used a set to hold tuples of int pairs (row, col) and manipulated them type By = Int type Row = Int type Col = Int type Pixels = Set (Row, Col) data Screen = Screen { maxX :: Col, maxY :: Row, pixels :: Pixels } Thanks Mike > On 24 Dec 2016, at 14:37, Magnus Therning wrote: > > How did it go? > > When I solved that AoC problem I ended up using the matrix package: http://hackage.haskell.org/package/matrix > > /M > > > On 19 Dec 2016 7:31 pm, "mike h" > wrote: > Thanks for the pointers - I’ll take a look. > > The background to this is one of the puzzles on Advent Of Code 2016 Q.8. > https://adventofcode.com/2016/day/8 > > There are (several hundred) sequential operations on a grid 50 x 6 - initially all zeroes > e.g. > rotate row y=0 by 4 > rect 2x1 — sets sub grid from (0,0) to (2,1) to all 1s > rotate column x=35 by 1 > > I’m fine about parsing the input to a data structure and executing them i.e. > > evalExpr :: Expr -> Screen -> Screen — screen is essentially [[Int]] > evalExpr e s = > case e of > (Rect r c ) -> evalRect r c s > (RotRow r by) -> evalRotRow r by s > (RotCol c by) -> evalRotCol c by s > (NOP ) -> id s > > rotating a row was simple enough, code to rotate column a bit untidy and not very nice. The > evalRect - which sets values to one in the rectangle of size r x c starting at (0,0) top left - triggered the original question. > > > At this point my knowledge of Haskell is being pushed (which is good) but I have a feeling that > my approach is not ‘correct’ once it gets beyond the parsing. Should each of the evalRect, evalRotRow and evalRotCol be called with a Screen (i.e. the grid at the root of this question)? > Is the state monad a fit for this problem? > Should I change my approach or is using vector the way forward? > > Many thanks > > Mike > > > > > >> On 19 Dec 2016, at 15:27, Michael Orlitzky > wrote: >> >> On 12/19/2016 08:10 AM, mike h wrote: >>> Hi, >>> >>> I’m looking a problem where I have an NxN grid of ints. I need a >>> function like setValue x y newVal >>> >>> I have tried using [[Int]] but it does become messy when splitting , >>> dropping and then ++ back together. >>> >>> What other options are available to represent a mutable grid? >>> >> >> Mutable vectors (from the vector[1] package) are an obvious choice. When >> I had to do something similar, I wound up going all the way to repa[2], >> which magically turns all of your grid operations into parallel ones. >> >> >> [1] https://hackage.haskell.org/package/vector >> [2] https://hackage.haskell.org/package/repa >> >> _______________________________________________ >> 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 imantc at gmail.com Wed Dec 28 10:55:06 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 28 Dec 2016 11:55:06 +0100 Subject: [Haskell-beginners] Alternative Message-ID: discovered this handy snippet today (duh :): >>> foldl (<|>) Nothing [Nothing, Just 1, Nothing, Just 2] Just 1 basically, pick first Just from a list of Maybes http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Applicative.html#g:2 -------------- next part -------------- An HTML attachment was scrubbed... URL: From ollie at ocharles.org.uk Wed Dec 28 12:10:29 2016 From: ollie at ocharles.org.uk (Oliver Charles) Date: Wed, 28 Dec 2016 12:10:29 +0000 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: If you want something even simpler: asum [Nothing, Just True, Nothing, Just False] >From Data.Foldable :) On Wed, 28 Dec 2016, 10:56 am Imants Cekusins, wrote: > discovered this handy snippet today (duh :): > > >>> foldl (<|>) Nothing [Nothing, Just 1, Nothing, Just 2] > Just 1 > > basically, pick first Just from a list of Maybes > > > > http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Applicative.html#g:2 > _______________________________________________ > 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 Wed Dec 28 12:41:07 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 28 Dec 2016 13:41:07 +0100 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: > something even simpler:​ cheers Oliver. asum *is* better. how is it possible to (<|>) results in: type Am m = (Alternative m, Monad m) (Am m, Am n) => (a -> m (n b)) -> [a] -> m (n b) ? say, m (n b) is IO (Maybe b) -------------- next part -------------- An HTML attachment was scrubbed... URL: From imantc at gmail.com Wed Dec 28 13:08:22 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 28 Dec 2016 14:08:22 +0100 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: > how is it possible to (<|>) results in: .. sequence + asum did it: do lm2 <- sequence m1 asum lm2 `shouldBe` (Just 1) where m1 = [pure Nothing, pure (Just 1), pure (Just 2), pure Nothing]::[IO (Maybe Int)] ​ thank you Oliver. good tip. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Wed Dec 28 20:02:18 2016 From: gale at sefer.org (Yitzchak Gale) Date: Wed, 28 Dec 2016 22:02:18 +0200 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: Imants Cekusins wrote: > foldl (<|>) Nothing [Nothing, Just 1, Nothing, Just 2] > Just 1 Apart from Ollie's suggestion of asum, here are a few more interesting points that come up from your observation: In your solution, you would want to use foldr, not foldl. The left fold forces reading the entire list to the end even though you already hit your Just. A right fold will short circuit. That also means the right fold will even work with an infinite list, as long as there is at least one Just somewhere in the list. (Note that asum uses foldr under the hood. :)) And if you still do use a left fold, you'll want foldl' (from Data.List) rather than foldl. The foldl from the Prelude will build up a pile of unevaluated lazy thunks the size of your list, and only then evaluate all the <|> calculations all at once. So this will crash with a stack overflow error if your list is very large. Whereas foldl' will perform all of the <|> calculations one by one in constant memory. Yitz From imantc at gmail.com Wed Dec 28 20:43:25 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 28 Dec 2016 21:43:25 +0100 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: > you would want to use foldr, not foldl foldl vs foldr baffles me a bit. in Erlang http://erlang.org/doc/man/lists.html#foldl-3 use of *foldl* is suggested. I got used to this and usually use foldl. another reason is: it appears that in Haskell - same as Erlang - *foldl* enumerates items in "natural" order: in [1,2] 1 is passed to the fn, then 2 *foldr* on the other hand begins with 2 and ends with 1. however: *foldr* arg order: a -> acc is more natural. I very rarely deal with large lists and never (so far) with inifinites. for this case for which I consider and use Alternatives - the list would be 2 - 5 items long. The order though is important. >>> asum [Just 1, Just 2] Just 1 >>> asum [Nothing, Just 1, Nothing, Just 2, Nothing] Just 1 looks "naturally" ordered: tested left to right. I may not understand the workings (memory and such) of foldl vs foldr however I hope that for small lists it is sufficient to focus on the order of element processing. order matters. This example hopefully confirms that foldr begins @ end, foldl begins @ start. Same as in Erlang ;) Prelude Data.Foldable> *foldr* (\i1 acc1 -> i1 + acc1 * 2) 0 [1,2] 5 Prelude Data.Foldable> *foldl* (\acc1 i1 -> i1 + acc1 * 2) 0 [1,2] 4 -------------- next part -------------- An HTML attachment was scrubbed... URL: From tonymorris at gmail.com Wed Dec 28 21:07:02 2016 From: tonymorris at gmail.com (Tony Morris) Date: Thu, 29 Dec 2016 07:07:02 +1000 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: <6925f9a5-2e6a-924d-4d30-67bafa0ff8d5@gmail.com> foldr doesn't begin anywhere. https://vimeo.com/64673035 On 29/12/16 06:43, Imants Cekusins wrote: > > you would want to use foldr, not foldl > > foldl vs foldr baffles me a bit. > > in Erlang http://erlang.org/doc/man/lists.html#foldl-3 > use of *foldl* is suggested. I got used to this and usually use foldl. > > another reason is: it appears that in Haskell - same as Erlang - > *foldl* enumerates items in "natural" order: in [1,2] 1 is passed to > the fn, then 2 > > *foldr* on the other hand begins with 2 and ends with 1. > > however: *foldr* arg order: a -> acc is more natural. > > I very rarely deal with large lists and never (so far) with inifinites. > > for this case for which I consider and use Alternatives - the list > would be 2 - 5 items long. The order though is important. > > >>> asum [Just 1, Just 2] > Just 1 > >>> asum [Nothing, Just 1, Nothing, Just 2, Nothing] > Just 1 > > looks "naturally" ordered: tested left to right. > > I may not understand the workings (memory and such) of foldl vs foldr > however I hope that for small lists it is sufficient to focus on the > order of element processing. > > order matters. This example hopefully confirms that foldr begins @ > end, foldl begins @ start. Same as in Erlang ;) > > Prelude Data.Foldable> *foldr* (\i1 acc1 -> i1 + acc1 * 2) 0 [1,2] > 5 > Prelude Data.Foldable> *foldl* (\acc1 i1 -> i1 + acc1 * 2) 0 [1,2] > 4 > > > > > > _______________________________________________ > 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: signature.asc Type: application/pgp-signature Size: 488 bytes Desc: OpenPGP digital signature URL: From gale at sefer.org Wed Dec 28 21:47:10 2016 From: gale at sefer.org (Yitzchak Gale) Date: Wed, 28 Dec 2016 23:47:10 +0200 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: I wrote: >> you would want to use foldr, not foldl Imants Cekusins wrote: > foldl enumerates items in "natural" order: > in [1,2] 1 is passed to the fn, then 2 > foldr on the other hand begins with 2 and ends with 1. The list is not reversed by either one of them. And in both of them, the first element of the list is examined first. With foldl, you apply the complete operation to each element of the list in turn, all the way to the end of the list. With foldr, you start with the first element and say: Let's think about what will happen when we apply the operation to the first element with the result of the entire fold from the second element onward. Knowing only the first element at this time, can we already say what the result will be? In this case, there are two possibilities: If the first element is Just, then yes, we already know the result, and we can discard the rest of the fold without ever actually computing it. If the first element is Nothing, then we don't know the result yet. But we do know that the first element is irrelevant, so we discard it and move on. Doesn't foldr seem like a more natural way to do what you want here? The reason this doesn't work in Erlang is because Erlang is a strict language. When we try to apply the operation with first parameter the first element of the list and second parameter the rest of the fold, Erlang does the entire calculation of that second parameter - the entire fold - before it even starts thinking about the operation. Regards, Yitz From imantc at gmail.com Wed Dec 28 22:14:18 2016 From: imantc at gmail.com (Imants Cekusins) Date: Wed, 28 Dec 2016 23:14:18 +0100 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: thank you Tony and Yitzchak. I may understand it one day ;) it is important to understand it alright. I remember spending half a day over unexpected (for me) results of recursive functions that contained folds. In the end I settled for TChan - a queue with predictable behaviour (my view of it - not necessarily correct). Yitzchak, how about this: Prelude Control.Applicative> *foldl* (<|>) Nothing [Just 1, Nothing, Just 2, Nothing] Just 1 Prelude Control.Applicative> *foldr* (<|>) Nothing [Just 1, Nothing, Just 2, Nothing] Just 1 ? I guess this is due to the nature of (<|>), no? Anyway, I'd use asum instead of fold_ for Alternatives. for non-Alternative cases, Erlang analogy seems to be a useful rule of thumb for foldl & foldr over shorter lists . After all, what matters most is what results to expect. *foldl* and *foldr* may yield different results for the same list & similar processing fn (save for different arg order). ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: From gale at sefer.org Wed Dec 28 23:24:25 2016 From: gale at sefer.org (Yitzchak Gale) Date: Thu, 29 Dec 2016 01:24:25 +0200 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: Imants Cekusins wrote: > Yitzchak, how about this: > > Prelude Control.Applicative> foldl (<|>) Nothing [Just 1, Nothing, Just 2, > Nothing] > Just 1 > Prelude Control.Applicative> foldr (<|>) Nothing [Just 1, Nothing, Just 2, > Nothing] > Just 1 > > ? I guess this is due to the nature of (<|>), no? Yes, you are right. <|> for Maybe satisfies the associative law: (x <|> y) <|> z == x <|> (y <|> z) for all x, y, and z. So it does not matter if you apply it from right to left or from left to right. > Anyway, I'd use asum instead of fold_ for Alternatives. Agreed. For the actual problem, Ollie is right. I just thought you might be interested in these other concepts that come up from your good thinking. Regards, Yitz From imantc at gmail.com Wed Dec 28 23:37:54 2016 From: imantc at gmail.com (Imants Cekusins) Date: Thu, 29 Dec 2016 00:37:54 +0100 Subject: [Haskell-beginners] Alternative In-Reply-To: References: Message-ID: Yitzchak, I am interested alright. However for very practical purpose. > (x <|> y) <|> z == x <|> (y <|> z) understood. thank you Yitzchak. we will revisit *recurse & fold *problem I ran into earlier. probably in Jan though. ​ -------------- next part -------------- An HTML attachment was scrubbed... URL: