module System.Console.Ansigraph.Examples (
demo
, legend
, showColors
, waveDemoComplex
, waveDemoReal
, waveDemoPositive
, wave
, matDemoReal
, matDemoComplex
, unitary
) where
import System.Console.Ansigraph
import System.Console.ANSI
import Control.Monad (forM_)
import Data.Complex (Complex (..), cis, realPart)
import Control.Applicative
wave :: [Complex Double]
wave = cis . (*) (pi/20) <$> [0..79]
deltas :: [Double]
deltas = (*) (pi/10) <$> [0..80]
waves :: [[Complex Double]]
waves = zipWith (\z -> map (* z)) (cis <$> deltas) $ repeat wave
rwaves :: [[Double]]
rwaves = map (map realPart) waves
pwaves :: [PosGraph]
pwaves = PosGraph . map (+1) <$> rwaves
waveDemoPositive :: IO ()
waveDemoPositive = animate pwaves
waveDemoReal :: IO ()
waveDemoReal = animate rwaves
waveDemoComplex :: IO ()
waveDemoComplex = animate waves
vscale :: Num a => a -> [a] -> [a]
vscale x = map (* x)
mscale :: Num a => a -> [[a]] -> [[a]]
mscale x = map $ map (* x)
fromRealVs :: [Double] -> [Double] -> [Complex Double]
fromRealVs = zipWith (:+)
fromRealMs :: [[Double]] -> [[Double]] -> [[Complex Double]]
fromRealMs = zipWith fromRealVs
vox :: Num a => [a] -> [a] -> [a]
vox v w = concatMap (`vscale` w) v
mox :: Num a => [[a]] -> [[a]] -> [[a]]
mox m1 m2 = zipWith vox (stepOne m1 m2) (stepTwo m1 m2)
where stepOne, stepTwo :: [[a]] -> [[a]] -> [[a]]
stepOne x y = concatMap (replicate (length y)) x
stepTwo x y = concat $ replicate (length x) y
sx, sz, sI :: [[Double]]
sz = [[1,0],[0,1]]
sx = [[0,1],[1,0]]
sI = [[1,0],[0,1]]
sinSX, sinSZ :: Double -> [[Complex Double]]
sinSX t = fromRealMs (mscale (cos t) sI) (mscale (sin t) sx)
sinSZ t = fromRealMs (mscale (cos t) sI) (mscale (sin t) sz)
unitary :: Double -> [[Complex Double]]
unitary t = sinSZ t `mox` sinSX (2*t)
slowDeltas :: [Double]
slowDeltas = (*) (pi/50) <$> [0..100]
matDemoComplex :: IO ()
matDemoComplex = animate $ unitary <$> slowDeltas
ry :: Double -> [[Double]]
ry t = [[cos t, 0, sin t]
,[0, 1, 0]
,[(sin t),0,cos t]]
matDemoReal :: IO ()
matDemoReal = animate $ (\t -> ry t `mox` ry (2*t)) <$> slowDeltas
colors = [Black,Red,Green,Yellow,Blue,Magenta,Cyan,White]
intensities = [Dull,Vivid]
ansicolors :: [AnsiColor]
ansicolors = [ AnsiColor i c | c <- colors, i <- intensities ]
showColors = do
boldStrLn noColoring "Available colors"
newline
forM_ ansicolors $ \c -> do
let clr = Coloring Nothing (Just c)
colorStr clr $ replicate 20 ' '
putStrLn $ " " ++ show (intensity c) ++ " " ++ show (color c)
setSGR [Reset]
cb, bc :: Coloring
cb = mkColoring (AnsiColor Dull Black) (AnsiColor Vivid Cyan)
bc = invert cb
newline = putStrLn ""
verticalPad io = do
newline
io
newline
newline
legend = do
boldStrLn cb " Legend "
newline
boldStrLn noColoring "Horizontal Graphs"
newline
colorStr (fromBG blue) " "
putStrLn " Real component (positive and negative)"
newline
colorStr (fromBG pink) " "
putStrLn " Imag component (positive and negative)"
newline
boldStrLn noColoring "Matrix Graphs"
newline
putStr " "
colorStr (mkColoring white pink) "+i"
putStrLn " "
colorStr (mkColoring white red) "-r"
putStr " "
colorStrLn (mkColoring white blue) "+r"
putStr " "
colorStr (mkColoring white green) "-i"
putStrLn " "
demo = do
verticalPad $ boldStrLn cb " Ansigraph demo "
putStr "Positive function graph "
colorStrLn bc " cos (x - t) + 1 "
verticalPad waveDemoPositive
putStr "Real function graph "
colorStrLn bc " cos (x - t) "
verticalPad waveDemoReal
putStr "Complex function graph "
colorStrLn bc " exp (ix - it) "
verticalPad waveDemoComplex
putStr "Real matrix graph "
colorStrLn bc " rotate_Y(t) ⊗ rotate_Y(2t) "
verticalPad matDemoReal
putStr "Complex matrix graph "
colorStrLn bc " exp (it σz) ⊗ exp (2it σx) "
verticalPad matDemoComplex
verticalPad showColors
verticalPad legend