[#14] Visualization tool

app/Main.hs

@@ -0,0 +1,79 @@
+module Main (main) where
+
+import ApplyMerge.MergeAll (applyMerge)
+
+import Data.List.Ordered (minus)
+import Data.Text qualified as Text
+import Data.Ix (range)
+import Data.Vector.Unboxed qualified as Vector
+import Data.Array qualified as Array
+import Data.Array (Array, (!))
+
+import Data.List (intersperse)
+import Data.Function ((&))
+import Data.Semigroup (Arg (..))
+import Data.Text (Text)
+
+primes :: [Int]
+primes = 2 : 3 : 5 : ([7..] `minus` composites)
+
+composites :: [Int]
+composites = applyMerge (\i p -> p * (p + i)) [0..] primes
+
+visualize'
+  :: forall c. (Num c, Ord c) => (Int -> Int -> c) -> [Int] -> [Int] -> Int -> Double -> String
+visualize' f xs ys n r =
+  let f' :: (Int, Int) -> (Int, Int) -> Arg c (Int, Int)
+      f' (x, a) (y, b) = Arg (f a b) (x, y)
+
+      firstHalf :: [(Int, Int)]
+      secondHalf :: [(Int, Int)]
+      (firstHalf, secondHalf) =
+        applyMerge f' (zip [1..n] xs) (zip [1..n] ys)
+        & map (\(Arg _ y) -> y)
+        & (\xs -> splitAt (scale (length xs) r) xs)
+      arr :: Array (Int, Int) Char
+      arr = Array.array ((1, 1), (n, n)) $
+        map (, ' ') (range ((1, 1), (n, n)))
+        ++ map (, '.') firstHalf
+        ++ map (, '*') secondHalf
+      mkRow :: Int -> [Char]
+      mkRow row =
+        map (\col -> arr ! (row, col)) [1..n]
+        & intersperse ' '
+
+   in unlines (map mkRow [1..n])
+
+visualize
+  :: forall c. (Num c, Ord c) => (Int -> Int -> c) -> Int -> Double -> String
+visualize f n r =
+  let f' :: Int -> Int -> Arg c (Int, Int)
+      f' a b = Arg (f a b) (a, b)
+
+      firstHalf :: [(Int, Int)]
+      secondHalf :: [(Int, Int)]
+      (firstHalf, secondHalf) =
+        applyMerge f' [1..n] [1..n]
+        & map (\(Arg _ y) -> y)
+        & (\xs -> splitAt (scale (length xs) r) xs)
+      arr :: Array (Int, Int) Char
+      arr = Array.array ((1, 1), (n, n)) $
+        map (, ' ') (range ((1, 1), (n, n)))
+        ++ map (, '.') firstHalf
+        ++ map (, '*') secondHalf
+      mkRow :: Int -> [Char]
+      mkRow row =
+        map (\col -> arr ! (row, col)) [1..n]
+        & intersperse ' '
+
+   in unlines (map mkRow [1..n])
+
+scale :: Int -> Double -> Int
+scale n r = round (fromIntegral n * r)
+
+takeHalf :: [a] -> [a]
+takeHalf xs = take (length xs `quot` 2) xs
+
+
+main :: IO ()
+main = putStrLn "Hello, World!"

apply-merge.cabal

@@ -50,6 +50,34 @@ library
     , reflection ==2.1.*
   default-language: GHC2021
 
+executable apply-merge-viz
+  main-is: Main.hs
+  other-modules:
+      ApplyMerge.DoublyLinkedList
+      ApplyMerge.IntMap
+      ApplyMerge.IntSet
+      ApplyMerge.MergeAll
+      Data.DoublyLinkedList.STRef
+      Data.List.ApplyMerge
+      Data.List.NonEmpty.ApplyMerge
+      Data.PQueue.Prio.Min.Mutable
+  hs-source-dirs:
+      app
+      src
+  ghc-options: -Wall -Wunused-packages
+  build-depends:
+      apply-merge
+    , array
+    , base >=4.16 && <4.17 || >=4.17 && <4.18 || >=4.18 && <4.19 || >=4.19 && <4.20
+    , containers
+    , data-ordlist
+    , pqueue
+    , reflection
+    , text
+    , transformers
+    , vector
+  default-language: GHC2021
+
 test-suite apply-merge-tests
   type: exitcode-stdio-1.0
   main-is: Main.hs

package.yaml

@@ -36,6 +36,23 @@ ghc-options:
 dependencies:
 - base ^>= {4.16, 4.17, 4.18, 4.19, 4.20}
 
+executables:
+  apply-merge-viz:
+    source-dirs:
+    - app
+    - src
+    main: Main.hs
+    dependencies:
+    - apply-merge
+    - pqueue
+    - transformers
+    - containers
+    - reflection
+    - text
+    - data-ordlist
+    - vector
+    - array
+
 library:
   source-dirs: src
   exposed-modules: