De Bruijn sequences: Difference between revisions

=={{header|Haskell}}==

Straight-forward implementation of inverse Burrows—Wheeler transform [https://en.wikipedia.org/wiki/De_Bruijn_sequence#Construction] is reasonably efficient for the task (about a milliseconds for B(10,4) in GHCi).

<lang haskell>import Data.List

import Data.Map ((!))

import qualified Data.Map as M

-- represents a permutation in a cycle notation

cycleForm :: [Int] -> [[Int]]

cycleForm p = unfoldr getCycle $ M.fromList $ zip [0..] p

where

getCycle p

| M.null p = Nothing

| otherwise =

let Just ((x,y), m) = M.minViewWithKey p

c = if x == y then [] else takeWhile (/= x) (iterate (m !) y)

in Just (c ++ [x], foldr M.delete m c)

-- the set of Lyndon words generated by inverse Burrows—Wheeler transform

lyndonWords :: Ord a => Int -> [a] -> [[a]]

lyndonWords k s = map (ref !!) <$> cycleForm perm

where

ref = concat $ replicate (length s ^ (k - 1)) s

perm = s >>= (`elemIndices` ref)

-- returns the de Bruijn sequence of order k for an alphabeth s

deBruijn :: Ord a => Int -> [a] -> [a]

deBruijn k s = let lw = concat $ lyndonWords k s

in lw ++ take (k-1) lw</lang>

<pre>λ> cycleForm [1,4,3,2,0]

[[1,4,0],[3,2]]

λ> lyndonWords 3 "ab"

["a","aab","abb","b"]

λ> deBruijn 3 "ab"

"aaababbbaa"</pre>

The task.

<lang haskell>import Control.Monad (replicateM)

main = do

let symbols = ['0'..'9']

let db = deBruijn 4 symbols

putStrLn $ "The length of de Bruijn sequence: " ++ show (length db)

putStrLn $ "The first 130 symbols are:\n" ++ show (take 130 db)

putStrLn $ "The last 130 symbols are:\n" ++ show (drop (length db - 130) db)

let words = replicateM 4 symbols

let validate db = filter (not . (`isInfixOf` db)) words

putStrLn $ "Words not in the sequence: " ++ unwords (validate db)

let db' = a ++ ('.': tail b) where (a,b) = splitAt 4444 db

putStrLn $ "Words not in the corrupted sequence: " ++ unwords (validate db') </lang>

<pre>λ> main

The length of de Bruijn sequence: 10003

The first 130 symbols are:

"0000100020003000400050006000700080009001100120013001400150016001700180019002100220023002400250026002700280029003100320033003400350"

The last 130 symbols are:

"6898689969697769786979698769886989699769986999777787779778877897798779978787978887889789878997979887989799879998888988998989999000"

Words not in the sequence:

Words not in the corrupted sequence: 1459 4591 5914 8145</pre>