Carview!

CARVIEW

MOTORHOMES

Select Language

HTTP/2 200 cross-origin-resource-policy: cross-origin etag: W/"b260a1e0df2eed55c8e9609ce6c2cc735df3254fb239b990e3b15fad213bfdeb" date: Sat, 17 Jan 2026 06:48:02 GMT content-type: application/atom+xml; charset=UTF-8 server: blogger-renderd expires: Sat, 17 Jan 2026 06:48:03 GMT cache-control: public, must-revalidate, proxy-revalidate, max-age=1 x-content-type-options: nosniff x-xss-protection: 0 last-modified: Fri, 09 Jan 2026 15:32:05 GMT content-encoding: gzip content-length: 33201 x-frame-options: SAMEORIGIN alt-svc: h3=":443"; ma=2592000,h3-29=":443"; ma=2592000 tag:blogger.com,1999:blog-83877315295603641372026-01-09T16:32:05.577+01:00A dose of logicA blag containing my current adventures in logic, haskell and agents.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.comBlogger13125tag:blogger.com,1999:blog-8387731529560364137.post-45752544159788705842011-05-01T13:57:00.004+02:002011-05-04T17:17:49.595+02:00Slides about Martin-Löf type theoryIt's been a while since my last update. Anyway, last year, I participated in the seminar Dependently typed programming given by Andres Löh and Doaitse Swierstra. I gave a presentation, or more of a lecture really, about Martin-Löf type theory, the Curry-Howard correspondence and some of its connections with Agda. Since I thought it would still be useful to share, here are the slides: <a title="View Type Systems on Scribd" href="https://www.scribd.com/doc/54313539/Type-Systems" style="margin: 12px auto 6px auto; font-family: Helvetica,Arial,Sans-serif; font-style: normal; font-variant: normal; font-weight: normal; font-size: 14px; line-height: normal; font-size-adjust: none; font-stretch: normal; -x-system-font: none; display: block; text-decoration: underline;">Type Systems</a><iframe class="scribd_iframe_embed" src="https://www.scribd.com/embeds/54313539/content?start_page=1&view_mode=slideshow&access_key=key-28q3ghwna8b0fbsszx24" data-auto-height="true" data-aspect-ratio="1.33115468409586" scrolling="no" id="doc_58782" width="100%" height="600" frameborder="0"></iframe><script type="text/javascript">(function() { var scribd = document.createElement("script"); scribd.type = "text/javascript"; scribd.async = true; scribd.src = "https://www.scribd.com/javascripts/embed_code/inject.js"; var s = document.getElementsByTagName("script")[0]; s.parentNode.insertBefore(scribd, s); })();</script> Download the slides <a href="https://www.students.science.uu.nl/~3448584/TypeSystems.pdf">here</a>.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com6tag:blogger.com,1999:blog-8387731529560364137.post-21506460110752977252010-06-28T14:36:00.005+02:002010-06-28T14:43:46.148+02:00Linking Interaction Nets and Post Canonical SystemsAnd one more update due to a <a href="https://www.students.science.uu.nl/~3448584/paper_MoC.pdf">paper</a> I wrote for the Models of Computation course. I'd like to attend you all to a very beautiful model of computation called interaction nets. One application this model is used for is to optimally implement lambda calculus in a certain theoretical sense. The paper I wrote connects the Post correspondence problem (PCP) to interaction nets, by reducing PCP in a number of steps to an interaction net and giving some suggestions for the other way around. (Thereby proving interaction nets at least Turing complete, and leaving the suggestion for Turing equivalence.) The reverse proof is much more involved, needing multiple reduction steps, possibly through the chemical abstract machine I referenced. I hope some of you will be inspired by interaction nets. You can find the paper <a href="https://www.students.science.uu.nl/~3448584/paper_MoC.pdf">here</a>.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com0tag:blogger.com,1999:blog-8387731529560364137.post-74110179813155673352010-06-28T14:16:00.004+02:002010-06-28T15:22:58.794+02:00Slides Church-Turing Thesis and Gödels Incompleteness TheoremsA pair of slides this time. Again for Models of Computation I held a presentation, this time about the Church-Turing Thesis and some interesting variants of it. As a computer scientist one should really know the general ideas surrounding it. And finally slides for a Philosophy of AI course about Gödel's Incompleteness Theorems (mostly the first theorem). In the slides I tackle some possible misconceptions when interpreting the theorem and try to convince you that Gödel's Incompleteness Theorems, although very interesting, are not very usable in a philosophical argument, but can be used as a starting point for devising new philosophical theories. I hope you'll find it interesting and comments are always welcome. The slides for the Church-Turing Thesis can be downloaded <a href="https://www.students.science.uu.nl/~3448584/slides_MoC_CT.pdf">here</a>. The slides for Gödel's Incompleteness Theorems can be downloaded <a href="https://www.students.science.uu.nl/~3448584/slides_WBFAI.pdf">here</a>. <a title="View Slides Church-Turing Thesis (MoC) on Scribd" href="https://www.scribd.com/doc/33655854/Slides-Church-Turing-Thesis-MoC" style="margin: 12px auto 6px auto; font-family: Helvetica,Arial,Sans-serif; font-style: normal; font-variant: normal; font-weight: normal; font-size: 14px; line-height: normal; font-size-adjust: none; font-stretch: normal; -x-system-font: none; display: block; text-decoration: underline;">Slides Church-Turing Thesis (MoC)</a> <object id="doc_249935967890226" name="doc_249935967890226" height="600" width="100%" type="application/x-shockwave-flash" data="https://d1.scribdassets.com/ScribdViewer.swf" style="outline:none;" > <param name="movie" value="https://d1.scribdassets.com/ScribdViewer.swf"> <param name="wmode" value="opaque"> <param name="bgcolor" value="#ffffff"> <param name="allowFullScreen" value="true"> <param name="allowScriptAccess" value="always"> <param name="FlashVars" value="document_id=33655854&access_key=key-2l8rb2go88226hwqavxe&page=1&viewMode=slideshow"> <embed id="doc_249935967890226" name="doc_249935967890226" src="https://d1.scribdassets.com/ScribdViewer.swf?document_id=33655854&access_key=key-2l8rb2go88226hwqavxe&page=1&viewMode=slideshow" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" height="600" width="100%" wmode="opaque" bgcolor="#ffffff"></embed> </object> <a title="View Slides Gödels Incompleteness Theorems on Scribd" href="https://www.scribd.com/doc/33655856/Slides-Godels-Incompleteness-Theorems" style="margin: 12px auto 6px auto; font-family: Helvetica,Arial,Sans-serif; font-style: normal; font-variant: normal; font-weight: normal; font-size: 14px; line-height: normal; font-size-adjust: none; font-stretch: normal; -x-system-font: none; display: block; text-decoration: underline;">Slides Gödels Incompleteness Theorems</a> <object id="doc_982873126743058" name="doc_982873126743058" height="600" width="100%" type="application/x-shockwave-flash" data="https://d1.scribdassets.com/ScribdViewer.swf" style="outline:none;" > <param name="movie" value="https://d1.scribdassets.com/ScribdViewer.swf"> <param name="wmode" value="opaque"> <param name="bgcolor" value="#ffffff"> <param name="allowFullScreen" value="true"> <param name="allowScriptAccess" value="always"> <param name="FlashVars" value="document_id=33655856&access_key=key-pnhqvhh4efiuvharp2j&page=1&viewMode=slideshow"> <embed id="doc_982873126743058" name="doc_982873126743058" src="https://d1.scribdassets.com/ScribdViewer.swf?document_id=33655856&access_key=key-pnhqvhh4efiuvharp2j&page=1&viewMode=slideshow" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" height="600" width="100%" wmode="opaque" bgcolor="#ffffff"></embed> </object> The slides for the Church-Turing Thesis can be downloaded <a href="https://www.students.science.uu.nl/~3448584/slides_MoC_CT.pdf">here</a>. The slides for Gödel's Incompleteness Theorems can be downloaded <a href="https://www.students.science.uu.nl/~3448584/slides_WBFAI.pdf">here</a>.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com0tag:blogger.com,1999:blog-8387731529560364137.post-10112917944675854882010-05-18T19:49:00.006+02:002010-06-28T14:31:36.156+02:00Post's Correspondence ProblemSo I held a presentation for my course Models of Computation and I thought I'd share the slides with you. The presentation is about the classic recursively unsolvable problem called Post's Correspondence Problem. I hope you find it interesting. <a title="View Slides MoC on Scribd" href="https://www.scribd.com/doc/31558322/Slides-MoC" style="margin: 12px auto 6px auto; font-family: Helvetica,Arial,Sans-serif; font-style: normal; font-variant: normal; font-weight: normal; font-size: 14px; line-height: normal; font-size-adjust: none; font-stretch: normal; -x-system-font: none; display: block; text-decoration: underline;">Slides MoC</a> <object id="doc_520844192933651" name="doc_520844192933651" height="500" width="100%" type="application/x-shockwave-flash" data="https://d1.scribdassets.com/ScribdViewer.swf" style="outline:none;" rel="media:presentation" resource="https://d1.scribdassets.com/ScribdViewer.swf?document_id=31558322&access_key=key-7ylwvxfyhouh1hyju47&page=1&viewMode=slideshow" xmlns:media="https://search.yahoo.com/searchmonkey/media/" xmlns:dc="https://purl.org/dc/terms/" > <param name="movie" value="https://d1.scribdassets.com/ScribdViewer.swf"> <param name="wmode" value="opaque"> <param name="bgcolor" value="#ffffff"> <param name="allowFullScreen" value="true"> <param name="allowScriptAccess" value="always"> <param name="FlashVars" value="document_id=31558322&access_key=key-7ylwvxfyhouh1hyju47&page=1&viewMode=slideshow"> <embed id="doc_520844192933651" name="doc_520844192933651" src="https://d1.scribdassets.com/ScribdViewer.swf?document_id=31558322&access_key=key-7ylwvxfyhouh1hyju47&page=1&viewMode=slideshow" type="application/x-shockwave-flash" allowscriptaccess="always" allowfullscreen="true" height="500" width="100%" wmode="opaque" bgcolor="#ffffff"></embed> </object> Updated: You can get the slides <a href="https://www.students.science.uu.nl/~3448584/slides_MoC_PCP.pdf">here</a>. I now completed the course and completed a paper related to this presentation. You can find that <a href="https://www.students.science.uu.nl/~3448584/paper_MoC.pdf">here</a>.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com0tag:blogger.com,1999:blog-8387731529560364137.post-64569412827431899562010-04-07T20:02:00.011+02:002011-05-04T17:26:59.230+02:00A small handout on TTTAS (Typed Transformations of Typed Abstract Syntax)This period I did the course Advanced Functional Programming and I had to choose a subject from a set list of subjects to present. I chose typed transformations of typed abstract syntax (TTTAS). (See <a href="https://www.cs.uu.nl/wiki/Center/TTTAS">this webpage</a> for the technical report and associated library by Arthur Baars, Doaitse Swierstra and Marcos Viera.) I already expected the subject to be one of the harder ones and I also had a restriction for the presentation due to practical issues, namely we could only use handouts (or your own laptop) and not a beamer because of multiple presenters. Thus I made some handouts in a tutorial like fashion. It might save you some typing of the code found in the paper and hopefully get you interested in the subject. You might also find it useful to get some motivation for the use of GADTs and transformations of EDSLs in general. The handouts: The PDF file is <a href="https://www.students.science.uu.nl/~3448584/Blog/TTTAS/AFPPresentation.pdf">here</a>. The lhs can be found <a href="https://www.students.science.uu.nl/~3448584/Blog/TTTAS/AFPPresentation.lhs">here</a>.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com2tag:blogger.com,1999:blog-8387731529560364137.post-11379613425708820712010-01-10T12:01:00.017+01:002010-01-11T12:02:36.229+01:00Using LaTeX for homework exercisesLast period I had a course about development of knowledge systems for which I had to do weekly (and quite large) assignments. The assignments were more suited for information science majors and therefore easier on the technical side. So I found this a good opportunity to invest some time in learning some more LaTeX by doing (most of) the exercises in LaTeX. Anyway, one of the problems I had while working with LaTeX was the lack of larger examples. The documentation for LaTeX and the packages I used was pretty good most of the times, but larger examples still help a lot when you're just starting out. So hoping some people will get use out of it, I've uploaded the sources of my solutions to the exercises. (Of course these solutions are not 100% correct.) Some of the packages I used were amsmath and amssymb. These really helped a lot to do the proofs. (Some documentation can be found <a href="ftp://ftp.ams.org/pub/tex/doc/amsmath/amsldoc.pdf">here</a> and <a href="ftp://ftp.ams.org/pub/tex/doc/amsmath/short-math-guide.pdf">here</a>.) For Assignment 2 I also learned to use <a href="https://www.graphviz.org/">graphviz</a> to draw my graphs. So some example DOT files are included in the extras. (The guide I used was <a href="https://www.graphviz.org/pdf/dotguide.pdf">here</a>.) I split the assignments into the original problem description (the part I had to deliver was the hand-in part), the LaTeX source and other sources such as pictures, the final outputted PDF and possibly additional sources such as the solutions in the tools. Assignment 1 (Logic): <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_1/Problem_Description/as1.pdf">Problem description</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_1/Sources.zip">LaTeX + other source files</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_1/PDF_Output/Assignment1.pdf">Outputted PDF</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_1/Extras.zip">Extra files</a> (Extra files include the python files I used and edited to generate the truth tables in LaTeX, thanks to <a href="https://www.siafoo.net/snippet/249">midorikid</a>) Assignment 2 (CLIPS): <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_2/Problem_Description/assignment2.pdf">Problem description</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_2/Sources.zip">LaTeX + other source files</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_2/PDF_Output/as2-vanGijzel-3448584.pdf">Outputted PDF</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_2/Extras.zip">Extra files</a> | <a href="https://clipsrules.sourceforge.net/">CLIPS</a> (Extra files include the DOT files I used for graphviz, Microsoft Visio Drawing of the family tree and the CLIPS files I made.) Assignment 3 (Protégé): This was not done in LaTeX because I did not have access to my own computer. If you're interested, tell me, and I'll find the sources from Protégé and Microsoft Word anyway. Assignment 4 (Hugin/Probability Theory): <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_4/Problem_Description/assignment4.pdf">Problem description</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_4/Sources.zip">LaTeX + other source files</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_4/PDF_Output/as4-vanGijzel-3448584.pdf">Outputted PDF</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_4/Extras.zip">Extra files</a> | <a href="https://www.hugin.com/productsservices/demo/hugin-lite">Hugin</a> (Extra files include the multiple probabilistic networks.) Assignment 5 (Fuzzy Logic/Systems): <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_5/Problem_Description/assignment5.pdf">Problem description</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_5/Sources.zip">LaTeX + other source files</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_5/PDF_Output/as5-vanGijzel-3448584.pdf">Outputted PDF</a> | <a href="https://www.students.cs.uu.nl/~bmgijzel/Blog/Assignment_5/Extras.zip">Extra files</a> (Extra files include the Maple 13 file to model the functions.)Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com4tag:blogger.com,1999:blog-8387731529560364137.post-77248252787519791062009-11-04T22:01:00.003+01:002009-11-04T22:15:37.693+01:00Comparing Parser Construction TechniquesAlready a few months ago I completed my Bachelor computer science by writing a small paper and attending and presenting at a student conference. Well anyway, the topic I wrote about is parser construction techniques. The paper talks about parser generators (ANTLR in specific), parser combinators (Parsec 2) and a nice novel combination of the two (Tinadic Parsing, still to published somewhere in the future). Anyway I hope this paper might be interesting to some people reading my blog. The paper comes with quite some code examples and it's probably not a very hard read. So you might consider it a small tutorial on parser construction techniques (or even learn some Parsec while you're at it :) ). My paper can be found <a href="https://referaat.cs.utwente.nl/new/paper.php?paperID=504">here at the website of the University of Twente</a>. The accompanying code examples can be found <a href="https://wwwhome.cs.utwente.nl/~michaelw/projects/vgijzel/parsercode.zip">here</a>. If someone would really appreciate it, I might consider writing some more documentation. As you might have noticed blog posts were a bit scarce the last weeks, because of my silly ambition of taking 3 instead of 2 courses :P. Anyway, I'm liking the pace but my side activities suffer a bit, so I'll probably switch back after next period. (People waiting for the extended state monad implementation: I haven't given up yet!)Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com6tag:blogger.com,1999:blog-8387731529560364137.post-65433578046988982602009-09-11T18:51:00.019+02:002009-09-15T17:27:16.239+02:00Breaking GHC and the monad lawsSo the summer school Applied Functional Programming at the University of Utrecht ended a few weeks ago. I really had a lot of fun and learned even more than I had fun ;). Anyway during the summer school we received a lot of extra exercises you could do out of your own interests. So I picked up one of the exercises I didn't do during course. Namely an extension of the state monad. In this exercise you should extend the state monad in such a way it keeps track of the number of binds, returns and some other capabilities. One can read the full exercise <a href="https://www.cs.uu.nl/wiki/pub/USCS2009/ComputerLab/StateMonad.pdf">here.</a> In short if you have a computation like this: <pre>do return 3 >> return 4 return 5 diagnostics</pre> After running this computation in the state monad one should have a result that somewhat looks like this: <pre> "[bind=3, diagnostics=1, return=3]"</pre> That looks doable, but is a lot more tedious than you except at first. Anyway, a very important point you should catch is that after implementing this functionality we now do NOT abide to the monad laws anymore. Remember the monad laws (stolen from <a href="https://www.haskell.org/haskellwiki/Monad_Laws">here</a>): <pre> 1. "Left identity": return a >>= f ≡ f a 2. "Right identity": m >>= return ≡ m 3. "Associativity": (m >>= f) >>= g ≡ m >>= (\x -> f x >>= g) </pre> As you can see all three laws can transform an expression on the left side to an expression that contains one bind less. Therefore if we perform a computation in our state monad we would have a different number of binds after transforming and could therefore give a different result when getting out our number of binds and returns. But let's first return to the implementation of this extension. I chose a Map with strings to int that can keep track of the number of binds and annotations. So we now have a State Monad with some extra functionality: <pre>data StateMonadPlus s a = StateMonadPlus {runStateMonadPlus:: (s,Map String Int) -> (a, s, Map String Int)} </pre> This is very similar to the original definition of the State Monad. (If you forgot some parts of it you can read a part of my State Monad tutorial <a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad_21.html">here</a>. Anyway, before defining the Monad instance we define a useful helper function for updating the Map that keeps track of the number of binds and annotations and another function that puts the diagnostics as the result of the computation. diagnostics :: StateMonadPlus s String diagnostics = StateMonadPlus $ \(s,m) -> let m2 = updateMap "diagnostics" m in ((show m2 ), s, m2) <pre>updateMap :: Ord k => k -> Map k Int -> Map k Int updateMap k = M.insertWith (+) k 1</pre> And now for the Monad instance:<pre>test1 = do diagnostics return 4 return 5 mget diag = diagStateMonadPlus test1 undefined eval = evalStateMonadPlus test1 undefined diageval = (diag, eval)</pre> Anyway, halfway during the implementation I got stuck on something that seemed like a bug in my program, but before spoiling everything I will first show the functions I defined for running and evaluating our freshly made State Monad. <pre>evalStateMonadPlus :: StateMonadPlus s a -> s -> a evalStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in a execStateMonadPlus :: StateMonadPlus s a -> s -> s execStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in b diagStateMonadPlus :: StateMonadPlus s a -> s -> Map String Int diagStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in c instance MonadState s (StateMonadPlus s) where get = StateMonadPlus $ \(s,m) -> (s, s, m) put a = StateMonadPlus $ \(_, m) -> ((),a, m) mget:: StateMonadPlus s (Map String Int) mget = StateMonadPlus $ \(s,m) -> (m, s, m)</pre> Here the get and put functions are the familiar functions in the original state monad, and mget does something similar to diagnostics, by putting our map into the result. Because I defined a multi parameter type class, and a flexible instance too, we will have to add some compiler pragma's to be able to use them. And we furthermore used some imports. So just add this to the start of the module: <pre>{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module StateMonadExercise where import Control.Monad.State import qualified Data.Map as M import Data.Map(Map)</pre> So the only part left to test this functionality is to define some tests: <pre>test1 = do return 4 return 5 mget diag = diagStateMonadPlus test1 undefined eval = evalStateMonadPlus test1 undefined diageval = (diag, eval)</pre> So now we're ready to run these test right? (I've enclosed the full test module at the end of this blog post for your convenience, so you could just copy the whole code at once if you'd like.) Anyway, after running these test, (and I think it's not a bug on my part but a (maybe) too enthusiastic optimization of GHC (6.10.4)). We get these results: <pre> *StateMonadExercise> diag fromList [("bind",2),("return",2)] *StateMonadExercise> eval fromList [("return",2)] *StateMonadExercise> diageval (fromList [("bind",2),("return",2)] ,fromList [("return",2)]) </pre> So here GHC just optimized away 2 binds for the result but not from the map. It serves me right though, since I'm breaking the monad laws anyway :-). So if anyone can confirm this is GHC's "fault" (or doing) and not mine I would be happy. One final comment: I will probably post the full implementation later this month. The full code: <pre>{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} module StateMonadExercise where import Control.Monad.State import qualified Data.Map as M import Data.Map(Map) data StateMonadPlus s a = StateMonadPlus {runStateMonadPlus:: (s,Map String Int) -> (a, s, Map String Int)} instance Monad (StateMonadPlus s) where return a = StateMonadPlus $ (\ (s, m) -> (a, s, updateMap "return" m)) (StateMonadPlus s) >>= f = StateMonadPlus $ \(state, m) -> (let (a1, st1, m1) = s (state,m) in let (a2, st2, m2) = runStateMonadPlus (f a1) (st1,m1) in (a2, st2, updateMap "bind" m2) ) updateMap :: Ord k => k -> Map k Int -> Map k Int updateMap k = M.insertWith (+) k 1 diagnostics :: StateMonadPlus s String diagnostics = StateMonadPlus $ \(s,m) -> let m2 = updateMap "diagnostics" m in ((show m2 ), s, m2) evalStateMonadPlus :: StateMonadPlus s a -> s -> a evalStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in a execStateMonadPlus :: StateMonadPlus s a -> s -> s execStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in b diagStateMonadPlus :: StateMonadPlus s a -> s -> Map String Int diagStateMonadPlus (StateMonadPlus s) st = let (a,b,c) = s (st, M.empty) in c instance MonadState s (StateMonadPlus s) where get = StateMonadPlus $ \(s,m) -> (s, s, m) put a = StateMonadPlus $ \(_, m) -> ((),a, m) mget:: StateMonadPlus s (Map String Int) mget = StateMonadPlus $ \(s,m) -> (m, s, m) test1 = do return 4 return 5 mget diag = diagStateMonadPlus test1 undefined eval = evalStateMonadPlus test1 undefined diageval = (diag, eval) {- *StateMonadExercise> diag fromList [("bind",2),("return",2)] *StateMonadExercise> eval fromList [("return",2)] *StateMonadExercise> diageval (fromList [("bind",2),("return",2)] ,fromList [("return",2)]) -}</pre>Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com8tag:blogger.com,1999:blog-8387731529560364137.post-75242088341718007782009-08-22T12:32:00.021+02:002009-08-22T13:08:11.796+02:00Parsing L-Systems with the uu-parsinglibSo I subscribed to the Utrecht Summer School program Applied Functional Programming a few months ago and got accepted. This week the course finally started. I'm really enjoying the nice lectures, new people I meet and the quick pace of new things to learn. One of the parts in this course is to do a project with 3 to 5 people with different levels in Haskell. But of course almost everyone is very motivated so the different levels work quite well :). Anyway, the project we chose after some discussion was: Write an L-systems generator and/or visualizer. So first a small introduction to L-systems. Wikipedia has a really really great page about it <a href="https://en.wikipedia.org/wiki/L-system">here</a>, and it also contains a <a href="https://algorithmicbotany.org/papers/#abop">link to a free book</a> containing even more information. From Wikipedia: "An L-system or Lindenmayer system is a parallel rewriting system, namely a variant of a formal grammar, most famously used to model the growth processes of plant development, but also able to model the morphology of a variety of organisms.[1] L-systems can also be used to generate self-similar fractals such as iterated function systems. L-systems were introduced and developed in 1968 by the Hungarian theoretical biologist and botanist from the University of Utrecht, Aristid Lindenmayer (1925–1989)." So quite fitting to do at a summer school in Utrecht :). If you don't know L-Systems (like I did) just take a short look at the wiki page. They're quite intuitive if you're familiar with something like BNF or grammars in general. Anyway, we split the project in 4 parts. Namely a GUI for visualizing the L-Systems, a GUI for inputting the generating gramamars and following from that are a parser that can parse the inputted grammar, and an algorithm generating the strings of symbols from an L-System. The part I started on was the parser. I already knew some Parsec (2) before coming to the summer school, but I thought it would be more interesting and fitting to use another parser combinator library, namely the newest version from the University of Utrecht themselves. So I started learning the uu-parsinglib. For the package and tutorial see the hackage page <a href="https://hackage.haskell.org/package/uu-parsinglib">here</a>. Anyway before I completely introduce my parser I'll first talk about the datatype we made up. I thought it was a good idea to settle for the most simple kind of L-Systems as a first implementation. And secondly to start with a very basic kind of alphabet to use for drawing the L-Systems. The alphabet will contain symbols directing the drawing, (F means to go forward and draw, f means to go forward without drawing, - means to turn right and + to turn left), the other symbols would only be used to do nothing or to be used in the generating part of the L-Systems. (The drawing part is called <a href="https://en.wikipedia.org/wiki/Turtle_graphics">Turtle Graphics</a> and is very similar to the <a href="https://en.wikipedia.org/wiki/Logo_%28programming_language%29">Logo programming language</a>.) Here is an EBNF I made that might clear up the problem a bit. I make no difference between variables or constants because you can handle that very easily in the generating part. <pre> VariableOrConstant := letter | '+' | '-' StartSymbol := VariableOrConstant+ Rule := VariableOrConstant "->" VariableOrConstant* Rules := Rule (('\n' | ',') Rule)* </pre> So we decided rules can generate a variable number of new symbols (possibly none). Spaces are allow everywhere except in the arrow. And we decided it's very easy to use the generation on a starting symbols rather than just one symbol. So the logical datatype was this: <pre>module DataType where -- we read in the angle and the movement step size -- RightAngle = '-', LeftAngle = '+', Forward = 'F', ForwardSkip = 'f', Variable Char = Char data TurtleMove = RightAngle | LeftAngle | Forward | ForwardSkip | Variable Char deriving (Show, Eq, Ord) type Rule = (TurtleMove, [TurtleMove]) type StartSymbol = [TurtleMove] </pre> The variables are just non movement symbols used in the grammar. The types are some shorthands that will be used in the parser. The parsers I wrote are most importantly for parsing the rules. I wrote increasingly larger parser building blocks with hopefully enough documentation so I will just give the full parser code. If anyone appreciates some explanation beside the exisisting tutorial you're welcome to ask me. To get the example working, before compiling do a cabal update and cabal install uu-parsinglib. (Or install it manually.) The most interesting method is probably runPRules which will take a string and produce a set of rules. Note the cool error correcting and online parsing from the uu-parsinglib if you enter too many symbols or incorrect symbols by using test. <pre>module LSystemParser where import Text.ParserCombinators.UU.Parsing import Text.ParserCombinators.UU.Examples import DataType -- parse one or more pMany p = (:) <$> p <*> pMany p <|> pReturn [] -- turn a parsed character into a TurtleMove -- RightAngle = '-', LeftAngle = '+', Forward = 'F', ForwardSkip = 'f', Variable Char = Char pLetterToDatatype :: Char -> TurtleMove pLetterToDatatype l = case l of '-' -> RightAngle '+' -> LeftAngle 'F' -> Forward 'f' -> ForwardSkip other -> Variable other -- parse a number of spaces spaces :: P_m (Str Char) [Char] spaces = pList $ pSym ' ' -- parse a variable or turtle graphic primitive pLetter' :: P_m (Str Char) Char pLetter' = pLetter <|> pSym '-' <|> pSym '+' -- parse a letter that is possibly surrounded by spaces pSimple :: P_m (Str Char) Char pSimple = (\ _ x _ -> x) <$> spaces <*> pLetter' <*> spaces -- parse a letter and turn it into a TurtleMove pVariable :: P_m (Str Char) TurtleMove pVariable = pLetterToDatatype <$> pSimple -- parse the right hand side of a rule pWord :: P_m (Str Char) [TurtleMove] pWord = map pLetterToDatatype <$> pMany pSimple -- parse a list of variables separated by commas pVariables :: P_m (Str Char) [TurtleMove] pVariables = map pLetterToDatatype <$> pListSep (pSym ',') pSimple -- *> doesn't work from R to R -- parse an arrow and the right hand side of a rule pArrow :: P_m (Str Char) [TurtleMove] pArrow = pSym '-' *> (pSym '>' *> pWord) -- parse one production rule pRule :: P_m (Str Char) Rule pRule = (\ x y -> (x,y)) <$> pVariable <*> pArrow -- parse a sequence of production rules separated by commas or newlines pRules :: P_m (Str Char) [Rule] pRules = pListSep (pSym '\n' <|> pSym ',') pRule -- parse the rules and take out the results runPRules :: String -> [Rule] runPRules = fst . test pRules main2 = test pRules $ "x -> blaF+-blabla\n F->SKF"</pre> Well that's it for today :).Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com1tag:blogger.com,1999:blog-8387731529560364137.post-63700671623894225882009-08-10T15:25:00.000+02:002009-08-10T15:26:29.728+02:00Cannibals, Missionaries and the State Monad pt. 3<a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad.html">Part 1: An Explicit State Implementation of Cannibals and Missionaries</a> <a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad_21.html">Part 2: A State Monad Introduction</a> Well this post took a lot longer to materialize due to the a lot of rewriting and extending of part 2. Anyway, I hope you will enjoy it. Comments are very welcome btw. <big>State Monad Implementation of Cannibals and Missionaries</big> I will start this post by pointing out possible improvements of the example from part 1, the cannibals and missionaries problem solution. Refer to part 1 for the old implementation if you need a refresher. (First we import Control.Monad.State) As we have seen at the first solution of the Cannibal problem we had defined a search function containing the type signature: <pre>idfs :: PState -> Int -> [PState]</pre> In the idfs function we increase our Int argument for each recursive call. This Int functioned as a counter for the current maximum search depth. We could hide this integer argument instead of having to explicitly pass it every time we call it recursively. The biggest improvement, however, can be gained by using the state monad in our helper function idfs'. Recall the large type signature of idfs': <pre>idfs' :: Int -> Int -> Bool -> PState -> [PState]</pre> idfs' takes 4 parameters, which respectively are: the current depth, the current max depth, a boolean depicting if the solution is found and finally the current search node (or state). We will hide this arguments by extending our record PState with some new fields. We will then use PState as our state in the state monad. (We won't need a boolean depicting if the solution is found.) Our new PState: <pre>data PState = PState { left :: [Person], -- left side of canal right :: [Person], -- right side of canal boat :: Position, -- position of boat curDepth :: Int, -- current search depth maxDepth :: Int, -- max search depth path :: [PState] -- path found to solution } deriving (Eq, Show)</pre> Defining our new beginState will be straightforward. The starting current and maxdepth should just be 0. Our idfs algorithm will increment the maxdepth with each recursive call, so 0 seems like a good starting point. The path should start empty. <pre>beginState :: PState beginState = PState { left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide, curDepth = 0, maxDepth = 0, path = [] }</pre> Defining the goal state now has a slight quirk. The fields curDepth, maxDepth and path don't have a sensible goal value and I therefore just use undefined. Our new goalState therefore is: <pre>goalState = PState { left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide, curDepth = undefined, -- arbitrary, to avoid warnings maxDepth = undefined, -- arbitrary, to avoid warnings path = undefined -- arbitrary, to avoid warnings }</pre> This new implementation of PState, and corresponding new goal and beginstate, forces almost no changes in the rest of our program. The only necessary change beside our idfs (and idfs') function(s) is the check for a goal state. It is still straightforward though: <pre>-- check if the state is a goal state isGoalState :: PState -> Bool isGoalState s = left s == left goalState && right s == right goalState && boat s == boat goalState</pre> Before starting with defining our search function and state monad we will define some helper functions to change our PState record more cleanly. We will need to able to increase the current and maxDepth by 1, and we need to be able to build up our path while maneuvering the search space. <pre>-- increase current search depth by 1 increaseDepth :: PState -> PState increaseDepth s = let depth = curDepth s in s{curDepth = depth + 1} -- increase max search depth by 1 increaseMaxDepth :: PState -> PState increaseMaxDepth s = let depth = maxDepth s in s{maxDepth = depth + 1}</pre> These functions are a straightforward record update, the following addPath function is a bit more dense though. Our current state not only contains the information of the problem, but also the path. When we add the current state to the path, the added state will still contain the older shorter path. This is needless clutter for our solution. We therefore empty the old path in the state that is added to the (possible) solution path. <pre>-- add the current state in front of the the path -- before adding the state the path in that state is replaced by [] (to avoid clutter) addPath :: PState -> PState addPath s = s{path = (s {path = []}) : path s}</pre> Now let's think about a sensible State s a for our solution. We already decided on our state type s, namely PState. A sensible type for our result a, would be the path, and would therefore we be a list of PStates ([PState]). Thus: State PState [PState] We can already change the type signature of idfs' into a much cleaner new one. <pre> idfs' :: State PState [PState]</pre> Before diving in to the definition of idfs' we will first redefine idfs. Because we use a list for our solution path we can use the empty list as our case for failure. So when idfs calls the helper function idfs' and gets an empty list as a result it can increase the current max search depth by 1 and start the process again at the beginstate. <pre>-- State monad implementation idfs :: PState -> [PState] idfs s = case evalState idfs' s of [] -> idfs $ increaseMaxDepth s other -> other</pre> The call to idfs' is done by using evalState. Recall that evalState runs the state and pulls out the result. When no solution is found the search depth is increased by 1, otherwise the solution is returned. The first call to our idfs function will be applied with beginState, therefore starting the search at maxDepth 0. Now to define idfs'. The function starts by adding the current node to the path. After that the border cases are handled. The search should end if: 1. The current state is a goal state. In this case we can immediately return our current path. 2. The current search depth is as large as the maximum search depth, in which case a path of [] should be returned. <pre> idfs' = do modify addPath s <- get if isGoalState s then return (path s) else if curDepth s >= maxDepth s then return []</pre> If no border cases occur our search will continue by calling idfs' recursively on all successors and taking the first solution that can be found. We will take the first real solution by taking the first non empty list as solution. If no solutions are found we should return the empty list indicating our search failed. <pre> else do modify increaseDepth s <- get let states = map (evalState idfs') (successors s) return . safeHead $ dropWhile null states -- returns [] if there are no solutions safeHead :: [[a]] -> [a] safeHead [] = [] safeHead xs = head xs</pre> Now all that remains is our redefinition of the final solution. All the other functions can remain the same :). <pre>-- State trace of the solution to the cannibal/missionaries problem -- The solution is in reverse order solution :: [PState] solution = reverse $ idfs beginState</pre> As you can see we also reverse our solution because we always added the last state on the front (for efficiency). I hope you enjoyed this post as much as I did writing it :-). If you have some corrections or comments, please feel free to make them. The final code: <pre> module AIMAMissionariesStateMonad where import Data.List(sort, nub, (\\)) import Control.Monad.State data Person = Missionary | Cannibal deriving (Ord, Eq, Show) data Position = LeftSide | RightSide deriving (Eq, Show) data PState = PState { left :: [Person], -- left side of canal right :: [Person], -- right side of canal boat :: Position, -- position of boat curDepth :: Int, -- current search depth maxDepth :: Int, -- max search depth path :: [PState] -- path found to solution } deriving (Eq, Show) beginState :: PState beginState = PState { left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide, curDepth = 0, maxDepth = 0, path = [] } goalState = PState { left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide, curDepth = undefined, -- arbitrary, to avoid warnings maxDepth = undefined, -- arbitrary, to avoid warnings path = undefined -- arbitrary, to avoid warnings } -- State trace of the solution to the cannibal/missionaries problem -- The solution is in reverse order solution :: [PState] solution = reverse $ idfs beginState -- State monad implementation idfs :: PState -> [PState] idfs s = case evalState idfs' s of [] -> idfs $ increaseMaxDepth s other -> other where idfs' :: State PState [PState] idfs' = do modify addPath s <- get if isGoalState s then return (path s) else if curDepth s >= maxDepth s then return [] else do modify increaseDepth s <- get let states = map (evalState idfs') (successors s) return . safeHead $ dropWhile null states -- returns [] if there are no solutions safeHead :: [[a]] -> [a] safeHead [] = [] safeHead xs = head xs -- increase current search depth by 1 increaseDepth :: PState -> PState increaseDepth s = let depth = curDepth s in s{curDepth = depth + 1} -- increase max search depth by 1 increaseMaxDepth :: PState -> PState increaseMaxDepth s = let depth = maxDepth s in s{maxDepth = depth + 1} -- add the current state in front of the the path -- before adding the state the path in that state is replaced by [] (to avoid clutter) addPath :: PState -> PState addPath s = s{path = (s {path = []}) : path s} -- check if the state is a goal state isGoalState :: PState -> Bool isGoalState s = left s == left goalState && right s == right goalState && boat s == boat goalState -- filter legal states successors :: PState -> [PState] successors = filter isLegalState . allSucc -- generate all states after applying all possible combinations allSucc :: PState -> [PState] allSucc s | boat s == LeftSide = map (updatePStateLeft s) (genCombs (left s)) | otherwise = map (updatePStateRight s) (genCombs (right s)) -- move a number of cannibals and missonaries to the right side updatePStateLeft :: PState -> [Person] -> PState updatePStateLeft s p = let oldLeft = left s oldRight = right s in s { left = sort $ oldLeft \\ p, right = sort $ oldRight ++ p, boat = RightSide } -- move a number of cannibals and missonaries to the left side updatePStateRight :: PState -> [Person] -> PState updatePStateRight s p = let oldLeft = left s oldRight = right s in s { left = sort $ oldLeft ++ p, right = sort $ oldRight \\ p, boat = LeftSide } -- unique combinations genCombs :: Ord a => [a] -> [[a]] genCombs = nub . map sort . genPerms -- permutations of length 1 and 2 genPerms :: Eq a => [a] -> [[a]] genPerms [] = [] genPerms (x:xs) = [x] : (map (: [x]) xs) ++ genPerms xs -- legal states are states with the number of cannibals equal or less -- to the number of missionaries on one riverside (or sides with no missionaries) isLegalState :: PState -> Bool isLegalState s = hasNoMoreCannibals (left s) && hasNoMoreCannibals (right s) where hasNoMoreCannibals lst = let lenMiss = length ( filter (== Missionary) lst) lenCann = length ( filter (== Cannibal) lst) in lenMiss == 0 || lenMiss >= lenCann</pre>Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com0tag:blogger.com,1999:blog-8387731529560364137.post-31662835152227276702009-07-21T14:46:00.116+02:002009-08-10T15:29:16.182+02:00Cannibals, Missionaries and the State Monad pt. 2<a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad.html">Part 1: An Explicit State Implementation of Cannibals and Missionaries</a> <a href="https://adoseoflogic.blogspot.com/2009/08/cannibals-missionaries-and-state-monad.html">Part 3: State Monad Implementation of Cannibals and Missionaries</a> Well here is part 2 of the Cannibals and Missionaries problem. I'll start with a(n) introduction/tutorial of the state monad. Hopefully this will enlighten some readers and myself a bit about how the state monad works. For the next explanations I assume you have seen some monads and now some of the basics such as the bind operator (>>=) and return. But you might learn something too if you've never seen monads before. Readers more comfortable with the state monad could skip to the implementation of the problem (Cannibals, Missionaries and the State Monad pt. 3). <big>Introduction to the State Monad</big> In this section I will give a motivation for the existence of the state monad by using random generators as an example(thanks to [1]). After that motivation we'll try to define our own state monad. In the section we will again motivate the use of the state monad by trying to renumber trees, define some more helper functions for the state monad and then implement the renumber example with the state monad. Motivation for implicit state Say we would like to implement a random number generator. How would a function that generates a random number look like? In contrast to stateful languages such as C, Haskell can't have a function such as <pre>randomNumber :: Int</pre> This function would not be referential transparant unless of course randomNumber always returns the same number (possibly chosen by a fair dice roll[2]). Therefore instead we provide an explicit state for our randomNumber function. We can use a pseudorandomgenerator on this state So the function type definition would look like: <pre>randomNumber :: RandomState -> (Int, RandomState)</pre> This function randomNumber takes a RandomState, possibly a seed value, and uses that RandomState to generate a pseudorandom Int and also returns the new seed value or changed RandomState. Let's pretend that randomNumber function already exists, and we wanted to define our own random function that takes a RandomState and returns two random numbers and the new RandomState. Exercise: Define the function <pre>twoRandomNumbers :: RandomState -> ((Int,Int), RandomState)</pre> Try define it yourself first by using the "predefined" function and datatype below. <pre>-- to test at least the types check use this: -- our predefined function randomNumber :: RandomState -> (Int, RandomState) randomNumber = undefined -- another placeholder data RandomState = RandomState</pre> Solution: We would have to explicitly thread the state like this: <pre>-- return two random numbers and the new RandomState twoRandomNumbers :: RandomState -> ((Int,Int), RandomState) twoRandomNumbers s = let (i, s') = randomNumber s (i', s'') = randomNumber s' in ((i,i'),s'')</pre> Our function twoRandomNumbers calls randomNumber with it's state, this produces a (pseudo)random Int and the new RandomState, this new state is then threaded in randomNumber again for another Int and newer state. These Int's are tupled and returned with the newest state. It is easy to make mistakes in this threading. We could accidentally thread an older state to our second randomNumber call (and always get the two same numbers) or return and older state as the final result. To avoid these kind of errors we woukd like to avoid this explicit passing of s, s' and s'' by abstracting this state and making it implicit. First we have to see a pattern in our code. The type of randomNumber indicates a common pattern for state passing. Namely, randomNumber takes a state and returns the changed state along with a result. So:<pre>(s -> (a, s))</pre> In this type signature s is the state, and a is the result. We would like to turn this general type signature into a datatype and then somehow use it for implicit state. We will do this by just trying to make this datatype a monad and see how useful it is and how we can improve on it. Now to define our own State Monad! Let's capture this s -> (a, s) pattern and just make it a new data type (you could also use newtype here). <pre>data State s a = State (s -> (a, s))</pre> (By simply following the types our randomFunction would now be of type State RandomState Int.) Now we try to make this datatype into a Monad. Remember that a Monad has a kind of * -> *, this means a monad type can still have a type applied to it. State takes two type parameters, namely s and a, and is therefore of kind * -> * -> * (takes two types and returns one type), so we can only make a Monad out of State s and not out of State or State s a. (See [3] for a small explanation of kinds.) So let's just start with defining our monad instance. The function stubs would look like this: <pre>instance Monad (State s) where -- return :: (Monad m) => x -> m x return x = undefined --(>>=) :: (Monad m) => m x -> (x -> m y) -> m y (State s) >>= f = undefined</pre> Exercise: Try to define return and bind (>>=). Hint: I have used the general type signatures on purpose here, try to specialize this type signatures for the State Monad yourself. The return function should then follow quite easily. The bind operator is quite a bit harder though, so don't worry if you don't get it at once. Solution: Let's look at the type of return. It's general type is x -> M x. Think what this x could mean. We can only really touch the second type parameter of our State datatype. Therefore that x must be the type of our result (a), and therefore can't be the type of our first type parameter. So the detailed type of return would be <pre>-- return :: a -> State s a </pre> This reduces our problem to: if we have a value a, how to make it into a State (s -> (a,s))? We will have to make it into a function s -> (a,s) and then wrap it with State. So: <pre>return a = State $ \s -> (a, s)</pre> There isn't another sensible implementation really. And now the bind operator (>>=). Again specializing types we get: <pre>-- (>>=) :: State s a -> (a -> State s b) -> State s b </pre> Now to reason a bit about what the bind should do. The result of the function is State s b and gives a bit of an intuition of how the final result should look like. State s b is just a function s -> (b, s) with a State wrapper around it, right?. So let's start with that:<pre>(State x) >>= f = State (\s -> (..., ...))</pre> Now we at least have a result that has a State wrapper and a function in it. But now what? We will need to pass the state to our first argument, State s a, get out the new state and result, and then use that for the next argument. So: <pre>(State x) >>= f = State (\s -> (let (a, s1) = x s in ...))</pre> Great now we've got the result of the first state computation, now to pass it to our function f to generate a State b. <pre>(State x) >>= f = State (\s -> (let (a, s1) = x s in ...))</pre> Okay that's that, but now we still need to apply our newest state to our State b. Thus: <pre>(State x) >>= f = State (\s -> (let (a, s1) = x s; State y = f a in y s1))</pre> Possibly reread it 2/3 times and let it take some time to sink in. Now to rewrite our randomNumber example. It is still a bit contrived because we haven't really implemented the randomNumber function itself, but forget that for now. We will implement a larger fully working and testable example later. So for now we keep pretending someone has implemented randomNumber for us. and we want to use it with our freshly made State Monad. So instead of randomNumber :: RandomState -> (Int, RandomState) we want: randomNumber' :: State RandomState Int. Exercise: Define the function: <pre>randomNumber' :: State RandomState Int</pre> Think for a second, it really is quite trivial. Solution: <pre>-- our State Monad randomNumber function randomNumber' :: State RandomState Int randomNumber' = State randomNumber</pre> Yup that's all it takes. Now to use our randomNumber' function and our monadic functions return and bind (>>=) to implicitly pass the state. Exercise: Like before, define the function: <pre>twoRandomNumbers' :: State RandomState (Int,Int)</pre> Hint: Remember >>= is used for passing the state, and return is used to make a value (or result) into a State monad. You will need lambda abstractions after the bind to be able to use the value as a result. Solution: <pre>-- State Monad implementation: return two random numbers and the new RandomState twoRandomNumbers' :: State RandomState (Int,Int) twoRandomNumbers' = randomNumber' >>= \ a -> randomNumber' >>= \ b -> return (a,b) -- or equivalently: -- do a <- randomNumber' -- b <- randomNumber' -- return (a,b)</pre> That looks a lot cleaner doesn't it :-)? We just call randomNumber' and bind the result to a, then the state is implicitly passed to the other randomNumber' call, we bind that result to b, implicitly pass that state again, and finally use return to make a State Monad out of (a,b). (The state is passed to this monad.) You might have noticed we're now stuck in a state monad. We will define some functions that enable us to peel of the wrapper and run the state in the next section. Take some deep breaths and then we will continue with another example and define some helpful functions for making the use of the state monad a lot easier. <big>Renumbering trees</big> I hope the previous example already showed some of the uses of the state monad. We will now continue with another example for the movation of use of the state monad by implementing a function that gives a binary tree number labels. We will define this function ourselves to undergo some of the difficulties of explicit state passing. Say we have a binary tree: <pre>data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show</pre> And instead of using the elements a, we would like to give all the Leafs a different number. The type signature of our function could therefore be: <pre>renumberTree :: Tree a -> Tree Int</pre> First consider the base case when a Leaf is given a number. The problem is how do we give all Leafs a different number and where do get that number from? We will need to keep the label number with us in the function by keeping it as an explicit argument. So instead we get:<pre>renumberTree :: (Tree a, Int) -> (Tree Int, Int)</pre> To keep the Int argument out of the function call we will keep our old renumberTree and define a helper function renumberTreeHelper inside, which will be called by renumberTree. <pre>renumberHelper :: (Tree a, Int) -> (Tree Int, Int)</pre> As you can see renumberHelper takes a tuple (Tree a, Int). The Int denotes the current label number. After renumbering a Leaf the relabeled Leaf should be returned along with an incremented integer. Try to define the rest yourself first! The base case for Leafs is quite easy, try that one first. The other case will need some pattern matching on the recursive calls. Solution: First we try to solve the base case, namely the case of a Leaf. As said the relabeled Leaf should be returned along with an incremented integer. <pre>renumberHelper ((Leaf x), n) = (Leaf n, n+1)</pre> The Node case is a bit harder though. Because we have to keep track of our current label number and we need to recursively call our two children (left and right) we will have to do some passing of our label number (Int). So first we do a pattern match on the Node as we did we the Leaf: <pre>renumberHelper ((Node l r), n) = </pre> Now we have access to the left and right children of this node, and importantly to the current integer label, n. The right hand side (rhs) can now be defined by applying renumberHelper to the left node, taking the resulting label number, then applying renumberHelper to the right node with the NEW label number from the left node, and then we produce our result by using our Node constructor, the new left and right children, and importantly the new label number returned by the call on the right child. Therefore: <pre> where renumberHelper :: (Tree a, Int) -> (Tree Int, Int) renumberHelper ((Leaf x), n) = (Leaf n, n+1) renumberHelper ((Node l r), n) = let (t1, n1) = renumberHelper (l,n) (t2, n2) = renumberHelper (r, n1) in ((Node t1 t2), n2)</pre> (We have used renumberHelper as a local definition in renumberTree.) Now to define the renumberTree. We only have to call renumberHelper with the tree argument, a starting number (we will take 0) and then take the tree out of the result of renumberHelper. Thus: <pre>-- take a tree and give all leafs a unique number. -- I number the leafs in depth first order, any order is fine though renumberTree :: Tree a -> Tree Int renumberTree tree = fst $ renumberHelper (tree, 0)</pre> And now for an example tree with example run (load it up in GHCi yourself!): <pre>tree1 = Node (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'd'))) (Leaf 'c') tree2 = Node (Leaf 'a') (Leaf 'b') > renumberTree tree1 Node (Node (Leaf 0) (Node (Leaf 1) (Leaf 2))) (Leaf 3)</pre> Well that works :)! But as you might have noticed, the let bindings and explicitly passing of our integer argument can be quite susceptible to mistakes. Especially when using names such as n, n' and n''. So instead we would like to have the integer argument passed implicitly. This again can be solved with the state monad. So let's start thinking how to implicitly thread our state. We want to pass our Int argument as the state and will therefore be our s argument in State s a. The result a should be the Tree Int. So a good type for our State Monad would be State Int (Tree Int). This would give us a type of Tree a -> State Int (Tree Int). Now what? We're stuck in a monad! We would like our upper function to have the type:<pre>renumberTree' :: Tree a -> Tree Int</pre> Well that isn't a problem with this monad. We don't have any side effects so pulling of our State wrapper shouldn't give any problems such as launching missiles. We'll define a function that just does this with one simple pattern match: <pre>-- pull of the State wrapper runState :: State s a -> (s -> (a, s)) runState (State s) = s</pre> So now we can pull out the function out of the wrapper. This gives us the opportunity to actually apply some state to this function and get results! So given that we have defined a helper function, this time of type: <pre>renumberHelper :: Tree a -> State Int (Tree Int)</pre> Exercise: Define the function: <pre>renumberTree' :: Tree a -> Tree Int</pre> Hint: Use runState and supply the state. Solution: We will need supply the renumberHelper function with the tree (giving us State s a), pull of the State wrapper (giving us s -> (a, s) , supply the state it needs to compute our result, such as 0, (giving (a,s)), and then just pull out the result out of the tuple by using fst. <pre>-- State Monad implementation: take a tree and give all leafs a unique number. -- I number the leafs in depth first order, any order is fine though renumberTree' :: Tree a -> Tree Int renumberTree' tree = fst $ runState (renumberHelper tree) 0</pre> Some helper functions: One can imagine that calling runState (to pull of the wrapper) and supplying a state and then getting out the result or the new state will be a common use case. We will therefore define some methods that implement these use cases. <pre>-- pull of the State wrapper, supply a state resulting in a (value, newState) pair -- and take out the resulting value evalState :: State s a -> s -> a evalState m s = fst (runState m s) -- pull of the State wrapper, supply a state resulting in a (value, newState) pair -- and take out the resulting new state execState :: State s a -> s -> s execState m s = snd (runState m s)</pre> We can therefore rewrite our renumberTree' call to: <pre>evalState (renumberHelper tree) 0</pre> <big>Explicit implicit state</big> Before defining the renumberHelper function we will define more functions that will help us use the State Monad. Sometimes we do want to explicitly use the state and we will define some helper functions for that purpose. What if we want to know what the current state is? Remember the datatype of our Monad, data State s a = State (s -> (a, s)) So if we're in the middle of a ((State s) >>= \ x -> ...), how do we get the state out? State should most of the times be implicit but if we want to make the state explicit the only way is to return it as a result. So let's define a get function which returns the state as result. So we just replace our type of the result, a, by the type of the state, s. So the only possibly type for our get function is: <pre>get :: State s s</pre> The function itself shouldn't be hard to define now either, give it a try! Exercise: Define the get function: Solution: <pre>-- return the current state by copying it as a value get :: State s s get = State (\ c -> (c, c))</pre> Now for a similar function: put. When we use the get function and get the current state, we sometimes want to change that state and put it back in a state monad. So given a state s, we would like to see a computation that results in that new state s. But what do we do with the result? Because there really isn't a result from putting our new state in the state monad there isn't a sensible value to use for that so we'll just use (). Exercise: Define put Hint: Again look at the possible types! Solution: <pre>-- put the given state s as current state put :: s -> State s () put s = State (\ _ -> ((), s))</pre> put takes a state as argument and constructs a State which ignores the next state and puts () as value. Now let's try putting these two functions to use. Let's try to define a function inc, that takes a State Monad with an Int as state, and increases that Int it. You do need to take a State Monad as argument, this can instead be done inside the monad so the type of inc becomes: <pre>inc :: State Int ()</pre> Exercise: Define inc Hint: Use a combination of get and put and bind. Solution: <pre>-- increase the state with 1 inc :: State Int () inc = get >>= \ x -> put (x + 1) -- or equivalently: -- inc = do x <- get -- put $ x + 1</pre> As you can see inc uses get to get the current state out as a value and then puts it back after incrementing it by 1. A short sidenote: you can probably imagine that the combination of get and put will often be used when a modification of the state is necessary. Instead of using get and put we can use a convenience function modify which will do the getting and putting for us. The only thing we will need to do is supply modify with our state changing function. Thus modify would look like this: <pre>modify :: (s -> s) -> State s () modify f = do x <- get put $ f x </pre> Defining inc now gets even easier: <pre>inc = modify (+1)</pre> We have now defined all the functions we need for the State Monad version of renumberTree'. Have a go at defining the renumberHelper using our functions inc, get, return and bind. Try to use do notation for a more readable implementation! Exercise: Define renumberHelper. Hint: Remember the type of the helper function: <pre>renumberHelper :: Tree a -> State Int (Tree Int)</pre> Solution: <pre>-- State Monad implementation: take a tree and give all leafs a unique number. -- I number the leafs in depth first order, any order is fine though renumberTree' :: Tree a -> Tree Int renumberTree' tree = fst $ runState (renumberHelper tree) 0 where renumberHelper :: Tree a -> State Int (Tree Int) renumberHelper (Leaf x) = do n <- get inc return (Leaf n) renumberHelper (Node l r) = do l' <- renumberHelper l r' <- renumberHelper r return (Node l' r')</pre> Well here's the complete implementation of renumberTree'. renumberTree' is as we defined it earlier, renumberHelper again is splitted in two cases, Leaf and Node cases. The actual changing of the state happens at the Leaf case, we first use get to take out our current counter value, call inc to increment our counter, construct a Leaf with our initial counter value and finally return that Leaf as a State Monad. The Node case has gotten a lot easier and more readable now, we just call renumberHelper two times and use the results in our Node constructor, which we then return as a State Monad. That's all folks! For another simple but sweet example of Fibonacci numbers see <a href="https://calpaterson.blogspot.com/2009/07/state-monad-example-infinite-list-of.html">here</a>. In the next blog post I will finally implement the Cannibals and Missionaries problem by using the State Monad. Try to make an implementation yourself if you think you're capable now! Just import Control.Monad.State and you'll be able to use all the state monad functions defined in this blog post. References: [1] <a href="https://ertes.de/articles/monads.html#section-6 ">https://ertes.de/articles/monads.html#section-6 </a> Understanding Haskell Monads by Ertugrul Söylemez Random number generator example and some good explanations of the state monad and monads in general. [2] <a href="https://xkcd.com/221/">https://xkcd.com/221/</a> [3] <a href="https://en.wikibooks.org/wiki/Haskell/Kinds">https://en.wikibooks.org/wiki/Haskell/Kinds</a> Explanation of kinds. Acknowledgements: I'd like to thank kosmikus for his help with the state monad. The final code: <pre> module State where -- to test at least the types check use this: -- our predefined function randomNumber :: RandomState -> (Int, RandomState) randomNumber = undefined -- another placeholder data RandomState = RandomState -- return two random numbers and the new RandomState twoRandomNumbers :: RandomState -> ((Int,Int), RandomState) twoRandomNumbers s = let (i, s') = randomNumber s (i', s'') = randomNumber s' in ((i,i'),s'') -- our datatype data State s a = State (s -> (a, s)) instance Monad (State s) where -- return :: (Monad m) => x -> m x -- specialized: return :: a -> State s a return x = State $ \s -> (x, s) --(>>=) :: (Monad m) => m x -> (x -> m y) -> m y -- specialized: (>>=) :: State s a -> (a -> State s b) -> State s b (State x) >>= f = State (\s -> (let (a, s1) = x s; State y = f a in y s1)) -- our State Monad randomNumber function randomNumber' :: State RandomState Int randomNumber' = State randomNumber -- State Monad implementation: return two random numbers and the new RandomState twoRandomNumbers' :: State RandomState (Int,Int) twoRandomNumbers' = randomNumber' >>= \ a -> randomNumber' >>= \ b -> return (a,b) -- or equivalently: -- do a <- randomNumber' -- b <- randomNumber' -- return (a,b) -- our tree type (a simple binary tree with values at the Leafs) data Tree a = Leaf a | Node (Tree a) (Tree a) deriving Show -- take a tree and give all leafs a unique number. -- I number the leafs in depth first order, any order is fine though renumberTree :: Tree a -> Tree Int renumberTree tree = fst $ renumberHelper (tree, 0) where renumberHelper :: (Tree a, Int) -> (Tree Int, Int) renumberHelper ((Leaf x), n) = (Leaf n, n+1) renumberHelper ((Node l r), n) = let (t1, n1) = renumberHelper (l,n) (t2, n2) = renumberHelper (r, n1) in ((Node t1 t2), n2) tree1 = Node (Node (Leaf 'a') (Node (Leaf 'b') (Leaf 'd'))) (Leaf 'c') tree2 = Node (Leaf 'a') (Leaf 'b') -- useful State Monad functions: -- pull of the State wrapper runState :: State s a -> (s -> (a, s)) runState (State s) = s -- pull of the State wrapper, supply a state resulting in a (value, newState) pair -- and take out the resulting value evalState :: State s a -> s -> a evalState m s = fst (runState m s) -- pull of the State wrapper, supply a state resulting in a (value, newState) pair -- and take out the resulting new state execState :: State s a -> s -> s execState m s = snd (runState m s) -- return the current state by copying it as a value get :: State s s get = State (\ c -> (c, c)) -- put the given state s as current state put :: s -> State s () put s = State (\ _ -> ((), s)) modify :: (s -> s) -> State s () modify f = do x <- get put $ f x -- increase the state with 1 inc :: State Int () inc = get >>= \ x -> put (x + 1) -- or equivalently: -- inc = do x <- get -- put $ x + 1 -- or even better: -- inc = modify (+1) -- State Monad implementation: take a tree and give all leafs a unique number. -- I number the leafs in depth first order, any order is fine though renumberTree' :: Tree a -> Tree Int renumberTree' tree = fst $ runState (renumberHelper tree) 0 -- or equivalently: evalState (renumberHelper tree) 0 where renumberHelper :: Tree a -> State Int (Tree Int) renumberHelper (Leaf x) = do n <- get inc return (Leaf n) renumberHelper (Node l r) = do l' <- renumberHelper l r' <- renumberHelper r return (Node l' r') </pre> Edit: Added modify, evalState, execState and changed renumberHelper' to function the same as renumberHelper. Edit: Rephrasing. (Last edit: August 7th)Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com0tag:blogger.com,1999:blog-8387731529560364137.post-89816672784412792252009-07-19T18:59:00.017+02:002009-09-08T19:20:33.806+02:00Cannibals, Missionaries and the State Monad pt. 1<a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad_21.html">Part 2: A State Monad Introduction</a> <a href="https://adoseoflogic.blogspot.com/2009/08/cannibals-missionaries-and-state-monad.html">Part 3: State Monad Implementation of Cannibals and Missionaries</a> As a preparation for my master, and to get myself into A.I. a bit more before starting my master, I have started working through Artificial Intelligence: A Modern Approach. I'm combining the exercises and interesting algorithms with functional programming by implementing the problems in Haskell. The last exercise I did was a long solution to the well known <a href="https://en.wikipedia.org/wiki/Missionaries_and_cannibals_problem">Missionaries and Cannibals problem</a>. (This is exercise 3.9b of the second edition of AIMA btw.) From wikipedia: "In the missionaries and cannibals problem, three missionaries and three cannibals must cross a river using a boat which can carry at most two people, under the constraint that, for both banks, if there are missionaries present on the bank, they cannot be outnumbered by cannibals (if they were, the cannibals would eat the missionaries.) The boat cannot cross the river by itself with no people on board." The exercise asks you two solve this problem by first formalizing it, and then searching through the state space by an appropriate search algorithm. (Complete and optimal). I chose <a href="https://en.wikipedia.org/wiki/Iterative_deepening_depth-first_search">iterative deepening depth-first search</a> which is complete if the solution is at finite depth, and optimal if step costs are equal. I'll introduce two solutions to this problem. The first was the solution I worked out the first time. I will work out that solution in this post. But I was not really happy with all the parameters used in the search function and I decided to finally tackle the state monad to try to improve that solution, which I'll work out in the next blog post. <big>An Explicit State Implementation of Cannibals and Missionaries</big> First formalizing the problem: We have two types of people, namely missionaries and cannibals. Furthermore we have 2 sides of the river, which we'll call left and right. This will be used to track the position of the boat. Therefore: <pre>data Person = Missionary | Cannibal deriving (Ord, Eq, Show) -- used later data Position = LeftSide | RightSide deriving (Eq, Show) -- used later</pre> This would be nice to track in a record therefore: <pre>data PState = PState {left :: [Person], right :: [Person], boat :: Position} deriving (Eq, Show) -- used later</pre> With this record we can already define the start and goalstate of the problem, namely: <pre>beginState = PState {left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide} goalState = PState {left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide}</pre> Before trying to tackle the search algorithm we will try define a successors function, meaning a function that given a state, generates the subsequent possible states. Because of the boat size of 2 and the minimum number of passengers 1, we need to consider moves containing combinations of 1 or 2 People. I used a function to generate all permutations of length 1 and 2 and filter all doubles to retain the combinations. <pre>-- unique combinations genCombs :: Ord a => [a] -> [[a]] genCombs = nub . map sort . genPerms -- permutations of length 1 and 2 genPerms :: Eq a => [a] -> [[a]] genPerms [] = [] genPerms (x:xs) = [x] : (map (: [x]) xs) ++ genPerms xs</pre> nub deletes all double (or more) elements, and sort sorts the list. (That's why I defined Person deriving Ord.) These are both imported from Data.List. Let's generate all successors of a given state using these combinations: <pre>-- generate all states after applying all possible combinations allSucc :: PState -> [PState] allSucc s | boat s == LeftSide = map (updatePStateLeft s) (genCombs (left s)) | otherwise = map (updatePStateRight s) (genCombs (right s))</pre> As you can see we consider two cases, the boat on the left side and on the right side of the river. The possible combinations are generated by taking all the persons available on the specific side of the river and calling genCombs. The sides are then updated for all combinations and returned as a list of possible next states. <pre>-- move a number of cannibals and missonaries to the right side updatePStateLeft s p = let oldLeft = left s oldRight = right s in s {left = sort $ oldLeft \\ p, right = sort $ oldRight ++ p, boat = RightSide } -- move a number of cannibals and missonaries to the left side updatePStateRight s p = let oldLeft = left s oldRight = right s in s {left = sort $ oldLeft ++ p, right = sort $ oldRight \\ p, boat = LeftSide }</pre> But now we have a successor function that generates all possible states given the available persons, the other conditions are not met yet though. In some of our states some poor missionaries will be eaten, so we'll have to filter these out too. First we define a new successor function and then the corresponding filter function. <pre>-- filter legal states successors :: PState -> [PState] successors = filter isLegalState . allSucc -- legal states are states with the number of cannibals equal or less -- to the number of missionaries on one riverside (or sides with no missionaries) isLegalState :: PState -> Bool isLegalState s = hasNoMoreCannibals (left s) && hasNoMoreCannibals (right s) where hasNoMoreCannibals lst = let lenMiss = length ( filter (== Missionary) lst) lenCann = length ( filter (== Cannibal) lst) in lenMiss == 0 || lenMiss >= lenCann</pre> As you can see we first generate all successors using our previous function, and then filter out the incorrect states using isLegalState and filter. (//) takes a list and deletes the elements given if present. This function is also imported from Data.List. So now that we have a begin and goal state, and a successor function we'll only need a goal test and a search function. The goal test is trivial: <pre>-- check if the state is a goal state isGoalState :: PState -> Bool isGoalState = (== goalState)</pre> The solution to the problem will be a call to the search function with the beginstate and the startdepth to search. The result is a list of PState that depicts the trace of states to the goal state. So: <pre>solution :: [PState] solution = idfs beginState 0 </pre> The search function idfs and especially the helper function idfs' will need some more explaining though and they aren't very elegant. First idfs: <pre>idfs :: PState -> Int -> [PState] idfs s n = case idfs' 0 n False s of [] -> idfs s (n+1) other -> other</pre> idfs is called with a state (at the first call the beginState), the current maxDepth, and it results in a lists of states containing the trace to the goal. It calls the idfs' helper function to deliver the actual trace. If the result of the helper function is "[]", then there was no solution and the search depth is increased by a recursive call. Otherwise the solution is returned. Now for the more difficult helper function idfs': <pre> where idfs' :: Int -> Int -> Bool -> PState -> [PState]</pre> idfs' takes 4 parameters, which respectively are: the current depth, the current max depth, a boolean depicting if the solution is found and finally the current search node (or state). Now I'll first explain the three border cases. The search should end if: 1. The boolean depicting the solution is found is true. In that case the current state should be added to the state trace. 2. The current state is a goal state. In that case the function should recursively be called with the boolean as true. 3. The current search depth is as large as the maximum search depth, in which case the search should stop. (And [] should be returned. Therefore: <pre> idfs' m n True s = [s] idfs' m n False s | isGoalState s = idfs' m n True s | m==n = []</pre> If these cases do not happen then the search should recursively be applied to each successor of the current state. The first result of these searches that does not contain the empty list, contains the solution. In that case we should take that first result and return that along with the current state. Therefore: <pre> | otherwise = case dropWhile (==[]) $ map (idfs' (m+1) n False) (successors s) of [] -> [] (x:xs) -> s : x</pre> And this concludes the search function :). So now we're ready to call solution! Load up the definitions in ghci and call solution. The result will be: <pre>[PState {left = [Missionary,Missionary,Missionary,Cannibal,Cannibal,Cannibal], r ight = [], boat = LeftSide},PState {left = [Missionary,Missionary,Cannibal,Canni bal], right = [Missionary,Cannibal], boat = RightSide},PState {left = [Missionar y,Missionary,Missionary,Cannibal,Cannibal], right = [Cannibal], boat = LeftSide} ,PState {left = [Missionary,Missionary,Missionary], right = [Cannibal,Cannibal,C annibal], boat = RightSide},PState {left = [Missionary,Missionary,Missionary,Can nibal], right = [Cannibal,Cannibal], boat = LeftSide},PState {left = [Missionary ,Cannibal], right = [Missionary,Missionary,Cannibal,Cannibal], boat = RightSide} ,PState {left = [Missionary,Missionary,Cannibal,Cannibal], right = [Missionary,C annibal], boat = LeftSide},PState {left = [Cannibal,Cannibal], right = [Missiona ry,Missionary,Missionary,Cannibal], boat = RightSide},PState {left = [Cannibal,C annibal,Cannibal], right = [Missionary,Missionary,Missionary], boat = LeftSide}, PState {left = [Cannibal], right = [Missionary,Missionary,Missionary,Cannibal,Ca nnibal], boat = RightSide},PState {left = [Missionary,Cannibal], right = [Missio nary,Missionary,Cannibal,Cannibal], boat = LeftSide},PState {left = [], right = [Missionary,Missionary,Missionary,Cannibal,Cannibal,Cannibal], boat = RightSide} ]</pre> It's not pretty, but at least it's a solution and an optimal one (the shortest solution is 11 steps, and therefore length 12) too. Well this concludes the first part of the cannibals and missonaries problem. I will explain the state monad implementation of the search function in the next blog post. I hope this was enjoyable :-). For a State Monad introduction see <a href="https://adoseoflogic.blogspot.com/2009/07/cannibals-missionaries-and-state-monad_21.html">Cannibals, Missionaries and the State Monad pt. 2</a>. The final code: <pre>module AIMAMissionaries where import Data.List(sort, nub, (\\)) data Person = Missionary | Cannibal deriving (Ord, Eq, Show) data Position = LeftSide | RightSide deriving (Eq, Show) data PState = PState {left :: [Person], right :: [Person], boat :: Position} deriving (Eq, Show) beginState = PState {left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide} goalState = PState {left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide} almostGoalState = PState {left = [Cannibal], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal], boat = LeftSide} almostGoalState2 = PState {left = [Cannibal, Missionary, Missionary], right = [Missionary, Cannibal, Cannibal], boat = LeftSide} solution :: [PState] solution = idfs beginState 0 idfs :: PState -> Int -> [PState] idfs s n = case idfs' 0 n False s of [] -> idfs s (n+1) other -> other where idfs' :: Int -> Int -> Bool -> PState -> [PState] idfs' m n True s = [s] idfs' m n False s | isGoalState s = idfs' m n True s | m==n = [] | otherwise = case dropWhile (==[]) $ map (idfs' (m+1) n False) (successors s) of [] -> [] (x:xs) -> s : x -- check if the state is a goal state isGoalState :: PState -> Bool isGoalState = (== goalState) -- filter legal states successors :: PState -> [PState] successors = filter isLegalState . allSucc -- generate all states after applying all possible combinations allSucc :: PState -> [PState] allSucc s | boat s == LeftSide = map (updatePStateLeft s) (genCombs (left s)) | otherwise = map (updatePStateRight s) (genCombs (right s)) -- move a number of cannibals and missonaries to the right side updatePStateLeft s p = let oldLeft = left s oldRight = right s in s {left = sort $ oldLeft \\ p, right = sort $ oldRight ++ p, boat = RightSide } -- move a number of cannibals and missonaries to the left side updatePStateRight s p = let oldLeft = left s oldRight = right s in s {left = sort $ oldLeft ++ p, right = sort $ oldRight \\ p, boat = LeftSide } -- unique combinations genCombs :: Ord a => [a] -> [[a]] genCombs = nub . map sort . genPerms -- permutations of length 1 and 2 genPerms :: Eq a => [a] -> [[a]] genPerms [] = [] genPerms (x:xs) = [x] : (map (: [x]) xs) ++ genPerms xs -- legal states are states with the number of cannibals equal or less -- to the number of missionaries on one riverside (or sides with no missionaries) isLegalState :: PState -> Bool isLegalState s = hasNoMoreCannibals (left s) && hasNoMoreCannibals (right s) where hasNoMoreCannibals lst = let lenMiss = length ( filter (== Missionary) lst) lenCann = length ( filter (== Cannibal) lst) in lenMiss == 0 || lenMiss >= lenCann</pre> Edit: Added colouring :) and link to part 2.Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com2tag:blogger.com,1999:blog-8387731529560364137.post-15885899358800185642009-07-19T03:24:00.001+02:002009-07-19T03:47:27.380+02:00The blagFirst a small introduction to why this blag was created. I (Bas) will start a master Agent Technology, a computer science master, in Utrecht University this year. This choice of master corresponds with my interest in functional programming, logic, agents and artificial intelligence, and I intend to combine these interests with my current favourite programming language, Haskell, and discuss my findings in this blog. Nebasukehttps://www.blogger.com/profile/00690086652715846121noreply@blogger.com1

Original Source | Taken Source