tag:blogger.com,1999:blog-12547926670292543132024-02-21T06:40:31.335+11:00David's BlogAnonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.comBlogger9125tag:blogger.com,1999:blog-1254792667029254313.post-23154237393625598192013-10-12T00:14:00.000+11:002013-10-14T09:46:55.252+11:00Haskell Lens IsomorphismsA small snippet of code I wrote to try and get my head around Van Laarhoven lenses. It shows the isomorphisms between three common representations of lenses.<br />
<br />
<pre class="prettyprint lang-hs">{-# LANGUAGE RankNTypes #-}
-- Traditional lens as a pair of getter and setter
type Lens a b = (b -> a, b -> a -> b)
-- Lens implemented with a store comonad
data Store a b = Store { get :: a, set :: a -> b }
instance Functor (Store a) where
fmap f (Store a ab) = Store a (f . ab)
type SLens a b = b -> Store a b
-- Van Laarhoven lens
type VLLens a b = forall g . Functor g => (a -> g a) -> (b -> g b)
-- Lens / SLens isomorphism
lensToSlens :: Lens a b -> SLens a b
lensToSlens (getter, setter) = \b -> Store (getter b) (setter b)
sLensToLens :: SLens a b -> Lens a b
sLensToLens slens = (get . slens, set . slens)
-- SLens / VLLens isomorphism
sLensToVLLens :: SLens a b -> VLLens a b
sLensToVLLens slens = \f b -> let Store a ab = slens b in fmap ab $ f a
vLLensToSLens :: VLLens a b -> SLens a b
vLLensToSLens vllens = \b -> ((flip vllens) b) (\a -> Store a id)
</pre>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-62106405473878909122013-10-03T13:14:00.002+10:002013-10-14T09:48:43.095+11:00Ubuntu on the Gigabyte P34G UltrabladeIn my <a href="http://overtond.blogspot.com.au/2013/09/gigabyte-p34g-ultrablade-laptop.html">previous post</a> on the Gigabyte P34G I looked at my reasons for buying it and first impressions. In this post, I'm going to look at installing and setting up Ubuntu GNU/Linux on this machine.<br />
<h1>Installation and Setup</h1><h3>Creating USB installation media</h3><div>On another Ubuntu machine:</div><div><ul><li>Download the Ubuntu Live CD ISO. I started with Ubuntu 13.04, but you are probably better off to go straight to 13.10 for reasons described below.</li>
<li>Copy to USB stick using <span style="font-family: Courier New, Courier, monospace;">usb-creator-gtk </span>(or <span style="font-family: Courier New, Courier, monospace;">dd</span> if you're feeling more adventurous, but make sure you don't wipe your hard disk by mistake!).</li>
</ul></div><h3>BIOS settings</h3><div>To get to the BIOS settings you first need to boot into Windows 8 and then do a proper shutdown (i.e. not a fastboot shutdown). I used the pre-installed Gigabyte utility to do this as the standard Windows shutdown just went into fastboot mode.</div><div><br />
</div><div>Insert the USB stick then boot into the BIOS by holding down <span style="font-family: Courier New, Courier, monospace;"><F2></span> during startup.<br />
BIOS settings:<br />
<ul><li>Disable 3D Graphic Acceleration. The X server won't start unless you do this. I think it's getting confused about which graphics adapter to use.</li>
<li>Intel Rapid Start Technology. Not sure if this is necessary.</li>
<li>Disable Secure Boot. Again, not sure that it's necessary.</li>
<li>Set boot sequence to boot from the USB stick.</li>
</ul></div><div>Boot the USB stick and select 'Install'.<br />
<br />
Note: I originally tried installing Linux Mint 15, but could not get the installation media to boot, even with the BIOS changes described above, which was why I went with Ubuntu instead.<br />
<h3>Partitioning</h3></div><div>I deleted the Windows partition on the 256GB SSD and replaced it with:</div><div><ul><li>25GB Ext4 Linux root (/) partition</li>
<li>16GB free space which I will hopefully be able to use with Intel Rapid Start Technology some time in the future (pending Linux kernel support, see <a href="http://www.phoronix.com/scan.php?%20page=news_item&px=MTQwMzU">http://www.phoronix.com/scan.php?%20page=news_item&px=MTQwMzU</a>)</li>
<li>Remainder Ext4 partition for /home</li>
</ul><div>There were two partitions for Windows restore, a small 20MB partition at the start and a larger 30GB partition at the end of the SSD. I kept both of these for now, in case I need to restore Windows 8 for some reason. I will probably eventually end up removing the 30GB and extending the size of /home. I also kept the EFI boot partition which is required for UEFI boot as the disk uses GPT.</div><div><br />
</div><div>If you want to dual boot Windows 8 and Ubuntu you should be able to shrink the size of the Windows partition to fit the Linux partitions in.</div><div><br />
</div><div>I partitioned the 1TB HDD as</div></div><div><ul><li>16GB for swap. Unlikely to ever actually use this, but it's there just in case.</li>
<li>Remainder Ext4 partition to mounted as /data.</li>
</ul></div><h3>Wifi</h3><div>After booting for the first time I noticed that the wifi card (Intel Centrino 7260) was not detected. After reading <a href="http://askubuntu.com/questions/322511/no-wireless-with-intel-centrino-advanced-n-7260">http://askubuntu.com/questions/322511/no-wireless-with-intel-centrino-advanced-n-7260</a> I determined that I needed to upgrade the Linux kernel to 3.11 (from 3.08), and possibly install some firmware binaries, to get this card to work. I couldn't find kernel 3.11 packages for Ubuntu 13.04, but noticed that it is the standard kernel in 13.10, which is due for release in just over 2 weeks. I decided the easiest option was probably to just upgrade to the latest development version of Ubuntu 13.10 which I did by connecting an ethernet cable to my router and running <span style="font-family: Courier New, Courier, monospace;">sudo upgrade-manager -d.</span><span style="font-family: inherit;"> If you're installing from scratch, I'd recommend going directly to Ubuntu 13.10 rather than installing 13.04 first. It may have even been officially released by the time you read this. Installing the firmware binary was not necessary. It must have been included either by Ubuntu or an update to the Linux kernel since the above-linked post was written.</span></div><div><span style="font-family: inherit;"><br />
</span></div><div><span style="font-family: inherit;">The other thing I've noticed about wifi is that it occasionally just stops working. It's happened maybe two or three times in the week since I've had the laptop. It's probably a sign that the drivers aren't yet mature. It can be easily fixed by running </span><span style="font-family: Courier New, Courier, monospace;">sudo rmmod iwlwifi; modprobe iwlwifi</span><span style="font-family: inherit;"> to remove and re-insert the wifi driver module. Hopefully this problem will go away after some future kernel upgrade.</span></div><h3>SSD options in fstab</h3><div>Once you've got the system up there are a couple of flags you need to add to the entries for the SSD partitions in <span style="font-family: Courier New, Courier, monospace;">/etc/fstab</span><span style="font-family: inherit;">:</span></div><div><ul><li>Add the <span style="font-family: Courier New, Courier, monospace;">discard</span><span style="font-family: inherit;"> flag to enable TRIM. The will prevent performance decreasing over time as the drive fills up.</span></li>
<li><span style="font-family: inherit;">Add </span><span style="font-family: Courier New, Courier, monospace;">noatime</span><span style="font-family: inherit;"> flag to avoid causing a write to the SSD every time you do a read (which will wear the SSD out much faster than necessary).</span></li>
</ul>I'm suprised the Ubuntu installer doesn't set these options by default for SSD drives.</div><h3>Sound</h3><div>The first time I tried playing a YouTube video in Ubuntu there was no sound. I've since noticed that the sound is now working so not sure what was going on there.</div><h3>Touchpad</h3><div>The touchpad is very sensitive to accidental palm touches, making typing a frustrating experience. You can easily disable it when necessary using <span style="font-family: Courier New, Courier, monospace;">Fn-F10</span> key combination. You can also use <span style="font-family: Courier New, Courier, monospace;">synclient </span>to configure palm detection, see e.g. <a href="http://askubuntu.com/questions/205512/touchpad-palm-sensitivity">http://askubuntu.com/questions/205512/touchpad-palm-sensitivity</a>. I had to use very low values (<span style="font-family: Courier New, Courier, monospace;">PalmMinWidth=3 PalmMinZ=1</span>) to get it to be usable, but YMMV. You can also use <span style="font-family: Courier New, Courier, monospace;">synclient </span>to configure other settings, such as two-finger scrolling and three-finger tap for middle mouse button.</div><div><br />
</div><div>One weird thing I noticed was that the other evening, after I had been playing with BIOS settings trying to work out what the minimum changes were that were needed to get Ubuntu to boot, I booted up and found that the touchpad was no longer working. Neither <span style="font-family: Courier New, Courier, monospace;">xinput n</span>or <span style="font-family: Courier New, Courier, monospace;">synclient </span>could find the touchpad at all. I plugged in a USB mouse which worked, but nothing I tried could get the touchpad to re-appear. Feeling frustrated, I turned off the computer and went to bed. Next day when I started it up the touchpad was back. No idea what happened there and hoping it doesn't happen again.</div><h3>Bluetooth</h3><div>Bluetooth is provided by the Intel Centrino 7260 wifi card. Ubuntu reports that it is working, but in a quick test I could not get it to pair up with my phone. The phone couldn't see the laptop and neither could the laptop see the phone. I didn't investigate this too much because I don't really have a need for it. It may be another sign of driver immaturity for this card.</div><h3>Suspend</h3><div>Suspend seems to work. I have it set to suspend when I close the lid and it has so far always come back ok. I am hoping a future Linux kernel will support Intel Rapid Start and, as mentioned previously, have left space on the SSD for it.</div><h1>Still to do</h1><div>Things I still need to do:</div><div><ul><li><a href="https://wiki.ubuntu.com/Bumblebee#Installation">Install Bumblebee</a> and the NVidia drivers to allow the GTX 760M to work with Optimus. I'm currently not using it at all and relying on the Intel integrated graphics. I did briefly try using the latest NVidia driver, which is <a href="http://www.webupd8.org/2013/08/using-nvidia-graphics-drivers-with.html">supposed to have Optimus support</a> without requiring Bumblebee, however, even after re-enabling "graphics acceleration" in the BIOS I could not get the X server to start. I haven't had time to investigate this further.</li>
<li>I find that the hard disk occasionally spins up when I'm not using it. This may be related to the kernel "swappiness" parameter (I have a swap partition there, but it shouldn't be using it with 16GB of RAM), or it may be due to some other activity. Not sure yet.</li>
<li>Install XMonad instead of the Unity window manager.</li>
<li>Check out whether I can get Intel Rapid Start to work.</li>
</ul></div>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-68596076692054063302013-09-30T11:53:00.000+10:002013-10-14T09:48:09.389+11:00Gigabyte P34G Ultrablade laptop <h1>Key specifications</h1><div><ul><li><a href="http://www.gigabyte.com.au/products/product-page.aspx?pid=4636#sp">Gigabyte P34G Ultrablade laptop</a></li>
<li>14 inch 1920x1080 AHVA (IPS) matte display</li>
<li>Intel Haswell Core i7-4700HQ CPU with integrated Intel HD 4600 graphics</li>
<li>NVidia GeForce GTX 760M discrete graphics with Optimus support</li>
<li>16GB DDR3 1600MHz RAM</li>
<li>256GB mSATA SSD</li>
<li>Space for a 2.5 inch x 9.5mm SATA HDD (I purchased and installed a Seagate 1TB 5400rpm SSHD)</li>
<li>21mm thickness</li>
<li>1.76kg weight (including HDD)</li>
</ul><h1>Reasons for choosing it</h1>This laptop is replacing a 5 year old Lenovo Thinkpad T61 which has a brilliant keyboard and touchpad (including middle mouse button) and average 15.4 inch 1680x1050 TFT screen with poor viewing angles and quite dull display. With its slow (by today's standards) Core 2 Duo CPU, slow 256GB HDD, only 4GB RAM (with no possibility to upgrade) and pretty much dead battery (lucky to get 5 minutes out of it) it was time to upgrade.<br />
<br />
I was originally tempted by the 15 inch Macbook Pro Retina, but ruled it out due to the price. Next I considered the new generation of Haswell Thinkpads, which have been announced, but have not yet been released. I have only ever owned Thinkpad laptops before (previously an IBM T40) and have always been very happy with them, in particular build quality, keyboard and touchpad, so was a bit hesitant to go for something else. The models I was considering are the T440s and T440p.<br />
<br />
I decided to go for a 14 inch model rather than 15.6 inch because I wanted something a bit thinner and lighter than my current Thinkpad. Also it seems to have become almost impossible to get a 15 inch laptop without a numeric keypad, even the new Thinkpads have them. I want to have my right hand on the right-hand side of the keyboard when typing, not over on the left with my wrist twisted into an RSI-inducing position.<br />
<h2>Requirements for my ideal laptop</h2><ul><li>14 inch (at least) 1920x1080 (at least) matte IPS display (with good viewing angles and reasonable colour gamut, suitable for photo editing)</li>
<li>Haswell Core i7 CPU, preferably quad core</li>
<li>Preferably at least 16GB RAM</li>
<li>At least 256GB SSD and preferably option for an additional HDD or larger SSD</li>
<li>No numeric keypad</li>
<li>Reasonably thin (prefer < 25mm) and light (prefer < 2kg)</li>
</ul><h2>Reasons I chose the Gigabyte over the Thinkpad models</h2><ul><li>Decent quad core CPU (T440s has a ULV dual core CPU, T440p will probably have the 4700MQ which is not much different to the 4700HQ on the P34G)</li>
<li>16GB RAM standard (T440s maxes out at 12GB, T440p supports up to 16GB, but at extra cost)</li>
<li>Similar size and weight to T440s (T440p is a fair bit thicker and heavier)</li>
<li>Option for 256 GB SSD and 1TB HDD (in the Thinkpads you have to choose one or the other and 256GB seems a bit small if you're doing lots of photo editing and want space for virtual machines and/or Windows/Linux dual boot)</li>
<li>It's available now, Thinkpads not expected to be available until at least November.</li>
<li>At $1700 it's probably about $1000 less than I'd expect to pay for one of the new Thinkpads with similar specs.</li>
</ul></div><div><h1>First thoughts</h1></div><div><ul><li>Case feels very solid, despite being so thin and light. Seems to have very good build quality and no noticeable flex.</li>
<li>Display is bright and crisp with good viewing angles. There is some backlight leakage along the bottom and in the top right corner, but only noticeable when looking at a very dark screen in a very dark room. There is one bright green stuck pixel in the centre-left of the display, but again is only noticeable when looking at very dark images (although I never noticed any stuck/dead pixels on either of my Thinkpads).</li>
<li>Keyboard is not nearly as good as either of my previous Thinkpad keyboards, but then I don't think anything is these days. I'm sure it will be ok, although I've noticed that occasionally pressing letters near the centre (e.g. N, M) will result in a double press being registered. Page Up, Page Down, Home and End keys are only accessible by using the arrow keys with the Fn button pressed. I think that is pretty typical these days (my colleague's new Dell XPS is the same), but it seems strange given how essential these keys are for navigation. I think Page Up and Page Down can be emulated via 3-finger swiping on the touchpad, so maybe I'll get used to it.</li>
<li>Touchpad seems unresponsive at first, especially for two-finger scrolling. However, after some adjustments it seems to be ok. I miss the middle mouse button on the Thinkpad, but it can be emulated with a three-finger tap. Something else to get used to I guess. The touchpad is huge compared to what I'm used to. I keep accidentally touching it while typing, which leads to unexpected and annoying behaviour. Will need to do some tweaking to the palm detection settings to avoid this.</li>
<li>Windows 8 starts up very quickly and feels snappy, but how do I actually use it? They seem to have made the most useful functionality deliberately hard to find. Will need to get Linux on here ASAP.</li>
<li>Despite having two massive fans, with two massive air vents at the back (one each for the CPU and GPU), the machine is almost silent when idling. I suspect the fan noise will pick up when I put the CPU and GPU to some serious use.</li>
<li>The hard drive was very easy to install: remove about 15 screws and take off the back cover. Plug HDD into the SATA cable and slot into place. Replace the cover and screws. I plan to use the HDD as secondary storage for my photos and a Windows VM or two so most of the time it's not spinning and the machine is quiet. You definitely know when it spins up though – it's quite noisy.</li>
</ul><h1>Still to come...</h1><div>I plan to write a follow-up post on my experience installing Ubuntu GNU/Linux on this machine.<br />
<br />
<b>Update 2013-10-3</b>: <a href="http://overtond.blogspot.com.au/2013/10/ubuntu-on-gigabyte-p34g-ultrablade.html">Blog post on Ubuntu installation is now available</a>. </div></div>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-5409646961509685352013-09-29T22:36:00.000+10:002013-10-14T10:19:04.826+11:00Running E-tax 2013 on Ubuntu 13.10<a href="http://www.ato.gov.au/Individuals/Lodging-your-tax-return/e-tax/">E-tax</a> is the <a href="http://ato.gov.au/">Australian Tax Office</a>'s antiquated Windows software for completing and filing personal tax returns. It's possible to run it under Linux using <a href="http://www.winehq.org/">Wine</a>. Here are the steps for Ubuntu 13.10. It should also work on older versions of Ubuntu and possibly other Debian derivatives.<br />
<ul><li><span style="font-family: Courier New, Courier, monospace;">export WINEARCH=win32</span></li>
<li><span style="font-family: Courier New, Courier, monospace;">sudo apt-get install winetricks</span></li>
<li><span style="font-family: Courier New, Courier, monospace;">winetricks msxml4</span></li>
<li><span style="font-family: Courier New, Courier, monospace;">wget http://www.ato.gov.au/misc/downloads/etax2013/etax2013_1.msi</span></li>
<li><span style="font-family: Courier New, Courier, monospace;">msiexec /i etax2013_1.msi</span></li>
</ul><br />
<h3>Update 14/10/2013</h3><div>When filling out my spouse's details I noticed that the radio buttons for spouse's gender were disabled. At the time I just assumed they no longer considered the question relevant and didn't think more of it. However, when I went to lodge my tax return I got the cryptic error <br />
<blockquote>V2357 - Spouse's ATI amount for income test purposes is incorrect.</blockquote>I couldn't work out what the problem was so eventually ended up booting up an old laptop with Windows Vista, installing e-Tax on it and copying my tax file across. That didn't resolve the error, but at least I could view the error description in the help docs, which basically just said call the ATO personal tax help line if you get this error.</div><div><br />
</div><div>Of course I was doing this on a Saturday afternoon and the help line is only open 8am to 6pm Monday to Friday so I had to wait until Monday morning. I called the help line, got transferred to e-Tax technical support then back to the help line before I got someone who was able to help. After 45 minutes on the phone, we eventually determined that the problem was with the aforementioned spouse's gender radio button. It turns out that on Vista the buttons do work and once I entered the correct gender the error went away.<br />
<br />
Note to the ATO's e-Tax developers: would it have been so hard to supply a meaningful error message so I didn't have to waste so much of my time and your help desk's time on this trivial issue?</div><br />
<h2>References</h2><ul><li><a href="http://forums.whirlpool.net.au/forum-replies.cfm?t=2122383&p=4">http://forums.whirlpool.net.au/forum-replies.cfm?t=2122383&p=4</a></li>
<li><a href="http://appdb.winehq.org/objectManager.php?sClass=version&iId=28504">http://appdb.winehq.org/objectManager.php?sClass=version&iId=28504</a></li>
<li><a href="http://forum.winehq.org/viewtopic.php?t=9074">http://forum.winehq.org/viewtopic.php?t=9074</a></li>
</ul>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-15400470101244648562008-07-04T21:27:00.001+10:002013-11-29T11:05:23.312+11:00A Haskell Sudoku Solver using Finite Domain Constraints<p>In a <a href="http://overtond.blogspot.com/2008/07/pre.html">previous post</a> we looked at how to write a finite domain constraint solver in Haskell. Now we're going to look at how to use this solver to solve <a href="http://en.wikipedia.org/wiki/Sudoku">Sudoku</a> puzzles. First we give the module header and define a useful type:</p><pre class="prettyprint lang-hs"><span class='keyword'>module</span> <span class='conid'>Sudoku</span> <span class='layout'>(</span><span class='conid'>Puzzle</span><span class='layout'>,</span> <span class='varid'>printSudoku</span><span class='layout'>,</span> <span class='varid'>displayPuzzle</span><span class='layout'>,</span> <span class='varid'>sudoku</span><span class='layout'>)</span> <span class='keyword'>where</span>
<span class='keyword'>import</span> <span class='conid'>Control</span><span class='varop'>.</span><span class='conid'>Monad</span>
<span class='keyword'>import</span> <span class='conid'>Data</span><span class='varop'>.</span><span class='conid'>List</span> <span class='layout'>(</span><span class='varid'>transpose</span><span class='layout'>)</span>
<span class='keyword'>import</span> <span class='conid'>FD</span>
<span class='keyword'>type</span> <span class='conid'>Puzzle</span> <span class='keyglyph'>=</span> <span class='keyglyph'>[</span><span class='conid'>Int</span><span class='keyglyph'>]</span>
</pre><p>We represent both unsolved and solved puzzles as a list of 81 <samp class=haskell><span class='conid'>Int</span></samp>s. In an unsolved puzzle, we use 0 to represent a blank square. The numbers 1 to 9 represent squares with known values. Here is an example of an unsolved puzzle that I copied from the local newspaper: </p><pre class="prettyprint lang-hs"><span class='varid'>test</span> <span class='keyglyph'>::</span> <span class='conid'>Puzzle</span>
<span class='varid'>test</span> <span class='keyglyph'>=</span> <span class='keyglyph'>[</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>8</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>1</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>6</span><span class='layout'>,</span> <span class='num'>5</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>7</span><span class='layout'>,</span>
<span class='num'>4</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>2</span><span class='layout'>,</span> <span class='num'>7</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>8</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>3</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>1</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>3</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>8</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>5</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>9</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>7</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>5</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>8</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>6</span><span class='layout'>,</span>
<span class='num'>3</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>1</span><span class='layout'>,</span> <span class='num'>2</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>4</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span>
<span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>6</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>1</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span><span class='layout'>,</span> <span class='num'>0</span> <span class='keyglyph'>]</span>
</pre><p>The function <samp>displayPuzzle</samp> displays a puzzle for us in rows and columns. The function <samp>printSudoku</samp> will solve a puzzle by calling <samp>sudoku</samp>, which we will define below. It then prints each solution. </p><pre class="prettyprint lang-hs"><span class='varid'>displayPuzzle</span> <span class='keyglyph'>::</span> <span class='conid'>Puzzle</span> <span class='keyglyph'>-></span> <span class='conid'>String</span>
<span class='varid'>displayPuzzle</span> <span class='keyglyph'>=</span> <span class='varid'>unlines</span> <span class='varop'>.</span> <span class='varid'>map</span> <span class='varid'>show</span> <span class='varop'>.</span> <span class='varid'>chunk</span> <span class='num'>9</span>
<span class='varid'>printSudoku</span> <span class='keyglyph'>::</span> <span class='conid'>Puzzle</span> <span class='keyglyph'>-></span> <span class='conid'>IO</span> <span class='conid'>()</span>
<span class='varid'>printSudoku</span> <span class='keyglyph'>=</span> <span class='varid'>putStr</span> <span class='varop'>.</span> <span class='varid'>unlines</span> <span class='varop'>.</span> <span class='varid'>map</span> <span class='varid'>displayPuzzle</span> <span class='varop'>.</span> <span class='varid'>sudoku</span>
<span class='varid'>chunk</span> <span class='keyglyph'>::</span> <span class='conid'>Int</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span><span class='keyglyph'>]</span>
<span class='varid'>chunk</span> <span class='keyword'>_</span> <span class='conid'>[]</span> <span class='keyglyph'>=</span> <span class='conid'>[]</span>
<span class='varid'>chunk</span> <span class='varid'>n</span> <span class='varid'>xs</span> <span class='keyglyph'>=</span> <span class='varid'>ys</span> <span class='conop'>:</span> <span class='varid'>chunk</span> <span class='varid'>n</span> <span class='varid'>zs</span> <span class='keyword'>where</span>
<span class='layout'>(</span><span class='varid'>ys</span><span class='layout'>,</span> <span class='varid'>zs</span><span class='layout'>)</span> <span class='keyglyph'>=</span> <span class='varid'>splitAt</span> <span class='varid'>n</span> <span class='varid'>xs</span>
</pre><p>We now present the code to actually solve the puzzle:</p><pre class="prettyprint lang-hs"><span class='varid'>sudoku</span> <span class='keyglyph'>::</span> <span class='conid'>Puzzle</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='conid'>Puzzle</span><span class='keyglyph'>]</span>
<span class='varid'>sudoku</span> <span class='varid'>puzzle</span> <span class='keyglyph'>=</span> <span class='varid'>runFD</span> <span class='varop'>$</span> <span class='keyword'>do</span>
<span class='varid'>vars</span> <span class='keyglyph'><-</span> <span class='varid'>newVars</span> <span class='num'>81</span> <span class='keyglyph'>[</span><span class='num'>1</span><span class='keyglyph'>..</span><span class='num'>9</span><span class='keyglyph'>]</span>
<span class='varid'>zipWithM_</span> <span class='layout'>(</span><span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>n</span> <span class='keyglyph'>-></span> <span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>n</span> <span class='varop'>></span> <span class='num'>0</span><span class='layout'>)</span> <span class='layout'>(</span><span class='varid'>x</span> <span class='varop'>`hasValue`</span> <span class='varid'>n</span><span class='layout'>)</span><span class='layout'>)</span> <span class='varid'>vars</span> <span class='varid'>puzzle</span>
<span class='varid'>mapM_</span> <span class='varid'>allDifferent</span> <span class='layout'>(</span><span class='varid'>rows</span> <span class='varid'>vars</span><span class='layout'>)</span>
<span class='varid'>mapM_</span> <span class='varid'>allDifferent</span> <span class='layout'>(</span><span class='varid'>columns</span> <span class='varid'>vars</span><span class='layout'>)</span>
<span class='varid'>mapM_</span> <span class='varid'>allDifferent</span> <span class='layout'>(</span><span class='varid'>boxes</span> <span class='varid'>vars</span><span class='layout'>)</span>
<span class='varid'>labelling</span> <span class='varid'>vars</span>
<span class='varid'>rows</span><span class='layout'>,</span> <span class='varid'>columns</span><span class='layout'>,</span> <span class='varid'>boxes</span> <span class='keyglyph'>::</span> <span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span><span class='keyglyph'>]</span>
<span class='varid'>rows</span> <span class='keyglyph'>=</span> <span class='varid'>chunk</span> <span class='num'>9</span>
<span class='varid'>columns</span> <span class='keyglyph'>=</span> <span class='varid'>transpose</span> <span class='varop'>.</span> <span class='varid'>rows</span>
<span class='varid'>boxes</span> <span class='keyglyph'>=</span> <span class='varid'>concat</span> <span class='varop'>.</span> <span class='varid'>map</span> <span class='layout'>(</span><span class='varid'>map</span> <span class='varid'>concat</span> <span class='varop'>.</span> <span class='varid'>transpose</span><span class='layout'>)</span> <span class='varop'>.</span> <span class='varid'>chunk</span> <span class='num'>3</span> <span class='varop'>.</span> <span class='varid'>chunk</span> <span class='num'>3</span> <span class='varop'>.</span> <span class='varid'>chunk</span> <span class='num'>3</span>
</pre><p>We start by initialising 81 new solver variables, one for each square in the puzzle. Next, we constrain each known square in the puzzle to its given value. The next three lines create the Sudoku constraints: each number 1 to 9 may occur only once in each row, column and 3x3 box. The functions for grouping the variables into rows, columns and boxes are given below the main function. Finally, we call <samp>labelling</samp> to search for solutions.</p><p>Let's see how this performs with our <samp>test</samp> puzzle, running on a 2.4GHz Intel Core 2 Duo with 4GB RAM: <pre>> ghc --make -O2 test
[1 of 3] Compiling FD ( FD.hs, FD.o )
[2 of 3] Compiling Sudoku ( Sudoku.hs, Sudoku.o )
[3 of 3] Compiling Main ( test.hs, test.o )
Linking test ...
> time ./test
[5,6,7,4,8,3,2,9,1]
[9,3,8,1,2,6,5,4,7]
[4,1,2,7,9,5,3,6,8]
[6,8,9,3,7,2,1,5,4]
[7,4,3,6,5,1,8,2,9]
[1,2,5,8,4,9,6,7,3]
[2,5,4,9,3,8,7,1,6]
[3,7,1,2,6,4,9,8,5]
[8,9,6,5,1,7,4,3,2]
real 0m6.518s
user 0m6.480s
sys 0m0.032s
</pre><p>So it takes around 6.5 seconds to find all solutions to this puzzle (of which there is exactly one, as expected). Can we do any better than that? Yes we can, actually. Recall our earlier definition of the function <samp>different</samp> which constrains two variables to have different values, and is used by the <samp>allDifferent</samp> function which features prominently in our Sudoku solving code: <pre class="prettyprint lang-hs"><span class='varid'>different</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>different</span> <span class='keyglyph'>=</span> <span class='varid'>addBinaryConstraint</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>-></span> <span class='keyword'>do</span>
<span class='varid'>xv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>x</span>
<span class='varid'>yv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>y</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>xv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>yv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='varid'>xv</span> <span class='varop'>/=</span> <span class='varid'>yv</span>
</pre><p>Notice how this function doesn't try to constrain the domains of the variables or do any constraint propagation. That's because, in the general case, we don't have enough information to do this, we just have to store the constraint and retest it each time the domains are changed. This means that in our Sudoku solver, the labelling step will effectively try each value 1 to 9 in turn for each blank square and then test whether the <samp>allDifferent</samp> constraints still hold. This is almost a brute force algorithm. </p><p>However, we have overlooked one case where we <em>can</em> further constrain the variables: if the domain of one variable is a singleton set, then we can remove that value from the domain of the other variable. This should drastically reduce the number of tests we need to do during labelling. Here's the modified function:</p><pre class="prettyprint lang-hs"><span class='varid'>different</span> <span class='keyglyph'>=</span> <span class='varid'>addBinaryConstraint</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>-></span> <span class='keyword'>do</span>
<span class='varid'>xv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>x</span>
<span class='varid'>yv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>y</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>xv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>yv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='varid'>xv</span> <span class='varop'>/=</span> <span class='varid'>yv</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>xv</span> <span class='varop'>==</span> <span class='num'>1</span> <span class='varop'>&&</span> <span class='varid'>xv</span> <span class='varop'>`</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>isProperSubsetOf</span><span class='varop'>`</span> <span class='varid'>yv</span><span class='layout'>)</span> <span class='varop'>$</span>
<span class='varid'>update</span> <span class='varid'>y</span> <span class='layout'>(</span><span class='varid'>yv</span> <span class='varop'>`</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>difference</span><span class='varop'>`</span> <span class='varid'>xv</span><span class='layout'>)</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>yv</span> <span class='varop'>==</span> <span class='num'>1</span> <span class='varop'>&&</span> <span class='varid'>yv</span> <span class='varop'>`</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>isProperSubsetOf</span><span class='varop'>`</span> <span class='varid'>xv</span><span class='layout'>)</span> <span class='varop'>$</span>
<span class='varid'>update</span> <span class='varid'>x</span> <span class='layout'>(</span><span class='varid'>xv</span> <span class='varop'>`</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>difference</span><span class='varop'>`</span> <span class='varid'>yv</span><span class='layout'>)</span>
</pre><p>Here are the times with the modified funtion:</p><pre>> time ./test
[5,6,7,4,8,3,2,9,1]
[9,3,8,1,2,6,5,4,7]
[4,1,2,7,9,5,3,6,8]
[6,8,9,3,7,2,1,5,4]
[7,4,3,6,5,1,8,2,9]
[1,2,5,8,4,9,6,7,3]
[2,5,4,9,3,8,7,1,6]
[3,7,1,2,6,4,9,8,5]
[8,9,6,5,1,7,4,3,2]
real 0m0.180s
user 0m0.160s
sys 0m0.020s
</pre>That's a 36-fold improvement. Not bad for adding four lines of code!Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com5tag:blogger.com,1999:blog-1254792667029254313.post-11518435628123986862008-07-03T21:54:00.010+10:002013-11-29T11:08:24.804+11:00Constraint Programming in Haskell<p>Having had a bit of free time in the evenings lately, I've finally got around to starting one of the things on my list of cool Haskell projects I'd like to get around to one day. Since my time working on <a href="http://www.cs.mu.oz.au/research/mercury/">Mercury</a> and <a href="http://www.csse.monash.edu.au/~mbanda/hal/">HAL</a>, I've been interested in logic programming and constraint logic programming and I've been wanting to find out how close I can get to something that looks like a constraint logic programming system in Haskell. </p><p>The Haskell list monad already allows a style of programming that feels somewhat like non-deterministic logic programming, with backtracking to do a depth-first left-to-right search. I'm going to build a monad on top of the list monad to do finite domain constraint programming. I'm aiming for a nice clean interface and a simple implementation, so this is not going to be as efficient as it could be, but that's ok for a proof of concept. If I get time later, I'll go back and try to make it more efficient.</p><p>In a finite domain solver the variables represent a finite set of (usually integer) values to which the programmer can add various constraints. They are particularly useful for scheduling and timetabling problems. They are also good for solving puzzles such as Sudoku, which I will detail in a later post.</p><p>An example of the kind of constraint program we're aiming to be able to write is <pre class="prettyprint lang-hs"><span class='varid'>runTest</span> <span class='keyglyph'>=</span> <span class='varid'>runFD</span> <span class='varid'>test</span>
<span class='varid'>test</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>x</span> <span class='keyglyph'><-</span> <span class='varid'>newVar</span> <span class='keyglyph'>[</span><span class='num'>0</span><span class='keyglyph'>..</span><span class='num'>3</span><span class='keyglyph'>]</span>
<span class='varid'>y</span> <span class='keyglyph'><-</span> <span class='varid'>newVar</span> <span class='keyglyph'>[</span><span class='num'>0</span><span class='keyglyph'>..</span><span class='num'>3</span><span class='keyglyph'>]</span>
<span class='layout'>(</span><span class='layout'>(</span> <span class='varid'>x</span> <span class='varop'>.<.</span> <span class='varid'>y</span><span class='layout'>)</span> <span class='varop'>`mplus`</span> <span class='layout'>(</span><span class='varid'>x</span> <span class='varop'>`same`</span> <span class='varid'>y</span><span class='layout'>)</span><span class='layout'>)</span>
<span class='varid'>x</span> <span class='varop'>`hasValue`</span> <span class='num'>2</span>
<span class='varid'>labelling</span> <span class='keyglyph'>[</span><span class='varid'>x</span><span class='layout'>,</span> <span class='varid'>y</span><span class='keyglyph'>]</span>
</pre>Here we create two finite domain variables <samp>x</samp> and <samp>y</samp>, each with an initial domain of <samp>{0, 1, 2, 3}</samp>. We then add a constraint that says either <samp>x</samp> is less than <samp>y</samp> or <samp>x</samp> is the same as <samp>y</samp>. We then further constrain <samp>x</samp> to have the value <samp>2</samp>. Finally, the call to <samp>labelling</samp> will search for all possible solutions that satisfy the given constraints. When we evaluate <samp>runTest</samp> we get the result <samp>[[2,3],[2,2]]</samp> which represents the two possible solutions <samp>{x = 2, y = 3}</samp> and <samp>{x = 2, y = 2}</samp>. </p><p>Finite domain solvers also allow constraints to contain arithmetic expressions involving constraint variables and integers. To keep things simple, we'll leave them out for now. The interface we are going to implement is shown below. </p><pre class="prettyprint lang-hs"><span class='comment'>{-# LANGUAGE GeneralizedNewtypeDeriving #-}</span>
<span class='comment'>{-# LANGUAGE RankNTypes #-}</span>
<span class='keyword'>module</span> <span class='conid'>FD</span> <span class='layout'>(</span>
<span class='comment'>-- Types</span>
<span class='conid'>FD</span><span class='layout'>,</span> <span class='comment'>-- Monad for finite domain constraint solver</span>
<span class='conid'>FDVar</span><span class='layout'>,</span> <span class='comment'>-- Finite domain solver variable</span>
<span class='comment'>-- Functions</span>
<span class='varid'>runFD</span><span class='layout'>,</span> <span class='comment'>-- Run the monad and return a list of solutions.</span>
<span class='varid'>newVar</span><span class='layout'>,</span> <span class='comment'>-- Create a new FDVar</span>
<span class='varid'>newVars</span><span class='layout'>,</span> <span class='comment'>-- Create multiple FDVars</span>
<span class='varid'>hasValue</span><span class='layout'>,</span> <span class='comment'>-- Constrain a FDVar to a specific value</span>
<span class='varid'>same</span><span class='layout'>,</span> <span class='comment'>-- Constrain two FDVars to be the same</span>
<span class='varid'>different</span><span class='layout'>,</span> <span class='comment'>-- Constrain two FDVars to be different</span>
<span class='varid'>allDifferent</span><span class='layout'>,</span> <span class='comment'>-- Constrain a list of FDVars to be different</span>
<span class='layout'>(</span><span class='varop'>.<.</span><span class='layout'>)</span><span class='layout'>,</span> <span class='comment'>-- Constrain one FDVar to be less than another</span>
<span class='varid'>labelling</span> <span class='comment'>-- Backtracking search for all solutions</span>
<span class='layout'>)</span> <span class='keyword'>where</span>
</pre>Modules we need to import: <pre class="prettyprint lang-hs"><span class='keyword'>import</span> <span class='conid'>Prelude</span> <span class='varid'>hiding</span> <span class='layout'>(</span><span class='varid'>lookup</span><span class='layout'>)</span>
<span class='keyword'>import</span> <span class='conid'>Control</span><span class='varop'>.</span><span class='conid'>Monad</span><span class='varop'>.</span><span class='conid'>State</span><span class='varop'>.</span><span class='conid'>Lazy</span>
<span class='keyword'>import</span> <span class='conid'>Control</span><span class='varop'>.</span><span class='conid'>Monad</span><span class='varop'>.</span><span class='conid'>Trans</span>
<span class='keyword'>import</span> <span class='keyword'>qualified</span> <span class='conid'>Data</span><span class='varop'>.</span><span class='conid'>Map</span> <span class='keyword'>as</span> <span class='conid'>Map</span>
<span class='keyword'>import</span> <span class='conid'>Data</span><span class='varop'>.</span><span class='conid'>Map</span> <span class='layout'>(</span><span class='layout'>(</span><span class='varop'>!</span><span class='layout'>)</span><span class='layout'>,</span> <span class='conid'>Map</span><span class='layout'>)</span>
<span class='keyword'>import</span> <span class='keyword'>qualified</span> <span class='conid'>Data</span><span class='varop'>.</span><span class='conid'>IntSet</span> <span class='keyword'>as</span> <span class='conid'>IntSet</span>
<span class='keyword'>import</span> <span class='conid'>Data</span><span class='varop'>.</span><span class='conid'>IntSet</span> <span class='layout'>(</span><span class='conid'>IntSet</span><span class='layout'>)</span>
</pre>Below we define the types for the solver. <pre class="prettyprint lang-hs"><span class='comment'>-- The FD monad</span>
<span class='keyword'>newtype</span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='varid'>a</span> <span class='keyglyph'>=</span> <span class='conid'>FD</span> <span class='layout'>{</span> <span class='varid'>unFD</span> <span class='keyglyph'>::</span> <span class='conid'>StateT</span> <span class='layout'>(</span><span class='conid'>FDState</span> <span class='varid'>s</span><span class='layout'>)</span> <span class='conid'>[]</span> <span class='varid'>a</span> <span class='layout'>}</span>
<span class='keyword'>deriving</span> <span class='layout'>(</span><span class='conid'>Monad</span><span class='layout'>,</span> <span class='conid'>MonadPlus</span><span class='layout'>,</span> <span class='conid'>MonadState</span> <span class='layout'>(</span><span class='conid'>FDState</span> <span class='varid'>s</span><span class='layout'>)</span><span class='layout'>)</span>
<span class='comment'>-- FD variables</span>
<span class='keyword'>newtype</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>FDVar</span> <span class='layout'>{</span> <span class='varid'>unFDVar</span> <span class='keyglyph'>::</span> <span class='conid'>Int</span> <span class='layout'>}</span> <span class='keyword'>deriving</span> <span class='layout'>(</span><span class='conid'>Ord</span><span class='layout'>,</span> <span class='conid'>Eq</span><span class='layout'>)</span>
<span class='keyword'>type</span> <span class='conid'>VarSupply</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>FDVar</span> <span class='varid'>s</span>
<span class='keyword'>data</span> <span class='conid'>VarInfo</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>VarInfo</span>
<span class='layout'>{</span> <span class='varid'>delayedConstraints</span> <span class='keyglyph'>::</span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span><span class='layout'>,</span> <span class='varid'>values</span> <span class='keyglyph'>::</span> <span class='conid'>IntSet</span> <span class='layout'>}</span>
<span class='keyword'>type</span> <span class='conid'>VarMap</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>Map</span> <span class='layout'>(</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='layout'>)</span> <span class='layout'>(</span><span class='conid'>VarInfo</span> <span class='varid'>s</span><span class='layout'>)</span>
<span class='keyword'>data</span> <span class='conid'>FDState</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>FDState</span>
<span class='layout'>{</span> <span class='varid'>varSupply</span> <span class='keyglyph'>::</span> <span class='conid'>VarSupply</span> <span class='varid'>s</span><span class='layout'>,</span> <span class='varid'>varMap</span> <span class='keyglyph'>::</span> <span class='conid'>VarMap</span> <span class='varid'>s</span> <span class='layout'>}</span>
</pre><p>The type <samp class=haskell><span class='conid'>FD</span> s a</samp> is our constraint solver monad. It contains a list monad to provide the search capability. This is wrapped in a <samp class=haskell><span class='conid'>StateT</span></samp> monad transformer which threads through the <em>constraint store</em> <samp class=haskell><span class=conid>FDState</span> s</samp>. The type variable <samp>s</samp> is a <em>phantom type</em>. We will see later how this can be used to prevent any of the implementation detail "leaking out" of the monad. </p><p>Our constraint store <samp class=haskell><span class=conid>FDState</span> s</samp> contains a supply of fresh constraint variables and also keeps track of the information we need to know about existing variables. For each existing variable we record its set of possible values (its <em>domain</em>) and a set of constraints on it. Whenever the domain of a variable changes, we need to execute its constraints to check that they are still satisfied. This, in turn, may further constrain the domain of other variables. This is known as <em>constraint propagation</em>.</p><pre class="prettyprint lang-hs"><span class='comment'>-- Run the FD monad and produce a lazy list of possible solutions.</span>
<span class='varid'>runFD</span> <span class='keyglyph'>::</span> <span class='layout'>(</span><span class='keyword'>forall</span> <span class='varid'>s</span> <span class='varop'>.</span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='varid'>a</span><span class='layout'>)</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span>
<span class='varid'>runFD</span> <span class='varid'>fd</span> <span class='keyglyph'>=</span> <span class='varid'>evalStateT</span> <span class='layout'>(</span><span class='varid'>unFD</span> <span class='varid'>fd</span><span class='layout'>)</span> <span class='varid'>initState</span>
<span class='varid'>initState</span> <span class='keyglyph'>::</span> <span class='conid'>FDState</span> <span class='varid'>s</span>
<span class='varid'>initState</span> <span class='keyglyph'>=</span> <span class='conid'>FDState</span> <span class='layout'>{</span> <span class='varid'>varSupply</span> <span class='keyglyph'>=</span> <span class='conid'>FDVar</span> <span class='num'>0</span><span class='layout'>,</span> <span class='varid'>varMap</span> <span class='keyglyph'>=</span> <span class='conid'>Map</span><span class='varop'>.</span><span class='varid'>empty</span> <span class='layout'>}</span>
</pre><p>The function <samp>runFD</samp> runs a constraint solver, starting with an initially empty constraint store, and return a list of all possible solutions. The type <samp class=haskell><span class='layout'>(</span><span class='keyword'>forall</span> <span class='varid'>s</span> <span class='varop'>.</span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='varid'>a</span><span class='layout'>)</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='varid'>a</span><span class='keyglyph'>]</span></samp> ensures that any values of a type containing the phantom type variable <samp>s</samp> can't "escape" from the monad. This means that we can't take a constraint variable from one monad and use it inside another one, thus ensuring, through the type system, that the monad is used safely. <pre class="prettyprint lang-hs"><span class='comment'>-- Get a new FDVar</span>
<span class='varid'>newVar</span> <span class='keyglyph'>::</span> <span class='keyglyph'>[</span><span class='conid'>Int</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='layout'>(</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='layout'>)</span>
<span class='varid'>newVar</span> <span class='varid'>domain</span><span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>v</span> <span class='keyglyph'><-</span> <span class='varid'>nextVar</span>
<span class='varid'>v</span> <span class='varop'>`isOneOf`</span> <span class='varid'>domain</span>
<span class='varid'>return</span> <span class='varid'>v</span>
<span class='keyword'>where</span>
<span class='varid'>nextVar</span> <span class='keyglyph'>::</span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='layout'>(</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='layout'>)</span>
<span class='varid'>nextVar</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>s</span> <span class='keyglyph'><-</span> <span class='varid'>get</span>
<span class='keyword'>let</span> <span class='varid'>v</span> <span class='keyglyph'>=</span> <span class='varid'>varSupply</span> <span class='varid'>s</span>
<span class='varid'>put</span> <span class='varop'>$</span> <span class='varid'>s</span> <span class='layout'>{</span> <span class='varid'>varSupply</span> <span class='keyglyph'>=</span> <span class='conid'>FDVar</span> <span class='layout'>(</span><span class='varid'>unFDVar</span> <span class='varid'>v</span> <span class='varop'>+</span> <span class='num'>1</span><span class='layout'>)</span> <span class='layout'>}</span>
<span class='varid'>return</span> <span class='varid'>v</span>
<span class='varid'>isOneOf</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='conid'>Int</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>x</span> <span class='varop'>`isOneOf`</span> <span class='varid'>domain</span><span class='keyglyph'>=</span>
<span class='varid'>modify</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>s</span> <span class='keyglyph'>-></span>
<span class='keyword'>let</span> <span class='varid'>vm</span> <span class='keyglyph'>=</span> <span class='varid'>varMap</span> <span class='varid'>s</span>
<span class='varid'>vi</span> <span class='keyglyph'>=</span> <span class='conid'>VarInfo</span> <span class='layout'>{</span>
<span class='varid'>delayedConstraints</span> <span class='keyglyph'>=</span> <span class='varid'>return</span> <span class='conid'>()</span><span class='layout'>,</span>
<span class='varid'>values</span> <span class='keyglyph'>=</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>fromList</span> <span class='varid'>domain</span><span class='layout'>}</span>
<span class='keyword'>in</span>
<span class='varid'>s</span> <span class='layout'>{</span> <span class='varid'>varMap</span> <span class='keyglyph'>=</span> <span class='conid'>Map</span><span class='varop'>.</span><span class='varid'>insert</span> <span class='varid'>x</span> <span class='varid'>vi</span> <span class='varid'>vm</span> <span class='layout'>}</span>
<span class='varid'>newVars</span> <span class='keyglyph'>::</span> <span class='conid'>Int</span> <span class='keyglyph'>-></span> <span class='keyglyph'>[</span><span class='conid'>Int</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='keyglyph'>[</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='keyglyph'>]</span>
<span class='varid'>newVars</span> <span class='varid'>n</span> <span class='varid'>domain</span> <span class='keyglyph'>=</span> <span class='varid'>replicateM</span> <span class='varid'>n</span> <span class='layout'>(</span><span class='varid'>newVar</span> <span class='varid'>domain</span><span class='layout'>)</span>
</pre><p>The function <samp>newVar domain</samp> creates a new constraint variable constrained to values in <samp>domain</samp>. The function <samp>newVars n domain</samp> is a convenient way of creating multiple variables with the same domain.</p><p>Some helper functions which are not exported, but are used when we define the constraint functions: </p><pre class="prettyprint lang-hs"><span class='comment'>-- Lookup the current domain of a variable.</span>
<span class='varid'>lookup</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>IntSet</span>
<span class='varid'>lookup</span> <span class='varid'>x</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>s</span> <span class='keyglyph'><-</span> <span class='varid'>get</span>
<span class='varid'>return</span> <span class='varop'>.</span> <span class='varid'>values</span> <span class='varop'>$</span> <span class='varid'>varMap</span> <span class='varid'>s</span> <span class='varop'>!</span> <span class='varid'>x</span>
<span class='comment'>-- Update the domain of a variable and fire all delayed constraints</span>
<span class='comment'>-- associated with that variable.</span>
<span class='varid'>update</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>IntSet</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>update</span> <span class='varid'>x</span> <span class='varid'>i</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>s</span> <span class='keyglyph'><-</span> <span class='varid'>get</span>
<span class='keyword'>let</span> <span class='varid'>vm</span> <span class='keyglyph'>=</span> <span class='varid'>varMap</span> <span class='varid'>s</span>
<span class='keyword'>let</span> <span class='varid'>vi</span> <span class='keyglyph'>=</span> <span class='varid'>vm</span> <span class='varop'>!</span> <span class='varid'>x</span>
<span class='varid'>put</span> <span class='varop'>$</span> <span class='varid'>s</span> <span class='layout'>{</span> <span class='varid'>varMap</span> <span class='keyglyph'>=</span> <span class='conid'>Map</span><span class='varop'>.</span><span class='varid'>insert</span> <span class='varid'>x</span> <span class='layout'>(</span><span class='varid'>vi</span> <span class='layout'>{</span> <span class='varid'>values</span> <span class='keyglyph'>=</span> <span class='varid'>i</span><span class='layout'>}</span><span class='layout'>)</span> <span class='varid'>vm</span> <span class='layout'>}</span>
<span class='varid'>delayedConstraints</span> <span class='varid'>vi</span>
<span class='comment'>-- Add a new constraint for a variable to the constraint store.</span>
<span class='varid'>addConstraint</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>addConstraint</span> <span class='varid'>x</span> <span class='varid'>constraint</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>s</span> <span class='keyglyph'><-</span> <span class='varid'>get</span>
<span class='keyword'>let</span> <span class='varid'>vm</span> <span class='keyglyph'>=</span> <span class='varid'>varMap</span> <span class='varid'>s</span>
<span class='keyword'>let</span> <span class='varid'>vi</span> <span class='keyglyph'>=</span> <span class='varid'>vm</span> <span class='varop'>!</span> <span class='varid'>x</span>
<span class='keyword'>let</span> <span class='varid'>cs</span> <span class='keyglyph'>=</span> <span class='varid'>delayedConstraints</span> <span class='varid'>vi</span>
<span class='varid'>put</span> <span class='varop'>$</span> <span class='varid'>s</span> <span class='layout'>{</span> <span class='varid'>varMap</span> <span class='keyglyph'>=</span>
<span class='conid'>Map</span><span class='varop'>.</span><span class='varid'>insert</span> <span class='varid'>x</span> <span class='layout'>(</span><span class='varid'>vi</span> <span class='layout'>{</span> <span class='varid'>delayedConstraints</span> <span class='keyglyph'>=</span> <span class='varid'>cs</span> <span class='varop'>>></span> <span class='varid'>constraint</span> <span class='layout'>}</span><span class='layout'>)</span> <span class='varid'>vm</span> <span class='layout'>}</span>
<span class='comment'>-- Useful helper function for adding binary constraints between FDVars.</span>
<span class='keyword'>type</span> <span class='conid'>BinaryConstraint</span> <span class='varid'>s</span> <span class='keyglyph'>=</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>addBinaryConstraint</span> <span class='keyglyph'>::</span> <span class='conid'>BinaryConstraint</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>BinaryConstraint</span> <span class='varid'>s</span>
<span class='varid'>addBinaryConstraint</span> <span class='varid'>f</span> <span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='keyword'>let</span> <span class='varid'>constraint</span> <span class='keyglyph'>=</span> <span class='varid'>f</span> <span class='varid'>x</span> <span class='varid'>y</span>
<span class='varid'>constraint</span>
<span class='varid'>addConstraint</span> <span class='varid'>x</span> <span class='varid'>constraint</span>
<span class='varid'>addConstraint</span> <span class='varid'>y</span> <span class='varid'>constraint</span>
</pre><p>The function <samp>lookup</samp> returns the current domain for a variable; <samp>update</samp> updates the domain for a variable and propagates the change into all constraints on that variable; <samp>addConstraint</samp> inserts a constraint into the constraint store; <samp>addBinaryConstraint</samp> tests a constraint on two variable and then adds it to the constraint store for each variable.</p><p>Now we can define the actual constraint functions:</p><pre class="prettyprint lang-hs"><span class='comment'>-- Constrain a variable to a particular value.</span>
<span class='varid'>hasValue</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>Int</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>var</span> <span class='varop'>`hasValue`</span> <span class='varid'>val</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>vals</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>var</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='varid'>val</span> <span class='varop'>`</span><span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>member</span><span class='varop'>`</span> <span class='varid'>vals</span>
<span class='keyword'>let</span> <span class='varid'>i</span> <span class='keyglyph'>=</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>singleton</span> <span class='varid'>val</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>i</span> <span class='varop'>/=</span> <span class='varid'>vals</span><span class='layout'>)</span> <span class='varop'>$</span> <span class='varid'>update</span> <span class='varid'>var</span> <span class='varid'>i</span>
</pre>In <samp>hasValue</samp> we lookup the current domain of the variable and test that the value to be set is within the domain. If the domain has changed, we update the constraint store and propagate the change. The other constraints are defined similarly: <pre class="prettyprint lang-hs"><span class='comment'>-- Constrain two variables to have the same value.</span>
<span class='varid'>same</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>same</span> <span class='keyglyph'>=</span> <span class='varid'>addBinaryConstraint</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>-></span> <span class='keyword'>do</span>
<span class='varid'>xv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>x</span>
<span class='varid'>yv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>y</span>
<span class='keyword'>let</span> <span class='varid'>i</span> <span class='keyglyph'>=</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>intersection</span> <span class='varid'>xv</span> <span class='varid'>yv</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='varid'>not</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>null</span> <span class='varid'>i</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>i</span> <span class='varop'>/=</span> <span class='varid'>xv</span><span class='layout'>)</span> <span class='varop'>$</span> <span class='varid'>update</span> <span class='varid'>x</span> <span class='varid'>i</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>i</span> <span class='varop'>/=</span> <span class='varid'>yv</span><span class='layout'>)</span> <span class='varop'>$</span> <span class='varid'>update</span> <span class='varid'>y</span> <span class='varid'>i</span>
<span class='comment'>-- Constrain two variables to have different values.</span>
<span class='varid'>different</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>different</span> <span class='keyglyph'>=</span> <span class='varid'>addBinaryConstraint</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>-></span> <span class='keyword'>do</span>
<span class='varid'>xv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>x</span>
<span class='varid'>yv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>y</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>xv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>size</span> <span class='varid'>yv</span> <span class='varop'>></span> <span class='num'>1</span> <span class='varop'>||</span> <span class='varid'>xv</span> <span class='varop'>/=</span> <span class='varid'>yv</span>
<span class='comment'>-- Constrain a list of variables to all have different values.</span>
<span class='varid'>allDifferent</span> <span class='keyglyph'>::</span> <span class='keyglyph'>[</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='varid'>allDifferent</span> <span class='layout'>(</span><span class='varid'>x</span><span class='conop'>:</span><span class='varid'>xs</span><span class='layout'>)</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>mapM_</span> <span class='layout'>(</span><span class='varid'>different</span> <span class='varid'>x</span><span class='layout'>)</span> <span class='varid'>xs</span>
<span class='varid'>allDifferent</span> <span class='varid'>xs</span>
<span class='varid'>allDifferent</span> <span class='keyword'>_</span> <span class='keyglyph'>=</span> <span class='varid'>return</span> <span class='conid'>()</span>
<span class='comment'>-- Constrain one variable to have a value less than the value of another</span>
<span class='comment'>-- variable.</span>
<span class='layout'>(</span><span class='varop'>.<.</span><span class='layout'>)</span> <span class='keyglyph'>::</span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FDVar</span> <span class='varid'>s</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='conid'>()</span>
<span class='layout'>(</span><span class='varop'>.<.</span><span class='layout'>)</span> <span class='keyglyph'>=</span> <span class='varid'>addBinaryConstraint</span> <span class='varop'>$</span> <span class='keyglyph'>\</span><span class='varid'>x</span> <span class='varid'>y</span> <span class='keyglyph'>-></span> <span class='keyword'>do</span>
<span class='varid'>xv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>x</span>
<span class='varid'>yv</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>y</span>
<span class='keyword'>let</span> <span class='varid'>xv'</span> <span class='keyglyph'>=</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>filter</span> <span class='layout'>(</span><span class='varop'><</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>findMax</span> <span class='varid'>yv</span><span class='layout'>)</span> <span class='varid'>xv</span>
<span class='keyword'>let</span> <span class='varid'>yv'</span> <span class='keyglyph'>=</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>filter</span> <span class='layout'>(</span><span class='varop'>></span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>findMin</span> <span class='varid'>xv</span><span class='layout'>)</span> <span class='varid'>yv</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='varid'>not</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>null</span> <span class='varid'>xv'</span>
<span class='varid'>guard</span> <span class='varop'>$</span> <span class='varid'>not</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>null</span> <span class='varid'>yv'</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>xv</span> <span class='varop'>/=</span> <span class='varid'>xv'</span><span class='layout'>)</span> <span class='varop'>$</span> <span class='varid'>update</span> <span class='varid'>x</span> <span class='varid'>xv'</span>
<span class='varid'>when</span> <span class='layout'>(</span><span class='varid'>yv</span> <span class='varop'>/=</span> <span class='varid'>yv'</span><span class='layout'>)</span> <span class='varop'>$</span> <span class='varid'>update</span> <span class='varid'>y</span> <span class='varid'>yv'</span>
</pre><p>Finally, in the <samp>labelling</samp> function we make use of the underlying list monad to search for all solutions for the given set of variables.</p><pre class="prettyprint lang-hs"><span class='comment'>-- Label variables using a depth-first left-to-right search.</span>
<span class='varid'>labelling</span> <span class='keyglyph'>::</span> <span class='keyglyph'>[</span><span class='conid'>FDVar</span> <span class='varid'>s</span><span class='keyglyph'>]</span> <span class='keyglyph'>-></span> <span class='conid'>FD</span> <span class='varid'>s</span> <span class='keyglyph'>[</span><span class='conid'>Int</span><span class='keyglyph'>]</span>
<span class='varid'>labelling</span> <span class='keyglyph'>=</span> <span class='varid'>mapM</span> <span class='varid'>label</span> <span class='keyword'>where</span>
<span class='varid'>label</span> <span class='varid'>var</span> <span class='keyglyph'>=</span> <span class='keyword'>do</span>
<span class='varid'>vals</span> <span class='keyglyph'><-</span> <span class='varid'>lookup</span> <span class='varid'>var</span>
<span class='varid'>val</span> <span class='keyglyph'><-</span> <span class='conid'>FD</span> <span class='varop'>.</span> <span class='varid'>lift</span> <span class='varop'>$</span> <span class='conid'>IntSet</span><span class='varop'>.</span><span class='varid'>toList</span> <span class='varid'>vals</span>
<span class='varid'>var</span> <span class='varop'>`hasValue`</span> <span class='varid'>val</span>
<span class='varid'>return</span> <span class='varid'>val</span>
</pre>In a later posts I plan to show how to use this finite domain solver monad to write a solver for Sudoku puzzles, and extend the monad to support arithmetic expressions.Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com7tag:blogger.com,1999:blog-1254792667029254313.post-14364396611317837632008-06-25T23:26:00.003+10:002008-06-25T23:44:32.297+10:00Off to Kiwiland<p>Yes, the rumours you may have been hearing are true. Just when you thought we'd finally decided which country to live in, we've gone and (temporarily) changed our minds again. We'll be spending most of the next six months in Auckland, courtesy of Deloitte.
</p>
<p>Moana left today (via Sydney and Christchurch, but that's another story) and I'll be following her in about a month. Of course we have to be back in Melbourne when Christine comes to visit from Wellington in July and when Peter and Lynne come over from Dunedin in October. I'll also be back a couple more times so that the people I work for don't forget that I exist. Apparently things weren't complicated enough already.
</p>
<p>This has all happened very suddenly and I think we are both still feeling a bit shell-shocked. We were just getting used to our new house, and staying in the one place. But hey, it's a good opportunity for Moana work-wise, and NZ is a great place to take photographs, so I'm happy. Now I just have to brush up on my accent and learn a bit about rugby and under-arm bowling....</p>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-47903139523702072862008-05-30T17:13:00.003+10:002008-05-30T17:52:45.687+10:00Misty Water<div style="float: right; margin-left: 10px; margin-bottom: 10px;"><a href="http://www.flickr.com/photos/overton/2530403413/" title="photo sharing"><img src="http://farm3.static.flickr.com/2387/2530403413_5394832be8_m.jpg" alt="" style="border: solid 2px #000000;" /></a><br /><span style="font-size: 0.9em; margin-top: 0px;"><a href="http://www.flickr.com/photos/overton/2530403413/">dsc_2219n</a><br />Originally uploaded by <a href="http://www.flickr.com/people/overton/">David Overton</a></span></div>I've already mentioned my recent <a href="http://overtond.blogspot.com/2008/05/sunset-at-cape-schanck.html">trip to Cape Schanck</a>. I'm particularly pleased with how this photo turned out. It was already about half an hour after sunset by this stage, making the lighting perfect for a long exposure (30 seconds) that would blur the water into an eerie-looking mist. I've tried to get shots like this before, but they've never turned out this well.<br clear="all" />Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0tag:blogger.com,1999:blog-1254792667029254313.post-28727017082928811222008-05-30T16:53:00.004+10:002008-05-30T17:08:41.126+10:00Sunset at Cape Schanck<p><div style="float: right; margin-left: 10px; margin-bottom: 10px;"><a href="http://www.flickr.com/photos/overton/2531135706/" title="photo sharing"><img src="http://farm3.static.flickr.com/2155/2531135706_d6244770ef_m.jpg" alt="" style="border: 2px solid rgb(0, 0, 0);" /></a>
<span style="margin-top: 0px;font-size:0;" ><a href="http://www.flickr.com/photos/overton/2531135706/">dsc_2128n</a>
Originally uploaded by <a href="http://www.flickr.com/people/overton/">David Overton</a></span></div>My mother moved down to the Mornington Peninsula, south-east of Melbourne, a few years ago. Since we moved back to Australia in December we've been visiting her regularly on the weekend and I've been meaning to get out and photograph the local scenery.</p>
<p>I finally got around to doing this last Saturday night. I headed down to Cape Schanck, at the southern tip of the Peninsula. The rugged cliffs overlooking Bass Strait make this a particularly spectacular area. The lighthouse also adds to the scene, although access to it closed half an hour before sunset, so this is as close as I could get.</p>
<p>You can see the rest of the photos from this trip at <a href="http://www.flickr.com/photos/overton/sets/72157605293985217/">flickr</a>.</p>Anonymoushttp://www.blogger.com/profile/02945248194158818964noreply@blogger.com0