Data commit

Task/Next-highest-int-from-digits/Haskell/next-highest-int-from-digits-1.hs

@@ -0,0 +1,39 @@
+import Data.List (nub, permutations, sort)
+
+digitShuffleSuccessors :: Integer -> [Integer]
+digitShuffleSuccessors n =
+  (fmap . (+) <*> (nub . sort . concatMap go . permutations . show)) n
+  where
+    go ds
+      | 0 >= delta = []
+      | otherwise = [delta]
+      where
+        delta = (read ds :: Integer) - n
+
+--------------------------- TEST ---------------------------
+main :: IO ()
+main =
+  putStrLn $
+  fTable
+    "Taking up to 5 digit-shuffle successors of a positive integer:\n"
+    show
+    (\xs ->
+        let harvest = take 5 xs
+        in rjust
+             12
+             ' '
+             (show (length harvest) <> " of " <> show (length xs) <> ": ") <>
+           show harvest)
+    digitShuffleSuccessors
+    [0, 9, 12, 21, 12453, 738440, 45072010, 95322020]
+
+------------------------- DISPLAY --------------------------
+fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
+fTable s xShow fxShow f xs =
+  unlines $
+  s : fmap (((<>) . rjust w ' ' . xShow) <*> ((" -> " <>) . fxShow . f)) xs
+  where
+    w = maximum (length . xShow <$> xs)
+
+rjust :: Int -> Char -> String -> String
+rjust n c = drop . length <*> (replicate n c <>)

Task/Next-highest-int-from-digits/Haskell/next-highest-int-from-digits-2.hs

@@ -0,0 +1,93 @@
+import Data.List (unfoldr)
+
+------------------- MINIMAL DIGIT-SWAPS ------------------
+
+digitShuffleSuccessors :: Integral b => b -> [b]
+digitShuffleSuccessors n =
+  unDigits <$> unfoldr nexts (go $ reversedDigits n)
+  where
+    go = minimalSwap . splitBy (>)
+    nexts x
+      | null x = Nothing
+      | otherwise = Just (((,) <*> go . reverse) x)
+
+
+minimalSwap :: Ord a => ([a], [a]) -> [a]
+minimalSwap ([], x : y : xs) = reverse (y : x : xs)
+minimalSwap ([], xs) = []
+minimalSwap (_, []) = []
+minimalSwap (reversedSuffix, pivot : prefix) =
+  reverse (h : prefix) <> less <> (pivot : more)
+  where
+    (less, h : more) = break (> pivot) reversedSuffix
+
+
+--------------------------- TEST -------------------------
+main :: IO ()
+main = do
+  putStrLn $
+    fTable
+      ( "Taking up to 5 digit-shuffle successors "
+          <> "of a positive integer:\n"
+      )
+      show
+      ( \xs ->
+          let harvest = take 5 xs
+           in rjust
+                12
+                ' '
+                ( show (length harvest) <> " of "
+                    <> show (length xs)
+                    <> ": "
+                )
+                <> show harvest
+      )
+      digitShuffleSuccessors
+      [0, 9, 12, 21, 12453, 738440, 45072010, 95322020]
+  putStrLn $
+    fTable
+      "Taking up to 10 digit-shuffle successors of a larger integer:\n"
+      show
+      (('\n' :) . unlines . fmap (("    " <>) . show))
+      (take 10 . digitShuffleSuccessors)
+      [9589776899767587796600]
+
+------------------------- GENERIC ------------------------
+reversedDigits :: Integral a => a -> [a]
+reversedDigits 0 = [0]
+reversedDigits n = go n
+  where
+    go 0 = []
+    go x = rem x 10 : go (quot x 10)
+
+splitBy :: (a -> a -> Bool) -> [a] -> ([a], [a])
+splitBy f xs = go $ break (uncurry f) $ zip xs (tail xs)
+  where
+    go (ys, zs)
+      | null ys = ([], xs)
+      | otherwise = (fst (head ys) : map snd ys, map snd zs)
+
+unDigits :: Integral a => [a] -> a
+unDigits = foldl (\a b -> 10 * a + b) 0
+
+------------------------- DISPLAY ------------------------
+fTable ::
+  String ->
+  (a -> String) ->
+  (b -> String) ->
+  (a -> b) ->
+  [a] ->
+  String
+fTable s xShow fxShow f xs =
+  unlines $
+    s :
+    fmap
+      ( ((<>) . rjust w ' ' . xShow)
+          <*> ((" -> " <>) . fxShow . f)
+      )
+      xs
+  where
+    w = maximum (length . xShow <$> xs)
+
+rjust :: Int -> Char -> String -> String
+rjust n c = drop . length <*> (replicate n c <>)