{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Factorization
-- Copyright   :  (c) 2012 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- Factorization diagrams, as seen at
-- <http://mathlesstraveled.com/2012/10/05/factorization-diagrams/>
-- and
-- <http://mathlesstraveled.com/2012/11/05/more-factorization-diagrams/>
-- and on the cover of Hacker Monthly
-- (<http://hackermonthly.com/issue-31.html>): visually represent the
-- prime factorization of n by drawing n dots recursively grouped
-- according to the factors.
--
-- <<diagrams/src_Diagrams_TwoD_Factorization_grid100Big.svg#diagram=grid100Big&width=600>>
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Factorization where

import           Data.Char        (digitToInt)
import           Data.List.Split  (chunksOf)
import           Data.Maybe       (listToMaybe)
import           Diagrams.Prelude

-- | @primeLayout@ takes a positive integer p (the idea is for it to
--   be prime, though it doesn't really matter) and a diagram, and lays
--   out p rotated copies of the diagram in a circular pattern.
--
--   There is a special case for @p = 2@: if the given diagram is taller
--   than it is wide, then the two copies will be placed beside each
--   other; if wider then tall, they will be placed one above the
--   other.
--
--   The regular @p@-gon connecting the centers of the laid-out
--   diagrams is also filled in with vertical bars of color
--   representing the number @p@.  In particular, there is one color
--   for each decimal digit (the provided list should have length 10
--   and represents the digits 0-9), and the colors, read left to
--   right, give the decimal expansion of @p@.
--
--   > import Diagrams.TwoD.Factorization
--   > plExample
--   >   = pad 1.1 . centerXY
--   >   . hsep 0.5
--   >   . map (sized (mkWidth 1))
--   >   $ [ primeLayout defaultColors 5 (circle 1 # fc black)
--   >     , primeLayout defaultColors 103 (square 1 # fc green # lw none)
--   >     , primeLayout (repeat white) 13 (circle 1 # lc orange)
--   >     ]
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_plExample.svg#diagram=plExample&width=400>>
primeLayout :: (Renderable (Path V2 n) b, TypeableFloat n)
            => [Colour Double] -> Integer -> QDiagram b V2 n Any -> QDiagram b V2 n Any
primeLayout :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Colour Double]
-> Integer -> QDiagram b V2 n Any -> QDiagram b V2 n Any
primeLayout [Colour Double]
_ Integer
2 QDiagram b V2 n Any
d
  | forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width QDiagram b V2 n Any
d forall a. Ord a => a -> a -> Bool
>= forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height QDiagram b V2 n Any
d = (QDiagram b V2 n Any
d forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
=== forall (v :: * -> *) n b m.
(Metric v, R2 v, OrderedField n) =>
n -> QDiagram b v n m
strutY (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height QDiagram b V2 n Any
d forall a. Fractional a => a -> a -> a
/ n
3) forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
=== QDiagram b V2 n Any
d forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY)
                        # centerY
  | Bool
otherwise           = (QDiagram b V2 n Any
d forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
||| forall (v :: * -> *) n b m.
(Metric v, R1 v, OrderedField n) =>
n -> QDiagram b v n m
strutX (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width QDiagram b V2 n Any
d forall a. Fractional a => a -> a -> a
/ n
3)  forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
||| QDiagram b V2 n Any
d)
                        # centerX
primeLayout [Colour Double]
colors Integer
p QDiagram b V2 n Any
d
  = (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
       forall a b. (a -> b) -> [a] -> [b]
map (\Integer
n -> QDiagram b V2 n Any
d forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY n
r forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy
              (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
nforall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p)) [Integer
0..Integer
pforall a. Num a => a -> a -> a
-Integer
1]
    )
    forall a. Semigroup a => a -> a -> a
<>
    forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Colour Double] -> Integer -> Path V2 n -> QDiagram b V2 n Any
colorBars [Colour Double]
colors Integer
p Path V2 n
poly
  where poly :: Path V2 n
poly = forall n t. (InSpace V2 n t, TrailLike t) => PolygonOpts n -> t
polygon (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (PolygonOpts n) (PolyType n)
polyType   forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall n. Int -> n -> PolyType n
PolyRegular (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p) n
r
                             forall a b. a -> (a -> b) -> b
& forall n. Lens' (PolygonOpts n) (PolyOrientation n)
polyOrient forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall n. PolyOrientation n
OrientH
                            )
        w :: n
w  = forall a. Ord a => a -> a -> a
max (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width QDiagram b V2 n Any
d) (forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height QDiagram b V2 n Any
d)
        r :: n
r  = n
w forall a. Num a => a -> a -> a
* n
c forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
sin (forall a. Floating a => a
tau forall a. Fractional a => a -> a -> a
/ (n
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p))
        c :: n
c  = n
0.75

-- | Draw vertical bars of color inside a polygon which represent the
--   decimal expansion of @p@, using the provided list of colors to
--   represent the digits 0-9.
--
--   > import Diagrams.TwoD.Factorization
--   > colorBarsEx = colorBars defaultColors 3526 (square 1)
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_colorBarsEx.svg#diagram=colorBarsEx&width=200>>
colorBars :: (Renderable (Path V2 n) b, TypeableFloat n)
          => [Colour Double] -> Integer -> Path V2 n -> QDiagram b V2 n Any
colorBars :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Colour Double] -> Integer -> Path V2 n -> QDiagram b V2 n Any
colorBars [Colour Double]
colors Integer
p Path V2 n
poly | Integer
p forall a. Ord a => a -> a -> Bool
<= Integer
11 = forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Path V2 n
poly
                             # fc (colors!!(fromIntegral p `mod` 10))
                             # lw none
colorBars [Colour Double]
colors Integer
p Path V2 n
poly = QDiagram b V2 n Any
bars forall a b. a -> (a -> b) -> b
# forall a n.
(HasStyle a, V a ~ V2, N a ~ n, TypeableFloat n) =>
Path V2 n -> a -> a
clipBy Path V2 n
poly
  where
    barColors :: [Colour Double]
barColors = forall a b. (a -> b) -> [a] -> [b]
map (([Colour Double]
colorsforall a. [a] -> Int -> a
!!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt) (forall a. Show a => a -> String
show Integer
p)
    barW :: n
barW = forall n a. (InSpace V2 n a, Enveloped a) => a -> n
width Path V2 n
poly forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Colour Double]
barColors)
    barH :: n
barH = forall n a. (InSpace V2 n a, Enveloped a) => a -> n
height Path V2 n
poly
    bars :: QDiagram b V2 n Any
bars = (forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Colour Double
c -> forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
barW n
barH forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c) [Colour Double]
barColors)
           # centerX

-- | A default set of digit colors, based very loosely on the color
--   code for resistors (<http://en.wikipedia.org/wiki/Electronic_color_code>),
--   lightened up a bit by blending with white.
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_showDefaultColors.svg#diagram=showDefaultColors&height=50>>
defaultColors :: [Colour Double]
defaultColors :: [Colour Double]
defaultColors = forall a b. (a -> b) -> [a] -> [b]
map (forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend Double
0.1 forall a. (Ord a, Floating a) => Colour a
white)
  [forall a. Num a => Colour a
black,forall a. (Ord a, Floating a) => Colour a
red,forall a. (Ord a, Floating a) => Colour a
orange,forall a. (Ord a, Floating a) => Colour a
yellow,forall a. (Ord a, Floating a) => Colour a
green,forall a. (Ord a, Floating a) => Colour a
blue,forall a. (Ord a, Floating a) => Colour a
gray,forall a. (Ord a, Floating a) => Colour a
purple,forall a. (Ord a, Floating a) => Colour a
white,forall a. (Ord a, Floating a) => Colour a
brown]

-- > import Diagrams.TwoD.Factorization
-- > showDefaultColors = hcat $ zipWith showColor defaultColors [0..]
-- >   where
-- >     showColor c d = text (show d) <> square 1 # fc c # lw none

-- | Create a centered factorization diagram from the given list of
--   factors (intended to be primes, but again, any positive integers
--   will do; note how the below example uses 6), by recursively
--   folding according to 'primeLayout', with the 'defaultColors' and
--   a base case of a black circle.
--
--   > import Diagrams.TwoD.Factorization
--   > factorDiagram'Ex = factorDiagram' [2,5,6]
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_factorDiagram'Ex.svg#diagram=factorDiagram'Ex&height=200>>
factorDiagram' :: (Renderable (Path V2 n) b, TypeableFloat n)
               => [Integer] -> QDiagram b V2 n Any
factorDiagram' :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Integer] -> QDiagram b V2 n Any
factorDiagram' = forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Colour Double]
-> Integer -> QDiagram b V2 n Any -> QDiagram b V2 n Any
primeLayout [Colour Double]
defaultColors) (forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
1 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc forall a. Num a => Colour a
black forall a b. a -> (a -> b) -> b
# forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw forall n. OrderedField n => Measure n
none)

-- | Create a default factorization diagram for the given integer, by
--   factoring it and calling 'factorDiagram'' on its prime
--   factorization (with the factors ordered from smallest to
--   biggest).
--
--   > import Diagrams.TwoD.Factorization
--   > factorDiagramEx = factorDiagram 700
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_factorDiagramEx.svg#diagram=factorDiagramEx&width=400>>
factorDiagram :: (Renderable (Path V2 n) b, TypeableFloat n)
              => Integer -> QDiagram b V2 n Any
factorDiagram :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Integer -> QDiagram b V2 n Any
factorDiagram = forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[Integer] -> QDiagram b V2 n Any
factorDiagram' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Integer]
factors

factors :: Integer -> [Integer]
factors :: Integer -> [Integer]
factors Integer
1 = []
factors Integer
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Integer
n] (\Integer
a -> Integer
a forall a. a -> [a] -> [a]
: Integer -> [Integer]
factors (Integer
n forall a. Integral a => a -> a -> a
`div` Integer
a)) Maybe Integer
mf
  where
    mf :: Maybe Integer
mf = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Integer
x -> (Integer
n forall a. Integral a => a -> a -> a
`mod` Integer
x) forall a. Eq a => a -> a -> Bool
== Integer
0) [Integer
2 .. Integer
n forall a. Num a => a -> a -> a
- Integer
1]
    -- only need to go to @intSqrt n@ really

-- | Place a diagram inside a square with the given side length,
--   centering and scaling it to fit with a bit of padding.
--
--   > import Diagrams.TwoD.Factorization
--   > ensquareEx = ensquare 1 (circle 25) ||| ensquare 1 (factorDiagram 30)
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_ensquareEx.svg#diagram=ensquareEx&width=200>>
ensquare
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
ensquare :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
ensquare n
n QDiagram b V2 n Any
d = QDiagram b V2 n Any
d forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, HasLinearMap v, Transformable a, Enveloped a) =>
SizeSpec v n -> a -> a
sized (forall n. n -> n -> SizeSpec V2 n
dims2D (n
0.8forall a. Num a => a -> a -> a
*n
n) (n
0.8forall a. Num a => a -> a -> a
*n
n)) forall a. Semigroup a => a -> a -> a
<> forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square n
n

-- | @fdGrid n@ creates a grid of factorization diagrams, given a list
--   of lists of integers: the inner lists represent L-R rows, which
--   are laid out from top to bottom.
--
--   > import Diagrams.TwoD.Factorization
--   > fdGridEx = fdGrid [[7,6,5],[4,19,200],[1,10,50]]
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_fdGridEx.svg#diagram=fdGridEx&width=200>>
fdGrid
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => [[Integer]] -> QDiagram b V2 n Any
fdGrid :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[[Integer]] -> QDiagram b V2 n Any
fdGrid  = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
[a] -> a
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
ensquare n
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Integer -> QDiagram b V2 n Any
factorDiagram)

-- | @fdGridList n@ creates a grid containing the factorization
--   diagrams of all the numbers from @1@ to @n^2@, ordered left to
--   right, top to bottom (like the grid seen on the cover of Hacker
--   Monthly, <http://hackermonthly.com/issue-31.html>).
--
--   > import Diagrams.TwoD.Factorization
--   > grid100 = fdGridList 10
--   > grid100Big = grid100
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_grid100.svg#diagram=grid100&width=400>>
fdGridList
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => Integer -> QDiagram b V2 n Any
fdGridList :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Integer -> QDiagram b V2 n Any
fdGridList Integer
n = forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[[Integer]] -> QDiagram b V2 n Any
fdGrid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Int -> [e] -> [[e]]
chunksOf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) forall a b. (a -> b) -> a -> b
$ [Integer
1..Integer
nforall a. Num a => a -> a -> a
*Integer
n]

-- | @fdTable n@ creates a \"multiplication table\" of factorization
--   diagrams, with the diagrams for @1@ to @n@ along both the top row
--   and left column, and the diagram for @m*n@ in row @m@ and column
--   @n@.
--
--   > import Diagrams.TwoD.Factorization
--   > fdMultTableEx = fdMultTable 13
--
--   <<diagrams/src_Diagrams_TwoD_Factorization_fdMultTableEx.svg#diagram=fdMultTableEx&width=600>>
fdMultTable
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => Integer -> QDiagram b V2 n Any
fdMultTable :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Integer -> QDiagram b V2 n Any
fdMultTable Integer
n = forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
[[Integer]] -> QDiagram b V2 n Any
fdGrid [ [Integer
rforall a. Num a => a -> a -> a
*Integer
c | Integer
c <- [Integer
1 .. Integer
n]] | Integer
r <- [Integer
1 .. Integer
n] ]