Code for CMSC702 midterm

bwt.rkt

#lang racket

;; String -> [Listof String]
;; return all rotations of a string
(define (>>n s)
  ;; rotate a string to the right
  (define (>> s)
    (string-append (substring s 1 (string-length s)) (substring s 0 1)))
  
  (let-values ([(ss _)
                (for/fold ([acc (list s)] [si s]) ([i (- (string-length s) 1)])
                  (let ([sj (>> si)])
                    (values (cons sj acc) sj)))])
    (reverse ss)))

;; String -> [Listof String]
;; return the sorted table of rotations for a string
(define (tab s)
  (sort (>>n (string-append s "$")) string<=?))

;; String -> String
;; compute the burrow wheeler transformation
(define (bwt s)
  (list->string (for/list ([si (tab s)]) (string-ref si (- (string-length si) 1)))))

;; compute LF mapping
(define (LF s)
  (let* ([s′ (bwt s)] ; transformed string
         [occs ; occurrence of each character in last column
          (for/fold ([occs (hash)]) ([c (in-string s′)] [i (in-naturals)])
            (hash-update occs c (λ (cs) (set-add cs i)) (λ () (set))))]
         [m ; LF mapping
          (for*/fold ([m (hash)]) ([c (in-string s′)] [i (in-range 0 (+ (string-length s′) 1))])
            (hash-set m (cons c i)
                      (for/sum ([j (hash-ref occs c)] #:when (> i j)) 1)))])
    ; readable representation of LF mapping
    (for/list ([c (in-hash-keys occs)])
      (cons (string c)
            (for/list ([i (in-range 0 (+ (string-length s′) 1))])
              (hash-ref m (cons c i)))))))

;; String -> (Hashtable String Int)
;; compute C array
(define (C s)
  (let* ([first-col (list->string (for/list ([row (tab s)]) (string-ref row 0)))]
         [pre-C (for/fold ([acc (hash)]) ([c (in-string first-col)])
                  (hash-update acc c add1 0))]
         [chars (sort (hash-keys pre-C) char<?)])
    (for*/fold ([C (hash (string (list-ref chars 0)) 0)])
      ([i (in-range 1 (length chars))]
       [c (in-value (list-ref chars i))]
       [d (in-value (list-ref chars (- i 1)))])
      (hash-set C (string c) (+ (hash-ref C (string d)) (hash-ref pre-C d))))))

;; answer to question in midterm:
(define S "TTCGAAGCGA")
(tab S) ; all cycles
(bwt S) ; burrow-wheeler transform
(LF S)  ; LF table
(C S)   ; C array