Bonus task - Console Function Plotter

[ichko]

Напишете Console Function Plotter на хаскел

(не е задължително вашето решение да изглежда точно както примера).

Може да използвате следната ф-я за да анимирате function plotter-a си.

loop render = animationFrame 0
  where
    w = 80
    h = 40
    animationFrame t = do
      putStr $ clear (round w + 1) (round h + 1)
      putStr $ "T:" ++ show (round t) ++ render w h t
      animationFrame (t + 1)

    clear w h = "\ESC[" ++ show h ++ "A\ESC[" ++ show w ++ "D"

трябва само да подадете ф-я render, която да приема размера на екрана и t - време и трябва да върне стринг репрезентиращ изрендения фрейм.

Следният код е използван за плотването на ф-ята от гифчето:

scale = 2
lineWidth = 3
f x = x * sin (x / 4 + t / 4) * 0.5 * cos (0.5 * x + t / 3) + sin (t / 5)

Използвайте набора от символи от първата бонус задачка - ░▒▓█

Ресурси

• Desmos
• C++ Console Function Plotte
• Command-line Unix ASCII-based charting / plotting tool

---

Публикувайте решенията като коментари в това issue директно или като линкове към репо/gist. Заградете кода на решението си по следния начин за да се highlight-не правилно кода ако публикувате тук:

```hs
-- solution
```

Всеки валидно решение ще получи бонус точка :star2:. Дерзайте!

[ichko]

Коментирайте взаимно решенията си. Ако получите реакция :heart: от мен или Свилен => получавате бонус точката. Може да добавяте и screenshot-и с резултата на решението си.

[dimitroffangel]

import System.Process 
import Control.DeepSeq (deepseq)
import Control.Concurrent (threadDelay)

-- variables to manipulate output
defaultColourMap = "░▒▓█"

stepBetweenPoints = 0.05

widthFrom = -1

widthTo = 1

heightFrom = -1.5
heightTo = 1.5

shadePixelEpsilon = 0.01

defaultBordersLimits = [firstBorderColour, secondBorderColour, thirdBorderColour]
firstBorderColour = shadePixelEpsilon * shadePixelEpsilon
secondBorderColour = shadePixelEpsilon
thirdBorderColour = 2 * shadePixelEpsilon 
----- 

shadeGrid f step colourMap borderLimits = 
    let grid =
            [ 
                [ 
                    shadePixel (x,y) f colourMap borderLimits | x <- [widthFrom, widthFrom + step .. widthTo]
                ] 
                | y <- [heightFrom, heightFrom + step .. heightTo]
            ]
    in grid

shadePixel (xPixel, yPixel) f colourMap borderLimits = 
    shadePixelHelper distanceFromPixelAndFunction colourMap borderLimits
        where 
            functionResultFromX = f xPixel
            distanceFromPixelAndFunction = (yPixel - functionResultFromX) * (yPixel - functionResultFromX)
            shadePixelHelper _ colourMap [] = last colourMap
            shadePixelHelper distanceFromPixelAndFunction 
                (currentColourMap: restOfColoursMap) (currentBorderLimit : restOfBordersLimit)
                    | distanceFromPixelAndFunction < currentBorderLimit = currentColourMap
                    | otherwise = shadePixelHelper distanceFromPixelAndFunction restOfColoursMap restOfBordersLimit

render canvas = 
    let newLineCanvas = [concat [[p,p] | p <- row] ++ "\n" | row <- canvas]
        in concat newLineCanvas

simpleFunc t x = sin (x / 4 + t / 4) * 0.5 * cos (0.5 * x + t / 3) + sin(t/5)

printRenderer t = 
    let 
        canvas = render $ shadeGrid (simpleFunc t) stepBetweenPoints defaultColourMap defaultBordersLimits
    in canvas `deepseq` putStrLn canvas

clear = system "cls"

loop t = do
    clear
    printRenderer t
    threadDelay 5  
    loop $ t + 1

main = loop 0

[googleson78]

@dimitroffangel Вместо да ползваш head и (!!), които могат да гръмнат (примерно идва колега утре и трие последния елемент на списъка с пикселите щото от UX екипа са казали че не ги кефи), направи си ги на top-level декларации или на наредена четворка (примерно). И двете имат и бонуса че (първото с -Wall, -Werror) ако добавиш нов цвят не може да забравиш да го ползваш, защото ще спре да се компилира.

[dimitroffangel]

@dimitroffangel Вместо да ползваш head и (!!), които могат да гръмнат (примерно идва колега утре и трие последния елемент на списъка с пикселите щото от UX екипа са казали че не ги кефи), направи си ги на top-level декларации или на наредена четворка (примерно). И двете имат и бонуса че (първото с -Wall, -Werror) ако добавиш нов цвят не може да забравиш да го ползваш, защото ще спре да се компилира.

мерси за забележката

[ichko]

@dimitroffangel

• system "cls" работи само под windows :Д
• Когато изтриваш и пререндерираш екрана се получават прескачания, ако използваш clear w h = "\ESC[" ++ show h ++ "A\ESC[" ++ show w ++ "D" прескачания не се виждаш, защото започваш новото изрисуване на екрана върху старото.

Може да пробваш кода с който е генерирано горното гифче. Благодаря че събмитна :relieved:

[ichko]

Кода, с който е генерирано гифчето:

getFuncValues :: (Enum a, Fractional a) => (a -> b) -> (a, a) -> a -> [(a, b)]
getFuncValues f (xMin, xMax) steps =
  map (\x -> (x, f x)) [xMin, xMin + dx .. xMax]
  where
    dx = (xMax - xMin) / steps

getGrid :: (Enum b, Fractional b) => (b, b) -> (b, b) -> b -> [[(b, b)]]
getGrid (xMin, xMax) (yMin, yMax) resolutionX =
  [[(x, y) | x <- [xMin, xMin + dx .. xMax]] | y <- [yMin, yMin + dx .. yMax]]
  where
    dx = (xMax - xMin) / resolutionX

getCenteredGrid :: (Enum a, Fractional a) => a -> a -> a -> [[(a, a)]]
getCenteredGrid w h = getGrid (- w / 2, w / 2) (- h / 2, h / 2)

mapGrid :: (a -> b) -> [[a]] -> [[b]]
mapGrid f = map (map f)

distance :: Floating a => (a, a) -> (a, a) -> a
distance (x1, y1) (x2, y2) = sqrt (dx ^ 2 + dy ^ 2)
  where
    dx = x1 - x2
    dy = y1 - y2

closeToFuncValue :: Floating t => (t -> t) -> (t, t) -> t
closeToFuncValue f (x, y) = distance (x, y) (x, f x)

showRealGrid :: RealFrac a => [[a]] -> [Char] -> [Char]
showRealGrid grid cmap = stringGrid
  where
    -- h = length grid
    w = length (head grid)
    shadePixel p =
      let cml = fromIntegral $ length cmap
          s = floor (p * (cml - 0.0001))
       in cmap !! s

    normalizedGrid =
      let max = maximum $ map maximum grid
          min = minimum $ map minimum grid
       in [[(p - min) / (max - min) | p <- row] | row <- grid]

    stringRow row = concatMap (replicate 2 . shadePixel) row ++ "\n"
    stringGrid = concatMap stringRow normalizedGrid

ditheredCmap :: [Char]
ditheredCmap = reverse " ░▒▓█"

shader :: (Enum a, Floating a, RealFrac a) => a -> a -> a -> [Char]
shader w h t = renderedGrid
  where
    scale = sin (t / 10) * 0.5 + 2
    lineWidth = sin t * 0.5 + 3
    f x = x * sin (x / 4 + t / 4) * 0.5 * cos (0.5 * x + t / 3) + sin (t / 5)

    scaledFunc x = - f (x / scale) * scale
    uv = getCenteredGrid w h w
    distField = mapGrid (min lineWidth . closeToFuncValue scaledFunc) uv
    renderedGrid = showRealGrid distField ditheredCmap

loop :: (RealFrac p2, RealFrac p1, RealFrac t) => (p2 -> p1 -> t -> [Char]) -> IO b
loop render = animationFrame 0
  where
    w = 80
    h = 40
    animationFrame t = do
      putStr $ clear (round w + 1) (round h + 1)
      putStr $ "T:" ++ show (round t) ++ render w h t
      animationFrame (t + 1)

    clear w h = "\ESC[" ++ show h ++ "A\ESC[" ++ show w ++ "D"

main :: IO ()
main = loop shader