How to resolve the algorithm Voronoi diagram step by step in the Haskell programming language

Published on 7 June 2024 03:52 AM
#Haskell

How to resolve the algorithm Voronoi diagram step by step in the Haskell programming language

Table of Contents

Problem Statement

A Voronoi diagram is a diagram consisting of a number of sites. Each Voronoi site s also has a Voronoi cell consisting of all points closest to s.

Demonstrate how to generate and display a Voroni diagram.

See algo K-means++ clustering.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Voronoi diagram step by step in the Haskell programming language

The provided source code is a function that calculates a Voronoi diagram. Voronoi diagram is a way to divide a plane into regions based on distance to a given set of points.

The function takes two parameters: the number of centers of the Voronoi diagram and the number of cells in the diagram. It uses the centers function to generate the centers of the diagram, and then uses the minimize1D function to find the nearest center to each cell in the diagram.

The cellReducer function is used to reduce the number of centers that need to be considered for each cell by eliminating centers that are too far away.

The nearestCenterIndex function is used to find the index of the nearest center to a given cell.

The voronoi function uses the fromFunction function to generate the Voronoi diagram, and the colorize function is used to colorize the diagram.

The main function generates a Voronoi diagram and colorizes it, and then writes the resulting image to a BMP file.

Source code in the haskell programming language

-- Compile with: ghc -O2 -fllvm -fforce-recomp -threaded --make
{-# LANGUAGE BangPatterns #-}
module Main where

import System.Random

import Data.Word
import Data.Array.Repa as Repa
import Data.Array.Repa.IO.BMP

{-# INLINE sqDistance #-}    
sqDistance :: Word32 -> Word32 -> Word32 -> Word32 -> Word32
sqDistance !x1 !y1 !x2 !y2 = ((x1-x2)^2) + ((y1-y2)^2)

centers :: Int -> Int -> Array U DIM2 Word32
centers nCenters nCells =
    fromListUnboxed (Z :. nCenters :. 2) $ take (2*nCenters) $ randomRs (0, fromIntegral nCells) (mkStdGen 1)

applyReduce2 arr f = 
    traverse arr (\(i :. j) -> i) $ \lookup (Z:.i) ->
        f (lookup (Z:.i:.0)) (lookup (Z:.i:.1))

minimize1D arr = foldS f h t
  where
    indexed arr = traverse arr id (\src idx@(Z :. i) -> (src idx, (fromIntegral i)))        
    (Z :. n) = extent arr
    iarr = indexed arr
    h = iarr ! (Z :. 0)
    t = extract (Z :. 1) (Z :. (n-1)) iarr

    f min@(!valMin, !iMin ) x@(!val, !i) | val < valMin = x
                                         | otherwise = min

voronoi :: Int -> Int -> Array D DIM2 Word32
voronoi nCenters nCells =
    let
      {-# INLINE cellReducer #-}
      cellReducer = applyReduce2 (centers nCenters nCells)
      {-# INLINE nearestCenterIndex #-}
      nearestCenterIndex = snd . (Repa.! Z) . minimize1D
    in        
      Repa.fromFunction (Z :. nCells :. nCells :: DIM2) $ \ (Z:.i:.j) ->
          nearestCenterIndex $ cellReducer (sqDistance (fromIntegral i) (fromIntegral j))

genColorTable :: Int -> Array U DIM1 (Word8, Word8, Word8)
genColorTable n = fromListUnboxed (Z :. n) $ zip3 l1 l2 l3
    where
      randoms = randomRs (0,255) (mkStdGen 1)
      (l1, rest1) = splitAt n randoms
      (l2, rest2) = splitAt n rest1
      l3 = take n rest2

colorize :: Array U DIM1 (Word8, Word8, Word8) -> Array D DIM2 Word32 -> Array D DIM2 (Word8, Word8, Word8)
colorize ctable = Repa.map $ \x -> ctable Repa.! (Z:. fromIntegral x)

main = do
  let nsites = 150
  let ctable = genColorTable nsites 
  voro <- computeP $ colorize ctable (voronoi nsites 512) :: IO (Array U DIM2 (Word8, Word8, Word8))
  writeImageToBMP "out.bmp" voro

You may also check:How to resolve the algorithm Roots of unity step by step in the RLaB programming language
You may also check:How to resolve the algorithm Call a function in a shared library step by step in the R programming language
You may also check:How to resolve the algorithm String case step by step in the Stata programming language
You may also check:How to resolve the algorithm Execute a Markov algorithm step by step in the Raku programming language
You may also check:How to resolve the algorithm Repeat step by step in the Go programming language