qhull-0.1.0.1: src/ConvexHull/R.hs
module ConvexHull.R
where
import Control.Monad (when)
import ConvexHull
import qualified Data.HashMap.Strict.InsOrd as H
import qualified Data.IntMap.Strict as IM
import Data.List.Index (iconcatMap)
import Data.Maybe
import Data.Tuple.Extra (snd3)
-- import System.IO (writeFile)
convexHull3DrglCode :: [[Double]] -> Bool -> Maybe FilePath -> IO String
convexHull3DrglCode points rainbow file = do
-- get edges --
hull1 <- convexHull points False False Nothing
let edges = H.elems (_hedges hull1)
-- get triangles --
hull2 <- convexHull points True False Nothing
let grpFaces = groupedFacets hull2
let triangles = map (map IM.elems . snd3) grpFaces
-- code for edges --
let code1 = concatMap rglSegment edges
-- color palette --
let code_colors = if rainbow
then "colors <- rainbow(" ++ show (length grpFaces + 1) ++
", alpha=0.5)\n"
else "colors <- rep(\"blue\", " ++
show (length grpFaces + 1) ++ ")\n"
-- code for triangles --
let code2 = iconcatMap (\i x -> concatMap (rglTriangle i) x) triangles
-- whole code --
let code = "library(rgl)\n" ++ code_colors ++ code1 ++ code2
-- write file --
when (isJust file) $
writeFile (fromJust file) code
-- --
return code
-- auxiliary functions --
where
asTriplet p = (p!!0, p!!1, p!!2)
rglSegment :: ([Double], [Double]) -> String
rglSegment (p1', p2') =
let p1 = asTriplet p1' in
let p2 = asTriplet p2' in
"segments3d(rbind(c" ++ show p1 ++ ", c" ++ show p2 ++
"), color=\"black\")\n"
rglTriangle :: Int -> [[Double]] -> String
rglTriangle i threepoints =
"triangles3d(rbind(c" ++ show p1 ++ ", c" ++ show p2 ++
", c" ++ show p3 ++ "), color=colors[" ++ show (i+1) ++ "]" ++
", alpha=0.75)\n"
where
p1 = asTriplet $ threepoints!!0
p2 = asTriplet $ threepoints!!1
p3 = asTriplet $ threepoints!!2