Export.hs

{-# LANGUAGE RecordWildCards #-}

-- | write an Infernal model. We aim for version 1.0.2 of Infernal but right
-- now, there is no explicit version management! We just return header
-- information as we read it. So we are compatible to all versions that can be
-- parsed but have no safeguards in place.
--
-- NOTE: exported model can apparently be calibrated.
--
-- TODO make sure that (Export.toString . Import.fromString == id); the other
-- way around is not absolutely necessary (except if the Infernal parser should
-- require this at some point)
--
-- TODO put functions like stringS into another module?

module Biobase.Infernal.CM.Export where

import qualified Data.Array.IArray as A
import Text.Printf

import Biobase.Infernal.CM

import Biobase.Infernal.CM.Import -- TODO for testing only!



-- | Main export function for CMs. Creates a string that is accepted by
-- Infernal

toString :: CM n s -> String
toString cm@CM{..} = unlines $ hdr ++ ["MODEL:"] ++ nds ++ ["//"]
  where
    hdr = map (\(k,v) -> k ++ " " ++ v) header
    nds = concatMap (nodeToString cm) $ A.elems nodes



-- | export a specific node, used by 'toString'

nodeToString :: CM n s -> Node n -> [String]
nodeToString cm Node{..} = printf "\t\t\t\t[ %s %d ]" (show ntype) nid : map (stateToString cm . (states cm A.!)) nstates



-- | export a specific states, used by 'nodeToString'

stateToString :: CM n s -> State s -> String
stateToString cm State{..} = printf "    %2s %6d %6d %2d %6d %6d %-55s %s" (show stype) sid maxP numP minC numC tscores escores
  where
    maxP
      | null sparents = -1
      | otherwise     = maximum sparents
    numP = length sparents
    minC
      | null schildren = -1
      | otherwise      = minimum $ map tchild schildren
    numC
      | stype == B = maximum $ map tchild schildren
      | otherwise  = length schildren
    tscores :: String
    tscores
      | stype == B = ""
      | otherwise  = concatMap (printf "%s   " . stringS . tscore) schildren
    escores :: String
    escores
      | null semission = ""
      | otherwise      = concatMap (printf "%.3f " . escore) semission



-- | export scores for transitions with the Infernal-specific "-infinity" value
-- of "*"

stringS x
  | x == (-1/0) = "      *"
  | otherwise   = printf "%.3f" x