{- file parsing part from Haskell program, 
   rest is alsmost completely D program 
-}

module Main where
import Data.HashTable
import Data.Array.Unboxed
import Data.List
import Data.Char
import Control.Monad
import Numeric

main = do st <- getContents
          ht <- new (==) hashString
          inp <- process st
          let arr = listArray (1,length inp) inp
              kfreq = MakeKFreq ht arr
          writeFrequences 1 kfreq
          writeFrequences 2 kfreq
          mapM_ (\t -> writeCount t kfreq) 
                ["GGT", "GGTA", "GGTATT", "GGTATTTTAATT", "GGTATTTTAATTTATAGT"]
  where process :: String -> IO String
        process ls  = return $ ul $ takeNorm $ tail $ dropComment $ dropOther $ lines ls
        dropOther   = dropWhile (\str -> not (">THREE" `isPrefixOf` str))
        dropComment = dropWhile (\str -> head str == ';')
        takeNorm    = takeWhile (\str -> head str /= '>')
        ul str      = map toUpper $ concat str
         
data KFreq = MakeKFreq { ht :: HashTable String Int, arr :: UArray Int Char }
generateFreqs :: Int -> KFreq -> IO ()
generateFreqs n kf = mapM_ (\i -> updateFreqs i kf) [1..n]
    where k = n
          updateFreqs rf kf = let n = (snd $ bounds $ arr kf) - k + 1
                              in (for rf n k (\i -> updateFreq kf (arrToStr (arr kf) (i,i+k-1)) ))
          updateFreq kf s = do val <- Data.HashTable.lookup (ht kf) s
                               case val of
                                Nothing -> Data.HashTable.insert (ht kf) s 1
                                Just v -> do update (ht kf) s (v+1)
                                             return ()

writeFrequences n kf = do generateFreqs n kf
                          lst <- toList $ ht kf
                          let sum' = foldr (\(k,f) s -> if length k == n 
                                                           then s+f
                                                           else s) 0 lst
                              lst' :: [(String,Int)]
                              lst' = sortBy (\(_,x) (_,y) -> compare y x) lst
                          foldM_ (\last' kvsr' -> printFreqs kvsr' sum' lst' last') 0 lst'
                          putStr "\n"
                          return ()
    where printFreqs (k,vsr') sum' lst' last'
            = if last' /= vsr'
                 then do mapM_ (\(k,val) -> 
                                do if (length k) == n && val == vsr'
                                      then do let ratio :: Float
                                                  ratio = if sum' /= 0
                                                             then (fromIntegral val)/ fromIntegral sum'
                                                             else 0
                                              putStr (k++" "++showFFloat (Just 3) (ratio*100) "\n")
                                      else return ()     
                                               ) lst'
                         return vsr'
                 else return last'
                                    
                          
writeCount s kf = do generateFreqs (length s) kf
                     val <- Data.HashTable.lookup (ht kf) s
                     let cnt = case val of
                               Nothing -> 0
                               Just v -> v
                     putStrLn (show cnt ++ "\t" ++ s)

for begin end increment f 
    | begin <= end = do { f begin; for (begin+increment) end increment f }
    | otherwise = return ()

arrToStr :: UArray Int Char-> (Int,Int) -> String
arrToStr a (b,e) | b<=e = a ! b : arrToStr a (b+1,e)
                 | otherwise = []