Personal tools

Haskell Quiz/Happy Numbers/Solution Dolio

From HaskellWiki

< Haskell Quiz | Happy Numbers(Difference between revisions)
Jump to: navigation, search
m (typo)
Current revision (18:53, 21 February 2010) (edit) (undo)
m
 
(4 intermediate revisions not shown.)
Line 1: Line 1:
-
[[Category:Code]]
+
[[Category:Haskell Quiz solutions|Happy Numbers]]
The important thing to know is that there is only one eventual infinite cycle other than 1 => 1, namely:
The important thing to know is that there is only one eventual infinite cycle other than 1 => 1, namely:
Line 14: Line 14:
import Control.Arrow
import Control.Arrow
import Memoizing
import Memoizing
 +
import Data.Ord (comparing)
square x = x * x
square x = x * x
-
 
-
comparing f a b = compare (f a) (f b)
 
digits = unfoldr mdiv
digits = unfoldr mdiv
Line 75: Line 74:
memoized = flip lookup m
memoized = flip lookup m
-
-- little-endian Patricia trees
+
-- little-endian bit tries
-
data Patricia v = Nil | Node v (Patricia v) (Patricia v)
+
data BTrie v = Nil | Node v (BTrie v) (BTrie v)
build n m f = Node (f n) (build n m' f) (build (setBit n m) m' f)
build n m f = Node (f n) (build n m' f) (build (setBit n m) m' f)
where m' = m+1
where m' = m+1
-
lookupP k (Node v l r)
+
lookupBT k (Node v l r)
| k == 0 = v
| k == 0 = v
-
| not m = lookupP d l
+
| not m = lookupBT d l
-
| m = lookupP d r
+
| m = lookupBT d r
where
where
d = shiftR k 1
d = shiftR k 1
m = testBit k 0
m = testBit k 0
-
-- Patricia trees can be defined as DPMaps for keys of type (Bits k) => k,
+
-- The bit tries can be defined as DPMaps for keys of type (Bits k) => k,
-- however, I have defined them only for Int and Integer to save space
-- however, I have defined them only for Int and Integer to save space
-- (one has to declare them all individually,
-- (one has to declare them all individually,
--
--
-
-- Bits k => DPMap (Patricia v) k v
+
-- Bits k => DPMap (BTrie v) k v
--
--
-- won't work)
-- won't work)
-
instance DPMap (Patricia v) Int v where
+
instance DPMap (BTrie v) Int v where
fromFunction = build 0 0
fromFunction = build 0 0
-
lookup = lookupP
+
lookup = lookupBT
-- DPMap instances for up to 4-tuples. In general, a map (k1,k2) -> v
-- DPMap instances for up to 4-tuples. In general, a map (k1,k2) -> v
-- is a map k1 -> (k2 -> v) and so on
-- is a map k1 -> (k2 -> v) and so on
-
instance DPMap (Patricia v) Integer v where
+
instance DPMap (BTrie v) Integer v where
fromFunction = build 0 0
fromFunction = build 0 0
-
lookup = lookupP
+
lookup = lookupBT
instance (DPMap m1 k1 m2, DPMap m2 k2 v) => DPMap m1 (k1,k2) v where
instance (DPMap m1 k1 m2, DPMap m2 k2 v) => DPMap m1 (k1,k2) v where
Line 125: Line 124:
lookup (i,j,k,l) = lookup l . lookup k . lookup j . lookup i
lookup (i,j,k,l) = lookup l . lookup k . lookup j . lookup i
</haskell>
</haskell>
 +
 +
== See also ==
 +
 +
* [[Memoization]]

Current revision


The important thing to know is that there is only one eventual infinite cycle other than 1 => 1, namely:

  • 4 => 16 => 37 => 58 => 89 => 145 => 42 => 20 => 4

Every positive integer is either happy, or eventually reaches that cycle, so one can arbitrarily choose one of those numbers to terminate a search and decide that a number is unhappy.

This is an easy job for memoizing/dynamic programming. The code specific to the problem looks like so: 

module Main where
import Data.List
import Control.Arrow
import Memoizing
import Data.Ord (comparing)
 
square x = x * x
 
digits = unfoldr mdiv
 where mdiv 0 = Nothing
       mdiv n = Just (m, d)
        where (d, m) = divMod n 10
 
happy :: Integer -> (Bool, Integer)
happy = dpm happy'
 where
 happy' f 1 = (True, -1)
 happy' f 4 = (False, -1)
 happy' f n = second (+1) . f . sum . map square . digits $ n
 
happiest n = head . sortBy (flip . comparing $ snd . snd) 
                  . filter (fst . snd)
                  . map (\n -> (n, happy n)) $ [1..n]

I arbitrarily picked 4 to terminate the unhappiness search. happy returns both the happy/unhappy status of the given number, and what order happiness it has (as defined on the rubyquiz page). happiest finds the highest order happy number between 1 and n.

The rest is a fairly reusable (for this sort of problem) module for dynamic programming (influenced by the memoizing recursion article on the old wiki; the original mailing list post by Chris Okasaki that inspired it all is here: http://www.haskell.org//pipermail/haskell-cafe/2005-July/010714.html): 

{-# OPTIONS -fglasgow-exts -fallow-overlapping-instances #-}
 
module Memoizing(dp, dpm) where
import Data.Array
import Data.Bits
import Prelude hiding (lookup)
 
tabulate :: (Ix a) => (a,a) -> (a -> b) -> Array a b
tabulate bounds f = array bounds [(i,f i) | i <- range bounds]
 
-- Array-based, bounded dynamic programming. dp will take an upper and lower
-- bound, and memoize a function between those bounds
dp :: (Ix a) => (a,a) -> ((a->b) -> a -> b) -> a -> b
dp bounds f = (memo!) where
    memo = tabulate bounds (f (memo!))
 
-- A type class for a memoizing map
--    m is the map type
--    k is the key type
--    v is the value type
--  fromFunction should build up a (possibly infinite) map for all keys, where
--   any key is mapped to the value of the function at that key.
class DPMap m k v | k v -> m where
    fromFunction :: (k -> v) -> m
    lookup :: k -> m -> v
 
-- dpm uses the above DPMap class to memoize functions with a potentially
-- unbounded domain 
dpm :: (DPMap m k v) => ((k -> v) -> k -> v) -> k -> v
dpm f = memoized
 where
 m = fromFunction (f memoized)
 memoized = flip lookup m
 
-- little-endian bit tries
data BTrie v = Nil | Node v (BTrie v) (BTrie v)
 
build n m f = Node (f n) (build n m' f) (build (setBit n m) m' f)
 where m' = m+1
 
lookupBT k (Node v l r)
    | k == 0 = v
    | not m  = lookupBT d l
    | m      = lookupBT d r
 where
 d = shiftR k 1
 m = testBit k 0
 
-- The bit tries can be defined as DPMaps for keys of type (Bits k) => k,
-- however, I have defined them only for Int and Integer to save space
-- (one has to declare them all individually,
--
--     Bits k => DPMap (BTrie v) k v 
--
-- won't work)
instance DPMap (BTrie v) Int v where
    fromFunction = build 0 0
    lookup = lookupBT
 
-- DPMap instances for up to 4-tuples. In general, a map (k1,k2) -> v
-- is a map k1 -> (k2 -> v) and so on
instance DPMap (BTrie v) Integer v where
    fromFunction = build 0 0
    lookup = lookupBT
 
instance (DPMap m1 k1 m2, DPMap m2 k2 v) => DPMap m1 (k1,k2) v where
    fromFunction f = fromFunction (\i -> fromFunction (\j -> f (i,j)))
    lookup (i,j) = lookup j . lookup i
 
instance (DPMap m1 k1 m2, DPMap m2 k2 m3, DPMap m3 k3 v) =>
    DPMap m1 (k1,k2,k3) v where
    fromFunction f = fromFunction (\i ->
                      fromFunction (\j ->
                       fromFunction (\k -> f (i,j,k))))
    lookup (i,j,k) = lookup k . lookup j . lookup i
 
instance (DPMap m1 k1 m2, DPMap m2 k2 m3, DPMap m3 k3 m4, DPMap m4 k4 v) =>
    DPMap m1 (k1,k2,k3,k4) v where
    fromFunction f = fromFunction (\i ->
                      fromFunction (\j ->
                       fromFunction (\k ->
                        fromFunction (\l -> f (i,j,k,l)))))
    lookup (i,j,k,l) = lookup l . lookup k . lookup j . lookup i

See also

Retrieved from "http://www.haskell.org/haskellwiki/Haskell_Quiz/Happy_Numbers/Solution_Dolio"

Category: Haskell Quiz solutions