-----------------------------------------------------------------------------
-- |
-- Module      :  Polynomial.Chebyshev
-- Copyright   :  (c) Matthew Donadio 2003
-- License     :  GPL
--
-- Maintainer  :  m.p.donadio@ieee.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Simple module for generating Chebyshev polynomials
--
-- @T_0(x) = 1@
--
-- @T_1(x) = x@
--
-- @T_N+1(x) = 2x T_N(x) - T_N-1(x)@
--
-----------------------------------------------------------------------------

module Polynomial.Chebyshev (cheby) where

import Polynomial.Basic

-- | generates Chebyshev polynomials

{-# specialize cheby :: Int -> [Int]    #-}
{-# specialize cheby :: Int -> [Double] #-}

cheby :: (Integral a, Num b) => a -- ^ N
      -> [b] -- ^ T_N(x)

-- the cases for n=2.. aren't needed for the recursion, but I added
-- them anyway

cheby :: forall a b. (Integral a, Num b) => a -> [b]
cheby a
0 = [ b
1 ]
cheby a
1 = [ b
0, b
1 ]
cheby a
2 = [ -b
1, b
0, b
2 ]
cheby a
3 = [ b
0, -b
3, b
0, b
4 ]
cheby a
4 = [ b
1, b
0, -b
8, b
0, b
8 ]
cheby a
5 = [ b
0, b
5, b
0, -b
20, b
0, b
16]
cheby a
6 = [ -b
1, b
0, b
18, b
0, -b
48, b
0, b
32 ]
cheby a
n = forall a. Num a => [a] -> [a] -> [a]
polysub (forall a. Num a => [a] -> [a] -> [a]
polymult [ b
0, b
2 ] (forall a b. (Integral a, Num b) => a -> [b]
cheby (a
nforall a. Num a => a -> a -> a
-a
1))) (forall a b. (Integral a, Num b) => a -> [b]
cheby (a
nforall a. Num a => a -> a -> a
-a
2))