{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Segment.Bernstein
-- Copyright   :  (c) 2014-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Bernstein polynomials, used internally by code to find
-- intersections of paths.  This module is probably not of any
-- relevance to most users of diagrams.
-----------------------------------------------------------------------------
module Diagrams.TwoD.Segment.Bernstein
  ( BernsteinPoly (..)
  , listToBernstein
  , evaluateBernstein

  , degreeElevate
  , bernsteinDeriv
  , evaluateBernsteinDerivs
  ) where

import           Data.List           (tails)
import           Diagrams.Core.V
import           Diagrams.Parametric
import           Linear.V1

-- | Compute the binomial coefficients of degree n.
binomials :: Num n => Int -> [n]
binomials :: forall n. Num n => Int -> [n]
binomials Int
n = (Int -> n) -> [Int] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [n]) -> [Int] -> [n]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
x Int
m -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
m) Int
1 [Int
1..Int
n]

data BernsteinPoly n = BernsteinPoly
  { forall n. BernsteinPoly n -> Int
bernsteinDegree :: Int
  , forall n. BernsteinPoly n -> [n]
bernsteinCoeffs :: [n]
  } deriving (Int -> BernsteinPoly n -> ShowS
[BernsteinPoly n] -> ShowS
BernsteinPoly n -> String
(Int -> BernsteinPoly n -> ShowS)
-> (BernsteinPoly n -> String)
-> ([BernsteinPoly n] -> ShowS)
-> Show (BernsteinPoly n)
forall n. Show n => Int -> BernsteinPoly n -> ShowS
forall n. Show n => [BernsteinPoly n] -> ShowS
forall n. Show n => BernsteinPoly n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall n. Show n => Int -> BernsteinPoly n -> ShowS
showsPrec :: Int -> BernsteinPoly n -> ShowS
$cshow :: forall n. Show n => BernsteinPoly n -> String
show :: BernsteinPoly n -> String
$cshowList :: forall n. Show n => [BernsteinPoly n] -> ShowS
showList :: [BernsteinPoly n] -> ShowS
Show, (forall a b. (a -> b) -> BernsteinPoly a -> BernsteinPoly b)
-> (forall a b. a -> BernsteinPoly b -> BernsteinPoly a)
-> Functor BernsteinPoly
forall a b. a -> BernsteinPoly b -> BernsteinPoly a
forall a b. (a -> b) -> BernsteinPoly a -> BernsteinPoly b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> BernsteinPoly a -> BernsteinPoly b
fmap :: forall a b. (a -> b) -> BernsteinPoly a -> BernsteinPoly b
$c<$ :: forall a b. a -> BernsteinPoly b -> BernsteinPoly a
<$ :: forall a b. a -> BernsteinPoly b -> BernsteinPoly a
Functor)

type instance V        (BernsteinPoly n) = V1
type instance N        (BernsteinPoly n) = n
type instance Codomain (BernsteinPoly n) = V1

-- | Create a bernstein polynomial from a list of coëfficients.
listToBernstein :: Fractional n => [n] -> BernsteinPoly n
listToBernstein :: forall n. Fractional n => [n] -> BernsteinPoly n
listToBernstein [] = BernsteinPoly n
0
listToBernstein [n]
l  = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly ([n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [n]
l

-- | Degree elevate a bernstein polynomial a number of times.
degreeElevate :: Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate :: forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate BernsteinPoly n
b                    Int
0     = BernsteinPoly n
b
degreeElevate (BernsteinPoly Int
lp [n]
p) Int
times =
  BernsteinPoly n -> Int -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate (Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly (Int
lpInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([n] -> n
forall a. HasCallStack => [a] -> a
head [n]
pn -> [n] -> [n]
forall a. a -> [a] -> [a]
:[n] -> n -> [n]
inner [n]
p n
1)) (Int
timesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  where
    n :: n
n = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lp

    inner :: [n] -> n -> [n]
inner []         n
_ = [n
0]
    inner [n
a]        n
_ = [n
a]
    inner (n
a:n
b:[n]
rest) n
i = (n
in -> n -> n
forall a. Num a => a -> a -> a
*n
an -> n -> n
forall a. Fractional a => a -> a -> a
/(n
nn -> n -> n
forall a. Num a => a -> a -> a
+n
1) n -> n -> n
forall a. Num a => a -> a -> a
+ n
bn -> n -> n
forall a. Num a => a -> a -> a
*(n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
in -> n -> n
forall a. Fractional a => a -> a -> a
/(n
nn -> n -> n
forall a. Num a => a -> a -> a
+n
1))) n -> [n] -> [n]
forall a. a -> [a] -> [a]
: [n] -> n -> [n]
inner (n
bn -> [n] -> [n]
forall a. a -> [a] -> [a]
:[n]
rest) (n
in -> n -> n
forall a. Num a => a -> a -> a
+n
1)

-- | Evaluate the bernstein polynomial.
evaluateBernstein :: Fractional n => BernsteinPoly n -> n -> n
evaluateBernstein :: forall n. Fractional n => BernsteinPoly n -> n -> n
evaluateBernstein (BernsteinPoly Int
_ [])       n
_ = n
0
evaluateBernstein (BernsteinPoly Int
_ [n
b])      n
_ = n
b
evaluateBernstein (BernsteinPoly Int
lp (n
b':[n]
bs)) n
t = n -> n -> n -> n -> [n] -> n
go n
t n
n (n
b'n -> n -> n
forall a. Num a => a -> a -> a
*n
u) n
2 [n]
bs
  where
    u :: n
u = n
1n -> n -> n
forall a. Num a => a -> a -> a
-n
t
    n :: n
n = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lp

    go :: n -> n -> n -> n -> [n] -> n
go n
tn n
bc n
tmp n
_ [n
b]      = n
tmp n -> n -> n
forall a. Num a => a -> a -> a
+ n
tnn -> n -> n
forall a. Num a => a -> a -> a
*n
bcn -> n -> n
forall a. Num a => a -> a -> a
*n
b
    go n
tn n
bc n
tmp n
i (n
b:[n]
rest) =
      n -> n -> n -> n -> [n] -> n
go (n
tnn -> n -> n
forall a. Num a => a -> a -> a
*n
t)              -- tn
         (n
bcn -> n -> n
forall a. Num a => a -> a -> a
*(n
n n -> n -> n
forall a. Num a => a -> a -> a
- n
in -> n -> n
forall a. Num a => a -> a -> a
+n
1)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
i)    -- bc
         ((n
tmp n -> n -> n
forall a. Num a => a -> a -> a
+ n
tnn -> n -> n
forall a. Num a => a -> a -> a
*n
bcn -> n -> n
forall a. Num a => a -> a -> a
*n
b)n -> n -> n
forall a. Num a => a -> a -> a
*n
u) -- tmp
         (n
in -> n -> n
forall a. Num a => a -> a -> a
+n
1)               -- i
         [n]
rest
    go n
_ n
_ n
_ n
_ []           = String -> n
forall a. HasCallStack => String -> a
error String
"evaluateBernstein: impossible"

-- | Evaluate the bernstein polynomial and its derivatives.
evaluateBernsteinDerivs :: Fractional n => BernsteinPoly n -> n -> [n]
evaluateBernsteinDerivs :: forall n. Fractional n => BernsteinPoly n -> n -> [n]
evaluateBernsteinDerivs BernsteinPoly n
b n
t
  | BernsteinPoly n -> Int
forall n. BernsteinPoly n -> Int
bernsteinDegree BernsteinPoly n
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [BernsteinPoly n -> n -> n
forall n. Fractional n => BernsteinPoly n -> n -> n
evaluateBernstein BernsteinPoly n
b n
t]
  | Bool
otherwise              = BernsteinPoly n -> n -> n
forall n. Fractional n => BernsteinPoly n -> n -> n
evaluateBernstein BernsteinPoly n
b n
t n -> [n] -> [n]
forall a. a -> [a] -> [a]
: BernsteinPoly n -> n -> [n]
forall n. Fractional n => BernsteinPoly n -> n -> [n]
evaluateBernsteinDerivs (BernsteinPoly n -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> BernsteinPoly n
bernsteinDeriv BernsteinPoly n
b) n
t

-- | Find the derivative of a bernstein polynomial.
bernsteinDeriv :: Fractional n => BernsteinPoly n -> BernsteinPoly n
bernsteinDeriv :: forall n. Fractional n => BernsteinPoly n -> BernsteinPoly n
bernsteinDeriv (BernsteinPoly Int
0 [n]
_)  = BernsteinPoly n
0
bernsteinDeriv (BernsteinPoly Int
lp [n]
p) =
  -- BernsteinPoly (lp-1) $ map (* fromIntegral lp) $ zipWith (-) (tail p) p
  Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly (Int
lpInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\n
a n
b -> (n
a n -> n -> n
forall a. Num a => a -> a -> a
- n
b) n -> n -> n
forall a. Num a => a -> a -> a
* Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lp) ([n] -> [n]
forall a. HasCallStack => [a] -> [a]
tail [n]
p) [n]
p

instance Fractional n => Parametric (BernsteinPoly n) where
  atParam :: BernsteinPoly n
-> N (BernsteinPoly n)
-> Codomain (BernsteinPoly n) (N (BernsteinPoly n))
atParam BernsteinPoly n
b = n -> V1 n
forall a. a -> V1 a
V1 (n -> V1 n) -> (n -> n) -> n -> V1 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BernsteinPoly n -> n -> n
forall n. Fractional n => BernsteinPoly n -> n -> n
evaluateBernstein BernsteinPoly n
b
instance Num n        => DomainBounds (BernsteinPoly n)
instance Fractional n => EndValues    (BernsteinPoly n)
instance Fractional n => Sectionable  (BernsteinPoly n) where
  splitAtParam :: BernsteinPoly n
-> N (BernsteinPoly n) -> (BernsteinPoly n, BernsteinPoly n)
splitAtParam  = BernsteinPoly n -> n -> (BernsteinPoly n, BernsteinPoly n)
BernsteinPoly n
-> N (BernsteinPoly n) -> (BernsteinPoly n, BernsteinPoly n)
forall n.
Num n =>
BernsteinPoly n -> n -> (BernsteinPoly n, BernsteinPoly n)
bernsteinSplit
  reverseDomain :: BernsteinPoly n -> BernsteinPoly n
reverseDomain (BernsteinPoly Int
i [n]
xs) = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
i ([n] -> [n]
forall a. [a] -> [a]
reverse [n]
xs)

-- | Split a bernstein polynomial.
bernsteinSplit :: Num n => BernsteinPoly n -> n -> (BernsteinPoly n, BernsteinPoly n)
bernsteinSplit :: forall n.
Num n =>
BernsteinPoly n -> n -> (BernsteinPoly n, BernsteinPoly n)
bernsteinSplit (BernsteinPoly Int
lp [n]
p) n
t =
  (Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
lp ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
forall a. HasCallStack => [a] -> a
head [[n]]
controls,
   Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
lp ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ [n] -> [n]
forall a. [a] -> [a]
reverse ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
forall a. HasCallStack => [a] -> a
last [[n]]
controls)
  where
    interp :: n -> n -> n
interp n
a n
b = (n
1n -> n -> n
forall a. Num a => a -> a -> a
-n
t)n -> n -> n
forall a. Num a => a -> a -> a
*n
a n -> n -> n
forall a. Num a => a -> a -> a
+ n
tn -> n -> n
forall a. Num a => a -> a -> a
*n
b

    terp :: [n] -> [[n]]
terp [n
_] = []
    terp [n]
l   = let ctrs :: [n]
ctrs = (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
interp [n]
l ([n] -> [n]
forall a. HasCallStack => [a] -> [a]
tail [n]
l)
               in  [n]
ctrs [n] -> [[n]] -> [[n]]
forall a. a -> [a] -> [a]
: [n] -> [[n]]
terp [n]
ctrs
    controls :: [[n]]
controls = [n]
p [n] -> [[n]] -> [[n]]
forall a. a -> [a] -> [a]
: [n] -> [[n]]
terp [n]
p

instance Fractional n => Num (BernsteinPoly n) where
  ba :: BernsteinPoly n
ba@(BernsteinPoly Int
la [n]
a) + :: BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
+ bb :: BernsteinPoly n
bb@(BernsteinPoly Int
lb [n]
b)
    | Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb   = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
lb ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) (BernsteinPoly n -> [n]
forall n. BernsteinPoly n -> [n]
bernsteinCoeffs (BernsteinPoly n -> [n]) -> BernsteinPoly n -> [n]
forall a b. (a -> b) -> a -> b
$ BernsteinPoly n -> Int -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate BernsteinPoly n
ba (Int -> BernsteinPoly n) -> Int -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ Int
lb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
la) [n]
b
    | Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lb   = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
la ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) [n]
a (BernsteinPoly n -> [n]
forall n. BernsteinPoly n -> [n]
bernsteinCoeffs (BernsteinPoly n -> [n]) -> BernsteinPoly n -> [n]
forall a b. (a -> b) -> a -> b
$ BernsteinPoly n -> Int -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate BernsteinPoly n
bb (Int -> BernsteinPoly n) -> Int -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ Int
la Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lb)
    | Bool
otherwise = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
la ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) [n]
a [n]
b

  ba :: BernsteinPoly n
ba@(BernsteinPoly Int
la [n]
a) - :: BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
- bb :: BernsteinPoly n
bb@(BernsteinPoly Int
lb [n]
b)
    | Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lb   = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
lb ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (BernsteinPoly n -> [n]
forall n. BernsteinPoly n -> [n]
bernsteinCoeffs (BernsteinPoly n -> [n]) -> BernsteinPoly n -> [n]
forall a b. (a -> b) -> a -> b
$ BernsteinPoly n -> Int -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate BernsteinPoly n
ba (Int
lb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
la)) [n]
b
    | Int
la Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lb   = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
la ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [n]
a (BernsteinPoly n -> [n]
forall n. BernsteinPoly n -> [n]
bernsteinCoeffs (BernsteinPoly n -> [n]) -> BernsteinPoly n -> [n]
forall a b. (a -> b) -> a -> b
$ BernsteinPoly n -> Int -> BernsteinPoly n
forall n. Fractional n => BernsteinPoly n -> Int -> BernsteinPoly n
degreeElevate BernsteinPoly n
bb (Int
la Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lb))
    | Bool
otherwise = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
la ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [n]
a [n]
b

  (BernsteinPoly Int
la [n]
a) * :: BernsteinPoly n -> BernsteinPoly n -> BernsteinPoly n
* (BernsteinPoly Int
lb [n]
b) =
    Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly (Int
laInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lb) ([n] -> BernsteinPoly n) -> [n] -> BernsteinPoly n
forall a b. (a -> b) -> a -> b
$
    (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((n -> n -> n) -> n -> n -> n
forall a b c. (a -> b -> c) -> b -> a -> c
flip n -> n -> n
forall a. Fractional a => a -> a -> a
(/)) (Int -> [n]
forall n. Num n => Int -> [n]
binomials (Int
la Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lb)) ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$
                   [n] -> [n]
forall a. HasCallStack => [a] -> [a]
init ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$
                   ([n] -> [n]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*) [n]
a') ([n] -> [[n]]
forall {a}. [a] -> [[a]]
down [n]
b') [[n]] -> [[n]] -> [[n]]
forall a. [a] -> [a] -> [a]
++
                   ([n] -> [n]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*) ([n] -> [n]
forall a. [a] -> [a]
reverse [n]
b')) ([[n]] -> [[n]]
forall a. HasCallStack => [a] -> [a]
tail ([[n]] -> [[n]]) -> [[n]] -> [[n]]
forall a b. (a -> b) -> a -> b
$ [n] -> [[n]]
forall {a}. [a] -> [[a]]
tails [n]
a')
                   -- zipWith (zipWith (*)) (tail $ tails a') (repeat $ reverse b')
    where down :: [a] -> [[a]]
down [a]
l = [[a]] -> [[a]]
forall a. HasCallStack => [a] -> [a]
tail ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> a -> [a]) -> [a] -> [a] -> [[a]]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [a]
l -- [[1], [2, 1], [3, 2, 1], ...
          a' :: [n]
a' = (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*) [n]
a (Int -> [n]
forall n. Num n => Int -> [n]
binomials Int
la)
          b' :: [n]
b' = (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*) [n]
b (Int -> [n]
forall n. Num n => Int -> [n]
binomials Int
lb)

  fromInteger :: Integer -> BernsteinPoly n
fromInteger Integer
a = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
0 [Integer -> n
forall a. Num a => Integer -> a
fromInteger Integer
a]

  signum :: BernsteinPoly n -> BernsteinPoly n
signum (BernsteinPoly Int
_ [])    = BernsteinPoly n
0
  signum (BernsteinPoly Int
_ (n
a:[n]
_)) = Int -> [n] -> BernsteinPoly n
forall n. Int -> [n] -> BernsteinPoly n
BernsteinPoly Int
0 [n -> n
forall a. Num a => a -> a
signum n
a]

  abs :: BernsteinPoly n -> BernsteinPoly n
abs = (n -> n) -> BernsteinPoly n -> BernsteinPoly n
forall a b. (a -> b) -> BernsteinPoly a -> BernsteinPoly b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n -> n
forall a. Num a => a -> a
abs