diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..9d0631b --- /dev/null +++ b/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!" diff --git a/apply-merge.cabal b/apply-merge.cabal index d9fe7dd..5a23218 100644 --- a/apply-merge.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index dd5e7dc..b96e72e 100644 --- a/package.yaml +++ b/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: