ProjectEuler/haskell/src/Utils.hs

module Utils where
  import Data.Function
  import Data.Maybe
  import Data.Ratio
  import Data.List
  import Data.Char

  import Debug.Trace
  import Text.Printf

  (|>) = (&)

  (!?) :: [a] -> Int -> Maybe a
  l !? i
    | i >= (length l) = Nothing
    | i == 0          = car l
    | otherwise       = cdr l >>= \x -> x !? (i-1)

  c2i :: Char -> Maybe Int
  c2i c = if cv < 48 || cv > 57
          then Nothing
          else Just (cv - 48)
    where cv = ord c

  car :: [a] -> Maybe a
  car []    = Nothing
  car [x]   = Just x
  car (x:_) = Just x

  cdr :: [a] -> Maybe [a]
  cdr []     = Nothing
  cdr [_]    = Just []
  cdr (_:xs) = Just xs

  run_maybe :: Maybe a -> (a -> b) -> Maybe b
  run_maybe x f = case x of
                    Nothing -> Nothing
                    Just x  -> Just (f x)

  to_maybe :: (a -> b) -> (a -> Maybe b)
  to_maybe f = \x -> Just (f x)

  compareLength :: [a] -> Int -> Ordering
  compareLength l s
    | len == s = EQ
    | len >  s = LT
    | len <  s = GT
      where len = length l

  combinations2 :: [a] -> [b] -> [(a, b)]
  combinations2 x y = go' x y 0 0
    where
      go' :: [a] -> [b] -> Int -> Int -> [(a, b)]
      go' x y xi yi
        | compareLength x xi == EQ = go' x y 0 (yi+1)
        | compareLength y yi == EQ = []
        | otherwise                = [((x !! xi), (y !! yi))] ++ go' x y (xi+1) yi

  combinations3 :: [a] -> [b] -> [c] -> [(a, b, c)]
  combinations3 x y z = go' x y z 0 0 0
    where
      go' :: [a] -> [b] -> [c] -> Int -> Int -> Int -> [(a, b, c)]
      go' x y z xi yi zi
        | compareLength x xi == EQ = go' x y z 0 (yi+1) zi
        | compareLength y yi == EQ = go' x y z 0 0      (zi+1)
        | compareLength z zi == EQ = []
        | otherwise                = [((x !! xi), (y !! yi), (z !! zi))] ++ go' x y z (xi+1) yi zi

  data Direction = DUp | DDown | DLeft | DRight | DUpRight | DUpLeft | DDownRight | DDownLeft deriving Show
  allDirection :: [Direction]
  allDirection = [DUp, DDown, DLeft, DRight, DUpRight, DUpLeft, DDownRight, DDownLeft]

  data Point = Point { x :: Int, y :: Int } deriving Show

  point_next_dir :: Point -> Direction -> Point
  point_next_dir p d =
    case d of
      DUp        -> Point ((x p)-1) (y p)
      DDown      -> Point ((x p)+1) (y p)
      DLeft      -> Point (x p)     ((y p)-1)
      DRight     -> Point (x p)     ((y p)+1)
      DUpRight   -> Point ((x p)-1) ((y p)+1)
      DUpLeft    -> Point ((x p)-1) ((y p)-1)
      DDownRight -> Point ((x p)+1) ((y p)+1)
      DDownLeft  -> Point ((x p)+1) ((y p)-1)

  type Matrix a = [[a]]

  matrix_n_rows :: Matrix a -> Int
  matrix_n_rows m = length m

  matrix_n_cols :: Matrix a -> Maybe Int
  matrix_n_cols m = car m >>= to_maybe length

  matrix_get :: Matrix a -> Int -> Int -> Maybe a
  matrix_get m x y = m !? x >>= \z -> z !? y

  matrix_get_n :: Matrix a -> Int -> Direction -> Point -> Maybe [a]
  matrix_get_n m a d p = go' m a d p 0
    where
      go' :: Matrix a -> Int -> Direction -> Point -> Int -> Maybe [a]
      go' m a d p c
        | c == a    = Just []
        | otherwise = case matrix_get m (x p) (y p) of
                        Nothing -> Nothing
                        Just z -> go' m a d (point_next_dir p d) (c+1) >>= \w -> Just ([z] ++ w)

  coalesce2 :: Maybe a -> Maybe a -> a -> a
  coalesce2 x y d = coalesce1 y (coalesce1 x d)

  coalesce1 :: Maybe a -> a -> a
  coalesce1 (Just x)  _ = x
  coalesce1 (Nothing) d = d

  bigger :: (a -> Int) -> [a] -> a
  bigger f xs = xs !! i where li = map f xs
                              i = fromJust $ elemIndex (maximum li) li

  data Tri a = EmptyTri | Node a (Tri a) (Tri a)
    deriving Show

  triLeft :: Tri a -> Tri a
  triLeft EmptyTri = EmptyTri
  triLeft (Node _ l _) = l

  triRight :: Tri a -> Tri a
  triRight EmptyTri = EmptyTri
  triRight (Node _ _ r) = r

  triVal :: Tri a -> Maybe a
  triVal EmptyTri     = Nothing
  triVal (Node x _ _) = Just x

  triValDef :: a -> Tri a -> a
  triValDef d EmptyTri     = d
  triValDef _ (Node x _ _) = x

  triVal' :: Tri a -> a
  triVal' (Node x _ _) = x

  triParseString :: String -> Tri Int
  triParseString s = lines s |> map words |> map (map read) |> go' 0
    where
      go' :: Int -> [[Int]] -> Tri Int
      go' _ [] = EmptyTri
      go' i [x] = Node (x !! i) EmptyTri EmptyTri
      go' i (x:xs) = Node (x !! i) (go' (i+0) xs) (go' (i+1) xs)

  tri2UnsortedList :: Int -> Tri a -> [a]
  tri2UnsortedList _  (EmptyTri) = []
  tri2UnsortedList td t          = go' t 0
    where
      go' (EmptyTri)   _ = []
      go' (Node x l r) d
        | d == td   = []
        | otherwise = [x] ++ go' l (d+1) ++ go' r (d+1)

  type Day = Int
  type Month = Int

  monthNumOfDay :: Year -> Month -> Int
  monthNumOfDay yyyy 2  = if (yearIsLeap yyyy) then 29 else 28
  monthNumOfDay _    4  = 30
  monthNumOfDay _    6  = 30
  monthNumOfDay _    9  = 30
  monthNumOfDay _    11 = 30
  monthNumOfDay _    mm = 31

  type Year = Int

  yearIsLeap :: Year -> Bool
  yearIsLeap yyyy = (mody 4) && ((not (mody 100)) || (mody 400))
    where mody = \x -> mod yyyy x == 0

  data Date = Date Year Month Day
    deriving (Show, Eq)

  dateDay :: Date -> Day
  dateDay (Date _ _ dd) = dd

  dateNextDay :: Date -> Date
  dateNextDay (Date yyyy mm dd)
    | dd == (monthNumOfDay yyyy mm) = dateNextMonth (Date yyyy mm 1)
    | otherwise                     = (Date yyyy mm (dd+1))

  dateNextMonth :: Date -> Date
  dateNextMonth (Date yyyy 12 dd) = dateNextYear (Date yyyy 1 dd)
  dateNextMonth (Date yyyy mm dd) = (Date yyyy (mm+1) dd)

  dateNextYear :: Date -> Date
  dateNextYear (Date yyyy mm dd) = (Date (yyyy+1) mm dd)

  data Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
    deriving (Show, Enum, Eq)

  weekdayNext :: Weekday -> Weekday
  weekdayNext Sunday = Monday
  weekdayNext x = succ x

  weekdayOfDate :: Date -> Weekday
  weekdayOfDate tD = go' (Date 1900 1 1) (iterate weekdayNext Monday)
    where
      go' :: Date -> [Weekday] -> Weekday
      go' d (x:xs)
        | d == tD   = x
        | otherwise = go' (dateNextDay d) xs

  factorial :: Integer -> Integer
  factorial 0 = 0
  factorial 1 = 1
  factorial x = x * factorial (x-1)

  divs :: Int -> [Int]
  divs 0 = []
  divs 1 = [1]
  divs x = filter (\x' -> (mod x x') == 0) (take (x-1) (iterate (+1) 1))

  flattenTupleList :: [(a, a)] -> [a]
  flattenTupleList [] = []
  flattenTupleList [(x, y)] = [x, y]
  flattenTupleList ((x, y):xs) = [x, y] ++ (flattenTupleList xs)

  mapi :: (Int -> a -> b) -> [a] -> [b]
  mapi _ [] = []
  mapi f l  = go' l 0
    where go' [] _ = []
          go' [x] i = [f i x]
          go' (x:xs) i = [f i x] ++ go' xs (i+1)

  splitByChar :: Char -> String -> [String]
  splitByChar c s = go' (elemIndex c s) s
    where go' :: Maybe Int -> String -> [String]
          go' (Nothing) s = [s]
          go' (Just i)  s = [b] ++ go' (elemIndex c a) a
                              where
                                (b, aRaw) = splitAt i s
                                a = tail aRaw

  tracePPId :: Show a => [a] -> [a]
  tracePPId l = if (go' l 0) then [] else l
    where
      go' :: Show a => [a] -> Int -> Bool
      go' []     _ = False
      go' (x:xs) i = trace (printf "%5d -> %s" i (show x)) (go' xs (i+1))

  slice :: Int -> Int -> [a] -> [a]
  slice b s l = drop b l |> take s

  howManyFit :: Int -> Int -> Int
  --howManyFit x y | trace (printf "howManyFit %3d %3d" x y) False = undefined
  howManyFit x y = if w == 0
                   then 1
                   else (if w > 0
                         then 1 + (howManyFit x w)
                         else 0)
    where w = y-x

  tW f (x:xs) = case f x of
                  True -> tW f xs
                  False -> x

  longDiv :: Ratio Int -> String
  longDiv r = if dn == nmRaw then "1" else pred ++ (go' nm False 5000)
    where
      nmRaw = numerator r
      dn = denominator r
      hMInc = iterate (+1) 1 |> tW (\x -> (howManyFit dn (nmRaw*(10^x))) == 0)
      nm = nmRaw * (10^hMInc)
      pred = case hMInc of
               1 -> "0."
               2 -> "0.0"
               3 -> "0.00"
               4 -> "0.000"
               _ -> ""

      go' :: Int -> Bool -> Int -> [Char]
      go' 0 _ _ = []
      go' _ _ 0 = []
      go' x z n
        -- | trace (printf "go' %3d %3d | hmf -> %3d" x n hmf) False = undefined
        | hmf == 0 && z = ['0'] ++ (go' x False (n-1))
        | otherwise = if hmf == 0
                      then go' (x * 10) True (n)
                      else [(intToDigit hmf)] ++ (go' (x-(dn*hmf)) False (n-1))
                        where hmf = howManyFit dn x

  isPrime :: Int -> Bool
  isPrime x = (divs x) == [1]

  addResult :: (a -> b) -> a -> (a, b)
  addResult f x = (x, f x)

  mapFindMaxInitial :: Ord b => (a -> b) -> [a] -> a
  mapFindMaxInitial f l = map (addResult f) l |> maximumBy (\a b -> compare (snd a) (snd b)) |> fst

  dup :: a -> (a,a)
  dup x = (x, x)