subsequence-repetition

subsequence-repetition/SubsequenceRepetition.hs

@@ -0,0 +1,53 @@
+module Main where
+
+import Control.Monad (forM_)
+import Data.Char (toLower)
+import Data.Map qualified as Map
+import Data.Set qualified as Set
+
+slidingWindow :: Int -> [a] -> [[a]]
+slidingWindow size list
+  | size > 0 && length list >= size =
+      let (window, rest) = splitAt size list
+       in window : slidingWindow size (drop 1 list)
+  | otherwise = []
+
+findRepetitions :: (Ord a) => [[a]] -> Map.Map [a] (Set.Set Int)
+findRepetitions windows =
+  Map.filter ((> 1) . Set.size) $
+    foldr
+      (\(i, window) acc -> Map.insertWith Set.union window (Set.singleton i) acc)
+      Map.empty
+      (zip [0 ..] windows)
+
+pairwiseComparison :: (Eq a) => [[a]] -> [([a], Int, Int)]
+pairwiseComparison xs = [(x1, i, j) | (i, x1) <- ixs, (j, x2) <- ixs, x1 == x2, i < j]
+  where
+    ixs = zip [0 ..] xs
+
+allPairwiseComparisons :: (Eq a) => [a] -> [[([a], Int, Int)]]
+allPairwiseComparisons xs = map (\n -> pairwiseComparison (slidingWindow n xs)) [0 .. length xs]
+
+allRepetitions :: (Ord a) => [a] -> [Map.Map [a] (Set.Set Int)]
+allRepetitions xs = map (\n -> findRepetitions (slidingWindow n xs)) [0 .. length xs]
+
+printPairwiseComparison :: [(Int, Int)] -> IO ()
+printPairwiseComparison [] = return ()
+printPairwiseComparison xys =
+  let (xs, ys) = unzip xys
+      maxX = maximum xs
+      maxY = maximum ys
+      lastDigit = last . show
+   in do
+        putChar ' '
+        forM_ [0 .. maxY] $ \y -> do
+          putChar (lastDigit y)
+        putChar '\n'
+        forM_ [0 .. maxX] $ \x -> do
+          putChar (lastDigit x)
+          forM_ [0 .. maxY] $ \y -> do
+            putChar $ if (x, y) `elem` xys then 'x' else '_'
+          putChar '\n'
+        putChar '\n'
+
+main = print $ allRepetitions $ map toLower " Vestr komk of ver | en ek Viðris ber |"