module Numl where

--------------------
-- Some stuff on combination/composites/compounds

data Color = Red | Green | Blue  deriving (Eq,Ord,Enum,Bounded,Show)
data Pet   = Cat | Dog           deriving (Eq,Ord,Enum,Bounded,Show)
data CP    = CP Color Pet        deriving  Eq

instance Show CP where show (CP c p) = show c ++ ' ' : show p

instance Enum CP where
  toEnum i = CP (toEnum j) (toEnum k) where (j,k) = divMod i 2
  fromEnum (CP c p) = sumProd 2 (fromEnum c) (fromEnum p)

instance Bounded CP where
  minBound = CP minBound minBound
  maxBound = CP maxBound maxBound

allcp = [minBound..maxBound] :: [CP]
test  = map (toEnum . fromEnum) allcp == allcp


-- need way to define "both" here with universal AND qualified ...
-- cpi i = uncurry CP . both toEnum . flip divMod 2


--------------------
-- Conversion of digits

bet i j k = i<=k && k<=j

off c d = fromInt (ord c - ord d)
ffo c k = chr (ord c + toInt k)

val c | bet '0' '9' c = off c '0'
      | bet 'A' 'Z' c = off c 'A' + 10

dig k | bet  0   9  k = ffo '0' k
dig k | bet 10  15  k = ffo 'A' (k - 10)

--------------------

data BinDigit = O | I  deriving (Eq,Ord,Enum,Bounded,Read,Show)

data DecDigit = D0 | D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9
                deriving (Eq,Ord,Enum,Bounded,Read,Show)

--------------------

(.<) = (.) . (.)

-- Inner product with list of powers

ip  = sum . map (uncurry (*))
numl b = ip . zip pows . reverse . map val
         where pows = iterate (b*) 1

ip' = sum .< zipWith (*)
numl' b = ip' (iterate (b*) 1) . reverse . map val

-- Consolidate points-free definitions in-line

numl2 b = sum . map (uncurry (*)) . zip (iterate (b*) 1) . reverse . map val

-- Consolidation enables simplification

numl3 b = sum . zipWith (*) (iterate (b*) 1) . reverse . map val

ones = replicate 50 '1'

--------------------

-- in terms of foldr and (modified) unfoldr?

num0 b = foldr (flip (sumProd b)) 0 . reverse

num1 = f 0  where f a b []     = a
                  f a b (d:ds) = f (b*a+d) b ds

sumProd b n m = b * n + m

rtsp b = uncurry (sumProd b) . (`divMod` b) 
rtdm b = (`divMod` b) . uncurry (sumProd b)

trt r xs = and [ x == r x | x <- xs ]
comb n = [(i,j) | i <- [0..n], j <- [0..n]]

--------------------

-- str VER CONCRETE, REV

str7 b 0 = []
str7 b n = r : str7 b m  where (m,r) = n `divMod` b

-- str VER ABS, BOOL, REV
str8 b = unfoldb (==0) (`divMod` b)

unfoldb p f b = if p b then [] else a : unfoldb p f b'
                where (b',a) = f b
 
-- str VER 1

str' b a 0 = a
str' b a n = str' b (r:a) m  where (m,r) = n `divMod` b

-- str VER 2, uf VER 1

str2 b = uf (`divMod` b) []

-- uf grows a list of b's from an Int, given an appropriate function

-- uf ::          (Int -> (Int,b)) -> [Int] -> Int -> [b]
uf    :: Num a => (a   -> (a,b))   -> [b]   -> a   -> [b]
uf f a 0 = a
uf f a n = uf f (r:a) m  where (m,r) = f n

-- uf: VER FINAL
unfoldl p f x = g x []
                where g x a = if p x then a else g r (y:a)
                              where (r,y) = f x
 
-- uf: VER POINTS-FREE
unfoldpf p f x = g x []
                 where g x = if p x then id else g r . (y:)
                             where (r,y) = f x

-- ufl: VER Maybe

unfoldlm f b a = g b []
                 where g b a = case f b of Nothing    -> a
                                           Just (r,b) -> g (r:a) b

-- NEED: 2 directions of equivalence between ufs vers Bool and Maybe

--------------------

crgt f g x y = f x (g y)
prgt f g w = (x, f y) where (x, y) = g w

num9 b = foldl         (crgt (sumProd  b) val)  0
str9 b = unfoldl (==0) (prgt dig (`divMod` b))

num b = foldl (sumProd b) 0 . map val
str b = map dig . unfoldl (==0) (`divMod` b)

[ (bin,unbin), (dec,undec), (hex,unhex) ] 
  = map (\b -> (str b, num b)) [2,10,16]

--------------------

    -- where base b = (str b, num b)

con b = foldl          (sumProd b)  0
exd b = unfoldl (==0) (`divMod` b)


--------------------

rev0 a [] = a
rev0 a (x:xs) = rev0 (x:a) xs

fl f a [] = a
fl f a (x:xs) = fl f (f a x) xs

f1 f [] a = a
f1 f (x:xs) a = f1 f xs (f a x)

f2 f []     = \a -> a
f2 f (x:xs) = \a -> f2 f xs (f a x)

f3 f []     = id
f3 f (x:xs) = f3 f xs . flip f x

foldl' f = flip (foldr (\a g -> (\b -> g (f b a))) id)

fl2    f = flip (foldr (\a g -> (g . flip f a))    id)

fl3    f = flip (foldr (flip (.) . flip f) id)

fl4    f = flip (flip foldr id (flip (.) . flip f))

fl5      = flip . flip foldr id . ((.) (flip (.))  .  flip)

fl6 = flip . flip foldr id . (flip (.) .) . flip

fl7 = flip . flip foldr id . (flip (.) .)

revv = fl7 (:) []