Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 89 lines (71 sloc) 2.938 kB
638b016 @epsilonhalbe Burrows-Wheeler-Transformation
authored
1 module BWT where
2
3 import Data.List (sort
4 ,sortBy
5 ,tails
6 ,transpose)
7 import Data.Array (listArray
8 ,(!))
9
10 -- | the slow version of transform
11 {-transform :: Ord a ⇒ [a] → ([a],Int)-}
12 {-transform xs = (map last xss, position xs xss)-}
13 {-where xss = sort $ rots xs-}
14 transform :: String → (String,Int)
15 transform xs = ([xa ! (pa ! i ) | i ← [0..(n-1)]], k )
16 where n = length xs
17 k = length (takeWhile (≡ 0) ps)
18 xa = listArray (0, n-1) (rrot xs)
19 pa = listArray (0, n-1) ps
20 ps = map snd (sort (zip (tails (tag xs))[0 .. n-1]))
21 tag x = x ++ "\EOT"
22
23 untransform :: Ord a ⇒ ([a],Int) → [a]
24 {-untransform (ys,k) = recreate n ys !! k-}
25 untransform (ys,k) = take n (tail (map (ya!)(iterate (pa!)k)))
26 where n = length ys
27 ya = listArray (0,n-1) ys
28 pa = listArray (0,n-1) (map snd (sort (zip ys [0..])))
29
30 -- | recreate has several versions
31 recreate :: Ord aInt → [a] → [[a]]
32 recreate 0 xs = map (const []) xs
33 {-recreate j xs = (headsort ∙ consCol ∙ fork (id , recreate (j-1))) xs-}
34 {-recreate j xs = (consCol ∙ fork (apply pp, apply pp ∙ recreate j)) xs-}
35 recreate j xs = (tp ∙ take j ∙ tailiterate (apply pp)) xs
36 where pp = p xs
37
38 apply :: [Int] → [a] → [a]
39 apply pp ys = [ys !! (pp !! i)|i ← [0..n']]
40 where n' = length ys - 1
41
42 {-recreate' :: Ord a ⇒ [a] → [[a]]-}
43 {-recreate' = undefined-}
44
45 {---------------------------------------------------------------------------
46 - auxiliary functions -
47 ---------------------------------------------------------------------------}
48
49 headsort :: Ord a ⇒ [[a]] → [[a]]
50 headsort = sortBy cmp
51 where cmp (x:_) (y:_) = compare x y
52 cmp [] _ = error "no first component"
53 cmp _ [] = error "no second component"
54
55 -- | calculates the position of a given element of a list - better use Maybe
56 position :: Eq aa → [a] → Int
57 position x xs = length $ takeWhile (≠ x) xs
58
59 -- | takes the first j columns of a matrix ([[a]])
60 takeCols :: Int → [[a]] → [[a]]
61 takeCols j = map $ take j
62
63 -- | prepends a column to a matrix
64 consCol :: ([a],[[a]]) → [[a]]
65 consCol (xs,xss) = zipWith (:) xs xss
66
67 -- | generates all rotations of a given list
68 rots :: [a] → [[a]]
69 rots xs = take (length xs) (iterate lrot xs)
70
71 -- | puts the first list element to the last position
72 lrot :: [a] → [a]
73 lrot [] = []
74 lrot (x:xs) = xs ++ [x]
75
76 -- | puts the last list element to the first position
77 rrot :: [a] → [a]
78 rrot xs = last xs : init xs
79
80 fork :: (ab, ac) → a → (b, c)
81 fork (f,g) x = (f x, g x)
82
83 p :: (Ord a) ⇒ [a] → [Int]
84 p ys = map snd (sort $ zip ys [0..])
85
86 -- | transpose
87 tp :: [[a]] → [[a]]
88 tp = transpose
Something went wrong with that request. Please try again.