Skip to content

Instantly share code, notes, and snippets.

@bradparker
Last active April 29, 2024 06:27
Show Gist options
  • Save bradparker/86e0ef0e99d6e8a258f20ff0327e694e to your computer and use it in GitHub Desktop.
Save bradparker/86e0ef0e99d6e8a258f20ff0327e694e to your computer and use it in GitHub Desktop.
Lehmer.hs
module Main where
import Data.Array (Array, elems, listArray, (!))
import Data.List (elemIndex, uncons, unfoldr)
import Data.Maybe (mapMaybe)
encodeLehmer :: forall a. (Eq a) => Array Int a -> [a] -> [Int]
encodeLehmer set =
unfoldr
( fmap
( \(x, xs) ->
( x,
map
( \y ->
if y > x
then pred y
else y
)
xs
)
)
. uncons
)
. mapMaybe (`elemIndex` ordered)
where
ordered = elems set
decodeLehmer :: forall a. Array Int a -> [Int] -> [a]
decodeLehmer set =
map (set !)
. foldl (\acc n -> n : map (\m -> if m >= n then m + 1 else m) acc) []
. reverse
main :: IO ()
main = do
let set = listArray (0, 6) ['A' .. 'G']
let permutation = ['B', 'F', 'A', 'G', 'D', 'E', 'C']
let encoded = encodeLehmer set permutation
print encoded
print (decodeLehmer set encoded)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment