Zora (empty) → 1.1.7
raw patch · 8 files changed
+888/−0 lines, 8 filesdep +basedep +bytestringdep +containerssetup-changed
Dependencies added: base, bytestring, containers, random, text
Files
- LICENSE +27/−0
- Setup.hs +2/−0
- Zora.cabal +25/−0
- Zora/List.hs +443/−0
- Zora/Math.hs +200/−0
- Zora/TreeGraphing.hs +95/−0
- Zora/Types.hs +31/−0
- supporting-files/dot.hs +65/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Brett Wines 2014.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Zora.cabal view
@@ -0,0 +1,25 @@+Name: Zora+Version: 1.1.7+Synopsis: A library of assorted useful functions and data types and classes.+Description: A library of assorted useful functions and data types and classes.+Category: Unclassified+Cabal-Version: >= 1.6+License: BSD3+License-File: LICENSE+Stability: Experimental+Author: Brett Wines+Maintainer: bgwines@cs.stanford.edu+Homepage: git://github.com/bgwines/zora.git+Build-Type: Simple+Extra-Source-Files: supporting-files/dot.hs+Source-Repository head+ type: git+ location: https://github.com/bgwines/zora++Library+ Build-Depends: base >= 4 && < 5, random, containers, bytestring, text+ Exposed-Modules:+ Zora.List+ Zora.Math+ Zora.Types+ Zora.TreeGraphing
+ Zora/List.hs view
@@ -0,0 +1,443 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Zora.List+-- Copyright : (c) Brett Wines 2014+--+-- License : BSD-style+--+-- Maintainer : bgwines@cs.stanford.edu+-- Stability : experimental+-- Portability : portable+-- +-- Assorted functions on lists.+--++module Zora.List+(+-- * List transformations+ uniqueify+, pairify+, decyclify+, shuffle++-- * Permutations, combinations, and cycles+, powerset+, gen_perms+, gen_subsets_of_size+, gen_cycles+, has_cycles++-- * Partitioning+, partition_with_block_size+, partition_into_k+, powerpartition++-- * Operations with two lists+, diff_infinite+, merge+, merge_by+, zip_while++-- * Sublists+, remove_at_index+, subseq+, take_while_keep_last+, take_while_and_rest++-- * Sorting+, is_sorted+, mergesort++-- * Predicates+, is_palindrome+, contains_duplicates++-- * Assorted functions+, map_keep+, maximum_with_index+, length'+, drop'+, take'+, cons+, snoc+) where++import qualified Data.List as List+import qualified Data.Ord as Ord+import qualified Data.Set as Set++import System.Random++import Data.Monoid+import Data.Maybe++-- ---------------------------------------------------------------------+-- List transformations++-- | /O(n log(n))/ Removes duplicate elements. Like `Data.List.nub`, but for `Ord` types, so it can be faster.+uniqueify :: (Ord a) => [a] -> [a]+uniqueify = Set.elems . Set.fromList++-- | /O(n)/ Zips the list up into pairs. For example,+-- +-- > pairify [1..6] == [(1,2), (3,4), (5,6)]+-- > pairify [1..5] == [(1,2), (3,4)]+pairify :: [a] -> [(a, a)]+pairify l@(a:b:l') = (a, b) : pairify l'+pairify 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)/.+decyclify :: (Eq a) => [a] -> [a]+decyclify = fromJust . List.find (not . has_cycles) . iterate decyclify_once++decyclify_once :: (Eq a) => [a] -> [a]+decyclify_once l =+ if isNothing lambda+ then l+ else take' (lambda' + mu'') l+ where+ i = alg1 (tail l) (tail . tail $ l)+ i' = fromJust i++ mu = if (i == Nothing) then Nothing else alg2 l (drop' i' l)+ mu' = fromInteger . fromJust $ mu+ mu'' = fromJust mu++ lambda = if (mu == Nothing) then Nothing else alg3 (drop (mu' + 1) l) (l !! mu')+ lambda' = fromJust lambda++ alg1' :: (Eq a) => Integer -> [a] -> [a] -> Maybe Integer+ alg1' i _ [] = Nothing+ alg1' i [] _ = Nothing+ alg1' i l1 l2 = + if (head l1) == (head l2) then+ Just (i + 1) -- + 1 beacuse we start off with l1 = tail l+ else+ if tail l2 == [] then+ Nothing+ else+ alg1' (i + 1) (tail l1) (tail . tail $ l2)++ alg2' :: (Eq a) => Integer -> [a] -> [a] -> Maybe Integer+ alg2' mu _ [] = Nothing+ alg2' mu [] _ = Nothing+ alg2' mu l1 l2 = + if (head l1) == (head l2) then+ Just mu+ else+ alg2' (mu + 1) (tail l1) (tail l2)++ alg3' :: (Eq a) => Integer -> [a] -> a -> Maybe Integer+ alg3' lambda [] e = Nothing+ alg3' lambda l e =+ if (head l) == e then+ Just lambda+ else+ alg3' (lambda + 1) (tail l) e++ alg1 :: (Eq a) => [a] -> [a] -> Maybe Integer+ alg1 = alg1' 0++ alg2 :: (Eq a) => [a] -> [a] -> Maybe Integer+ alg2 = alg2' 0++ alg3 :: (Eq a) => [a] -> a -> Maybe Integer+ alg3 = alg3' 1++shuffle' :: [a] -> [Integer] -> [a]+shuffle' l indices =+ map fst . List.sortBy (Ord.comparing snd) $ zip l indices++-- | /O(n log(n))/ Shuffles the given list. The second parameter is the seed for the random number generator that backs the shuffle.+shuffle :: forall a. (Eq a) => [a] -> Integer -> [a]+shuffle l seed = shuffle' l randomness+ where+ randomness :: [Integer]+ randomness = prep (length' l) $ random_integers (0, (length' l) - 1) seed++ random_integers :: (Integer, Integer) -> Integer -> [Integer]+ random_integers range = randomRs range . mkStdGen . fromInteger++ prep :: Integer -> [Integer] -> [Integer]+ prep len l' = reverse . take' len $ prep' l' []++ prep' :: [Integer] -> [Integer] -> [Integer]+ prep' [] seen = []+ prep' src seen =+ if head src `elem` seen+ then prep' (tail src) seen+ else head src : (prep' (tail src) (head src : seen))++-- ---------------------------------------------------------------------+-- Permutations, combinations, and cycles++-- | /O(2^n)/ Computes the powerset of the given list.+powerset :: [a] -> [[a]]+powerset l = powerset_rec l []+ where+ powerset_rec :: [a] -> [a] -> [[a]]+ powerset_rec [] so_far = [so_far]+ powerset_rec src so_far = without ++ with+ where without = powerset_rec (tail src) (so_far)+ with = powerset_rec (tail src) ((head src) : so_far)++-- TODO: actually O(n!)?+-- | /O(n!)/ Computes all permutations of the given list.+gen_perms :: [a] -> [[a]]+gen_perms 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]+ | 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+ where+ gen_subsets_of_size_rec :: [a] -> [a] -> Integer -> [[a]]+ gen_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)++{-gen_subsets_of_size_with_replacement_rec :: Integer -> [a] -> [a] -> [[a]]+gen_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)++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 []-}++-- | /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+ 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+ | l == original_l = [l]+ | otherwise = [l] ++ (gen_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+has_cycles l = (decyclify_once l) /= l++-- ---------------------------------------------------------------------+-- Partitioning++-- | /O(n)/ Partitions the given list into blocks of the specified length. Truncation behaves as follows:+-- +-- > partition_with_block_size 3 [1..10] == [[1,2,3],[4,5,6],[7,8,9],[10]]+partition_with_block_size :: Int -> [a] -> [[a]]+partition_with_block_size len l =+ if (length l) <= len+ then [l]+ else (take len l) : (partition_with_block_size len (drop len l))++-- | /O(n)/ Partitions the given list into /k/ blocks. Truncation behavior is best described by example:+-- +-- > partition_into_k 3 [1..9] == [[1,2,3],[4,5,6],[7,8,9]]+-- > partition_into_k 3 [1..10] == [[1,2,3,4],[5,6,7,8],[9,10]]+-- > partition_into_k 3 [1..11] == [[1,2,3,4],[5,6,7,8],[9,10,11]]+-- > partition_into_k 3 [1..12] == [[1,2,3,4],[5,6,7,8],[9,10,11,12]]+-- > partition_into_k 3 [1..13] == [[1,2,3,4,5],[6,7,8,9,10],[11,12,13]]+partition_into_k :: Int -> [a] -> [[a]]+partition_into_k k arr = partition_with_block_size block_size arr+ where+ block_size :: Int+ block_size = if (((length arr) `mod` k) == 0)+ then (length arr) `div` k+ else (length arr) `div` k + 1++-- | /O(B(n))/, where /B(n)/ is the /n/^th <http://en.wikipedia.org/wiki/Bell_number Bell number>. Computes all partitions of the given list. For example,+-- +-- > powerpartition [1..3] == [[[1],[2],[3]], [[1,2],[3]], [[2],[1,3]], [[1],[2,3]], [[1,2,3]]]+powerpartition :: [a] -> [[[a]]]+powerpartition [] = []+powerpartition l@(x:xs) =+ if length l == 1+ then [[[x]]]+ else concatMap (get_next_partitions x) . powerpartition $ xs+ where+ get_next_partitions :: a -> [[a]] -> [[[a]]]+ get_next_partitions e l = ([e] : l) : (map f indices)+ where+ f i = (a i) ++ (b i) ++ (c i)+ + a i = ((take' i) l)+ b i = [e : (l !! (fromInteger i))]+ c i = (drop' (i+1) l)++ indices = [0..((length' l) - 1)]++-- ---------------------------------------------------------------------+-- Operations with two lists++-- | Given two infinite sorted lists, generates a list of elements in the first but not the second.+diff_infinite :: (Ord a) => [a] -> [a] -> [a]+diff_infinite xs@(x:xt) ys@(y:yt) = + case compare x y of+ LT -> x : (diff_infinite xt ys)+ EQ -> diff_infinite xt yt+ GT -> diff_infinite xs yt++-- | /O(max(n, m))/ Merges the two given sorted lists of respective lengths /n/ and /m/. A special case of `merge_by` where the comparison function is `compare`.+merge :: (Ord a) => [a] -> [a] -> [a]+merge = merge_by compare++-- | /O(max(n, m))/ Merges the two given sorted lists of respective lengths /n/ and /m/, comparing elements in between the two lists with the given comparator function.+merge_by :: (Ord a) => (a -> a -> Ordering) -> [a] -> [a] -> [a]+merge_by cmp as bs+ | length as == 0 = bs+ | length bs == 0 = as+ | otherwise =+ let+ a = head as+ b = head bs+ as' = tail as+ bs' = tail bs+ in+ case cmp a b of+ LT -> a : merge_by cmp as' bs+ EQ -> a : merge_by cmp as' bs+ GT -> b : merge_by cmp as bs'+++-- | /O(min(n, m))/ Zips the two given lists of respective lengths /n/ and /m/ as long as the pairs satisfy the given predicate function.+zip_while :: (a -> b -> Bool) -> [a] -> [b] -> [(a, b)]+zip_while f as bs = takeWhile (\(a, b) -> f a b) $ zip as bs++-- ---------------------------------------------------------------------+-- Sublists++-- | /O(n)/ Removes an element at the specified index in the given list.+remove_at_index :: Integer -> [a] -> [a]+remove_at_index i l =+ let a = fst $ splitAt (fromInteger i) l + b = snd $ splitAt (fromInteger i) l + in a ++ tail b++-- | /O(n)/ Returns the subsequence of the given length at starting at index /i/ of length /m/. For example,+-- +-- > subseq 4 5 [1..20] == [5,6,7,8,9]+subseq :: Integer -> Integer -> [a] -> [a]+subseq i len = take (fromInteger len) . drop (fromInteger i)++-- | /(O(n))/ Identical to `takeWhile`, but also contains the first element to satisfy the given predicate function. For example:+-- +-- > take_while_keep_last (<3) [1..] == [1,2,3]+take_while_keep_last :: (a -> Bool) -> [a] -> [a]+take_while_keep_last f [] = []+take_while_keep_last f (x:xs) =+ if f x+ then [x]+ else x : take_while_keep_last f xs++-- | /(O(n))/ Returns a pair where the first element is identical to what `takeWhile` returns and the second element is the rest of the list+-- +-- > take_while_keep_last (<3) [1..] == [1,2,3]+take_while_and_rest :: (a -> Bool) -> [a] -> ([a], [a])+take_while_and_rest f [] = ([], [])+take_while_and_rest f l@(x:xs) = if not . f $ x+ then ([], l)+ else (x:(fst rec), snd rec)+ where+ rec = take_while_and_rest f xs++-- ---------------------------------------------------------------------+-- Sorting++-- | /O(n)/ Returns whether the given list is sorted.+is_sorted :: (Ord a) => [a] -> Bool+is_sorted l = and $ zipWith (<=) l (tail l)++-- | /O(n log(n))/ Sorts the given list.+mergesort :: (Ord a) => [a] -> [a]+mergesort l =+ if length l <= 1+ then l+ else merge (mergesort a) (mergesort b)+ where+ (a, b) = splitAt (floor ((fromIntegral $ length l) / 2)) l++-- ---------------------------------------------------------------------+-- Predicates++-- TODO: O(n log(n))+-- | /O(n^2)/ Returns whether the given list is a palindrome.+is_palindrome :: (Eq e) => [e] -> Bool+is_palindrome s =+ if length s <= 1+ then True+ 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.+contains_duplicates :: forall a . (Ord a) => [a] -> Bool+contains_duplicates l =+ if is_sorted l+ then or $ zipWith (==) l (tail l)+ else isNothing $ foldr insert (Just Set.empty) l+ where+ insert :: a -> Maybe (Set.Set a) -> Maybe (Set.Set a)+ insert a s = if isNothing s+ then Nothing+ else if Set.member a (fromJust s)+ then Nothing+ else Just (Set.insert a (fromJust s))++-- ---------------------------------------------------------------------+-- Assorted functions++-- | /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 :: (a -> b) -> [a] -> [(a, b)]+map_keep f l = zipWith (\a b -> (a, b)) l (map f l)++-- | Like `length`, but returns an integer.+length' :: [a] -> Integer+length' = toInteger . length++-- | Like `drop`, but takes an integer.+drop' :: Integer -> [a] -> [a]+drop' = drop . fromInteger++-- | Like `take`, but takes an integer.+take' :: Integer -> [a] -> [a]+take' = take . fromInteger++-- | List pre-pending.+cons :: a -> [a] -> [a]+cons = (:)++-- | List post-pending.+snoc :: a -> [a] -> [a]+snoc e l = l ++ [e]++-- | /O(n)/ Finds the maximum element of the given list and returns a pair of it and the index at which it occurs (if the maximum element occurs multiple times, behavior is identical to that of `Data.List.maximumBy`). The list must be finite and non-empty.+maximum_with_index :: (Ord a) => [a] -> (a, Integer)+maximum_with_index xs =+ List.maximumBy (Ord.comparing fst) (zip xs [0..])++-- | /O(n)/ Finds the minimum element of the given list and returns a pair of it and the index at which it occurs (if the minimum element occurs multiple times, behavior is identical to that of `Data.List.minimumBy`). The list must be finite and non-empty.+minimum_with_index :: (Ord a) => [a] -> (a, Integer)+minimum_with_index xs =+ List.minimumBy (Ord.comparing fst) (zip xs [0..])
+ Zora/Math.hs view
@@ -0,0 +1,200 @@+-- |+-- Module : Zora.Math+-- Copyright : (c) Brett Wines 2014+--+-- License : BSD-style+--+-- Maintainer : bgwines@cs.stanford.edu+-- Stability : experimental+-- Portability : portable+-- +-- Assorted mathematical functions.+--++module Zora.Math+( -- * Prime numbers and division+ primes+, nonprimes+, is_prime+, coprime+, euler_phi+, factorize+, divisors++-- * Square roots+, irr_squares+, sqrt_convergents+, continued_fraction_sqrt+, continued_fraction_sqrt_infinite++-- * Assorted functions+, is_int+, is_power_of_int+, int_to_double+, get_num_digits+, tri_area+, tri_area_double+) where++import qualified Data.List as List++import Data.Maybe++import Zora.List++-- ---------------------------------------------------------------------+-- Prime numbers and division++-- | A complete, monotonically increasing, infinite list of primes. Implementation based on <http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)>.+primes :: [Integer]+primes = [2, 3, 5] ++ (diff_infinite [7, 9 ..] nonprimes)++-- | A complete, monotonically increasing, infinite list of non-prime numbers.+nonprimes :: [Integer]+nonprimes = foldr1 f $ map g $ tail primes+ where+ f (x:xt) ys = x : (merge_infinite xt ys)+ g p = [ n * p | n <- [p, p + 2 ..]]++ merge_infinite :: (Ord a) => [a] -> [a] -> [a]+ merge_infinite xs@(x:xt) ys@(y:yt) = + case compare x y of+ LT -> x : (merge_infinite xt ys)+ EQ -> x : (merge_infinite xt yt)+ GT -> y : (merge_infinite xs yt)++is_prime_rec :: Integer -> Integer -> Bool+is_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)++-- | /O(n)/ Returns whether the parameter is a prime number.+is_prime :: Integer -> Bool+is_prime n = is_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)]+ where+ is_common_divisor n = (a `mod` n == 0) && (b `mod` n == 0)++-- | /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)++-- | /O(k n log(n)^-1)/, where /k/ is the number of primes dividing /n/ (double-counting for powers).+euler_phi :: Integer -> Integer+euler_phi 1 = 0+euler_phi n = product + $ map+ euler_phi_for_powers_of_primes+ $ map format $ List.group $ factorize 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)+ 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++-- ---------------------------------------------------------------------+-- Square roots++sqrt_convergents_rec :: (Integer, Integer) -> (Integer, Integer) -> [Integer] -> [(Integer, Integer)]+sqrt_convergents_rec (a'', b'') (a', b') cf =+ (a, b) : sqrt_convergents_rec (a', b') (a, b) cf'+ where+ a = e * a' + a''+ b = e * b' + b''+ 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)>.+sqrt_convergents :: Integer -> [(Integer, Integer)]+sqrt_convergents n =+ (a0, b0) : (a1, b1) : + sqrt_convergents_rec+ (a0, b0)+ (a1, b1)+ (tail . tail $ cf)+ where+ (a0, b0) = (e, 1)+ (a1, b1) = (e * e' + 1, e')+ e = head cf+ e' = head . tail $ cf+ 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..] ++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)+ where+ d' = (n - m'^2) `div` d+ m' = (d * a) - m+ a' = floor $ (fromIntegral (a0 + m')) / (fromIntegral d')++-- | An infinite list of the terms of the continued fraction representation of the square root of the given parameter.+continued_fraction_sqrt_infinite :: Integer -> [Integer]+continued_fraction_sqrt_infinite n =+ map trd5+ $ iterate next_continued_fraction_sqrt (d0, m0, a0, a0, n)+ where+ m0 = 0+ d0 = 1+ a0 = floor . sqrt . fromInteger $ n+ trd5 (_, _, x, _, _) = x++-- | /O(k)/ The <http://en.wikipedia.org/wiki/Continued_fraction continued fraction> representation of the square root of the parameter. /k/ is the length of the continued fraction.+continued_fraction_sqrt :: Integer -> [Integer]+continued_fraction_sqrt n =+ take_while_keep_last (/= (2 * a0)) . continued_fraction_sqrt_infinite $ n+ where+ a0 = floor . sqrt . fromInteger $ n++-- ---------------------------------------------------------------------+-- Assorted functions++-- | /O(1)/ Area of a triangle, where the parameters are the edge lengths (Heron's formula).+tri_area :: Integer -> Integer -> Integer -> Double+tri_area a b c = + sqrt $ p * (p-a') * (p-b') * (p-c')+ where+ a' = fromInteger a+ b' = fromInteger b+ c' = fromInteger c+ p = (fromInteger (a + b + c)) / 2++-- | /O(1)/ Area of a triangle, where the parameters are the edge lengths (Heron's formula).+tri_area_double :: Double -> Double -> Double -> Double+tri_area_double a b c = + sqrt $ p * (p-a) * (p-b) * (p-c)+ where+ p = (a + b + c) / 2+++-- | /O(1)/ Calculates whether /n/ is the /e/^th power of any integer, where /n/ is the first parameter and /e/ is the second.+is_power_of_int :: Integer -> Integer -> Bool+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)))++-- | 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`.+int_to_double :: Double -> Integer+int_to_double = (toInteger . round)
+ Zora/TreeGraphing.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Zora.TreeGraphing+-- Copyright : (c) Brett Wines 2014+--+-- 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>.+--++module Zora.TreeGraphing+( Graphable+, value+, get_children+, is_empty+, graph+) where++import Zora.Types++import Data.Maybe+import Data.Tuple++import qualified Data.Map as M+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)+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+ -- | Gets the value contained in a node. For example,+ -- + -- > value (Empty) = error "Empty nodes don't contain values."+ -- > value (Leaf x) = x+ -- > value (Node x _ _) = x+ value :: g a -> a+ + -- | Gets the children of the current node. For example,+ -- + -- > get_children (Empty) = error "Empty nodes don't have children."+ -- > get_children (Leaf _) = []+ -- > 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@.+ -- + -- > 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)+ where+ nodes :: [Node]+ nodes = zip [0..] $ map show' nodes_in_g++ show' :: g a -> Ly.Text+ show' = Ly.pack . show . value++ nodes_in_g :: [g a]+ nodes_in_g = zoldMap (\a -> [a]) g++ edges :: [Edge]+ edges = concatMap edgeify nodes_in_g++ edgeify :: g a -> [Edge]+ edgeify node =+ catMaybes . map maybe_edge . get_children $ node+ where + maybe_edge :: g a -> Maybe Edge+ maybe_edge child = if is_empty child+ then Nothing+ else Just+ ( m M.! (show' node)+ , m M.! (show' child)+ , Ly.empty )++ m :: M.Map Ly.Text Label+ m = M.fromList $ map swap nodes
+ Zora/Types.hs view
@@ -0,0 +1,31 @@+-- |+-- Module : Zora.Types+-- Copyright : (c) Brett Wines 2014+--+-- License : BSD-style+--+-- Maintainer : bgwines@cs.stanford.edu+-- Stability : experimental+-- Portability : portable+-- +-- Assorted types and typeclasses+--+module Zora.Types+( Zoldable+, zoldMap+) where++import Data.Monoid++-- | `Zora.Zoldable` is much like `Data.Foldable`, but with a crucial difference:+-- +-- > foldMap :: (Foldable t, Monoid m) => ( a -> m) -> t a -> m+-- > zoldMap :: (Zoldable t, Monoid m) => (t a -> m) -> t a -> m+-- +-- It is an augmented form -- @foldMap f t@ is @zoldMap (f . g) t@ where @g :: t a -> a@. With @foldMap@, you lose information that you have at the time of invocation of @f@: the @t a@; the context in which the @a@ is enclosed is discarded. Consider the following situation: you have some tree type, e.g.+-- +-- > data Tree a = Leaf a | Node a (Tree a) (Tree a)+-- +-- Suppose you want to get a list of all the nodes in the tree. This is just @zoldMap (\x -> [x]) tree@.+class Zoldable z where+ zoldMap :: (Monoid m) => (z a -> m) -> z a -> m
+ supporting-files/dot.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Graph.Inductive+import Data.GraphViz+import Data.GraphViz.Attributes.Complete+import Data.GraphViz.Types.Generalised as G+import Data.GraphViz.Types.Monadic+import Data.Text.Lazy as L+import Data.Word++import System.IO++-- $ runhaskell dot.hs > graph.dot+-- $ dot -Tpng graph.dot > graph.png'++make_graph :: String -> Gr Text Text+make_graph str = mkGraph v e+ where+ (v, e) = graph . fromList $ str'+ str' = read str :: [Integer]++example_graph :: Gr Text Text+example_graph = mkGraph+ [(1,"one"), (3,"three")]+ [(1,3,"edge label")]++params :: GraphvizParams n L.Text L.Text () L.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+ ]+ ]++some_color :: Word8 -> ColorList+some_color n | n == 1 = c $ (RGB 127 108 138)+ | n == 2 = c $ (RGB 175 177 112)+ | n == 3 = c $ (RGB 226 206 179)+ | n == 4 = c $ (RGB 172 126 100)+ where c rgb = toColorList [rgb]++my_color :: Word8 -> Attribute+my_color = Color . some_color++main :: IO ()+main = do+ str <- getLine+ putStr . unpack . printDotGraph . graphToDot params . make_graph $ str+++