From alexander at chenjia.nl Tue Jun 2 16:05:51 2020 From: alexander at chenjia.nl (Alexander Chen) Date: Tue, 2 Jun 2020 18:05:51 +0200 (CEST) Subject: [Haskell-beginners] filtering on a datatype Message-ID: <2130923369.348871.1591113951698@ichabod.co-bxl> Hi, given this: import Data.Time data DatabaseItem = DbString String                   | DbNumber Integer                   | DbDate   UTCTime                   deriving  (Eq, Ord, Show) theDatabase :: [DatabaseItem] theDatabase =     [ DbDate (UTCTime              (fromGregorian 1911 5 1)       (secondsToDiffTime 34250))     , DbNumber 9001     , DbString "Hello, world!"     , DbDate (UTCTime              (fromGregorian 1921 5 1)              (secondsToDiffTime 34123))     ] question from textbook is : write a function that filters for DbDate values and returns a list of the UTCTime values inside them. my question could you give me an example of a working function, I don't get how i use the filter function on a data type in a list. Hence i am kinda stuck. thanks in advance. best, -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Tue Jun 2 16:45:33 2020 From: bob at redivi.com (Bob Ippolito) Date: Tue, 2 Jun 2020 09:45:33 -0700 Subject: [Haskell-beginners] filtering on a datatype In-Reply-To: <2130923369.348871.1591113951698@ichabod.co-bxl> References: <2130923369.348871.1591113951698@ichabod.co-bxl> Message-ID: I can see why you’re a bit confused here, the question is poorly written. You can not use the Prelude filter function to do this, but you do need to write a function that filters and maps over the data to do this transformation (onlyDateTimes below is an example type signature for such a function). mapMaybe is the sort of function you may to use for this purpose. Here are some type signatures as a hint for one way to implement it: dbDateTime :: DatabaseItem -> Maybe UTCTime onlyDateTimes :: [DatabaseItem] -> [UTCTime] There are of course other ways to implement onlyDateTimes such as directly using pattern matching and recursion, or using foldr, concatMap, etc. I would go with whichever method you’ve learned from the textbook so far. -bob On Tue, Jun 2, 2020 at 09:06 Alexander Chen wrote: > Hi, > > given this: > import Data.Time > > data DatabaseItem = DbString String > | DbNumber Integer > | DbDate UTCTime > deriving (Eq, Ord, Show) > > theDatabase :: [DatabaseItem] > theDatabase = > [ DbDate (UTCTime > (fromGregorian 1911 5 1) > (secondsToDiffTime 34250)) > , DbNumber 9001 > , DbString "Hello, world!" > , DbDate (UTCTime > (fromGregorian 1921 5 1) > (secondsToDiffTime 34123)) > ] > > > question from textbook is : write a function that filters for DbDate > values and returns a list of the UTCTime values inside them. > > > my question could you give me an example of a working function, I don't > get how i use the filter function on a data type in a list. Hence i am > kinda stuck. > > thanks in advance. > > 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 alexander at chenjia.nl Wed Jun 10 14:49:05 2020 From: alexander at chenjia.nl (Alexander Chen) Date: Wed, 10 Jun 2020 16:49:05 +0200 (CEST) Subject: [Haskell-beginners] foldr point free notation Message-ID: <514947741.528496.1591800545875@ichabod.co-bxl> hi, --any function foldr myAny'' :: (a-> Bool) -> [a] -> Bool myAny'' f = foldr (\a b -> f a || b) False this is the foldr notions. How would i make this point free? best, -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Wed Jun 10 15:00:34 2020 From: bob at redivi.com (Bob Ippolito) Date: Wed, 10 Jun 2020 08:00:34 -0700 Subject: [Haskell-beginners] foldr point free notation In-Reply-To: <514947741.528496.1591800545875@ichabod.co-bxl> References: <514947741.528496.1591800545875@ichabod.co-bxl> Message-ID: The better question is why would you want to? If you could even manage, the result would be practically incomprehensible. On Wed, Jun 10, 2020 at 07:49 Alexander Chen wrote: > hi, > > --any function foldr > myAny'' :: (a-> Bool) -> [a] -> Bool > myAny'' f = foldr (\a b -> f a || b) False > > this is the foldr notions. How would i make this point free? > > 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 apoorv.ingle at gmail.com Wed Jun 10 15:50:27 2020 From: apoorv.ingle at gmail.com (Apoorv Ingle) Date: Wed, 10 Jun 2020 10:50:27 -0500 Subject: [Haskell-beginners] foldr point free notation In-Reply-To: References: <514947741.528496.1591800545875@ichabod.co-bxl> Message-ID: Hi Alexander, I found this tool online[1], that converts your function to a point free style. myAny'' f = foldr (\a b -> f a || b) False is transformed to myAny'' = flip foldr False . ((||) .) Again as Bob mentions, the point free style comes at a cost of unreadability and hence unmaintainable. Cheers! Apoorv [1]: http://pointfree.io/ > On Jun 10, 2020, at 10:00, Bob Ippolito wrote: > > The better question is why would you want to? If you could even manage, the result would be practically incomprehensible. > > On Wed, Jun 10, 2020 at 07:49 Alexander Chen > wrote: > hi, > > --any function foldr > myAny'' :: (a-> Bool) -> [a] -> Bool > myAny'' f = foldr (\a b -> f a || b) False > > this is the foldr notions. How would i make this point free? > > best, > _______________________________________________ > 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 alexander at chenjia.nl Wed Jun 10 18:42:12 2020 From: alexander at chenjia.nl (Alexander Chen) Date: Wed, 10 Jun 2020 20:42:12 +0200 (CEST) Subject: [Haskell-beginners] Why do i need to take out the list for this to work Message-ID: <1276054988.546547.1591814532791@ichabod.co-bxl> hi, assigment: make your own element function with the any function. --elem with any myElemAny :: Eq a => a -> [a] -> Bool myElemAny a = any (== a) --elem with any myElemAny' :: Eq a => a -> [a] -> Bool myElemAny' a [x]= any (== a) [x] myElemAny' compiles but throws an error because it has a non-exhaustive pattern. Could somebody tell me why the list gives the function grieveness? thanks, -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Wed Jun 10 18:49:48 2020 From: bob at redivi.com (Bob Ippolito) Date: Wed, 10 Jun 2020 11:49:48 -0700 Subject: [Haskell-beginners] Why do i need to take out the list for this to work In-Reply-To: <1276054988.546547.1591814532791@ichabod.co-bxl> References: <1276054988.546547.1591814532791@ichabod.co-bxl> Message-ID: Square brackets [] are pattern match syntax for lists. This will only work for lists of length 1, anything else will be an error. Get rid of the brackets on both sides of the equation and it will do what you expect. Typically list variables are given plural names, such as xs instead of x. On Wed, Jun 10, 2020 at 11:42 Alexander Chen wrote: > hi, > > assigment: make your own element function with the any function. > > --elem with any > myElemAny :: Eq a => a -> [a] -> Bool > myElemAny a = any (== a) > > --elem with any > myElemAny' :: Eq a => a -> [a] -> Bool > myElemAny' a [x]= any (== a) [x] > > > myElemAny' compiles but throws an error because it has a non-exhaustive > pattern. Could somebody tell me why the list gives the function grieveness? > > 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 alexander at chenjia.nl Wed Jun 17 10:13:02 2020 From: alexander at chenjia.nl (Alexander Chen) Date: Wed, 17 Jun 2020 12:13:02 +0200 (CEST) Subject: [Haskell-beginners] Easy to use XML parser Message-ID: <761200936.386756.1592388782825@ichabod.co-bxl> Hi, For eductional/testing purposes I am looking for an .xml parser which can output strictly .csv. The pipeline goes from .xml -> .csv -> SQL table. The fat ones are already written in another language. Can you recommend a parser that can achieve this, has understandable documentation and is easy to use? thanks in advance. p.s. It would be great if you have personal experience with the library. best, -------------- next part -------------- An HTML attachment was scrubbed... URL: From tonymorris at gmail.com Wed Jun 17 12:29:05 2020 From: tonymorris at gmail.com (Tony Morris) Date: Wed, 17 Jun 2020 22:29:05 +1000 Subject: [Haskell-beginners] Easy to use XML parser In-Reply-To: <761200936.386756.1592388782825@ichabod.co-bxl> References: <761200936.386756.1592388782825@ichabod.co-bxl> Message-ID: hackage.haskell.org/package/tagsoup hackage.haskell.org/package/tagsoup-navigate hackage.haskell.org/package/sv On 6/17/20 8:13 PM, Alexander Chen wrote: > Hi, > > For eductional/testing purposes I am looking for an .xml parser which > can output strictly .csv. The pipeline goes from .xml -> *.csv -> SQL > table. *The fat ones are already written in another language. > > Can you recommend a parser that can achieve this, has understandable > documentation and is easy to use? > > thanks in advance. > > p.s. It would be great if you have personal experience with the library. > > best, > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 488 bytes Desc: OpenPGP digital signature URL: From ky3 at atamo.com Wed Jun 17 19:48:10 2020 From: ky3 at atamo.com (Kim-Ee Yeoh) Date: Thu, 18 Jun 2020 02:48:10 +0700 Subject: [Haskell-beginners] Why do i need to take out the list for this to work In-Reply-To: <1276054988.546547.1591814532791@ichabod.co-bxl> References: <1276054988.546547.1591814532791@ichabod.co-bxl> Message-ID: On Thu, Jun 11, 2020 at 1:42 AM Alexander Chen wrote: > hi, > > assigment: make your own element function with the any function. > > --elem with any > myElemAny :: Eq a => a -> [a] -> Bool > myElemAny a = any (== a) > > --elem with any > myElemAny' :: Eq a => a -> [a] -> Bool > myElemAny' a [x]= any (== a) [x] > > >From a beginners perspective, the second function looks perfectly cromulent. After all, how should one indicate a list if not by enclosing it with square brackets like this, [x]? An x might or might not be a list, but [x] surely has to be one, yes? But consider all the things that could be a list. Specifically, look at the following: 1. An empty list—which haskell denotes using []—is a list 2. [1,2,3] is a list 3. [1,1,1,…] is a list In each of the cases above, what is the value of x in [x]? Recall that haskell is a value-oriented language. Every identifier at the term-level evaluates to something that has a well-defined type. > myElemAny' compiles but throws an error because it has a non-exhaustive > pattern. Could somebody tell me why the list gives the function grieveness? > > thanks, > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -- -- Kim-Ee -------------- next part -------------- An HTML attachment was scrubbed... URL: From julian_ong at yahoo.com Sat Jun 27 22:41:42 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Sat, 27 Jun 2020 22:41:42 +0000 (UTC) Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ References: <454363786.217504.1593297702557.ref@mail.yahoo.com> Message-ID: <454363786.217504.1593297702557@mail.yahoo.com> Hi - I'm working through these problems using Haskell and was curious if anyone else is doing that. I'm currently stuck on the Two Knights problem. I have implemented a solution using recursion but it's not fast enough to pass the tests. Has anyone been able to solve this problem using Haskell? Looking for some optimization tips. I'm not sure if there's a better way to implement the recursive algorithm - is it doing unnecessary work? The problem requires that you calculate solutions for 1..n so you need to keep track of all intermediate values. The program fails the speed test for n=10000 -- it needs to complete in less than a second. I hold out hope that it's doable in Haskell but I can't figure it out. The algorithm uses the solution for the (k-1)x(k-1) board and adds the additional possibilities when you add a new left column and bottom row to make a kxk board. My current attempt looks like this:---- import Control.Monad main :: IO ()main = do    line <- getLine    let n = read line :: Integer    putStr $ unlines $ map show $ reverse $ solveK n solveK :: Integer -> [Integer]solveK k    | k == 1 = [0]    | otherwise = (solveFrameK k + head (solveK (k-1))) : solveK (k-1) -- Returns list of knight moves in the upper right (k-1) x (k-1) portion of the board excluding the first column and first rowmoveKnightUR :: Integer -> (Integer, Integer) -> [(Integer, Integer)]moveKnightUR k (c, r) = do    (c', r') <- [(c-1, r+2), (c+1, r+2), (c+2, r+1), (c+2, r-1), (c+1, r-2), (c-1, r-2), (c-2, r-1), (c-2, r+1)]    guard (c' `elem` [2..k] && r' `elem` [2..k])    return (c', r')    -- Returns list of left and bottom border squares for k x k board in (col, row) format with (1, 1) being the lower left squaregenBorder :: Integer -> [(Integer, Integer)]genBorder k = [(1, a) | a <- [1..k]] ++ [(a, 1) | a <- [2..k]] -- Formula for combinations C(n, r)combinations :: Integer -> Integer -> Integercombinations n r = product [1..n] `div` (product [1..(n-r)] * product [1..r]) -- Calculates additional number of two knight placements along the left and bottom border and from that border into the upper right (k-1) x (k-1) regionsolveFrameK :: Integer -> IntegersolveFrameK k    | k == 1 = 0    | k == 2 = 6    | otherwise = ((combinations (2*k-1) 2) - 2) + (k-1) * (k-1) * (2*k-1) - sum (map (toInteger . length) (map (moveKnightUR k) (genBorder k)))---- Julian -------------- next part -------------- An HTML attachment was scrubbed... URL: From joshuatfriedlander at gmail.com Sun Jun 28 11:36:36 2020 From: joshuatfriedlander at gmail.com (Josh Friedlander) Date: Sun, 28 Jun 2020 14:36:36 +0300 Subject: [Haskell-beginners] Using output of head in data constuctor Message-ID: Given the following code: module Log where import Control.Applicative data MessageType = Info | Warning | Error Int type TimeStamp = Int data LogMessage = LogMessage MessageType TimeStamp String | Unknown String I want to create a log parser like this: module LogAnalysis where import Log parseMessage :: String -> LogMessage parseMessage xs | length(words(xs)) < 3 = Unknown xs | notElem(head(words(xs)) ["I", "E", "W"]) = Unknown xs | otherwise = LogMessage Info 3 head(words(xs)) But GHC gives me "• Couldn't match type ‘[a0] -> a0’ with ‘[Char]’ Expected type: String Actual type: [a0] -> a0" So it thinks I am giving it the *function* head, when I would like to give it the output. How do I fix this? Thanks in advance, -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sun Jun 28 11:47:09 2020 From: fa-ml at ariis.it (Francesco Ariis) Date: Sun, 28 Jun 2020 13:47:09 +0200 Subject: [Haskell-beginners] Using output of head in data constuctor In-Reply-To: References: Message-ID: <20200628114709.GA24819@extensa> Hello Josh Il 28 giugno 2020 alle 14:36 Josh Friedlander ha scritto: > I want to create a log parser like this: > > module LogAnalysis where > import Log > > parseMessage :: String -> LogMessage > parseMessage xs > | length(words(xs)) < 3 = Unknown xs > | notElem(head(words(xs)) ["I", "E", "W"]) = Unknown xs > | otherwise = LogMessage Info 3 head(words(xs)) > > But GHC gives me "• Couldn't match type ‘[a0] -> a0’ with ‘[Char]’ > Expected type: String > Actual type: [a0] -> a0" I suspect `LogMessage Info 3 head(words(xs))` is the problem. This is the same as writing LogMessage Info 3 head (words xs) keeping in mind how whitespace and parentheses work in Haskell. You probably want LogMessage Info 3 (head (words xs)) instead. From joshuatfriedlander at gmail.com Sun Jun 28 12:50:20 2020 From: joshuatfriedlander at gmail.com (Josh Friedlander) Date: Sun, 28 Jun 2020 15:50:20 +0300 Subject: [Haskell-beginners] Using output of head in data constuctor In-Reply-To: <20200628114709.GA24819@extensa> References: <20200628114709.GA24819@extensa> Message-ID: Thanks Francesco, that works. I don't quite understand what the issue was, though. Specifically: - Did the parentheses around (xs) hurt, or were they just redundant? - Wouldn't the parentheses around (head ...) be binding it as an argument to whatever comes before (in this case, 3)? On Sun, 28 Jun 2020 at 14:47, Francesco Ariis wrote: > Hello Josh > > Il 28 giugno 2020 alle 14:36 Josh Friedlander ha scritto: > > I want to create a log parser like this: > > > > module LogAnalysis where > > import Log > > > > parseMessage :: String -> LogMessage > > parseMessage xs > > | length(words(xs)) < 3 = Unknown xs > > | notElem(head(words(xs)) ["I", "E", "W"]) = Unknown xs > > | otherwise = LogMessage Info 3 head(words(xs)) > > > > But GHC gives me "• Couldn't match type ‘[a0] -> a0’ with ‘[Char]’ > > Expected type: String > > Actual type: [a0] -> a0" > > I suspect `LogMessage Info 3 head(words(xs))` is the problem. This is > the same as writing > > LogMessage Info 3 head (words xs) > > keeping in mind how whitespace and parentheses work in Haskell. You > probably want > > LogMessage Info 3 (head (words xs)) > > instead. > _______________________________________________ > 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 t_gass at gmx.de Sun Jun 28 14:03:37 2020 From: t_gass at gmx.de (Tilmann) Date: Sun, 28 Jun 2020 16:03:37 +0200 Subject: [Haskell-beginners] How to structure an application? Message-ID: Hi, I hope to get some advice on how to structure an application. So I acquire a handle early on that I use all over the app, but I don't want to pass the handle itself around, but wrap the handle with "commands" that a) make a nicer api and/or b) only allow specific usecases of the handle. I tried and failed to use MonadReader in a straightforward way and now I'm wondering what options there are. Looking forward to your feedback, Best, Tilmann module Main where import           Control.Monad import           Control.Monad.Reader import           Graphics.UI.WX import           System.IO -- imagine many more commands like this one ping :: (MonadReader Handle m, MonadIO m) => m () ping = do   h <- ask   liftIO $ hPutStrLn h "ping" main :: IO () main = do   let h = stdout -- in the real app, this handle isn't stdout of course but opened separately   start $ runReaderT wxApp h wxApp :: (MonadReader Handle m, MonadIO m) => m () wxApp = do   ping -- this works, but I don't need it here..   liftIO $ do     f <- frame [ ]     timer f [ interval := 1000             -- , on command := hputStrLn h "ping" -- this is what I try to avoid             -- , on command := ping -- of course, this doesn't work, but it would be so nice..             , enabled := True]     return () -- Alternatively main2 :: IO () main2 = do   let h = stdout   start $ runReaderT wxApp2 (mkCommands h) wxApp2 :: (MonadReader Commands m, MonadIO m) => m () wxApp2 = do   commands <- ask   liftIO $ do     f <- frame [ ]     timer f [ interval := 1000             , on command := ping2 commands             , enabled := True]     return () data Commands = Commands {     ping2 :: IO ()   -- .. many more } mkCommands :: Handle -> Commands mkCommands h = Commands (hPutStrLn h "ping") From bob at redivi.com Sun Jun 28 14:35:15 2020 From: bob at redivi.com (Bob Ippolito) Date: Sun, 28 Jun 2020 07:35:15 -0700 Subject: [Haskell-beginners] Using output of head in data constuctor In-Reply-To: References: <20200628114709.GA24819@extensa> Message-ID: Parentheses in Haskell aren’t really related to function application, they are only for grouping. It makes more sense if you avoid using them unless strictly necessary. In Haskell instead of `f(g(x))` we would write `f (g x)`, and instead of `f(x,g(y),z)` we would write `f x (g y) z`. You could use more parentheses but it would be more confusing, such as `(f)(x)(g(y))(z)`. On Sun, Jun 28, 2020 at 05:50 Josh Friedlander wrote: > Thanks Francesco, that works. I don't quite understand what the issue was, > though. Specifically: > - Did the parentheses around (xs) hurt, or were they just redundant? > - Wouldn't the parentheses around (head ...) be binding it as an argument > to whatever comes before (in this case, 3)? > > On Sun, 28 Jun 2020 at 14:47, Francesco Ariis wrote: > >> Hello Josh >> >> Il 28 giugno 2020 alle 14:36 Josh Friedlander ha scritto: >> > I want to create a log parser like this: >> > >> > module LogAnalysis where >> > import Log >> > >> > parseMessage :: String -> LogMessage >> > parseMessage xs >> > | length(words(xs)) < 3 = Unknown xs >> > | notElem(head(words(xs)) ["I", "E", "W"]) = Unknown xs >> > | otherwise = LogMessage Info 3 head(words(xs)) >> > >> > But GHC gives me "• Couldn't match type ‘[a0] -> a0’ with ‘[Char]’ >> > Expected type: String >> > Actual type: [a0] -> a0" >> >> I suspect `LogMessage Info 3 head(words(xs))` is the problem. This is >> the same as writing >> >> LogMessage Info 3 head (words xs) >> >> keeping in mind how whitespace and parentheses work in Haskell. You >> probably want >> >> LogMessage Info 3 (head (words xs)) >> >> instead. >> _______________________________________________ >> 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 doug at cs.dartmouth.edu Sun Jun 28 15:26:06 2020 From: doug at cs.dartmouth.edu (Doug McIlroy) Date: Sun, 28 Jun 2020 11:26:06 -0400 Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ Message-ID: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> > I'm currently stuck on the Two Knights problem. Having placed one knight on the board, in how many places can you put the other? Doug McIlroy From julian_ong at yahoo.com Sun Jun 28 16:00:51 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Sun, 28 Jun 2020 09:00:51 -0700 Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ In-Reply-To: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> References: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> Message-ID: <014477EA-33D5-47BC-BD4F-9FB147775CDD@yahoo.com> There are 8 possibilities and then you can filter them by column and row values depending on the region of the board you’re interested in. Julian On Jun 28, 2020, at 8:26 AM, Doug McIlroy wrote:  > I'm currently stuck on the Two Knights problem. Having placed one knight on the board, in how many places can you put the other? Doug McIlroy From irfon at ambienautica.com Sun Jun 28 16:48:12 2020 From: irfon at ambienautica.com (Irfon-Kim Ahmad) Date: Sun, 28 Jun 2020 12:48:12 -0400 Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ In-Reply-To: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> References: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> Message-ID: <0bcd69e9-10d4-3f41-274f-8e860692a9ed@ambienautica.com> On 2020-06-28 11:26 a.m., Doug McIlroy wrote: >> I'm currently stuck on the Two Knights problem. > Having placed one knight on the board, in how many > places can you put the other? If you check the website indicated, it's a slight variation on that: "Your task is to count for k=1,2,…,nthe number of ways two knights can be placed on a k×kchessboard so that they do not attack each other." The input is n (an integer that can range from 1 to 10000), the output is a single integer for each value from 1 to n, one per line, the memory limit is 512MB, and the maximum runtime is 1.00 seconds. -------------- next part -------------- An HTML attachment was scrubbed... URL: From julian_ong at yahoo.com Sun Jun 28 23:27:07 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Sun, 28 Jun 2020 23:27:07 +0000 (UTC) Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ In-Reply-To: <0bcd69e9-10d4-3f41-274f-8e860692a9ed@ambienautica.com> References: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> <0bcd69e9-10d4-3f41-274f-8e860692a9ed@ambienautica.com> Message-ID: <1817199903.471182.1593386827847@mail.yahoo.com> I realized I did not answer the question Doug posed, but the algorithm as originally presented works correctly and calculates correctly the number of possible knight pairings for each k x k board and generates the correct output requested by the problem. The issue is still that, as I have implemented it in Haskell, it doesn't run fast enough to pass the automated CSES testing for n=10000. I am very curious whether it's possible to pass the speed testing for this problem using Haskell and if so how. On Sunday, June 28, 2020, 09:49:02 AM PDT, Irfon-Kim Ahmad wrote: On 2020-06-28 11:26 a.m., Doug McIlroy wrote: I'm currently stuck on the Two Knights problem. Having placed one knight on the board, in how many places can you put the other? If you check the website indicated, it's a slight variation on that: "Your task is to count for k=1,2,…,n the number of ways two knights can be placed on a k×k chessboard so that they do not attack each other." The input is n (an integer that can range from 1 to 10000), the output is a single integer for each value from 1 to n, one per line, the memory limit is 512MB, and the maximum runtime is 1.00 seconds. _______________________________________________ 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 julian_ong at yahoo.com Sun Jun 28 23:45:18 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Sun, 28 Jun 2020 23:45:18 +0000 (UTC) Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ In-Reply-To: <1817199903.471182.1593386827847@mail.yahoo.com> References: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> <0bcd69e9-10d4-3f41-274f-8e860692a9ed@ambienautica.com> <1817199903.471182.1593386827847@mail.yahoo.com> Message-ID: <1581505561.464885.1593387918987@mail.yahoo.com> I've simplified and optimized it slightly (no need to use a monad for moveKnightUR) but overall it's still not fast enough to pass the CSES test. I'm wondering if the recursion is somehow inefficient because of two instances of solveK (k-1)...?---- main :: IO ()main = do    line <- getLine    let n = read line :: Integer    putStr $ unlines $ map show $ reverse $ solveK n solveK :: Integer -> [Integer]solveK k    | k == 1 = [0]    | otherwise = (solveFrameK k + head (solveK (k-1))) : solveK (k-1) -- Returns list of knight moves in the upper right (k-1) x (k-1) portion of the board excluding the first column and first rowmoveKnightUR :: Integer -> (Integer, Integer) -> [(Integer, Integer)]moveKnightUR k (c, r) = filter (\(c', r') -> c' `elem` [2..k] && r' `elem` [2..k]) [(c-1, r+2), (c+1, r+2), (c+2, r+1), (c+2, r-1), (c+1, r-2), (c-2, r+1)]    -- Returns list of left and bottom border squares for k x k board in (col, row) format with (1, 1) being the lower left squaregenBorder :: Integer -> [(Integer, Integer)]genBorder k = [(1, a) | a <- [1..k]] ++ [(a, 1) | a <- [2..k]] -- Formula for combinations C(n, r)combinations :: Integer -> Integer -> Integercombinations n r = product [1..n] `div` (product [1..(n-r)] * product [1..r]) -- Calculates additional number of two knight placements along the left and bottom border and from that border into the upper right (k-1) x (k-1) regionsolveFrameK :: Integer -> IntegersolveFrameK k    | k == 1 = 0    | k == 2 = 6    | otherwise = ((combinations (2*k-1) 2) - 2) + (k-1) * (k-1) * (2*k-1) - sum (map (toInteger . length) (map (moveKnightUR k) (genBorder k)))---- Julian On Sunday, June 28, 2020, 04:27:07 PM PDT, Julian Ong wrote: I realized I did not answer the question Doug posed, but the algorithm as originally presented works correctly and calculates correctly the number of possible knight pairings for each k x k board and generates the correct output requested by the problem. The issue is still that, as I have implemented it in Haskell, it doesn't run fast enough to pass the automated CSES testing for n=10000. I am very curious whether it's possible to pass the speed testing for this problem using Haskell and if so how. On Sunday, June 28, 2020, 09:49:02 AM PDT, Irfon-Kim Ahmad wrote: On 2020-06-28 11:26 a.m., Doug McIlroy wrote: I'm currently stuck on the Two Knights problem. Having placed one knight on the board, in how many places can you put the other? If you check the website indicated, it's a slight variation on that: "Your task is to count for k=1,2,…,n the number of ways two knights can be placed on a k×k chessboard so that they do not attack each other." The input is n (an integer that can range from 1 to 10000), the output is a single integer for each value from 1 to n, one per line, the memory limit is 512MB, and the maximum runtime is 1.00 seconds. _______________________________________________ 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 julian_ong at yahoo.com Mon Jun 29 00:50:40 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Mon, 29 Jun 2020 00:50:40 +0000 (UTC) Subject: [Haskell-beginners] CSES Two Sets problem at https://cses.fi/problemset/task/1092/ References: <1998786082.488717.1593391840318.ref@mail.yahoo.com> Message-ID: <1998786082.488717.1593391840318@mail.yahoo.com> After the Two Knights problem, I went on this next problem which requires that you separate 1..n into two sets with the same sum if possible. Again my algorithm in Haskell works but is apparently too slow. It fails for CSES test inputs >= 26560 where a solution exists. I'm starting to wonder if Haskell is fundamentally too slow compared to other languages. From what I've read that shouldn't be the case though. For this problem it looks like it's doable in Python (I haven't tried that). Most of the fastest solutions for these problems seem to be written in C++. If there's anyone who's trying to solve these problems in Haskell (they're really fun by the way if you've never checked them out) and has solved this one (or Two Knights) and passed all the tests, I'd love to hear how you did it. Thanks. --- -- CSES - Two Sets-- Given 1..n, separate into two sets of equal sums and if possible list the elements of each set of a possible solution or output NO if not possible main :: IO ()main = do    line <- getLine    let n = read line :: Integer    putStrLn $ solveN n    -- Observe that sum [1..n] = n*(n+1)/2 so each set sum must be n*(n+1)/4 and so the set sum must be divisible by 4 for the separation to be possible-- Then the algorithm starts adding numbers from n down to 1 until the next number would make the sum exceed the required set sum-- At this point you add one more number, which will be the lowest number, to fill in the gap to complete set1. Set2 is then the other numbers.solveN :: Integer -> StringsolveN n    | (n * (n+1) `mod` 4 /= 0) = "NO"    | otherwise = "YES\n" ++ show set1_count ++ "\n" ++ (unwords $ map show set1_list) ++ "\n" ++ show set2_count ++ "\n" ++ (unwords $ map show set2_list)        where            set_sum = (n * (n+1)) `div` 4            set1_part1 = takeWhile (\x -> x*(n+1-x) + sum [0..(n-x)] < (n * (n+1)) `div` 4) [n, n-1..1]            set1_part2 = set_sum - sum set1_part1            set1_list = set1_part1 ++ [set1_part2]            set1_count = (toInteger . length) set1_list            set2_list = [x | x <- [1..n], not (x `elem` set1_list)]            set2_count = (toInteger . length) set2_list---- Julian -------------- next part -------------- An HTML attachment was scrubbed... URL: From irfon at ambienautica.com Mon Jun 29 14:36:11 2020 From: irfon at ambienautica.com (Irfon-Kim Ahmad) Date: Mon, 29 Jun 2020 10:36:11 -0400 Subject: [Haskell-beginners] CSES Two Sets problem at https://cses.fi/problemset/task/1092/ In-Reply-To: <1998786082.488717.1593391840318@mail.yahoo.com> References: <1998786082.488717.1593391840318.ref@mail.yahoo.com> <1998786082.488717.1593391840318@mail.yahoo.com> Message-ID: Without having attempted to code this in any particular language, but just thinking about the problem, I believe the CSES knights problem is not a test of language speed or programming acumen but a test of choosing an efficient choice of algorithm that doesn't generate more information than the question asks for. In short, they're asking for the NUMBER of boards, not the actual boards. Most of the solutions people are proposing in Haskell simulate the problem instead of calculating it -- in short, they generate the actual boards, then count them, whereas the solution only requires you to count them. The solutions for n = 1 and n = 2 can be calculated by hand and put in as constants. n = 3 you can calculate or simulate as is your preference. Knights have a maximum interaction range of three linear squares. Knights placed more than three squares apart in any one direction cannot hinder each other. So the number of illegal placements of knights can be confined to a 3x3 board. After that, all illegal boards of size n x n are simply one of those 3 x 3 boards shifted to a new position. The total number of n x n boards with two knights placed on them is given by (n^2) choose 2, which I'm not going to look up because it's been over 20 years since I took statistics and I'm happy about that. Still, it's a calculation. Not a super simple one from a computing perspective, since it involved factorials, but I'm assuming someone has figured out how to do factorials quickly in Haskell? The number of places you can position a 3 x 3 board within an n x n space is something like (n-3)^2 if I'm not mistaken? So you can subtract that from the total number of boards to arrive at a result. NOTE: This likely requires SOME tweaking for edge cases (For example, Is the board where k1 is in position x and k2 is in position y considered the same as the board where their positions reversed, or not? Does the choosing calculation factor for that properly?) because it's literally a ten-second-in-the-shower concept, but it seems like this could come up with a result. Whether it does it in time is mostly down to whether Haskell can do factorials fast enough at that point. On 2020-06-28 8:50 p.m., Julian Ong wrote: > After the Two Knights problem, I went on this next problem which > requires that you separate 1..n into two sets with the same sum if > possible. Again my algorithm in Haskell works but is apparently too > slow. It fails for CSES test inputs >= 26560 where a solution exists. > > I'm starting to wonder if Haskell is fundamentally too slow compared > to other languages. From what I've read that shouldn't be the case > though. For this problem it looks like it's doable in Python (I > haven't tried that). Most of the fastest solutions for these problems > seem to be written in C++. If there's anyone who's trying to solve > these problems in Haskell (they're really fun by the way if you've > never checked them out) and has solved this one (or Two Knights) and > passed all the tests, I'd love to hear how you did it. Thanks. > > --- > > -- CSES - Two Sets > -- Given 1..n, separate into two sets of equal sums and if possible > list the elements of each set of a possible solution or output NO if > not possible > > main :: IO () > main = do >     line <- getLine >     let n = read line :: Integer >     putStrLn $ solveN n > -- Observe that sum [1..n] = n*(n+1)/2 so each set sum must be > n*(n+1)/4 and so the set sum must be divisible by 4 for the separation > to be possible > -- Then the algorithm starts adding numbers from n down to 1 until the > next number would make the sum exceed the required set sum > -- At this point you add one more number, which will be the lowest > number, to fill in the gap to complete set1. Set2 is then the other > numbers. > solveN :: Integer -> String > solveN n >     | (n * (n+1) `mod` 4 /= 0) = "NO" >     | otherwise = "YES\n" ++ show set1_count ++ "\n" ++ (unwords $ map > show set1_list) ++ "\n" ++ show set2_count ++ "\n" ++ (unwords $ map > show set2_list) >         where >             set_sum = (n * (n+1)) `div` 4 >             set1_part1 = takeWhile (\x -> x*(n+1-x) + sum [0..(n-x)] < > (n * (n+1)) `div` 4) [n, n-1..1] >             set1_part2 = set_sum - sum set1_part1 >             set1_list = set1_part1 ++ [set1_part2] >             set1_count = (toInteger . length) set1_list >             set2_list = [x | x <- [1..n], not (x `elem` set1_list)] >             set2_count = (toInteger . length) set2_list > ---- > > Julian > > _______________________________________________ > 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 julian_ong at yahoo.com Tue Jun 30 05:59:09 2020 From: julian_ong at yahoo.com (Julian Ong) Date: Tue, 30 Jun 2020 05:59:09 +0000 (UTC) Subject: [Haskell-beginners] CSES programming problems at https://cses.fi/problemset/ [Two Knights] In-Reply-To: <014477EA-33D5-47BC-BD4F-9FB147775CDD@yahoo.com> References: <202006281526.05SFQ6il119550@tahoe.cs.Dartmouth.EDU> <014477EA-33D5-47BC-BD4F-9FB147775CDD@yahoo.com> Message-ID: <590680425.128466.1593496749046@mail.yahoo.com> Update: Doug showed me a fast algorithm that does the trick. It doesn't use recursion. For an nxn board, the algorithm counts the possibilities given a knight in each of these regions: 1.    The central (n-4)x(n-4) sub-board2.    The squares bordering this central sub-board but excluding the four "corners" where the row and column squares intersect3.    The edge squares adjacent to the ones in #24.    The four "corners" excluded in #2 that are one square diagonal from each of the four corners of the nxn board5.    The eight edge squares adjacent to the four corners of the nxn board6.    The four corners of the nxn board Sum these and divide by two (because the two knights are interchangeable) and you can calculate the solution very quickly for any nxn. Mapping this over [1..n] will provide the required output. My takeaway from this is that using the solution to case n-1 in order to solve case n may not be the most efficient way to do things. Sometimes just solving for case n from scratch is faster. Thanks Doug. Julian On Sunday, June 28, 2020, 09:00:53 AM PDT, Julian Ong wrote: There are 8 possibilities and then you can filter them by column and row values depending on the region of the board you’re interested in. Julian On Jun 28, 2020, at 8:26 AM, Doug McIlroy wrote:  > I'm currently stuck on the Two Knights problem. Having placed one knight on the board, in how many places can you put the other? Doug McIlroy -------------- next part -------------- An HTML attachment was scrubbed... URL: From magnus at therning.org Tue Jun 30 21:54:13 2020 From: magnus at therning.org (Magnus Therning) Date: Tue, 30 Jun 2020 23:54:13 +0200 Subject: [Haskell-beginners] How to structure an application? In-Reply-To: References: Message-ID: <87a70kdxtm.fsf@therning.org> Tilmann writes: > Hi, > > I hope to get some advice on how to structure an application. So I > acquire a handle early on that I use all over the app, but I don't > want to pass the handle itself around, but wrap the handle with > "commands" that a) make a nicer api and/or b) only allow specific > usecases of the handle. I tried and failed to use MonadReader in a > straightforward way and now I'm wondering what options there are. > Looking forward to your feedback, Below a certain size I'd actually consider just passing the handle around, possibly in a type holding other info that's needed "all over." At some point that becomes unwieldy and then I'd look at things like - monad transformers (like you have below) - tagless final: https://serokell.io/blog/2018/12/07/tagless-final - readerT design pattern: https://www.fpcomplete.com/blog/2017/06/readert-design-pattern I'm not too experienced with them, but I'm guessing free monads/effects would be an alternative too... /M -- Magnus Therning OpenPGP: 0x927912051716CE39 email: magnus at therning.org twitter: magthe http://magnus.therning.org/ I am always doing that which I cannot do, in order that I may learn how to do it. — Pablo Picasso -------------- next part -------------- A non-text attachment was scrubbed... Name: signature.asc Type: application/pgp-signature Size: 832 bytes Desc: not available URL: