{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
module ELynx.Tree.Length
(
Length (fromLength),
toLength,
toLengthUnsafe,
HasMaybeLength (..),
HasLength (..),
height,
rootHeight,
distancesOriginLeaves,
totalBranchLength,
normalizeBranchLengths,
normalizeHeight,
ultrametric,
makeUltrametric,
)
where
import Control.DeepSeq
import Data.Aeson
import Data.Bifunctor
import Data.Default.Class
import Data.Foldable
import Data.Semigroup
import ELynx.Tree.Rooted
import ELynx.Tree.Splittable
import GHC.Generics
newtype Length = Length {Length -> Double
fromLength :: Double}
deriving (ReadPrec [Length]
ReadPrec Length
Int -> ReadS Length
ReadS [Length]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Length]
$creadListPrec :: ReadPrec [Length]
readPrec :: ReadPrec Length
$creadPrec :: ReadPrec Length
readList :: ReadS [Length]
$creadList :: ReadS [Length]
readsPrec :: Int -> ReadS Length
$creadsPrec :: Int -> ReadS Length
Read, Int -> Length -> ShowS
[Length] -> ShowS
Length -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Length] -> ShowS
$cshowList :: [Length] -> ShowS
show :: Length -> String
$cshow :: Length -> String
showsPrec :: Int -> Length -> ShowS
$cshowsPrec :: Int -> Length -> ShowS
Show, forall x. Rep Length x -> Length
forall x. Length -> Rep Length x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Length x -> Length
$cfrom :: forall x. Length -> Rep Length x
Generic, Length -> ()
forall a. (a -> ()) -> NFData a
rnf :: Length -> ()
$crnf :: Length -> ()
NFData)
deriving
( Length
forall a. a -> Default a
def :: Length
$cdef :: Length
Default,
Int -> Length
Length -> Int
Length -> [Length]
Length -> Length
Length -> Length -> [Length]
Length -> Length -> Length -> [Length]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Length -> Length -> Length -> [Length]
$cenumFromThenTo :: Length -> Length -> Length -> [Length]
enumFromTo :: Length -> Length -> [Length]
$cenumFromTo :: Length -> Length -> [Length]
enumFromThen :: Length -> Length -> [Length]
$cenumFromThen :: Length -> Length -> [Length]
enumFrom :: Length -> [Length]
$cenumFrom :: Length -> [Length]
fromEnum :: Length -> Int
$cfromEnum :: Length -> Int
toEnum :: Int -> Length
$ctoEnum :: Int -> Length
pred :: Length -> Length
$cpred :: Length -> Length
succ :: Length -> Length
$csucc :: Length -> Length
Enum,
Length -> Length -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Length -> Length -> Bool
$c/= :: Length -> Length -> Bool
== :: Length -> Length -> Bool
$c== :: Length -> Length -> Bool
Eq,
Fractional Length
Length
Length -> Length
Length -> Length -> Length
forall a.
Fractional a
-> a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
log1mexp :: Length -> Length
$clog1mexp :: Length -> Length
log1pexp :: Length -> Length
$clog1pexp :: Length -> Length
expm1 :: Length -> Length
$cexpm1 :: Length -> Length
log1p :: Length -> Length
$clog1p :: Length -> Length
atanh :: Length -> Length
$catanh :: Length -> Length
acosh :: Length -> Length
$cacosh :: Length -> Length
asinh :: Length -> Length
$casinh :: Length -> Length
tanh :: Length -> Length
$ctanh :: Length -> Length
cosh :: Length -> Length
$ccosh :: Length -> Length
sinh :: Length -> Length
$csinh :: Length -> Length
atan :: Length -> Length
$catan :: Length -> Length
acos :: Length -> Length
$cacos :: Length -> Length
asin :: Length -> Length
$casin :: Length -> Length
tan :: Length -> Length
$ctan :: Length -> Length
cos :: Length -> Length
$ccos :: Length -> Length
sin :: Length -> Length
$csin :: Length -> Length
logBase :: Length -> Length -> Length
$clogBase :: Length -> Length -> Length
** :: Length -> Length -> Length
$c** :: Length -> Length -> Length
sqrt :: Length -> Length
$csqrt :: Length -> Length
log :: Length -> Length
$clog :: Length -> Length
exp :: Length -> Length
$cexp :: Length -> Length
pi :: Length
$cpi :: Length
Floating,
Num Length
Rational -> Length
Length -> Length
Length -> Length -> Length
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Length
$cfromRational :: Rational -> Length
recip :: Length -> Length
$crecip :: Length -> Length
/ :: Length -> Length -> Length
$c/ :: Length -> Length -> Length
Fractional,
Integer -> Length
Length -> Length
Length -> Length -> Length
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Length
$cfromInteger :: Integer -> Length
signum :: Length -> Length
$csignum :: Length -> Length
abs :: Length -> Length
$cabs :: Length -> Length
negate :: Length -> Length
$cnegate :: Length -> Length
* :: Length -> Length -> Length
$c* :: Length -> Length -> Length
- :: Length -> Length -> Length
$c- :: Length -> Length -> Length
+ :: Length -> Length -> Length
$c+ :: Length -> Length -> Length
Num,
Eq Length
Length -> Length -> Bool
Length -> Length -> Ordering
Length -> Length -> Length
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Length -> Length -> Length
$cmin :: Length -> Length -> Length
max :: Length -> Length -> Length
$cmax :: Length -> Length -> Length
>= :: Length -> Length -> Bool
$c>= :: Length -> Length -> Bool
> :: Length -> Length -> Bool
$c> :: Length -> Length -> Bool
<= :: Length -> Length -> Bool
$c<= :: Length -> Length -> Bool
< :: Length -> Length -> Bool
$c< :: Length -> Length -> Bool
compare :: Length -> Length -> Ordering
$ccompare :: Length -> Length -> Ordering
Ord,
Num Length
Ord Length
Length -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Length -> Rational
$ctoRational :: Length -> Rational
Real,
Floating Length
RealFrac Length
Int -> Length -> Length
Integer -> Int -> Length
Length -> Bool
Length -> Int
Length -> Integer
Length -> (Int, Int)
Length -> (Integer, Int)
Length -> Length
Length -> Length -> Length
forall a.
RealFrac a
-> Floating a
-> (a -> Integer)
-> (a -> Int)
-> (a -> (Int, Int))
-> (a -> (Integer, Int))
-> (Integer -> Int -> a)
-> (a -> Int)
-> (a -> a)
-> (Int -> a -> a)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> Bool)
-> (a -> a -> a)
-> RealFloat a
atan2 :: Length -> Length -> Length
$catan2 :: Length -> Length -> Length
isIEEE :: Length -> Bool
$cisIEEE :: Length -> Bool
isNegativeZero :: Length -> Bool
$cisNegativeZero :: Length -> Bool
isDenormalized :: Length -> Bool
$cisDenormalized :: Length -> Bool
isInfinite :: Length -> Bool
$cisInfinite :: Length -> Bool
isNaN :: Length -> Bool
$cisNaN :: Length -> Bool
scaleFloat :: Int -> Length -> Length
$cscaleFloat :: Int -> Length -> Length
significand :: Length -> Length
$csignificand :: Length -> Length
exponent :: Length -> Int
$cexponent :: Length -> Int
encodeFloat :: Integer -> Int -> Length
$cencodeFloat :: Integer -> Int -> Length
decodeFloat :: Length -> (Integer, Int)
$cdecodeFloat :: Length -> (Integer, Int)
floatRange :: Length -> (Int, Int)
$cfloatRange :: Length -> (Int, Int)
floatDigits :: Length -> Int
$cfloatDigits :: Length -> Int
floatRadix :: Length -> Integer
$cfloatRadix :: Length -> Integer
RealFloat,
Fractional Length
Real Length
forall b. Integral b => Length -> b
forall b. Integral b => Length -> (b, Length)
forall a.
Real a
-> Fractional a
-> (forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
floor :: forall b. Integral b => Length -> b
$cfloor :: forall b. Integral b => Length -> b
ceiling :: forall b. Integral b => Length -> b
$cceiling :: forall b. Integral b => Length -> b
round :: forall b. Integral b => Length -> b
$cround :: forall b. Integral b => Length -> b
truncate :: forall b. Integral b => Length -> b
$ctruncate :: forall b. Integral b => Length -> b
properFraction :: forall b. Integral b => Length -> (b, Length)
$cproperFraction :: forall b. Integral b => Length -> (b, Length)
RealFrac
)
via Double
deriving (NonEmpty Length -> Length
Length -> Length -> Length
forall b. Integral b => b -> Length -> Length
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Length -> Length
$cstimes :: forall b. Integral b => b -> Length -> Length
sconcat :: NonEmpty Length -> Length
$csconcat :: NonEmpty Length -> Length
<> :: Length -> Length -> Length
$c<> :: Length -> Length -> Length
Semigroup, Semigroup Length
Length
[Length] -> Length
Length -> Length -> Length
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Length] -> Length
$cmconcat :: [Length] -> Length
mappend :: Length -> Length -> Length
$cmappend :: Length -> Length -> Length
mempty :: Length
$cmempty :: Length
Monoid) via Sum Double
instance Splittable Length where
split :: Length -> Length
split = (forall a. Fractional a => a -> a -> a
/ Length
2.0)
instance ToJSON Length
instance FromJSON Length
instance HasMaybeLength Length where
getMaybeLength :: Length -> Maybe Length
getMaybeLength = forall a. a -> Maybe a
Just
instance HasLength Length where
getLength :: Length -> Length
getLength = forall a. a -> a
id
setLength :: Length -> Length -> Length
setLength = forall a b. a -> b -> a
const
modifyLength :: (Length -> Length) -> Length -> Length
modifyLength Length -> Length
f = Length -> Length
f
toLength :: Double -> Either String Length
toLength :: Double -> Either String Length
toLength Double
x
| Double
x forall a. Ord a => a -> a -> Bool
< Double
0 = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Length is negative: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Double
x forall a. [a] -> [a] -> [a]
++ String
"."
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> Length
Length Double
x
toLengthUnsafe :: Double -> Length
toLengthUnsafe :: Double -> Length
toLengthUnsafe = Double -> Length
Length
class HasMaybeLength e where
getMaybeLength :: e -> Maybe Length
instance HasMaybeLength () where
getMaybeLength :: () -> Maybe Length
getMaybeLength = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
class HasMaybeLength e => HasLength e where
getLength :: e -> Length
setLength :: Length -> e -> e
modifyLength :: (Length -> Length) -> e -> e
height :: HasLength e => Tree e a -> Length
height :: forall e a. HasLength e => Tree e a -> Length
height = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves
rootHeight :: HasLength e => Tree e a -> Length
rootHeight :: forall e a. HasLength e => Tree e a -> Length
rootHeight (Node e
_ a
_ []) = Length
0
rootHeight Tree e a
t = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves (forall e a. Tree e a -> Forest e a
forest Tree e a
t)
distancesOriginLeaves :: HasLength e => Tree e a -> [Length]
distancesOriginLeaves :: forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves (Node e
br a
_ []) = [forall e. HasLength e => e -> Length
getLength e
br]
distancesOriginLeaves (Node e
br a
_ [Tree e a]
ts) = forall a b. (a -> b) -> [a] -> [b]
map (forall e. HasLength e => e -> Length
getLength e
br forall a. Num a => a -> a -> a
+) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves [Tree e a]
ts)
totalBranchLength :: HasLength e => Tree e a -> Length
totalBranchLength :: forall e a. HasLength e => Tree e a -> Length
totalBranchLength = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Num a => a -> a -> a
(+) Length
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e. HasLength e => e -> Length
getLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. Tree e a -> ZipBranchTree a e
ZipBranchTree
normalizeBranchLengths :: HasLength e => Tree e a -> Tree e a
normalizeBranchLengths :: forall e a. HasLength e => Tree e a -> Tree e a
normalizeBranchLengths Tree e a
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall e. HasLength e => (Length -> Length) -> e -> e
modifyLength (forall a. Fractional a => a -> a -> a
/ Length
s)) Tree e a
t
where
s :: Length
s = forall e a. HasLength e => Tree e a -> Length
totalBranchLength Tree e a
t
normalizeHeight :: HasLength e => Tree e a -> Tree e a
normalizeHeight :: forall e a. HasLength e => Tree e a -> Tree e a
normalizeHeight Tree e a
t = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall e. HasLength e => (Length -> Length) -> e -> e
modifyLength (forall a. Fractional a => a -> a -> a
/ Length
h)) Tree e a
t
where
h :: Length
h = forall e a. HasLength e => Tree e a -> Length
height Tree e a
t
eps :: Double
eps :: Double
eps = Double
1e-12
allNearlyEqual :: [Length] -> Bool
allNearlyEqual :: [Length] -> Bool
allNearlyEqual [] = Bool
True
allNearlyEqual [Length]
xs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Length
y -> Double
eps forall a. Ord a => a -> a -> Bool
> forall a. Num a => a -> a
abs (Length -> Double
fromLength forall a b. (a -> b) -> a -> b
$ Length
x forall a. Num a => a -> a -> a
- Length
y)) (forall a. [a] -> [a]
tail [Length]
xs)
where
x :: Length
x = forall a. [a] -> a
head [Length]
xs
ultrametric :: HasLength e => Tree e a -> Bool
ultrametric :: forall e a. HasLength e => Tree e a -> Bool
ultrametric = [Length] -> Bool
allNearlyEqual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. HasLength e => Tree e a -> [Length]
distancesOriginLeaves
makeUltrametric :: HasLength e => Tree e a -> Tree e a
makeUltrametric :: forall e a. HasLength e => Tree e a -> Tree e a
makeUltrametric Tree e a
t = forall e a. HasLength e => Length -> Tree e a -> Tree e a
go Length
0 Tree e a
t
where
h :: Length
h = forall e a. HasLength e => Tree e a -> Length
height Tree e a
t
go :: HasLength e => Length -> Tree e a -> Tree e a
go :: forall e a. HasLength e => Length -> Tree e a -> Tree e a
go Length
h' (Node e
br a
lb []) = let dh :: Length
dh = Length
h forall a. Num a => a -> a -> a
- Length
h' forall a. Num a => a -> a -> a
- forall e. HasLength e => e -> Length
getLength e
br in forall e a. e -> a -> Forest e a -> Tree e a
Node (forall e. HasLength e => (Length -> Length) -> e -> e
modifyLength (forall a. Num a => a -> a -> a
+ Length
dh) e
br) a
lb []
go Length
h' (Node e
br a
lb [Tree e a]
ts) = let h'' :: Length
h'' = Length
h' forall a. Num a => a -> a -> a
+ forall e. HasLength e => e -> Length
getLength e
br in forall e a. e -> a -> Forest e a -> Tree e a
Node e
br a
lb forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall e a. HasLength e => Length -> Tree e a -> Tree e a
go Length
h'') [Tree e a]
ts