Zora 1.1.8 → 1.1.9

raw patch · 4 files changed

+208/−81 lines, 4 filesdep +directorydep +fgldep +graphvizPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, fgl, graphviz, shelly

API changes (from Hackage documentation)

Files

• Zora.cabal +15/−5
• Zora/List.hs +28/−27
• Zora/Math.hs +37/−30
• Zora/TreeGraphing.hs +128/−19

@@ -1,14 +1,14 @@ Name:		   Zora-Version:	   1.1.8-Synopsis:      A library of assorted useful functions and data types and classes.-Description:   A library of assorted useful functions and data types and classes.+Version:	   1.1.9+Synopsis:      Graphing library wrapper + assorted useful functions +Description:   A library of assorted useful functions and data types and classes for working with lists, doing mathematical operations and graphing custom data types. Category:      Unclassified Cabal-Version: >= 1.6 License:	   BSD3 License-File:  LICENSE Stability:	Experimental Author:		Brett Wines-Maintainer: bgwines@cs.stanford.edu+Maintainer: brettwines@gmail.com Homepage:	http://github.com/bgwines/zora Build-Type: Simple Extra-Source-Files: supporting-files/dot.hs@@ -17,7 +17,17 @@     location: git://github.com/bgwines/zora.git  Library-  Build-Depends: base >= 4 && < 5, random, containers, bytestring, text+  Build-Depends:+    base >= 4 && < 5,+    random,+    containers,+    bytestring,+    text,+    graphviz,+    fgl,+    shelly >= 1.5.4.1,+    directory+   Exposed-Modules:     Zora.List     Zora.Math

@@ -23,9 +23,9 @@  -- * Permutations, combinations, and cycles , powerset-, gen_perms-, gen_subsets_of_size-, gen_cycles+, permutations+, all_subsets_of_size+, cycles , has_cycles  -- * Partitioning@@ -56,6 +56,7 @@ -- * Assorted functions , map_keep , maximum_with_index+, minimum_with_index , length' , drop' , take'@@ -184,56 +185,56 @@  -- TODO: actually O(n!)? -- | /O(n!)/ Computes all permutations of the given list.-gen_perms :: [a] -> [[a]]-gen_perms l+permutations :: [a] -> [[a]]+permutations l     | (length l <= 1) = [l]     | otherwise =          let splice_pairs = [(l !! i, remove_at_index (toInteger i) l) | i <- [0..((length l) - 1)]]         in             concat [-                [fst splice_pair : recpair | recpair <- gen_perms $ snd splice_pair]+                [fst splice_pair : recpair | recpair <- permutations $ snd splice_pair]                 | splice_pair <- splice_pairs             ]  -- | /O(2^k)/ Generates all subsets of the given list of size /k/.-gen_subsets_of_size :: [a] -> Integer -> [[a]]-gen_subsets_of_size l size = gen_subsets_of_size_rec l [] size+all_subsets_of_size :: [a] -> Integer -> [[a]]+all_subsets_of_size l size = all_subsets_of_size_rec l [] size     where-        gen_subsets_of_size_rec :: [a] -> [a] -> Integer -> [[a]]-        gen_subsets_of_size_rec src so_far size =+        all_subsets_of_size_rec :: [a] -> [a] -> Integer -> [[a]]+        all_subsets_of_size_rec src so_far size =             if size == 0                 then [so_far]                 else if (length src) == 0                     then []                     else without ++ with             where-                without = gen_subsets_of_size_rec (tail src) so_far size-                with    = gen_subsets_of_size_rec (tail src) ((head src) : so_far) (size-1)+                without = all_subsets_of_size_rec (tail src) so_far size+                with    = all_subsets_of_size_rec (tail src) ((head src) : so_far) (size-1) -{-gen_subsets_of_size_with_replacement_rec :: Integer -> [a] -> [a] -> [[a]]-gen_subsets_of_size_with_replacement_rec size src so_far =+{-all_subsets_of_size_with_replacement_rec :: Integer -> [a] -> [a] -> [[a]]+all_subsets_of_size_with_replacement_rec size src so_far =     case size == 0 of         True  -> [so_far]         False -> concat [map (e:) rec | e <- src]-        where rec = gen_subsets_of_size_with_replacement_rec (size - 1)+        where rec = all_subsets_of_size_with_replacement_rec (size - 1) -gen_subsets_of_size_with_replacement :: [a] -> Integer -> [[a]]-gen_subsets_of_size_with_replacement l size =-    gen_subsets_of_size_with_replacement_rec size l []-}+all_subsets_of_size_with_replacement :: [a] -> Integer -> [[a]]+all_subsets_of_size_with_replacement l size =+    all_subsets_of_size_with_replacement_rec size l []-}  -- | /O(n)/ Generates all cycles of a given list. For example, -- --- > gen_cycles [1..3] == [[2,3,1],[3,1,2],[1,2,3]]-gen_cycles :: (Eq a) => [a] -> [[a]]-gen_cycles l = gen_cycles_rec l $ cycle_list l+-- > cycles [1..3] == [[2,3,1],[3,1,2],[1,2,3]]+cycles :: (Eq a) => [a] -> [[a]]+cycles l = cycles_rec l $ cycle_list l     where         cycle_list :: [a] -> [a]         cycle_list l = (tail l) ++ [head l] -        gen_cycles_rec :: (Eq a) => [a] -> [a] -> [[a]]-        gen_cycles_rec original_l l+        cycles_rec :: (Eq a) => [a] -> [a] -> [[a]]+        cycles_rec original_l l             | l == original_l = [l]-            | otherwise = [l] ++ (gen_cycles_rec original_l $ cycle_list l)+            | otherwise = [l] ++ (cycles_rec original_l $ cycle_list l)  -- | /O(l m)/, where /l/ is the cycle length and /m/ is the index of the start of the cycle. If the list contains no cycles, then the runtime is /O(n)/. has_cycles :: (Eq a) => [a] -> Bool@@ -290,7 +291,7 @@ -- --------------------------------------------------------------------- -- Operations with two lists --- | Given two infinite sorted lists, generates a list of elements in the first but not the second.+-- | Given two infinite sorted lists, generates a list of elements in the first but not the second. Implementation from <http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)>. diff_infinite :: (Ord a) => [a] -> [a] -> [a] diff_infinite xs@(x:xt) ys@(y:yt) =      case compare x y of@@ -389,7 +390,7 @@         else (head s == last s) && (is_palindrome $ tail . init $ s)  -- TODO: do this more monadically?--- | /O(n log(n))/ Returns whether the given list contains the any element more than once.+-- | /O(n log(n))/ Returns whether the given list contains any element more than once. contains_duplicates :: forall a . (Ord a) => [a] -> Bool contains_duplicates l =     if is_sorted l@@ -408,7 +409,7 @@  -- | /O(n)/ Maps the given function over the list while keeping the original list. For example: -- --- > λ map_keep chr [97..100] == [(97,'a'),(98,'b'),(99,'c'),(100,'d')]+-- > map_keep chr [97..100] == [(97,'a'),(98,'b'),(99,'c'),(100,'d')] map_keep :: (a -> b) -> [a] -> [(a, b)] map_keep f l = zipWith (\a b -> (a, b)) l (map f l) 

@@ -14,15 +14,15 @@ module Zora.Math ( -- * Prime numbers and division   primes-, nonprimes-, is_prime+, composites+, prime , coprime , euler_phi-, factorize+, factor , divisors  -- * Square roots-, irr_squares+, irrational_squares , sqrt_convergents , continued_fraction_sqrt , continued_fraction_sqrt_infinite@@ -31,7 +31,7 @@ , is_int , is_power_of_int , int_to_double-, get_num_digits+, num_digits , tri_area , tri_area_double ) where@@ -45,13 +45,13 @@ -- --------------------------------------------------------------------- -- Prime numbers and division --- | A complete, monotonically increasing, infinite list of primes. Implementation based on <http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)>.+-- | A complete, monotonically increasing, infinite list of primes. Implementation from <http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)>. primes :: [Integer]-primes = [2, 3, 5] ++ (diff_infinite [7, 9 ..] nonprimes)+primes = [2, 3, 5] ++ (diff_infinite [7, 9 ..] composites) --- | A complete, monotonically increasing, infinite list of non-prime numbers.-nonprimes :: [Integer]-nonprimes = foldr1 f $ map g $ tail primes+-- | A complete, monotonically increa?ing, infinite list of composite numbers.+composites :: [Integer]+composites = foldr1 f $ map g $ tail primes 	where 		f (x:xt) ys = x : (merge_infinite xt ys) 		g p		 = [ n * p | n <- [p, p + 2 ..]]@@ -63,24 +63,31 @@ 				EQ -> x : (merge_infinite xt yt) 				GT -> y : (merge_infinite xs yt) -is_prime_rec :: Integer -> Integer -> Bool-is_prime_rec n k+prime_rec :: Integer -> Integer -> Bool+prime_rec n k 	| (n <= 1) = False 	| (fromInteger k >= ((fromInteger n) / 2) + 1.0) = True 	| ((n `mod` k) == 0) = False-	| otherwise = is_prime_rec n (k+1)+	| otherwise = prime_rec n (k+1)  -- | /O(n)/ Returns whether the parameter is a prime number.-is_prime :: Integer -> Bool-is_prime n = is_prime_rec n 2+prime :: Integer -> Bool+prime n = prime_rec n 2  -- | /O(min(n, m))/ Returns whether the the two parameters are <http://en.wikipedia.org/wiki/Coprime coprime>, that is, whether they share any divisors. coprime :: Integer -> Integer -> Bool-coprime a b = Nothing == List.find is_common_divisor [2..(min a b)]+coprime a b = isNothing .  List.find is_common_divisor $ [2..(min a' b')] 	where+		a' :: Integer+		a' = abs a++		b' :: Integer+		b' = abs b++		is_common_divisor :: Integer -> Bool 		is_common_divisor n = (a `mod` n == 0) && (b `mod` n == 0) --- | /O(1)/ `phi(p^a)` for prime `p` and nonnegative `a`.+-- | /O(1)/ @phi(p^a)@ for prime @p@ and nonnegative @a@. euler_phi_for_powers_of_primes :: (Integer, Integer) -> Integer euler_phi_for_powers_of_primes (p, a) = p^(a-1) * (p-1) @@ -90,21 +97,21 @@ euler_phi n = product  	$ map 		euler_phi_for_powers_of_primes-		$ map format $ List.group $ factorize n+		$ map format $ List.group $ factor n 	where 		format l = (head l, (toInteger . length) l)   -- TODO: don't start over in `primes` -- | /O(k n log(n)^-1)/, where /k/ is the number of primes dividing /n/ (double-counting for powers). /n log(n)^-1/ is an approximation for <http://en.wikipedia.org/wiki/Prime-counting_function the number of primes below a number>.-factorize :: Integer -> [Integer]-factorize 0 = []-factorize 1 = []-factorize n = p : factorize (n `div` p)+factor :: Integer -> [Integer]+factor 0 = []+factor 1 = []+factor n = p : factor (n `div` p) 	where p = fromJust . List.find (\p -> (n `mod` p) == 0) $ primes  -- | /O(4^(k n log(n)^-1))/, where /k/ is the number of primes dividing /n/ (double-counting for powers). divisors :: Integer -> [Integer]-divisors = init . uniqueify . map product . powerset . factorize+divisors = init . uniqueify . map product . powerset . factor  -- --------------------------------------------------------------------- -- Square roots@@ -118,7 +125,7 @@ 			e = head cf 			cf' = tail cf --- | A list of fractions monotonically increasingly accurately approximating the square root of the parameter, where each fraction is represented as a pair of `(numerator, denominator)` See <http://en.wikipedia.org/wiki/Convergent_(continued_fraction)>.+-- | A list of fractions monotonically increasingly accurately approximating the square root of the parameter, where each fraction is represented as a pair of @(numerator, denominator)@ See <http://en.wikipedia.org/wiki/Convergent_(continued_fraction)>. sqrt_convergents :: Integer -> [(Integer, Integer)] sqrt_convergents n = 	(a0, b0) : (a1, b1) : @@ -134,8 +141,8 @@ 		cf = continued_fraction_sqrt_infinite n  -- | An infinite list of integers with irrational square roots.-irr_squares :: [Integer]-irr_squares = map round $ filter (not . is_int . sqrt) [1..] +irrational_squares :: [Integer]+irrational_squares = map round $ filter (not . is_int . sqrt) [1..]   next_continued_fraction_sqrt :: (Integer, Integer, Integer, Integer, Integer) -> (Integer, Integer, Integer, Integer, Integer) next_continued_fraction_sqrt (d, m, a, a0, n) = (d', m', a', a0, n)@@ -188,13 +195,13 @@ is_power_of_int n e = (round (fromIntegral n ** (1/(fromInteger e))))^e == n  -- | /O(log_10(n))/ Calculates the number of digits in an integer.-get_num_digits :: Integer -> Integer-get_num_digits n = (1 + (floor $ logBase 10 (fromInteger n)))+num_digits :: Integer -> Integer+num_digits n = (1 + (floor $ logBase 10 (fromInteger n))) --- | Returns whether a `Double` value is an integer. For example, `16.0 :: Double` is an integer, but not `16.1`.+-- | Returns whether a @Double@ value is an integer. For example, @16.0 :: Double@ is an integer, but not @16.1@. is_int :: Double -> Bool is_int x = x == (fromInteger (round x)) --- | Converts a `Double` to an `Integer`.+-- | Converts a @Double@ to an @Integer@. int_to_double :: Double -> Integer int_to_double = (toInteger . round)

@@ -1,47 +1,68 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}  -- | -- Module      : Zora.TreeGraphing -- Copyright   : (c) Brett Wines 2014 ----- License     : BSD-style+-- License	   : BSD-style -- -- Maintainer  : bgwines@cs.stanford.edu -- Stability   : experimental -- Portability : portable -- --- A typeclass with default implementation for graphing trees with <https://hackage.haskell.org/package/graphviz Haskell GraphViz>.+-- A typeclass with default implementation for graphing trees with <https://hackage.haskell.org/package/graphviz Haskell GraphViz>. It is intended to be extremely straightforward to graph your data type; you only need to define three very simple functions (example implementations below). --  module Zora.TreeGraphing-( Graphable+( TreeGraphable , value , get_children , is_empty , graph+, zoldMap ) where -import Zora.Types+import Shelly+import System.Directory (removeFile, getDirectoryContents)+import Control.Exception+import System.IO.Error hiding (catch) +import System.IO.Unsafe+ import Data.Maybe import Data.Tuple +import Data.Monoid+ import qualified Data.Map as M+import qualified Data.List as L hiding (zip, map, length, take, drop, takeWhile, last, filter, concatMap) import qualified Data.Text.Lazy as Ly import qualified Data.ByteString.Char8 as ByteString -type Graph = ([Node], [Edge])-type Node = (Int, Ly.Text)-type Edge = (Int, Int, Ly.Text)+--  hiding (Graph, Edge, Node)+import Data.Graph.Inductive+import Data.GraphViz+import Data.GraphViz.Attributes.Complete hiding (value, Label)+import Data.Word+ type Label = Int  -- | A typeclass for algebraic data types that are able to be graphed.+-- -- For these descriptions, assume the following example data type: --  -- > data Tree a = Empty | Leaf a | Node a (Tree a) (Tree a) -- --- See the supporting file @dot.hs@ for an example of how to graph your data type.-class (Zoldable g) => Graphable g where+-- Being an instance of @TreeGraphable@ is enough to make your data type an instance of @Zoldable@; just define+--+-- > instance Zoldable Tree where+-- > 	zoldMap :: (Monoid m) => (Tree a -> m) -> Tree a -> m+-- > 	zoldMap = G.zoldMap+--+class TreeGraphable g where 	-- | Gets the value contained in a node. For example, 	--  	-- > value (Empty) = error "Empty nodes don't contain values."@@ -56,18 +77,24 @@ 	-- > get_children (Node _ l r) = [l, r] 	get_children :: g a -> [g a] -	-- | Returns whether a node is empty. Sometimes, when declaring algebraic data types, it is desirable to have an "Empty" value constructor. If your data type does not have an "Empty" value constructor, just always return @False@.+	-- | Returns whether a node is empty. Sometimes, when declaring algebraic data types, it is desirable to have an \"Empty\" value constructor. If your data type does not have an \"Empty\" value constructor, just always return @False@. 	-- -	-- > is_empty (Empty) = True+	-- > is_empty Empty = True 	-- > is_empty _ = False 	is_empty :: g a -> Bool -	-- TODO: Multiple trees (e.g. binomial heaps / random access lists)-	-- | Returns a @Graph@ for the given @Graphable@ type. You shouldn't need to override this implementation.-	graph :: forall a. (Show a, Ord a) => g a -> Graph-	graph g = (nodes, edges)+	-- | A default implementation of @zoldMap@. This enough to make you an instance of @Zoldable@ (in @Zora.Types@). You shouldn't need to override this implementation.+	zoldMap :: (Monoid m) => (g a -> m) -> g a -> m+	zoldMap f node =+		if is_empty node+			then mempty+			else (f node) `mappend` (mconcat . map (zoldMap f) . get_children $ node)++	-- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You shouldn't need to override this implementation.+	as_graph :: forall a. (Ord a, Show a) => g a -> ([LNode Ly.Text], [LEdge Ly.Text])+	as_graph g = (nodes, edges) 		where-			nodes :: [Node]+			nodes :: [LNode Ly.Text] 			nodes = zip [0..] $ map show' nodes_in_g  			show' :: g a -> Ly.Text@@ -76,14 +103,14 @@ 			nodes_in_g :: [g a] 			nodes_in_g = zoldMap (\a -> [a]) g -			edges :: [Edge]+			edges :: [LEdge Ly.Text] 			edges = concatMap edgeify nodes_in_g -			edgeify :: g a -> [Edge]+			edgeify :: g a -> [LEdge Ly.Text] 			edgeify node = 				catMaybes . map maybe_edge . get_children $ node 				where -					maybe_edge :: g a -> Maybe Edge+					maybe_edge :: g a -> Maybe (LEdge Ly.Text) 					maybe_edge child = if is_empty child 						then Nothing 						else Just@@ -93,3 +120,85 @@  					m :: M.Map Ly.Text Label 					m = M.fromList $ map swap nodes++	-- TODO: Multiple trees (e.g. binomial heaps / random access lists)+	-- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You won't need to override this implementation.+	as_dotfile :: forall a. (Show a, Ord a) => g a -> String+	as_dotfile+		= Ly.unpack+		. printDotGraph+		. graphToDot params+		. mkGraph'+		. as_graph+		where+			mkGraph' :: ([LNode Ly.Text], [LEdge Ly.Text]) -> (Gr Ly.Text Ly.Text)+			mkGraph' (v, e) = mkGraph v e++			params :: GraphvizParams n Ly.Text Ly.Text () Ly.Text+			params = nonClusteredParams { globalAttributes = ga+										, fmtNode = fn+										, fmtEdge = fe }+				where+					fn (_,l) = [textLabel l]+					fe (_,_,l) = [textLabel l]++					ga = [ GraphAttrs [ RankDir	 FromTop+									  , BgColor	 [toWColor White] ]+						 , NodeAttrs	[ shape	 BoxShape+										-- , FillColor (some_color 4)+										-- , style	 filled+										, Width	 0.1+										, Height	0.1 ] ]++	-- TODO : output is written to a file named \"graph-i.dot\", where /i/ is the successor of the highest /i/-value of all existing \"graph-i.dot\" files in the current directory.+	-- | Graphs the given @TreeGraphable@ data type. Creates and writes to a file named \"graph.png\", overwriting any existing files with that name. You won't need to override this implementation.+	graph :: (Show a, Ord a) => g a -> IO String+	graph g =+		let+			outfile :: String+			outfile = "graph-" ++ index ++ ".png"+				where+					index :: String+					index+						= show+						. (+) 1+						. (\s -> read s :: Integer)+						. takeWhile (/= '.')+						. drop 6 -- (length "graph-")+						. last+						$ "graph--1" : graph_files_in_dir++					files_in_dir :: IO [String]+					files_in_dir = getDirectoryContents "." :: IO [String]+					+					graph_files_in_dir :: [String]+					graph_files_in_dir+						= L.sort+						. filter (starts_with "graph-")+						. filter ((==) "graph.png")+						. unsafePerformIO -- TODO: not this+						$ files_in_dir++					starts_with :: String -> String -> Bool+					starts_with prefix str = take (length prefix) str == prefix++			run_dot_cmd :: IO ()+			run_dot_cmd = shelly $ do+				cmd "dot" "-Tpng" "graph.dot" "-ograph.png"--("-o" ++ outfile) -- Can't get this to compile. Not sure why yet. For now, we always write to the same file.++			write_dot_file :: IO ()+			write_dot_file = do+				writeFile "graph.dot" $ as_dotfile g++			remove_dot_file :: IO ()+			remove_dot_file = removeFile "graph.dot" `catch` handleExists+				where+					handleExists e+						| isDoesNotExistError e = return ()+						| otherwise = throwIO e+		in+			do+				write_dot_file+				run_dot_cmd+				remove_dot_file+				return ("Graphed data structure to " ++ "graph.png") -- outfile