module NumericPrelude.List where

import Data.List.HT (switchL, switchR, )


{- * Zip lists -}

{- | zip two lists using an arbitrary function, the shorter list is padded -}
{-# INLINE zipWithPad #-}
zipWithPad :: a               {-^ padding value -}
           -> (a -> a -> b)   {-^ function applied to corresponding elements of the lists -}
           -> [a]
           -> [a]
           -> [b]
zipWithPad :: a -> (a -> a -> b) -> [a] -> [a] -> [b]
zipWithPad a
z a -> a -> b
f =
   let aux :: [a] -> [a] -> [b]
aux [a]
l []          = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a -> a -> b
f a
x a
z) [a]
l
       aux [] [a]
l          = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\a
y -> a -> a -> b
f a
z a
y) [a]
l
       aux (a
x:[a]
xs) (a
y:[a]
ys) = a -> a -> b
f a
x a
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [b]
aux [a]
xs [a]
ys
   in  [a] -> [a] -> [b]
aux

{-# INLINE zipWithOverlap #-}
zipWithOverlap :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithOverlap :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c]
zipWithOverlap a -> c
fa b -> c
fb a -> b -> c
fab =
   let aux :: [a] -> [b] -> [c]
aux (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c
fab a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [c]
aux [a]
xs [b]
ys
       aux [a]
xs [] = (a -> c) -> [a] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map a -> c
fa [a]
xs
       aux [] [b]
ys = (b -> c) -> [b] -> [c]
forall a b. (a -> b) -> [a] -> [b]
map b -> c
fb [b]
ys
   in  [a] -> [b] -> [c]
aux

{-
This is exported as Checked.zipWith.
We need to define it here in order to prevent an import cycle.
-}
zipWithChecked
   :: (a -> b -> c)   {-^ function applied to corresponding elements of the lists -}
   -> [a]
   -> [b]
   -> [c]
zipWithChecked :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWithChecked a -> b -> c
f =
   let aux :: [a] -> [b] -> [c]
aux (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [a] -> [b] -> [c]
aux [a]
xs [b]
ys
       aux []     []     = []
       aux [a]
_      [b]
_      = [Char] -> [c]
forall a. HasCallStack => [Char] -> a
error [Char]
"Checked.zipWith: lists must have the same length"
   in  [a] -> [b] -> [c]
aux


{- |
Apply a function to the last element of a list.
If the list is empty, nothing changes.
-}
{-# INLINE mapLast #-}
mapLast :: (a -> a) -> [a] -> [a]
mapLast :: (a -> a) -> [a] -> [a]
mapLast a -> a
f =
   [a] -> (a -> [a] -> [a]) -> [a] -> [a]
forall b a. b -> (a -> [a] -> b) -> [a] -> b
switchL []
      (\a
x [a]
xs ->
         (a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((a, [a]) -> [a]) -> (a, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$
         (a -> (a -> (a, [a])) -> a -> (a, [a]))
-> (a -> (a, [a])) -> [a] -> a -> (a, [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x1 a -> (a, [a])
k a
x0 -> (a
x0, (a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) (a -> (a, [a])
k a
x1)))
            (\a
x0 -> (a -> a
f a
x0, [])) [a]
xs a
x)

mapLast' :: (a -> a) -> [a] -> [a]
mapLast' :: (a -> a) -> [a] -> [a]
mapLast' a -> a
f =
   let recourse :: [a] -> [a]
recourse [] = [] -- behaviour as needed in powerBasis
          -- otherwise: error "mapLast: empty list"
       recourse (a
x:[a]
xs) =
          (a -> [a] -> [a]) -> (a, [a]) -> [a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((a, [a]) -> [a]) -> (a, [a]) -> [a]
forall a b. (a -> b) -> a -> b
$
          if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
            then (a -> a
f a
x, [])
            else (a
x, [a] -> [a]
recourse [a]
xs)
   in  [a] -> [a]
recourse

mapLast'' :: (a -> a) -> [a] -> [a]
mapLast'' :: (a -> a) -> [a] -> [a]
mapLast'' a -> a
f =
   [a] -> ([a] -> a -> [a]) -> [a] -> [a]
forall b a. b -> ([a] -> a -> b) -> [a] -> b
switchR [] (\[a]
xs a
x -> [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a -> a
f a
x])