{-# language LambdaCase #-}
{-# options_ghc -Wno-unused-imports #-}
module Data.RPTree.Draw where

import Data.List (intercalate)
import Text.Printf (PrintfArg, printf)

-- boxes
import qualified Text.PrettyPrint.Boxes as B (Box, render, emptyBox, vcat, hcat, text, top, bottom, center1)
-- bytestring
import qualified Data.ByteString.Lazy    as LBS (ByteString, writeFile)
import qualified Data.ByteString.Builder as BSB (Builder, toLazyByteString, string7, charUtf8)
-- -- mtl
-- import Control.Monad.State (MonadState(..))
-- vector
import qualified Data.Vector as V (Vector, replicateM)
import qualified Data.Vector.Generic as VG (Vector(..), map, sum, unfoldr, unfoldrM, length, replicateM, (!))
import qualified Data.Vector.Unboxed as VU (Unbox)

import Data.RPTree.Internal (RPTree(..), RPT(..), DVector, toListDv)




-- | Encode dataset as CSV and save into file
writeCsv :: (Show a, Show b, VU.Unbox a) =>
            FilePath
         -> [(DVector a, b)] -- ^ data point, label
         -> IO ()
writeCsv :: FilePath -> [(DVector a, b)] -> IO ()
writeCsv FilePath
fp [(DVector a, b)]
ds = FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [(DVector a, b)] -> Builder
forall a b.
(Show a, Show b, Unbox a) =>
[(DVector a, b)] -> Builder
toCsv [(DVector a, b)]
ds

toCsvRow :: (Show a, Show b, VU.Unbox a) =>
            DVector a
         -> b
         -> BSB.Builder
toCsvRow :: DVector a -> b -> Builder
toCsvRow DVector a
dv b
i = FilePath -> Builder
BSB.string7 (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [a -> FilePath
forall a. Show a => a -> FilePath
show a
x, a -> FilePath
forall a. Show a => a -> FilePath
show a
y, b -> FilePath
forall a. Show a => a -> FilePath
show b
i]
  where
    (a
x:a
y:[a]
_) = DVector a -> [a]
forall a. Unbox a => DVector a -> [a]
toListDv DVector a
dv

toCsv :: (Show a, Show b, VU.Unbox a) =>
         [(DVector a, b)] -> BSB.Builder
toCsv :: [(DVector a, b)] -> Builder
toCsv [(DVector a, b)]
rs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [DVector a -> b -> Builder
forall a b. (Show a, Show b, Unbox a) => DVector a -> b -> Builder
toCsvRow DVector a
r b
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.charUtf8 Char
'\n' | (DVector a
r, b
i) <- [(DVector a, b)]
rs]

-- | Render a tree to stdout
--
-- Useful for debugging
--
-- This should be called only for small trees, otherwise the printed result quickly overflows the screen and becomes hard to read.
--
-- NB : prints distance information rounded to two decimal digits
draw :: (Show a, Boxed a, PrintfArg v) => RPTree v a -> IO ()
draw :: RPTree v a -> IO ()
draw = RPT v a -> IO ()
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> IO ()
drawRPT (RPT v a -> IO ())
-> (RPTree v a -> RPT v a) -> RPTree v a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPTree v a -> RPT v a
forall d a. RPTree d a -> RPT d a
_rpTree

drawRPT :: (Show a, Boxed a, PrintfArg v) => RPT v a -> IO ()
drawRPT :: RPT v a -> IO ()
drawRPT = FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (RPT v a -> FilePath) -> RPT v a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v a -> FilePath
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> FilePath
toStringRPT

toStringRPT :: (Show a, Boxed a, PrintfArg v) => RPT v a -> String
toStringRPT :: RPT v a -> FilePath
toStringRPT = Box -> FilePath
B.render (Box -> FilePath) -> (RPT v a -> Box) -> RPT v a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox

toBox :: (Show a, Boxed a, PrintfArg v) => RPT v a -> B.Box
toBox :: RPT v a -> Box
toBox = \case
  (Bin v
thr Margin v
_ RPT v a
tl RPT v a
tr) ->
    FilePath -> Box
txt (v -> FilePath
forall t t. (PrintfArg t, PrintfType t) => t -> t
node v
thr) Box -> Box -> Box
`stack` (RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox RPT v a
tl Box -> Box -> Box
`byside` RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox RPT v a
tr)
  Tip a
xs -> a -> Box
forall a. Boxed a => a -> Box
boxed a
xs -- tipData xs -- txt $ show x
  where
    node :: t -> t
node t
x = FilePath -> t -> t
forall r. PrintfType r => FilePath -> r
printf FilePath
"%5.2f" t
x -- (show x)

class Boxed a where
  boxed :: a -> B.Box
instance (Show a) => Boxed [a] where
  boxed :: [a] -> Box
boxed = (Box -> a -> Box) -> Box -> [a] -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> [a] -> Box) -> Box -> [a] -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
0 Int
0
instance Boxed () where
  boxed :: () -> Box
boxed ()
_ = FilePath -> Box
txt FilePath
"*"

tipData :: (Show a, Foldable t) => t a -> B.Box
tipData :: t a -> Box
tipData = (Box -> a -> Box) -> Box -> t a -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> t a -> Box) -> Box -> t a -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
1 Int
1

txt :: String -> B.Box
txt :: FilePath -> Box
txt FilePath
t = Box
spc Box -> Box -> Box
`byside` FilePath -> Box
B.text FilePath
t Box -> Box -> Box
`byside` Box
spc
  where spc :: Box
spc = Int -> Int -> Box
B.emptyBox Int
1 Int
1

byside :: B.Box -> B.Box -> B.Box
byside :: Box -> Box -> Box
byside Box
l Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.hcat Alignment
B.top [Box
l, Box
r]

stack :: B.Box -> B.Box -> B.Box
stack :: Box -> Box -> Box
stack Box
t Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.center1 [Box
t, Box
b]