23 lines
638 B
Haskell
23 lines
638 B
Haskell
module Petzval.Calculations where
|
|
|
|
import Control.Arrow
|
|
import Data.Foldable
|
|
import Linear
|
|
|
|
|
|
|
|
foldl1' fn (x:xs) = foldl' fn x xs
|
|
|
|
bimap2 :: (a -> b -> c) -> (a' -> b' -> c') -> (a,a') -> (b,b') -> (c,c')
|
|
bimap2 af bf (a,b) (a',b') = (af a a', bf b b')
|
|
|
|
rmsSize' :: Floating a => V2 a -> [V2 a] -> a
|
|
rmsSize' centroid = sqrt . uncurry (/) . foldl1' (bimap2 (+) (+)) . map (quadrance . (^-^ centroid) &&& (const 1))
|
|
|
|
rmsSize :: Floating a => [V2 a] -> a
|
|
rmsSize [] = 1/0
|
|
rmsSize points = rmsSize' (centroid points) points
|
|
|
|
centroid :: Fractional a => [V2 a] -> V2 a
|
|
centroid = uncurry (^/) . foldl1' (bimap2 (^+^) (+)) . map (flip (,) 1)
|