-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Points
-- Copyright   :  (c) 2011 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Points in space.  For more tools for working with points and
-- vectors, see "Linear.Affine".
--
-----------------------------------------------------------------------------

module Diagrams.Points
       ( -- * Points
         Point (..), origin, (*.)

         -- * Point-related utilities
       , centroid
       , pointDiagram
       , _Point, lensP
       ) where

import           Diagrams.Core        (pointDiagram)
import           Diagrams.Core.Points

import           Data.Foldable        as F

import           Linear.Affine
import           Linear.Vector

-- | The centroid of a set of /n/ points is their sum divided by /n/.
--   Returns the origin for an empty list of points.
centroid :: (Additive v, Fractional n) => [Point v n] -> Point v n
centroid :: [Point v n] -> Point v n
centroid [] = Point v n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
centroid [Point v n]
ps = [Point v n] -> Point v n
forall (f :: * -> *) (v :: * -> *) a.
(Foldable f, Additive v, Fractional a) =>
f (v a) -> v a
meanV [Point v n]
ps
{-# INLINE centroid #-}

meanV :: (Foldable f, Additive v, Fractional a) => f (v a) -> v a
meanV :: f (v a) -> v a
meanV = (v a -> a -> v a) -> (v a, a) -> v a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry v a -> a -> v a
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
(^/) ((v a, a) -> v a) -> (f (v a) -> (v a, a)) -> f (v a) -> v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v a, a) -> v a -> (v a, a)) -> (v a, a) -> f (v a) -> (v a, a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\(v a
s,a
c) v a
e -> (v a
e v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v a
s,a
ca -> a -> a
forall a. Num a => a -> a -> a
+a
1)) (v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero,a
0)
{-# INLINE meanV #-}