# Haskell Quiz/Numeric Maze/Solution Dolio

### From HaskellWiki

< Haskell Quiz | Numeric Maze(Difference between revisions)

(new) |
m |
||

(2 intermediate revisions by 2 users not shown) | |||

Line 1: | Line 1: | ||

− | This is a simple breadth-first search with some pruning. It avoids visiting numbers that have already been seen in a shorter sequence, and trims in too-large values (I noticed that no shortest sequences | + | [[Category:Haskell Quiz solutions|Numeric Maze]] |

+ | This is a simple breadth-first search with some pruning. It avoids visiting numbers that have already been seen in a shorter sequence, and trims in too-large values (I noticed that no shortest sequences seemed to use numbers greater than 2*max(init, target) + 2, so such values could be discarded). | ||

<haskell> | <haskell> | ||

Line 7: | Line 8: | ||

import Control.Monad | import Control.Monad | ||

import Data.IntSet (fromList, insert, empty, notMember, union) | import Data.IntSet (fromList, insert, empty, notMember, union) | ||

− | |||

import Data.Ratio | import Data.Ratio | ||

import System | import System | ||

Line 15: | Line 15: | ||

t = target % 1 | t = target % 1 | ||

search' ls s | search' ls s | ||

− | | | + | | (x:_) <- filter ((==t) . head) ls = x |

| otherwise = search' ls' s' | | otherwise = search' ls' s' | ||

where | where |

## Latest revision as of 07:19, 13 December 2009

This is a simple breadth-first search with some pruning. It avoids visiting numbers that have already been seen in a shorter sequence, and trims in too-large values (I noticed that no shortest sequences seemed to use numbers greater than 2*max(init, target) + 2, so such values could be discarded).

{-# OPTIONS_GHC -fglasgow-exts #-} module Main where import Control.Monad import Data.IntSet (fromList, insert, empty, notMember, union) import Data.Ratio import System search init target = reverse . map numerator $ search' [[init % 1]] (fromList [init]) where t = target % 1 search' ls s | (x:_) <- filter ((==t) . head) ls = x | otherwise = search' ls' s' where s' = s `union` fromList (map (numerator . head) ls') ls' = do l@(h:_) <- ls n <- [h + 2, h * 2, h / 2] guard (denominator n == 1) guard (numerator n `notMember` s) guard (if target > init then n < 2*t + 1 else n < 2*(init%1) + 3) return (n:l) main = do [i, t] <- fmap (map read) getArgs print $ search i t