How to resolve the algorithm Kronecker product based fractals step by step in the Haskell programming language

Published on 7 June 2024 03:52 AM
#Haskell

How to resolve the algorithm Kronecker product based fractals step by step in the Haskell programming language

Table of Contents

Problem Statement

This task is based on   Kronecker product   of two matrices. If your language has no a built-in function for such product then you need to implement it first. The essence of fractals is self-replication (at least, self-similar replications). So, using   n   times self-product of the matrix   (filled with 0/1)   we will have a fractal of the   nth   order. Actually, "self-product" is a Kronecker power of the matrix. In other words: for a matrix   M   and a power   n   create a function like   matkronpow(M, n), which returns   MxMxMx...   (n   times product). A formal recurrent algorithm of creating Kronecker power of a matrix is the following:

Even just looking at the resultant matrix you can see what will be plotted. There are virtually infinitely many fractals of this type. You are limited only by your creativity and the power of your computer.

Using Kronecker product implement and show two popular and well-known fractals, i.e.:

The last one ( Sierpinski carpet) is already here on RC, but built using different approaches.

These 2 fractals (each order/power 4 at least) should be built using the following 2 simple matrices:

See implementations and results below in JavaScript, PARI/GP and R languages. They have additional samples of "H", "+" and checkerboard fractals.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Kronecker product based fractals step by step in the Haskell programming language

Haskell Source Code Explained

Language: Haskell

Purpose: Generate and display Kroneker product-based fractals, including Vicsek and Sierpinski Carpet fractals.

Main Function:

  • main is the entry point of the program.
  • It initializes the main widget and renders the UI.

Widgets and Elements:

  • elAttr attributes an element with CSS styles.
  • text displays text.
  • el creates an element without attributes.
  • elSvgns creates an SVG element.

Fractal Generation:

  • A fractal is generated using iterate, which repeatedly applies a function (in this case, kronekerProduct) to an initial seed matrix.
  • kronekerProduct calculates the Kroneker product of two matrices.
  • The shown variable displays the fourth fractal in the sequence (starting from 0).

Matrix Display:

  • showMatrix converts a matrix into a list of rows and displays them.
  • showRow displays a single row of integers as a horizontal line of boxes.
  • showCell displays an individual box with a circle if the corresponding matrix element is 1.

Additional Notes:

  • OverloadedStrings language extension is used for concise string literals.
  • Data.Map, Data.Text, and Data.Char are imported for working with maps, text, and characters.
  • constDyn is used to create a constant dynamic value.
  • SVG attributes are wrapped in fromList to avoid unnecessary string concatenation.
  • The cellSize constant controls the size of individual cells in the fractal.
  • Seed matrices for the Vicsek and Sierpinski Carpet fractals are provided.

Output:

The program displays two fractals:

  • Vicsek Fractal: A pattern of squares with smaller squares inside.
  • Sierpinski Carpet Fractal: A pattern of squares with progressively smaller squares forming a self-similar pattern.

Source code in the haskell programming language

{-# LANGUAGE OverloadedStrings #-}
import Reflex
import Reflex.Dom
import Data.Map as DM (Map, fromList)
import Data.Text (Text, pack)
import Data.List (transpose)

-- Show Vicsek and Sierpinski Carpet fractals
main :: IO ()
main = mainWidget $ do 
  elAttr "h1" ("style" =: "color:black") $ text "Kroneker Product Based Fractals" 
  elAttr "a" ("href" =: "http://rosettacode.org/wiki/Kronecker_product_based_fractals#Haskell") $ text "Rosetta Code / Kroneker product based fractals / Haskell"

  -- Show a Vicsek fractal
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Vicsek Fractal" 
  showFractal [[0, 1, 0] ,[1, 1, 1] ,[0, 1, 0] ]

  -- Show a Sierpinski Carpet fractal
  el "br" $ return ()
  elAttr "h2" ("style" =: "color:brown") $ text "Sierpinski Carpet Fractal" 
  showFractal [[1, 1, 1] ,[1, 0, 1] ,[1, 1, 1] ]

-- Size in pixels of an individual cell
cellSize :: Int
cellSize = 8

-- Given a "seed" matrix, generate and display a fractal.
showFractal :: MonadWidget t m => [[Int]] -> m ()
showFractal seed = do
  let boardAttrs w h = 
         fromList [ ("width" , pack $ show $ w * cellSize)
                  , ("height", pack $ show $ h * cellSize)
                  ]
      fractals = iterate (kronekerProduct seed) seed
      shown = fractals !! 3 -- the fourth fractal (starting from 0)
      w = length $ head shown
      h = length shown
  elSvgns "svg" (constDyn $ boardAttrs w h) $ showMatrix shown

-- Compute the Kroneker product of two matrices.
kronekerProduct :: Num a => [[a]] -> [[a]] -> [[a]]
kronekerProduct xs ys = 
    let m0 = flip $ fmap.fmap.(*)
        m1 = flip $ fmap.fmap.m0
    in concat $ fmap (fmap concat.transpose) $ m1 xs ys

-- Show an entire matrix
showMatrix :: MonadWidget t m => [[Int]] -> m ()
showMatrix m = mapM_ showRow $ zip [0..] m 

-- Show a single horizontal row of a matrix
showRow :: MonadWidget t m => (Int,[Int]) -> m ()
showRow (x,r) = mapM_ (showCell x) $ zip [0..] r 

-- Show a circle in a box moved to the correct location on screen
showCell :: MonadWidget t m => Int -> (Int,Int) -> m ()
showCell x (y,on) = 
  let boxAttrs (x,y) = -- Place box on screen
        fromList [ ("transform", 
                    pack $    "scale (" ++ show cellSize ++ ", " ++ show cellSize ++ ") " 
                           ++ "translate (" ++ show x ++ ", " ++ show y ++ ")" 
                   )
                 ] 

      cellAttrs = -- Draw circle in box.
        fromList [ ( "cx",      "0.5")
                 , ( "cy",      "0.5")
                 , ( "r",       "0.45")
                 , ( "style",   "fill:green")
                 ] 

  in if (on==1) then  -- Only draw circle for elements containing 1
       elSvgns "g"  (constDyn $ boxAttrs (x,y)) $ 
         elSvgns "circle" (constDyn $ cellAttrs) $ 
           return ()
     else
       return ()

-- Wrapper around elDynAttrNS'
elSvgns :: MonadWidget t m => Text -> Dynamic t (Map Text Text) -> m a -> m a
elSvgns t m ma = do
    (el, val) <- elDynAttrNS' (Just "http://www.w3.org/2000/svg") t m ma
    return val

You may also check:How to resolve the algorithm Morse code step by step in the Ursa programming language
You may also check:How to resolve the algorithm String append step by step in the SNOBOL4 programming language
You may also check:How to resolve the algorithm Happy numbers step by step in the ACL2 programming language
You may also check:How to resolve the algorithm Longest common subsequence step by step in the Scala programming language
You may also check:How to resolve the algorithm Remove lines from a file step by step in the C programming language