module Biobase.Taxonomy.Visualization (
module Biobase.Taxonomy.Types,
drawTaxonomyComparison,
drawTaxonomy,
writeTree,
writeDotTree,
writeJsonTree
) where
import Prelude
import Biobase.Taxonomy.Types
import Data.Graph.Inductive.Tree
import Data.Graph.Inductive.Basic
import qualified Data.GraphViz as GV
import qualified Data.GraphViz.Printing as GVP
import qualified Data.GraphViz.Attributes.Colors as GVAC
import qualified Data.GraphViz.Attributes.Complete as GVA
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Aeson as AE
import qualified Data.Text.Lazy as T
drawTaxonomy :: Bool -> Gr SimpleTaxon Double -> String
drawTaxonomy withRank inputGraph = do
let nodeFormating = if withRank then nodeFormatWithRank else nodeFormatWithoutRank
let params = GV.nonClusteredParams {GV.isDirected = True
, GV.globalAttributes = [GV.GraphAttrs [GVA.Size (GVA.GSize (20 :: Double) (Just (20 :: Double)) False)]]
, GV.isDotCluster = const True
, GV.fmtNode = nodeFormating
, GV.fmtEdge = const []
}
let dotFormat = GV.graphToDot params inputGraph
let dottext = GVP.renderDot $ GVP.toDot dotFormat
T.unpack dottext
nodeFormatWithRank :: (t, SimpleTaxon) -> [GVA.Attribute]
nodeFormatWithRank (_,l) = [GV.textLabel (T.concat [T.pack (show (simpleRank l)), T.pack ("\n") , simpleScientificName l])]
nodeFormatWithoutRank :: (t, SimpleTaxon) -> [GVA.Attribute]
nodeFormatWithoutRank (_,l) = [GV.textLabel (simpleScientificName l)]
drawTaxonomyComparison :: Bool -> (Int,Gr CompareTaxon Double) -> String
drawTaxonomyComparison withRank (treeNumber,inputGraph) = do
let cList = makeColorList treeNumber
let nodeFormating = if withRank then (compareNodeFormatWithRank cList) else (compareNodeFormatWithoutRank cList)
let params = GV.nonClusteredParams {GV.isDirected = True
, GV.globalAttributes = []
, GV.isDotCluster = const True
, GV.fmtNode = nodeFormating
, GV.fmtEdge = const []
}
let dotFormat = GV.graphToDot params (grev inputGraph)
let dottext = GVP.renderDot $ GVP.toDot dotFormat
T.unpack dottext
compareNodeFormatWithRank :: [GVA.Color] -> (t, CompareTaxon) -> [GVA.Attribute]
compareNodeFormatWithRank cList (_,l) = [GV.textLabel (T.concat [T.pack (show (compareRank l) ++ "\n"),compareScientificName l]), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)]
compareNodeFormatWithoutRank :: [GVA.Color] -> (t, CompareTaxon) -> [GVA.Attribute]
compareNodeFormatWithoutRank cList (_,l) = [GV.textLabel (compareScientificName l), GV.style GV.wedged, GVA.Color (selectColors (inTree l) cList)]
selectColors :: [Int] -> [GVA.Color] -> GVAC.ColorList
selectColors inTrees currentColorList = GVAC.toColorList (map (\i -> currentColorList !! i) inTrees)
makeColorList :: Int -> [GVA.Color]
makeColorList treeNumber = cList
where cList = map (\i -> GVAC.HSV ((fromIntegral i/fromIntegral neededColors) * 0.708) 0.5 1.0) [0..neededColors]
neededColors = treeNumber - 1
writeTree :: String -> String -> Bool -> Gr SimpleTaxon Double -> IO ()
writeTree requestedFormat outputDirectoryPath withRank inputGraph = do
case requestedFormat of
"dot" -> writeDotTree outputDirectoryPath withRank inputGraph
"json"-> writeJsonTree outputDirectoryPath inputGraph
_ -> writeDotTree outputDirectoryPath withRank inputGraph
writeDotTree :: String -> Bool -> Gr SimpleTaxon Double -> IO ()
writeDotTree outputDirectoryPath withRank inputGraph = do
let diagram = drawTaxonomy withRank (grev inputGraph)
writeFile (outputDirectoryPath ++ "taxonomy.dot") diagram
writeJsonTree :: String -> Gr SimpleTaxon Double -> IO ()
writeJsonTree outputDirectoryPath inputGraph = do
let jsonOutput = AE.encode (grev inputGraph)
L.writeFile (outputDirectoryPath ++ "taxonomy.json") jsonOutput