{-# LANGUAGE FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Layout.CirclePacking
-- Copyright   :  (c) 2012 Joachim Breitner
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  mail@joachim-breitner.de
--
-- A method for laying out diagrams using a circle packing algorithm. For
-- details on the algorithm, see "Optimisation.CirclePacking" in the module
-- circle-packing.
--
-- Here is an example:
--
-- > import Optimisation.CirclePacking
-- > import Diagrams.TwoD.Vector       (e)
-- >
-- > colorize = zipWith fc $
-- >     cycle [red,blue,yellow,magenta,cyan,bisque,firebrick,indigo]
-- >
-- > objects = colorize $
-- >     [ circle r  | r <- [0.1,0.2..1.6] ] ++
-- >     [ hexagon r | r <- [0.1,0.2..0.7] ] ++
-- >     [ decagon r | r <- [0.1,0.2..0.7] ]
-- >
-- > -- Just a approximation, diagram objects do not have an exact radius
-- > radiusApproximation o = maximum [ radius (e (alpha @@ turn)) o | alpha <- [0,0.1..1.0]]
-- >
-- > circlePackingExample =
-- >     position $ map (\(o,(x,y)) -> (p2 (x,y),o)) $
-- >     packCircles radiusApproximation objects
--
-- <<diagrams/src_Diagrams_TwoD_Layout_CirclePacking_circlePackingExample.svg#diagram=circlePackingExample&width=400>>

module Diagrams.TwoD.Layout.CirclePacking
       ( renderCirclePacking
       , createCirclePacking
       , RadiusFunction
       , approxRadius
       , circleRadius ) where

import           Optimisation.CirclePacking

import           Diagrams.Core.Envelope
import           Diagrams.Prelude
import           Diagrams.TwoD.Vector       (e)


-- | Combines the passed objects, whose radius is estimated using the given
-- 'RadiusFunction', so that they do not overlap (according to the radius
-- function) and otherwise form, as far as possible, a tight circle.
renderCirclePacking :: (Monoid' m, Floating (N b), Ord (N b)) => RadiusFunction b m -> [QDiagram b V2 (N b) m] -> QDiagram b V2 (N b) m
renderCirclePacking :: forall m b.
(Monoid' m, Floating (N b), Ord (N b)) =>
RadiusFunction b m
-> [QDiagram b V2 (N b) m] -> QDiagram b V2 (N b) m
renderCirclePacking RadiusFunction b m
radiusFunc = RadiusFunction b m
-> (QDiagram b V2 (N b) m -> QDiagram b V2 (N b) m)
-> [QDiagram b V2 (N b) m]
-> QDiagram b V2 (N b) m
forall m b a.
(Monoid' m, Ord (N b), Floating (N b)) =>
(a -> Double)
-> (a -> QDiagram b V2 (N b) m) -> [a] -> QDiagram b V2 (N b) m
createCirclePacking RadiusFunction b m
radiusFunc QDiagram b V2 (N b) m -> QDiagram b V2 (N b) m
forall a. a -> a
id

toFractional :: (Real a, Fractional b) => a -> b
toFractional :: forall a b. (Real a, Fractional b) => a -> b
toFractional = Rational -> b
forall a. Fractional a => Rational -> a
fromRational (Rational -> b) -> (a -> Rational) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rational
forall a. Real a => a -> Rational
toRational

-- | More general version of 'renderCirclePacking'. You can use this if you
-- have more information available in the values of type @a@ that allows you to
-- calculate the radius better (or even exactly).
createCirclePacking :: (Monoid' m, Ord (N b), Floating (N b)) => (a -> Double) -> (a -> QDiagram b V2 (N b) m) -> [a] -> QDiagram b V2 (N b) m
createCirclePacking :: forall m b a.
(Monoid' m, Ord (N b), Floating (N b)) =>
(a -> Double)
-> (a -> QDiagram b V2 (N b) m) -> [a] -> QDiagram b V2 (N b) m
createCirclePacking a -> Double
radiusFunc a -> QDiagram b V2 (N b) m
diagramFunc =
    [(Point V2 (N b), QDiagram b V2 (N b) m)] -> QDiagram b V2 (N b) m
forall (v :: * -> *) n a.
(InSpace v n a, HasOrigin a, Monoid' a) =>
[(Point v n, a)] -> a
position ([(Point V2 (N b), QDiagram b V2 (N b) m)]
 -> QDiagram b V2 (N b) m)
-> ([a] -> [(Point V2 (N b), QDiagram b V2 (N b) m)])
-> [a]
-> QDiagram b V2 (N b) m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((a, (Double, Double)) -> (Point V2 (N b), QDiagram b V2 (N b) m))
-> [(a, (Double, Double))]
-> [(Point V2 (N b), QDiagram b V2 (N b) m)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
o,(Double
x,Double
y)) -> ((N b, N b) -> Point V2 (N b)
forall n. (n, n) -> P2 n
p2 (Double -> N b
forall a b. (Real a, Fractional b) => a -> b
toFractional Double
x, Double -> N b
forall a b. (Real a, Fractional b) => a -> b
toFractional Double
y), a -> QDiagram b V2 (N b) m
diagramFunc a
o)) ([(a, (Double, Double))]
 -> [(Point V2 (N b), QDiagram b V2 (N b) m)])
-> ([a] -> [(a, (Double, Double))])
-> [a]
-> [(Point V2 (N b), QDiagram b V2 (N b) m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (a -> Double) -> [a] -> [(a, (Double, Double))]
forall a. (a -> Double) -> [a] -> [(a, (Double, Double))]
packCircles a -> Double
radiusFunc

-- | The type of radius-estimating functions for Diagrams such as
-- 'approxRadius' and 'circleRadius'. When you can calculate the radius better,
-- but not any more once you converted your data to a diagram, use 'createCirclePacking'.
type RadiusFunction b m = QDiagram b V2 (N b) m -> Double

-- | A safe approximation. Calculates the outer radius of the smallest
-- axis-aligned polygon with the given number of edges that contains the
-- object. A parameter of 4 up to 8 should be sufficient for most applications.
approxRadius :: (Monoid' m, Floating (N b), Real (N b), Ord (N b)) => Int -> RadiusFunction b m
approxRadius :: forall m b.
(Monoid' m, Floating (N b), Real (N b), Ord (N b)) =>
Int -> RadiusFunction b m
approxRadius Int
n =
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
    then [Char] -> QDiagram b V2 (N b) m -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"circleRadius: n needs to be at least 3"
    else \QDiagram b V2 (N b) m
o -> Double
outByIn Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ N (QDiagram b V2 (N b) m) -> Double
forall a b. (Real a, Fractional b) => a -> b
toFractional (V2 (N (QDiagram b V2 (N b) m))
-> QDiagram b V2 (N b) m -> N (QDiagram b V2 (N b) m)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
envelopeS (Angle (N (QDiagram b V2 (N b) m)) -> V2 (N (QDiagram b V2 (N b) m))
forall n. Floating n => Angle n -> V2 n
e Angle (N (QDiagram b V2 (N b) m))
alpha) QDiagram b V2 (N b) m
o)
                          | Int
i <- [Int
1..Int
n]
                          , let alpha :: Angle (N (QDiagram b V2 (N b) m))
alpha = (Int -> N (QDiagram b V2 (N b) m)
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i N (QDiagram b V2 (N b) m)
-> N (QDiagram b V2 (N b) m) -> N (QDiagram b V2 (N b) m)
forall a. Num a => a -> a -> a
+ N (QDiagram b V2 (N b) m)
0.5) N (QDiagram b V2 (N b) m)
-> N (QDiagram b V2 (N b) m) -> N (QDiagram b V2 (N b) m)
forall a. Fractional a => a -> a -> a
/ Int -> N (QDiagram b V2 (N b) m)
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n N (QDiagram b V2 (N b) m)
-> AReview
     (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
-> Angle (N (QDiagram b V2 (N b) m))
forall b a. b -> AReview a b -> a
@@ AReview
  (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
forall n. Floating n => Iso' (Angle n) n
Iso'
  (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
turn
                          ]
    -- incircle radius: a / (2 * tan (tau/n))
    -- outcircle radius: a / (2 * sin (tau /n))
    -- hence factor is : out/in = tan (tau/n) / sin (tau/n)
  where
    outByIn :: Double
outByIn = Double -> Double
forall a. Floating a => a -> a
Prelude.tan (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sin (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))
--
-- | An unsafe approximation. This is the radius of the largest circle that
-- fits in the rectangular bounding box of the object, so it may be too small.
-- It is, however, exact for circles, and there is no function that is safe for
-- all diagrams and exact for circles.
circleRadius :: (Monoid' m, Floating (N b), Real (N b)) => RadiusFunction b m
circleRadius :: forall m b.
(Monoid' m, Floating (N b), Real (N b)) =>
RadiusFunction b m
circleRadius QDiagram b V2 (N b) m
o = N (QDiagram b V2 (N b) m) -> Double
forall a b. (Real a, Fractional b) => a -> b
toFractional (N (QDiagram b V2 (N b) m) -> Double)
-> N (QDiagram b V2 (N b) m) -> Double
forall a b. (a -> b) -> a -> b
$ [N (QDiagram b V2 (N b) m)] -> N (QDiagram b V2 (N b) m)
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ V2 (N (QDiagram b V2 (N b) m))
-> QDiagram b V2 (N b) m -> N (QDiagram b V2 (N b) m)
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> n
envelopeS (Angle (N (QDiagram b V2 (N b) m)) -> V2 (N (QDiagram b V2 (N b) m))
forall n. Floating n => Angle n -> V2 n
e (N (QDiagram b V2 (N b) m)
alpha N (QDiagram b V2 (N b) m)
-> AReview
     (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
-> Angle (N (QDiagram b V2 (N b) m))
forall b a. b -> AReview a b -> a
@@ AReview
  (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
forall n. Floating n => Iso' (Angle n) n
Iso'
  (Angle (N (QDiagram b V2 (N b) m))) (N (QDiagram b V2 (N b) m))
turn)) QDiagram b V2 (N b) m
o | N (QDiagram b V2 (N b) m)
alpha <- [N (QDiagram b V2 (N b) m)
0,N (QDiagram b V2 (N b) m)
0.25,N (QDiagram b V2 (N b) m)
0.5,N (QDiagram b V2 (N b) m)
0.75]]