Yellowstone sequence: Difference between revisions

Content added Content deleted
Line 666: Line 666:
and displaying a chart of the first 100 terms:
and displaying a chart of the first 100 terms:


<lang haskell>import qualified Graphics.SVGFonts.ReadFont as F
<lang haskell>import Codec.Picture
import Data.Bifunctor (second)
import Diagrams.Backend.Rasterific
import Diagrams.Prelude
import Graphics.Rendering.Chart.Backend.Diagrams
import Graphics.Rendering.Chart.Backend.Diagrams
import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Easy
import qualified Graphics.SVGFonts.ReadFont as F
import Diagrams.Backend.Rasterific
import Diagrams.Prelude
import Codec.Picture
import Data.Bifunctor (second)


----------------- YELLOWSTONE PERMUTATION ------------------
----------------- YELLOWSTONE PERMUTATION ----------------
yellowstone :: [Integer]
yellowstone :: [Integer]
yellowstone =
yellowstone = 1 : 2 : (active <$> iterate nextWindow (2, 3, [4 ..]))
1 :
2 :
(active <$> iterate nextWindow (2, 3, [4 ..]))
where
where
nextWindow (p2, p1, rest) = (p1, n, residue)
nextWindow (p2, p1, rest) = (p1, n, residue)
where
where
[rp2, rp1] = relativelyPrime <$> [p2, p1]
[rp2, rp1] = relativelyPrime <$> [p2, p1]
go (x:xs)
go (x : xs)
| rp1 x && not (rp2 x) = (x, xs)
| rp1 x && not (rp2 x) = (x, xs)
| otherwise = second ((:) x) (go xs)
| otherwise = second ((:) x) (go xs)
Line 690: Line 693:
relativelyPrime a b = 1 == gcd a b
relativelyPrime a b = 1 == gcd a b


---------- 30 FIRST TERMS, AND CHART OF FIRST 100 ----------
---------- 30 FIRST TERMS, AND CHART OF FIRST 100 --------
main :: IO (Image PixelRGBA8)
main :: IO (Image PixelRGBA8)
main = do
main = do
Line 697: Line 700:
return $
return $
chartRender env $
chartRender env $
plot
plot (line "Yellowstone terms" [zip [1 ..] (take 100 yellowstone)])
( line

"Yellowstone terms"
[zip [1 ..] (take 100 yellowstone)]
)


--------------------- CHART GENERATION ---------------------
--------------------- CHART GENERATION -------------------
chartRender
chartRender ::
:: (Default r, ToRenderable r)
(Default r, ToRenderable r) =>
=> DEnv Double -> EC r () -> Image PixelRGBA8
DEnv Double ->
EC r () ->
Image PixelRGBA8
chartRender env ec =
chartRender env ec =
renderDia
renderDia Rasterific (RasterificOptions (mkWidth (fst (envOutputSize env)))) $
Rasterific
fst $ runBackendR env (toRenderable (execEC ec))
( RasterificOptions
(mkWidth (fst (envOutputSize env)))
)
$ fst $ runBackendR env (toRenderable (execEC ec))


------------------------ LOCAL FONT ------------------------
------------------------ LOCAL FONT ----------------------
chartEnv :: IO (DEnv Double)
chartEnv :: IO (DEnv Double)
chartEnv = do
chartEnv = do
Line 714: Line 726:
sansRB <- F.loadFont "SourceSansPro_RB.svg"
sansRB <- F.loadFont "SourceSansPro_RB.svg"
let fontChosen fs =
let fontChosen fs =
case (_font_name fs, _font_slant fs, _font_weight fs) of
case ( _font_name fs,
_font_slant fs,
("sans-serif", FontSlantNormal, FontWeightNormal) -> sansR
_font_weight fs
("sans-serif", FontSlantNormal, FontWeightBold) -> sansRB
) of
( "sans-serif",
FontSlantNormal,
FontWeightNormal
) -> sansR
( "sans-serif",
FontSlantNormal,
FontWeightBold
) -> sansRB
return $ createEnv vectorAlignmentFns 640 400 fontChosen</lang>
return $ createEnv vectorAlignmentFns 640 400 fontChosen</lang>
{{Out}}
{{Out}}