The CLISP specialty is used when producing a png from the dot file in Chapter 7.
brew install graphviz
which dot -> /usr/local/bin/dot
(defun dot->png (fname thunk)
(with-open-file (*standard-output*
fname
:direction :output
:if-exists :supersede)
(funcall thunk))
(sb-ext:run-program "/usr/local/bin/dot" (list "-Tpng" "-O" fname)))
| Data for dot-bracket notation (a.k.a. Vienna notation) | |
| > type Viennachar = Char | |
| > type RNAchar = Char | |
| Data for tree structure | |
| > data Tree a = N a (Forest a) deriving (Show,Eq,Ord) | |
| > type Forest a = [Tree a] | |
| Parse dot-bracket notation and build an RNA forest | |
| > build' :: [(Viennachar, RNAchar)] -> Forest RNAchar | |
| > build' [] = [] | |
| > build' [('.',a)] = [N a []] | |
| > build' [(')',a)] = error $ "structure not well parenthesized" | |
| > build' [('(',a)] = error $ "structure not well parenthesized" | |
| > build' [( x ,a)] = error $ show x++" symbol not allowed in vienna notation" | |
| > build' (('(',a1):(')',a2):ps) = (N 'P' (open:[close])) : build' ps | |
| > where (open, close) = ((N a1 []), (N a2 [])) | |
| > | |
| > build' (('.',a):ps) = (N a []) : build' ps | |
| > build' (('(',o):ps) = (N 'P' ((open:inbracketsrecursion)++[close])) : build' trest | |
| > where (open, close) = ((N o []), (N (snd hrest) [])) | |
| > inbracketsrecursion = build' inbrackets | |
| > (hrest, trest) = (head rest, tail rest) | |
| > (inbrackets,rest) = if (l==[]) then error "closing bracket missing" else (head l) | |
| > l = [splitAt k ps| k<-[1..length(ps)], level(take (k+1) (map fst ps))<0 ] | |
| > | |
| > build' ((')',a):ps) = error "no closing bracket expected here" | |
| > build' (( x ,a):ps) = error $ show x++" symbol not allowed in vienna notation" | |
| Print an RNA forest as a list of lines in pgf/tikz tree format | |
| > pprint :: [Tree RNAchar] -> [String] | |
| > pprint ((N x (a:as)):bs) = ("\\begin{scope}[xshift=1em]"):("\\node {"++ [x] ++ "}"):(pprint' (a:as)) ++ ["; "] ++ pprint bs ++ ["\\end{scope}"] | |
| > pprint ((N x []):bs) = ("\\begin{scope}[xshift=1em]"):("\\node {"++ [x] ++ "};") : pprint bs ++ ["\\end{scope}"] | |
| > pprint [] = [] | |
| > pprint' ((N x (a:as)):bs) = ("child { node {"++ [x] ++ "} "):(pprint' (a:as)) ++ ["} "] ++ pprint' bs | |
| > pprint' ((N x []):bs) = ("child { node {"++ [x] ++ "} "):"} ": pprint' bs | |
| > pprint' [] = [] | |
| Testdata | |
| > test0 = ("GGGGGGCCGCCGGGGAAAAA", "..((..)).((..)).....") | |
| > test = ("GGGGGCGCCGGGG", "..(..).((..))") | |
| Main function | |
| > dotBracketToTikz s = putStr $ unlines $ pprint (build (snd s) (fst s)) | |
| Example call in GHCi / hugs | |
| dotBracketToTikz test0 |