-- | c.f. Statistics.Sample.Histogram (this is much slower but doesn't require any libraries)
module Music.Theory.Math.Histogram where

import Music.Theory.List {- hmt-base -}
import Music.Theory.Math.Constant {- hmt-base -}

{- | Calculate histogram on numBins places.  Returns the range of each bin and the number of elements in each.


> map (snd . bHistogram 10) [[1 .. 10],[1,1,1,2,2,3,10]] == [[1,1,1,1,1,1,1,1,1,1],[3,2,1,0,0,0,0,0,0,1]]
-}
bHistogram :: Int -> [Double] -> ([(Double, Double)], [Int])
bHistogram :: Int -> [Double] -> ([(Double, Double)], [Int])
bHistogram Int
numBins [Double]
xs =
  let (Double
lo, Double
hi) = Int -> [Double] -> (Double, Double)
bHistogramRange Int
numBins [Double]
xs
      d :: Double
d = (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBins
      step :: a -> Double
step a
i = Double
lo forall a. Num a => a -> a -> a
+ Double
d forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
      lhs_seq :: [Double]
lhs_seq = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => a -> Double
step [Int
0 .. Int
numBins forall a. Num a => a -> a -> a
- Int
1]
      rng_seq :: [(Double, Double)]
rng_seq = forall a b. (a -> b) -> [a] -> [b]
map (\Double
n -> (Double
n, Double
n forall a. Num a => a -> a -> a
+ Double
d)) [Double]
lhs_seq
      cnt_seq :: [Int]
cnt_seq = forall a b. (a -> b) -> [a] -> [b]
map (\(Double, Double)
rng -> forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => (a, a) -> [a] -> [a]
filterInRange (Double, Double)
rng [Double]
xs)) [(Double, Double)]
rng_seq
  in ([(Double, Double)]
rng_seq, [Int]
cnt_seq)

{- | Calculate range.

> bHistogramRange 10 (replicate 10 1) == (0.9, 1.1)
> bHistogramRange 10 (replicate 10 0) == (-1, 1)
> bHistogramRange 10 [1 .. 10] == (0.5, 10.5)
> bHistogramRange 25 [1 .. 10] == (0.8125,10.1875)
-}
bHistogramRange :: Int -> [Double] -> (Double, Double)
bHistogramRange :: Int -> [Double] -> (Double, Double)
bHistogramRange Int
numBins [Double]
xs =
  let d :: Double
d = if Int
numBins forall a. Eq a => a -> a -> Bool
== Int
1 then Double
0 else (Double
hi forall a. Num a => a -> a -> a
- Double
lo) forall a. Fractional a => a -> a -> a
/ ((forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBins forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
2)
      (Double
lo, Double
hi) = forall t. Ord t => [t] -> (t, t)
minmax [Double]
xs
  in if Int
numBins forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
xs
     then forall a. HasCallStack => [Char] -> a
error [Char]
"bHistogramRange: empty sample"
     else if Double
lo forall a. Eq a => a -> a -> Bool
== Double
hi
          then let a :: Double
a = forall a. Num a => a -> a
abs Double
lo forall a. Fractional a => a -> a -> a
/ Double
10
               in if Double
a forall a. Ord a => a -> a -> Bool
< Double
smallestNormalizedValue then (-Double
1,Double
1) else (Double
lo forall a. Num a => a -> a -> a
- Double
a, Double
lo forall a. Num a => a -> a -> a
+ Double
a)
          else (Double
loforall a. Num a => a -> a -> a
-Double
d, Double
hiforall a. Num a => a -> a -> a
+Double
d)