{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE DataKinds #-}
-- |
-- Module      : Graphics.Color.Illuminant.CIE1931
-- Copyright   : (c) Alexey Kuleshevich 2019-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Graphics.Color.Illuminant.CIE1931
  ( CIE1931(..)
  , spectralPowerDistributions
  , xyzColorMatchingFunctions
  -- , xyzColorMatchingFunctions1nm
  , rectifyColorTemperature
  , wavelengths
  ) where

import Graphics.Color.Algebra
import Graphics.Color.Space.Internal

-- | Planckian constant has changed over the years, this function adjusts for that fact.
--
-- @since 0.1.0
rectifyColorTemperature ::
     Int
  -- ^ Original temperature
  -> Double
  -- ^ Original radiation constant c2
  -> CCT (i :: k)
rectifyColorTemperature :: Int -> Double -> CCT i
rectifyColorTemperature Int
cct Double
c2 = Double -> CCT i
forall k (i :: k). Double -> CCT i
CCT (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cct Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.4388 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
c2)
  --CCT (fromIntegral cct * 1.438776877 / c2) <-- Planckian radiation constant from 2018


-- | @[x=0.44758, y=0.40745]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'A   where
  type Temperature 'A = 2856
  whitePoint :: WhitePoint 'A e
whitePoint = e -> e -> WhitePoint 'A e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44758 e
0.40745
  colorTemperature :: CCT 'A
colorTemperature = Int -> Double -> CCT 'A
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
2848 Double
1.4350

-- | @[x=0.34842, y=0.35161]@ - CIE 1931 2° Observer -
-- /https://www.colour-science.org/
instance Illuminant 'B   where
  type Temperature 'B = 4874
  whitePoint :: WhitePoint 'B e
whitePoint = e -> e -> WhitePoint 'B e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34842 e
0.35161

-- | @[x=0.31006, y=0.31616]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'C   where
  type Temperature 'C = 6774
  whitePoint :: WhitePoint 'C e
whitePoint = e -> e -> WhitePoint 'C e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31006 e
0.31616

-- | @[x=0.34567, y=0.35851]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'D50 where
  type Temperature 'D50 = 5003
  whitePoint :: WhitePoint 'D50 e
whitePoint = e -> e -> WhitePoint 'D50 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34567 e
0.35851
  colorTemperature :: CCT 'D50
colorTemperature = Int -> Double -> CCT 'D50
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
5000 Double
1.4380

-- | @[x=0.33243, y=0.34744]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'D55 where
  type Temperature 'D55 = 5503
  whitePoint :: WhitePoint 'D55 e
whitePoint = e -> e -> WhitePoint 'D55 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.33243 e
0.34744
  colorTemperature :: CCT 'D55
colorTemperature = Int -> Double -> CCT 'D55
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
5500 Double
1.4380

-- | @[x=0.32163, y=0.33774]@ - CIE 1931 2° Observer -
-- /https://www.colour-science.org (rounded to 5 decimal points)/
instance Illuminant 'D60 where
  type Temperature 'D60 = 6003
  whitePoint :: WhitePoint 'D60 e
whitePoint = e -> e -> WhitePoint 'D60 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.32163 e
0.33774
  colorTemperature :: CCT 'D60
colorTemperature = Int -> Double -> CCT 'D60
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
6000 Double
1.4380

-- | @[x=0.31272, y=0.32903]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'D65 where
  type Temperature 'D65 = 6504
  whitePoint :: WhitePoint 'D65 e
whitePoint = e -> e -> WhitePoint 'D65 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31272 e
0.32903
  colorTemperature :: CCT 'D65
colorTemperature = Int -> Double -> CCT 'D65
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
6500 Double
1.4380

-- | @[x=0.29903, y=0.31488]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'D75 where
  type Temperature 'D75 = 7504
  whitePoint :: WhitePoint 'D75 e
whitePoint = e -> e -> WhitePoint 'D75 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.29903 e
0.31488
  colorTemperature :: CCT 'D75
colorTemperature = Int -> Double -> CCT 'D75
forall k (i :: k). Int -> Double -> CCT i
rectifyColorTemperature Int
7500 Double
1.4380

-- | @[x=1\/3, y=1\/3]@ - CIE 1931 2° Observer -
-- /https://www.colour-science.org/
instance Illuminant 'E   where
  type Temperature 'E = 5454
  whitePoint :: WhitePoint 'E e
whitePoint = e -> e -> WhitePoint 'E e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
3) (e
1 e -> e -> e
forall a. Fractional a => a -> a -> a
/ e
3)


-- | @[x=0.31310, y=0.33710]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL1  where
  type Temperature 'FL1 = 6430
  whitePoint :: WhitePoint 'FL1 e
whitePoint = e -> e -> WhitePoint 'FL1 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31310 e
0.33710

-- | @[x=0.37210, y=0.37510]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL2  where
  type Temperature 'FL2 = 4230
  whitePoint :: WhitePoint 'FL2 e
whitePoint = e -> e -> WhitePoint 'FL2 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37210 e
0.37510

-- | @[x=0.40910, y=0.39410]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3  where
  type Temperature 'FL3 = 3450
  whitePoint :: WhitePoint 'FL3 e
whitePoint = e -> e -> WhitePoint 'FL3 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.40910 e
0.39410

-- | @[x=0.44020, y=0.40310]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL4  where
  type Temperature 'FL4 = 2940
  whitePoint :: WhitePoint 'FL4 e
whitePoint = e -> e -> WhitePoint 'FL4 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44020 e
0.40310

-- | @[x=0.31380, y=0.34520]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL5  where
  type Temperature 'FL5 = 6350
  whitePoint :: WhitePoint 'FL5 e
whitePoint = e -> e -> WhitePoint 'FL5 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31380 e
0.34520

-- | @[x=0.37790, y=0.38820]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL6  where
  type Temperature 'FL6 = 4150
  whitePoint :: WhitePoint 'FL6 e
whitePoint = e -> e -> WhitePoint 'FL6 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37790 e
0.38820

-- | @[x=0.31290, y=0.32920]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL7  where
  type Temperature 'FL7 = 6500
  whitePoint :: WhitePoint 'FL7 e
whitePoint = e -> e -> WhitePoint 'FL7 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31290 e
0.32920

-- | @[x=0.34580, y=0.35860]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL8  where
  type Temperature 'FL8 = 5000
  whitePoint :: WhitePoint 'FL8 e
whitePoint = e -> e -> WhitePoint 'FL8 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34580 e
0.35860

-- | @[x=0.37410, y=0.37270]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL9  where
  type Temperature 'FL9 = 4150
  whitePoint :: WhitePoint 'FL9 e
whitePoint = e -> e -> WhitePoint 'FL9 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37410 e
0.37270

-- | @[x=0.34580, y=0.35880]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL10 where
  type Temperature 'FL10 = 5000
  whitePoint :: WhitePoint 'FL10 e
whitePoint = e -> e -> WhitePoint 'FL10 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34580 e
0.35880

-- | @[x=0.38050, y=0.37690]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL11 where
  type Temperature 'FL11 = 4000
  whitePoint :: WhitePoint 'FL11 e
whitePoint = e -> e -> WhitePoint 'FL11 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38050 e
0.37690

-- | @[x=0.43700, y=0.40420]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL12 where
  type Temperature 'FL12 = 3000
  whitePoint :: WhitePoint 'FL12 e
whitePoint = e -> e -> WhitePoint 'FL12 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.43700 e
0.40420


-- | @[x=0.44070, y=0.40330]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_1 where
  type Temperature 'FL3_1 = 2932
  whitePoint :: WhitePoint 'FL3_1 e
whitePoint = e -> e -> WhitePoint 'FL3_1 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44070 e
0.40330

-- | @[x=0.38080, y=0.37340]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_2 where
  type Temperature 'FL3_2 = 3965
  whitePoint :: WhitePoint 'FL3_2 e
whitePoint = e -> e -> WhitePoint 'FL3_2 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38080 e
0.37340

-- | @[x=0.31530, y=0.34390]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_3 where
  type Temperature 'FL3_3 = 6280
  whitePoint :: WhitePoint 'FL3_3 e
whitePoint = e -> e -> WhitePoint 'FL3_3 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31530 e
0.34390

-- | @[x=0.44290, y=0.40430]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_4 where
  type Temperature 'FL3_4 = 2904
  whitePoint :: WhitePoint 'FL3_4 e
whitePoint = e -> e -> WhitePoint 'FL3_4 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.44290 e
0.40430

-- | @[x=0.37490, y=0.36720]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_5 where
  type Temperature 'FL3_5 = 4086
  whitePoint :: WhitePoint 'FL3_5 e
whitePoint = e -> e -> WhitePoint 'FL3_5 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37490 e
0.36720

-- | @[x=0.34880, y=0.36000]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_6 where
  type Temperature 'FL3_6 = 4894
  whitePoint :: WhitePoint 'FL3_6 e
whitePoint = e -> e -> WhitePoint 'FL3_6 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34880 e
0.36000

-- | @[x=0.43840, y=0.40450]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_7 where
  type Temperature 'FL3_7 = 2979
  whitePoint :: WhitePoint 'FL3_7 e
whitePoint = e -> e -> WhitePoint 'FL3_7 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.43840 e
0.40450

-- | @[x=0.38200, y=0.38320]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_8 where
  type Temperature 'FL3_8 = 4006
  whitePoint :: WhitePoint 'FL3_8 e
whitePoint = e -> e -> WhitePoint 'FL3_8 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38200 e
0.38320

-- | @[x=0.34990, y=0.35910]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_9 where
  type Temperature 'FL3_9 = 4853
  whitePoint :: WhitePoint 'FL3_9 e
whitePoint = e -> e -> WhitePoint 'FL3_9 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34990 e
0.35910

-- | @[x=0.34550, y=0.35600]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_10 where
  type Temperature 'FL3_10 = 5000
  whitePoint :: WhitePoint 'FL3_10 e
whitePoint = e -> e -> WhitePoint 'FL3_10 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34550 e
0.35600

-- | @[x=0.32450, y=0.34340]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_11 where
  type Temperature 'FL3_11 = 5854
  whitePoint :: WhitePoint 'FL3_11 e
whitePoint = e -> e -> WhitePoint 'FL3_11 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.32450 e
0.34340

-- | @[x=0.43770, y=0.40370]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_12 where
  type Temperature 'FL3_12 = 2984
  whitePoint :: WhitePoint 'FL3_12 e
whitePoint = e -> e -> WhitePoint 'FL3_12 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.43770 e
0.40370

-- | @[x=0.38300, y=0.37240]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_13 where
  type Temperature 'FL3_13 = 3896
  whitePoint :: WhitePoint 'FL3_13 e
whitePoint = e -> e -> WhitePoint 'FL3_13 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38300 e
0.37240

-- | @[x=0.34470, y=0.36090]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_14 where
  type Temperature 'FL3_14 = 5045
  whitePoint :: WhitePoint 'FL3_14 e
whitePoint = e -> e -> WhitePoint 'FL3_14 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.34470 e
0.36090

-- | @[x=0.31270, y=0.32880]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'FL3_15 where
  type Temperature 'FL3_15 = 6509
  whitePoint :: WhitePoint 'FL3_15 e
whitePoint = e -> e -> WhitePoint 'FL3_15 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.31270 e
0.32880


-- | @[x=0.53300, y=0.41500]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'HP1  where
  type Temperature 'HP1 = 1959
  whitePoint :: WhitePoint 'HP1 e
whitePoint = e -> e -> WhitePoint 'HP1 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.53300 e
0.41500

-- | @[x=0.47780, y=0.41580]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'HP2  where
  type Temperature 'HP2 = 2506
  whitePoint :: WhitePoint 'HP2 e
whitePoint = e -> e -> WhitePoint 'HP2 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.47780 e
0.41580

-- | @[x=0.43020, y=0.40750]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'HP3  where
  type Temperature 'HP3 = 3144
  whitePoint :: WhitePoint 'HP3 e
whitePoint = e -> e -> WhitePoint 'HP3 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.43020 e
0.40750

-- | @[x=0.38120, y=0.37970]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'HP4  where
  type Temperature 'HP4 = 4002
  whitePoint :: WhitePoint 'HP4 e
whitePoint = e -> e -> WhitePoint 'HP4 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.38120 e
0.37970

-- | @[x=0.37760, y=0.37130]@ - CIE 1931 2° Observer -
-- /CIE15: Technical Report: Colorimetry, 3rd edition/
instance Illuminant 'HP5  where
  type Temperature 'HP5 = 4039
  whitePoint :: WhitePoint 'HP5 e
whitePoint = e -> e -> WhitePoint 'HP5 e
forall k e (i :: k). e -> e -> WhitePoint i e
WhitePoint e
0.37760 e
0.37130


-- | CIE 1931 2° observer illuminants
--
-- References:
--
-- * [CIE15: Technical Report: Colorimetry, 3rd edition](https://web.archive.org/web/20190510201823/https://www.cdvplus.cz/file/3-publikace-cie15-2004/)
-- * [HunterLab: Equivalent White Light Sources and CIE Illuminants](https://web.archive.org/web/20050523033826/http://www.hunterlab.com:80/appnotes/an05_05.pdf)

data CIE1931
  = A
  -- ^ Incandescent / Tungsten
  | B
  -- ^ Direct sunlight at noon (obsolete)
  | C
  -- ^ Average / North sky Daylight (obsolete)
  | D50
  -- ^  Horizon Light.
  | D55
  -- ^ Mid-morning / Mid-afternoon Daylight
  | D60
  | D65
  -- ^ Noon Daylight
  | D75
  -- ^ Overcast dayligh / North sky Daylight
  | E
  -- ^ Equal energy
  | FL1
  -- ^ Daylight Fluorescent
  | FL2
  -- ^ The fluorescent illuminant in most common use, represents cool white fluorescent
  -- (4100° Kelvin, CRI 60). Non-standard names include F, F02, Fcw, CWF, CWF2.
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL3
  -- ^ White Fluorescent
  | FL4
  -- ^ Warm White Fluorescent
  | FL5
  -- ^ Daylight Fluorescent
  | FL6
  -- ^ Lite White Fluorescent
  | FL7
  -- ^ Represents a broadband fluorescent lamp, which approximates CIE illuminant `D65`
  -- (6500° Kelvin, CRI 90).
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL8
  -- ^ `D50` simulator, Sylvania F40 Design 50 (F40DSGN50)
  | FL9
  -- ^ Cool White Deluxe Fluorescent
  | FL10
  -- ^ Philips TL85, Ultralume 50
  | FL11
  -- ^ Philips TL84, SP41, Ultralume 40
  --
  -- Represents a narrow tri-band fluorescent of 4000° Kelvin color temperature, CRI 83.
  --
  -- /Note/ - Takes precedence over other F illuminants
  | FL12
  -- ^ Philips TL83, Ultralume 30
  | FL3_1
  -- ^ Standard halophosphate lamp (New set of fluorescent lamps)
  | FL3_2
  -- ^ Standard halophosphate lamp (New set of fluorescent lamps)
  | FL3_3
  -- ^ Standard halophosphate lamp (New set of fluorescent lamps)
  | FL3_4
  -- ^ Deluxe type lamp (New set of fluorescent lamps)
  | FL3_5
  -- ^ Deluxe type lamp (New set of fluorescent lamps)
  | FL3_6
  -- ^ Deluxe type lamp (New set of fluorescent lamps)
  | FL3_7
  -- ^ Three band fluorescent lamp (New set of fluorescent lamps)
  | FL3_8
  -- ^ Three band fluorescent lamp (New set of fluorescent lamps)
  | FL3_9
  -- ^ Three band fluorescent lamp (New set of fluorescent lamps)
  | FL3_10
  -- ^ Three band fluorescent lamp (New set of fluorescent lamps)
  | FL3_11
  -- ^ Three band fluorescent lamp (New set of fluorescent lamps)
  | FL3_12
  -- ^ Multi-band fluorescent lamp (New set of fluorescent lamps)
  | FL3_13
  -- ^ Multi-band fluorescent lamp (New set of fluorescent lamps)
  | FL3_14
  -- ^ Multi-band fluorescent lamp (New set of fluorescent lamps)
  | FL3_15
  -- ^ `D65` simulator lamp (New set of fluorescent lamps)
  | HP1
  -- ^ Standard high pressure sodium lamp
  | HP2
  -- ^ Colour enhanced high pressure sodium lamp
  | HP3
  -- ^ High pressure metal halide lamp
  | HP4
  -- ^ High pressure metal halide lamp
  | HP5
  -- ^ High pressure metal halide lamp
  deriving (CIE1931 -> CIE1931 -> Bool
(CIE1931 -> CIE1931 -> Bool)
-> (CIE1931 -> CIE1931 -> Bool) -> Eq CIE1931
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CIE1931 -> CIE1931 -> Bool
$c/= :: CIE1931 -> CIE1931 -> Bool
== :: CIE1931 -> CIE1931 -> Bool
$c== :: CIE1931 -> CIE1931 -> Bool
Eq, Int -> CIE1931 -> ShowS
[CIE1931] -> ShowS
CIE1931 -> String
(Int -> CIE1931 -> ShowS)
-> (CIE1931 -> String) -> ([CIE1931] -> ShowS) -> Show CIE1931
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIE1931] -> ShowS
$cshowList :: [CIE1931] -> ShowS
show :: CIE1931 -> String
$cshow :: CIE1931 -> String
showsPrec :: Int -> CIE1931 -> ShowS
$cshowsPrec :: Int -> CIE1931 -> ShowS
Show, ReadPrec [CIE1931]
ReadPrec CIE1931
Int -> ReadS CIE1931
ReadS [CIE1931]
(Int -> ReadS CIE1931)
-> ReadS [CIE1931]
-> ReadPrec CIE1931
-> ReadPrec [CIE1931]
-> Read CIE1931
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CIE1931]
$creadListPrec :: ReadPrec [CIE1931]
readPrec :: ReadPrec CIE1931
$creadPrec :: ReadPrec CIE1931
readList :: ReadS [CIE1931]
$creadList :: ReadS [CIE1931]
readsPrec :: Int -> ReadS CIE1931
$creadsPrec :: Int -> ReadS CIE1931
Read, Int -> CIE1931
CIE1931 -> Int
CIE1931 -> [CIE1931]
CIE1931 -> CIE1931
CIE1931 -> CIE1931 -> [CIE1931]
CIE1931 -> CIE1931 -> CIE1931 -> [CIE1931]
(CIE1931 -> CIE1931)
-> (CIE1931 -> CIE1931)
-> (Int -> CIE1931)
-> (CIE1931 -> Int)
-> (CIE1931 -> [CIE1931])
-> (CIE1931 -> CIE1931 -> [CIE1931])
-> (CIE1931 -> CIE1931 -> [CIE1931])
-> (CIE1931 -> CIE1931 -> CIE1931 -> [CIE1931])
-> Enum CIE1931
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CIE1931 -> CIE1931 -> CIE1931 -> [CIE1931]
$cenumFromThenTo :: CIE1931 -> CIE1931 -> CIE1931 -> [CIE1931]
enumFromTo :: CIE1931 -> CIE1931 -> [CIE1931]
$cenumFromTo :: CIE1931 -> CIE1931 -> [CIE1931]
enumFromThen :: CIE1931 -> CIE1931 -> [CIE1931]
$cenumFromThen :: CIE1931 -> CIE1931 -> [CIE1931]
enumFrom :: CIE1931 -> [CIE1931]
$cenumFrom :: CIE1931 -> [CIE1931]
fromEnum :: CIE1931 -> Int
$cfromEnum :: CIE1931 -> Int
toEnum :: Int -> CIE1931
$ctoEnum :: Int -> CIE1931
pred :: CIE1931 -> CIE1931
$cpred :: CIE1931 -> CIE1931
succ :: CIE1931 -> CIE1931
$csucc :: CIE1931 -> CIE1931
Enum, CIE1931
CIE1931 -> CIE1931 -> Bounded CIE1931
forall a. a -> a -> Bounded a
maxBound :: CIE1931
$cmaxBound :: CIE1931
minBound :: CIE1931
$cminBound :: CIE1931
Bounded)

-- -- | Academy Color Encoding System
-- data ACES =
--   ACES
--   deriving (Eq, Show)

-- instance Illuminant 'ACES where
--   whitePoint = WhitePoint 0.32168 0.33767


-- Move into it's own module

-- -- | [DCI-P3](https://en.wikipedia.org/wiki/DCI-P3) is a color space from the American film industry
-- data DCI_P3 = DCI_P3

-- instance Illuminant 'DCI_P3 where
--   whitePoint = WhitePoint 0.314 0.351

wavelengths :: [(Double, V3 Double)]
wavelengths :: [(Double, V3 Double)]
wavelengths = [(Double, V3 Double)]
spectralPowerDistributions
{-# DEPRECATED wavelengths "In favor of 'spectralPowerDistributions'" #-}

-- | Daylight SPDs: S0, S1 and S2. The SPD of the studied daylight samples can be
--  expressed as the linear combination of three, fixed SPDs.
--
-- * The first vector (S0) is the mean of all the SPD samples, which is the best
--   reconstituted SPD that can be formed with only a fixed vector.
--
-- * The second vector (S1) corresponds to yellow–blue variation, accounting for changes
--   in the correlated color temperature due to presence or absence of clouds or direct
--   sunlight.
--
-- * The third vector (S2) corresponds to pink–green variation caused by the
--   presence of water in the form of vapor and haze.
--
-- All of the values were taken directly from: /CIE15: Technical Report: Colorimetry, 3rd edition/
--
-- ![spectralPowerDistributions](files/spectralPowerDistributions.svg)
--
-- @since 0.1.2
spectralPowerDistributions :: [(Double, V3 Double)]
spectralPowerDistributions :: [(Double, V3 Double)]
spectralPowerDistributions =
  [ (Double
300, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3   Double
0.04   Double
0.02  Double
0.00)
  , (Double
305, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3   Double
3.02   Double
2.26  Double
1.00)
  , (Double
310, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3   Double
6.00   Double
4.50  Double
2.00)
  , (Double
315, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
17.80  Double
13.45  Double
3.00)
  , (Double
320, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
29.60  Double
22.40  Double
4.00)
  , (Double
325, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
42.45  Double
32.20  Double
6.25)
  , (Double
330, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
55.30  Double
42.00  Double
8.50)
  , (Double
335, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
56.30  Double
41.30  Double
8.15)
  , (Double
340, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
57.30  Double
40.60  Double
7.80)
  , (Double
345, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
59.55  Double
41.10  Double
7.25)
  , (Double
350, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
61.80  Double
41.60  Double
6.70)
  , (Double
355, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
61.65  Double
39.80  Double
6.00)
  , (Double
360, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
61.50  Double
38.00  Double
5.30)
  , (Double
365, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
65.15  Double
40.20  Double
5.70)
  , (Double
370, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
68.80  Double
42.40  Double
6.10)
  , (Double
375, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
66.10  Double
40.45  Double
4.55)
  , (Double
380, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
63.40  Double
38.50  Double
3.00)
  , (Double
385, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
64.60  Double
36.75  Double
2.10)
  , (Double
390, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
65.80  Double
35.00  Double
1.20)
  , (Double
395, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
80.30  Double
39.20  Double
0.05)
  , (Double
400, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
94.80  Double
43.40 Double
-1.10)
  , (Double
405, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
99.80  Double
44.85 Double
-0.80)
  , (Double
410, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
104.80  Double
46.30 Double
-0.50)
  , (Double
415, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
105.35  Double
45.10 Double
-0.60)
  , (Double
420, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
105.90  Double
43.90 Double
-0.70)
  , (Double
425, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
101.35  Double
40.50 Double
-0.95)
  , (Double
430, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
96.80  Double
37.10 Double
-1.20)
  , (Double
435, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
105.35  Double
36.90 Double
-1.90)
  , (Double
440, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
113.90  Double
36.70 Double
-2.60)
  , (Double
445, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
119.75  Double
36.30 Double
-2.75)
  , (Double
450, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
125.60  Double
35.90 Double
-2.90)
  , (Double
455, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
125.55  Double
34.25 Double
-2.85)
  , (Double
460, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
125.50  Double
32.60 Double
-2.80)
  , (Double
465, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
123.40  Double
30.25 Double
-2.70)
  , (Double
470, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
121.30  Double
27.90 Double
-2.60)
  , (Double
475, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
121.30  Double
26.10 Double
-2.60)
  , (Double
480, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
121.30  Double
24.30 Double
-2.60)
  , (Double
485, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
117.40  Double
22.20 Double
-2.20)
  , (Double
490, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
113.50  Double
20.10 Double
-1.80)
  , (Double
495, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
113.30  Double
18.15 Double
-1.65)
  , (Double
500, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
113.10  Double
16.20 Double
-1.50)
  , (Double
505, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
111.95  Double
14.70 Double
-1.40)
  , (Double
510, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
110.80  Double
13.20 Double
-1.30)
  , (Double
515, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
108.65  Double
10.90 Double
-1.25)
  , (Double
520, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
106.50   Double
8.60 Double
-1.20)
  , (Double
525, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
107.65   Double
7.35 Double
-1.10)
  , (Double
530, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
108.80   Double
6.10 Double
-1.00)
  , (Double
535, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
107.05   Double
5.15 Double
-0.75)
  , (Double
540, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
105.30   Double
4.20 Double
-0.50)
  , (Double
545, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
104.85   Double
3.05 Double
-0.40)
  , (Double
550, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
104.40   Double
1.90 Double
-0.30)
  , (Double
555, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
102.20   Double
0.95 Double
-0.15)
  , (Double
560, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
100.00   Double
0.00  Double
0.00)
  , (Double
565, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
98.00  Double
-0.80  Double
0.10)
  , (Double
570, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
96.00  Double
-1.60  Double
0.20)
  , (Double
575, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
95.55  Double
-2.55  Double
0.35)
  , (Double
580, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
95.10  Double
-3.50  Double
0.50)
  , (Double
585, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
92.10  Double
-3.50  Double
1.30)
  , (Double
590, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
89.10  Double
-3.50  Double
2.10)
  , (Double
595, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
89.80  Double
-4.65  Double
2.65)
  , (Double
600, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
90.50  Double
-5.80  Double
3.20)
  , (Double
605, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
90.40  Double
-6.50  Double
3.65)
  , (Double
610, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
90.30  Double
-7.20  Double
4.10)
  , (Double
615, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
89.35  Double
-7.90  Double
4.40)
  , (Double
620, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
88.40  Double
-8.60  Double
4.70)
  , (Double
625, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
86.20  Double
-9.05  Double
4.90)
  , (Double
630, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
84.00  Double
-9.50  Double
5.10)
  , (Double
635, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
84.55 Double
-10.20  Double
5.90)
  , (Double
640, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
85.10 Double
-10.90  Double
6.70)
  , (Double
645, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
83.50 Double
-10.80  Double
7.00)
  , (Double
650, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
81.90 Double
-10.70  Double
7.30)
  , (Double
655, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
82.25 Double
-11.35  Double
7.95)
  , (Double
660, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
82.60 Double
-12.00  Double
8.60)
  , (Double
665, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
83.75 Double
-13.00  Double
9.20)
  , (Double
670, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
84.90 Double
-14.00  Double
9.80)
  , (Double
675, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
83.10 Double
-13.80 Double
10.00)
  , (Double
680, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
81.30 Double
-13.60 Double
10.20)
  , (Double
685, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
76.60 Double
-12.80  Double
9.25)
  , (Double
690, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
71.90 Double
-12.00  Double
8.30)
  , (Double
695, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
73.10 Double
-12.65  Double
8.95)
  , (Double
700, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
74.30 Double
-13.30  Double
9.60)
  , (Double
705, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
75.35 Double
-13.10  Double
9.05)
  , (Double
710, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
76.40 Double
-12.90  Double
8.50)
  , (Double
715, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
69.85 Double
-11.75  Double
7.75)
  , (Double
720, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
63.30 Double
-10.60  Double
7.00)
  , (Double
725, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
67.50 Double
-11.10  Double
7.30)
  , (Double
730, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
71.70 Double
-11.60  Double
7.60)
  , (Double
735, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
74.35 Double
-11.90  Double
7.80)
  , (Double
740, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
77.00 Double
-12.20  Double
8.00)
  , (Double
745, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
71.10 Double
-11.20  Double
7.35)
  , (Double
750, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
65.20 Double
-10.20  Double
6.70)
  , (Double
755, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
56.45  Double
-9.00  Double
5.95)
  , (Double
760, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
47.70  Double
-7.80  Double
5.20)
  , (Double
765, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
58.15  Double
-9.50  Double
6.30)
  , (Double
770, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
68.60 Double
-11.20  Double
7.40)
  , (Double
775, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
66.80 Double
-10.80  Double
7.10)
  , (Double
780, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
65.00 Double
-10.40  Double
6.80)
  , (Double
785, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
65.50 Double
-10.50  Double
6.90)
  , (Double
790, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
66.00 Double
-10.60  Double
7.00)
  , (Double
795, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
63.50 Double
-10.15  Double
6.70)
  , (Double
800, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
61.00  Double
-9.70  Double
6.40)
  , (Double
805, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
57.15  Double
-9.00  Double
5.95)
  , (Double
810, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
53.30  Double
-8.30  Double
5.50)
  , (Double
815, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
56.10  Double
-8.80  Double
5.80)
  , (Double
820, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
58.90  Double
-9.30  Double
6.10)
  , (Double
825, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
60.40  Double
-9.55  Double
6.30)
  , (Double
830, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3  Double
61.90  Double
-9.80  Double
6.50)
  ]

-- | @[(λ, V3 x̄(λ) ȳ(λ) z̄(λ), V2 x(λ) z(λ))]@
--
-- All of the values were taken directly from: /CIE15: Technical Report: Colorimetry, 3rd edition/
--
-- ![colorMatchingFunctions](files/colorMatchingFunctions.svg)
--
-- @since 0.1.2
xyzColorMatchingFunctions :: [(Double, V3 Double, V2 Double)]
xyzColorMatchingFunctions :: [(Double, V3 Double, V2 Double)]
xyzColorMatchingFunctions =
  [ (Double
l, Double -> Double -> Double -> V3 Double
forall a. a -> a -> a -> V3 a
V3 Double
x' Double
y' Double
z', Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
x Double
y)
  | (Double
l, Double
x', Double
y', Double
z', Double
x, Double
y) <-
      [ (Double
380, Double
0.001368, Double
0.000039, Double
0.006450, Double
0.17411, Double
0.00496)
      , (Double
385, Double
0.002236, Double
0.000064, Double
0.010550, Double
0.17401, Double
0.00498)
      , (Double
390, Double
0.004243, Double
0.000120, Double
0.020050, Double
0.17380, Double
0.00492)
      , (Double
395, Double
0.007650, Double
0.000217, Double
0.036210, Double
0.17356, Double
0.00492)
      , (Double
400, Double
0.014310, Double
0.000396, Double
0.067850, Double
0.17334, Double
0.00480)
      , (Double
405, Double
0.023190, Double
0.000640, Double
0.110200, Double
0.17302, Double
0.00478)
      , (Double
410, Double
0.043510, Double
0.001210, Double
0.207400, Double
0.17258, Double
0.00480)
      , (Double
415, Double
0.077630, Double
0.002180, Double
0.371300, Double
0.17209, Double
0.00483)
      , (Double
420, Double
0.134380, Double
0.004000, Double
0.645600, Double
0.17141, Double
0.00510)
      , (Double
425, Double
0.214770, Double
0.007300, Double
1.039050, Double
0.17030, Double
0.00579)
      , (Double
430, Double
0.283900, Double
0.011600, Double
1.385600, Double
0.16888, Double
0.00690)
      , (Double
435, Double
0.328500, Double
0.016840, Double
1.622960, Double
0.16690, Double
0.00856)
      , (Double
440, Double
0.348280, Double
0.023000, Double
1.747060, Double
0.16441, Double
0.01086)
      , (Double
445, Double
0.348060, Double
0.029800, Double
1.782600, Double
0.16110, Double
0.01379)
      , (Double
450, Double
0.336200, Double
0.038000, Double
1.772110, Double
0.15664, Double
0.01770)
      , (Double
455, Double
0.318700, Double
0.048000, Double
1.744100, Double
0.15099, Double
0.02274)
      , (Double
460, Double
0.290800, Double
0.060000, Double
1.669200, Double
0.14396, Double
0.02970)
      , (Double
465, Double
0.251100, Double
0.073900, Double
1.528100, Double
0.13550, Double
0.03988)
      , (Double
470, Double
0.195360, Double
0.090980, Double
1.287640, Double
0.12412, Double
0.05780)
      , (Double
475, Double
0.142100, Double
0.112600, Double
1.041900, Double
0.10959, Double
0.08684)
      , (Double
480, Double
0.095640, Double
0.139020, Double
0.812950, Double
0.09129, Double
0.13270)
      , (Double
485, Double
0.057950, Double
0.169300, Double
0.616200, Double
0.06871, Double
0.20072)
      , (Double
490, Double
0.032010, Double
0.208020, Double
0.465180, Double
0.04539, Double
0.29498)
      , (Double
495, Double
0.014700, Double
0.258600, Double
0.353300, Double
0.02346, Double
0.41270)
      , (Double
500, Double
0.004900, Double
0.323000, Double
0.272000, Double
0.00817, Double
0.53842)
      , (Double
505, Double
0.002400, Double
0.407300, Double
0.212300, Double
0.00386, Double
0.65482)
      , (Double
510, Double
0.009300, Double
0.503000, Double
0.158200, Double
0.01387, Double
0.75019)
      , (Double
515, Double
0.029100, Double
0.608200, Double
0.111700, Double
0.03885, Double
0.81202)
      , (Double
520, Double
0.063270, Double
0.710000, Double
0.078250, Double
0.07430, Double
0.83380)
      , (Double
525, Double
0.109600, Double
0.793200, Double
0.057250, Double
0.11416, Double
0.82621)
      , (Double
530, Double
0.165500, Double
0.862000, Double
0.042160, Double
0.15472, Double
0.80586)
      , (Double
535, Double
0.225750, Double
0.914850, Double
0.029840, Double
0.19288, Double
0.78163)
      , (Double
540, Double
0.290400, Double
0.954000, Double
0.020300, Double
0.22962, Double
0.75433)
      , (Double
545, Double
0.359700, Double
0.980300, Double
0.013400, Double
0.26578, Double
0.72432)
      , (Double
550, Double
0.433450, Double
0.994950, Double
0.008750, Double
0.30160, Double
0.69231)
      , (Double
555, Double
0.512050, Double
1.000000, Double
0.005750, Double
0.33736, Double
0.65885)
      , (Double
560, Double
0.594500, Double
0.995000, Double
0.003900, Double
0.37310, Double
0.62445)
      , (Double
565, Double
0.678400, Double
0.978600, Double
0.002750, Double
0.40874, Double
0.58961)
      , (Double
570, Double
0.762100, Double
0.952000, Double
0.002100, Double
0.44406, Double
0.55471)
      , (Double
575, Double
0.842500, Double
0.915400, Double
0.001800, Double
0.47877, Double
0.52020)
      , (Double
580, Double
0.916300, Double
0.870000, Double
0.001650, Double
0.51249, Double
0.48659)
      , (Double
585, Double
0.978600, Double
0.816300, Double
0.001400, Double
0.54479, Double
0.45443)
      , (Double
590, Double
1.026300, Double
0.757000, Double
0.001100, Double
0.57515, Double
0.42423)
      , (Double
595, Double
1.056700, Double
0.694900, Double
0.001000, Double
0.60293, Double
0.39650)
      , (Double
600, Double
1.062200, Double
0.631000, Double
0.000800, Double
0.62704, Double
0.37249)
      , (Double
605, Double
1.045600, Double
0.566800, Double
0.000600, Double
0.64823, Double
0.35139)
      , (Double
610, Double
1.002600, Double
0.503000, Double
0.000340, Double
0.66576, Double
0.33401)
      , (Double
615, Double
0.938400, Double
0.441200, Double
0.000240, Double
0.68008, Double
0.31975)
      , (Double
620, Double
0.854450, Double
0.381000, Double
0.000190, Double
0.69150, Double
0.30834)
      , (Double
625, Double
0.751400, Double
0.321000, Double
0.000100, Double
0.70061, Double
0.29930)
      , (Double
630, Double
0.642400, Double
0.265000, Double
0.000050, Double
0.70792, Double
0.29203)
      , (Double
635, Double
0.541900, Double
0.217000, Double
0.000030, Double
0.71403, Double
0.28593)
      , (Double
640, Double
0.447900, Double
0.175000, Double
0.000020, Double
0.71903, Double
0.28093)
      , (Double
645, Double
0.360800, Double
0.138200, Double
0.000010, Double
0.72303, Double
0.27695)
      , (Double
650, Double
0.283500, Double
0.107000, Double
0.000000, Double
0.72599, Double
0.27401)
      , (Double
655, Double
0.218700, Double
0.081600, Double
0.000000, Double
0.72827, Double
0.27173)
      , (Double
660, Double
0.164900, Double
0.061000, Double
0.000000, Double
0.72997, Double
0.27003)
      , (Double
665, Double
0.121200, Double
0.044580, Double
0.000000, Double
0.73109, Double
0.26891)
      , (Double
670, Double
0.087400, Double
0.032000, Double
0.000000, Double
0.73199, Double
0.26801)
      , (Double
675, Double
0.063600, Double
0.023200, Double
0.000000, Double
0.73272, Double
0.26728)
      , (Double
680, Double
0.046770, Double
0.017000, Double
0.000000, Double
0.73342, Double
0.26658)
      , (Double
685, Double
0.032900, Double
0.011920, Double
0.000000, Double
0.73405, Double
0.26595)
      , (Double
690, Double
0.022700, Double
0.008210, Double
0.000000, Double
0.73439, Double
0.26561)
      , (Double
695, Double
0.015840, Double
0.005723, Double
0.000000, Double
0.73459, Double
0.26541)
      , (Double
700, Double
0.011359, Double
0.004102, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
705, Double
0.008111, Double
0.002929, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
710, Double
0.005790, Double
0.002091, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
715, Double
0.004109, Double
0.001484, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
720, Double
0.002899, Double
0.001047, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
725, Double
0.002049, Double
0.000740, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
730, Double
0.001440, Double
0.000520, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
735, Double
0.001000, Double
0.000361, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
740, Double
0.000690, Double
0.000249, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
745, Double
0.000476, Double
0.000172, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
750, Double
0.000332, Double
0.000120, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
755, Double
0.000235, Double
0.000085, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
760, Double
0.000166, Double
0.000060, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
765, Double
0.000117, Double
0.000042, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
770, Double
0.000083, Double
0.000030, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
775, Double
0.000059, Double
0.000021, Double
0.000000, Double
0.73469, Double
0.26531)
      , (Double
780, Double
0.000042, Double
0.000015, Double
0.000000, Double
0.73469, Double
0.26531)
      ]
  ]
{-
xyzColorMatchingFunctions1nm :: RealFloat e => [(e, V3 e)]
xyzColorMatchingFunctions1nm =
  [ (nm, V3 xHat yHat zHat)
  | (nm, xHat, yHat, zHat) <-
      [ (360, 0.0001299, 3.917E-06, 0.0006061)
      , (361, 0.000145847, 4.393581E-06, 0.0006808792)
      , (362, 0.0001638021, 4.929604E-06, 0.0007651456)
      , (363, 0.0001840037, 5.532136E-06, 0.0008600124)
      , (364, 0.0002066902, 6.208245E-06, 0.0009665928)
      , (365, 0.0002321, 6.965E-06, 0.001086)
      , (366, 0.000260728, 7.813219E-06, 0.001220586)
      , (367, 0.000293075, 8.767336E-06, 0.001372729)
      , (368, 0.000329388, 9.839844E-06, 0.001543579)
      , (369, 0.000369914, 1.104323E-05, 0.001734286)
      , (370, 0.0004149, 1.239E-05, 0.001946)
      , (371, 0.0004641587, 1.388641E-05, 0.002177777)
      , (372, 0.000518986, 1.555728E-05, 0.002435809)
      , (373, 0.000581854, 1.744296E-05, 0.002731953)
      , (374, 0.0006552347, 1.958375E-05, 0.003078064)
      , (375, 0.0007416, 2.202E-05, 0.003486)
      , (376, 0.0008450296, 2.483965E-05, 0.003975227)
      , (377, 0.0009645268, 2.804126E-05, 0.00454088)
      , (378, 0.001094949, 3.153104E-05, 0.00515832)
      , (379, 0.001231154, 3.521521E-05, 0.005802907)
      , (380, 0.001368, 3.9E-05, 0.006450001)
      , (381, 0.00150205, 4.28264E-05, 0.007083216)
      , (382, 0.001642328, 4.69146E-05, 0.007745488)
      , (383, 0.001802382, 5.15896E-05, 0.008501152)
      , (384, 0.001995757, 5.71764E-05, 0.009414544)
      , (385, 0.002236, 6.4E-05, 0.01054999)
      , (386, 0.002535385, 7.234421E-05, 0.0119658)
      , (387, 0.002892603, 8.221224E-05, 0.01365587)
      , (388, 0.003300829, 9.350816E-05, 0.01558805)
      , (389, 0.003753236, 0.0001061361, 0.01773015)
      , (390, 0.004243, 0.00012, 0.02005001)
      , (391, 0.004762389, 0.000134984, 0.02251136)
      , (392, 0.005330048, 0.000151492, 0.02520288)
      , (393, 0.005978712, 0.000170208, 0.02827972)
      , (394, 0.006741117, 0.000191816, 0.03189704)
      , (395, 0.00765, 0.000217, 0.03621)
      , (396, 0.008751373, 0.0002469067, 0.04143771)
      , (397, 0.01002888, 0.00028124, 0.04750372)
      , (398, 0.0114217, 0.00031852, 0.05411988)
      , (399, 0.01286901, 0.0003572667, 0.06099803)
      , (400, 0.01431, 0.000396, 0.06785001)
      , (401, 0.01570443, 0.0004337147, 0.07448632)
      , (402, 0.01714744, 0.000473024, 0.08136156)
      , (403, 0.01878122, 0.000517876, 0.08915364)
      , (404, 0.02074801, 0.0005722187, 0.09854048)
      , (405, 0.02319, 0.00064, 0.1102)
      , (406, 0.02620736, 0.00072456, 0.1246133)
      , (407, 0.02978248, 0.0008255, 0.1417017)
      , (408, 0.03388092, 0.00094116, 0.1613035)
      , (409, 0.03846824, 0.00106988, 0.1832568)
      , (410, 0.04351, 0.00121, 0.2074)
      , (411, 0.0489956, 0.001362091, 0.2336921)
      , (412, 0.0550226, 0.001530752, 0.2626114)
      , (413, 0.0617188, 0.001720368, 0.2947746)
      , (414, 0.069212, 0.001935323, 0.3307985)
      , (415, 0.07763, 0.00218, 0.3713)
      , (416, 0.08695811, 0.0024548, 0.4162091)
      , (417, 0.09717672, 0.002764, 0.4654642)
      , (418, 0.1084063, 0.0031178, 0.5196948)
      , (419, 0.1207672, 0.0035264, 0.5795303)
      , (420, 0.13438, 0.004, 0.6456)
      , (421, 0.1493582, 0.00454624, 0.7184838)
      , (422, 0.1653957, 0.00515932, 0.7967133)
      , (423, 0.1819831, 0.00582928, 0.8778459)
      , (424, 0.198611, 0.00654616, 0.959439)
      , (425, 0.21477, 0.0073, 1.0390501)
      , (426, 0.2301868, 0.008086507, 1.1153673)
      , (427, 0.2448797, 0.00890872, 1.1884971)
      , (428, 0.2587773, 0.00976768, 1.2581233)
      , (429, 0.2718079, 0.01066443, 1.3239296)
      , (430, 0.2839, 0.0116, 1.3856)
      , (431, 0.2949438, 0.01257317, 1.4426352)
      , (432, 0.3048965, 0.01358272, 1.4948035)
      , (433, 0.3137873, 0.01462968, 1.5421903)
      , (434, 0.3216454, 0.01571509, 1.5848807)
      , (435, 0.3285, 0.01684, 1.62296)
      , (436, 0.3343513, 0.01800736, 1.6564048)
      , (437, 0.3392101, 0.01921448, 1.6852959)
      , (438, 0.3431213, 0.02045392, 1.7098745)
      , (439, 0.3461296, 0.02171824, 1.7303821)
      , (440, 0.34828, 0.023, 1.74706)
      , (441, 0.3495999, 0.02429461, 1.7600446)
      , (442, 0.3501474, 0.02561024, 1.7696233)
      , (443, 0.350013, 0.02695857, 1.7762637)
      , (444, 0.349287, 0.02835125, 1.7804334)
      , (445, 0.34806, 0.0298, 1.7826)
      , (446, 0.3463733, 0.03131083, 1.7829682)
      , (447, 0.3442624, 0.03288368, 1.7816998)
      , (448, 0.3418088, 0.03452112, 1.7791982)
      , (449, 0.3390941, 0.03622571, 1.7758671)
      , (450, 0.3362, 0.038, 1.77211)
      , (451, 0.3331977, 0.03984667, 1.7682589)
      , (452, 0.3300411, 0.041768, 1.764039)
      , (453, 0.3266357, 0.043766, 1.7589438)
      , (454, 0.3228868, 0.04584267, 1.7524663)
      , (455, 0.3187, 0.048, 1.7441)
      , (456, 0.3140251, 0.05024368, 1.7335595)
      , (457, 0.308884, 0.05257304, 1.7208581)
      , (458, 0.3032904, 0.05498056, 1.7059369)
      , (459, 0.2972579, 0.05745872, 1.6887372)
      , (460, 0.2908, 0.06, 1.6692)
      , (461, 0.2839701, 0.06260197, 1.6475287)
      , (462, 0.2767214, 0.06527752, 1.6234127)
      , (463, 0.2689178, 0.06804208, 1.5960223)
      , (464, 0.2604227, 0.07091109, 1.564528)
      , (465, 0.2511, 0.0739, 1.5281)
      , (466, 0.2408475, 0.077016, 1.4861114)
      , (467, 0.2298512, 0.0802664, 1.4395215)
      , (468, 0.2184072, 0.0836668, 1.3898799)
      , (469, 0.2068115, 0.0872328, 1.3387362)
      , (470, 0.19536, 0.09098, 1.28764)
      , (471, 0.1842136, 0.09491755, 1.2374223)
      , (472, 0.1733273, 0.09904584, 1.1878243)
      , (473, 0.1626881, 0.1033674, 1.1387611)
      , (474, 0.1522833, 0.1078846, 1.090148)
      , (475, 0.1421, 0.1126, 1.0419)
      , (476, 0.1321786, 0.117532, 0.9941976)
      , (477, 0.1225696, 0.1226744, 0.9473473)
      , (478, 0.1132752, 0.1279928, 0.9014531)
      , (479, 0.1042979, 0.1334528, 0.8566193)
      , (480, 0.09564, 0.13902, 0.8129501)
      , (481, 0.08729955, 0.1446764, 0.7705173)
      , (482, 0.07930804, 0.1504693, 0.7294448)
      , (483, 0.07171776, 0.1564619, 0.6899136)
      , (484, 0.06458099, 0.1627177, 0.6521049)
      , (485, 0.05795001, 0.1693, 0.6162)
      , (486, 0.05186211, 0.1762431, 0.5823286)
      , (487, 0.04628152, 0.1835581, 0.5504162)
      , (488, 0.04115088, 0.1912735, 0.5203376)
      , (489, 0.03641283, 0.199418, 0.4919673)
      , (490, 0.03201, 0.20802, 0.46518)
      , (491, 0.0279172, 0.2171199, 0.4399246)
      , (492, 0.0241444, 0.2267345, 0.4161836)
      , (493, 0.020687, 0.2368571, 0.3938822)
      , (494, 0.0175404, 0.2474812, 0.3729459)
      , (495, 0.0147, 0.2586, 0.3533)
      , (496, 0.01216179, 0.2701849, 0.3348578)
      , (497, 0.00991996, 0.2822939, 0.3175521)
      , (498, 0.00796724, 0.2950505, 0.3013375)
      , (499, 0.006296346, 0.308578, 0.2861686)
      , (500, 0.0049, 0.323, 0.272)
      , (501, 0.003777173, 0.3384021, 0.2588171)
      , (502, 0.00294532, 0.3546858, 0.2464838)
      , (503, 0.00242488, 0.3716986, 0.2347718)
      , (504, 0.002236293, 0.3892875, 0.2234533)
      , (505, 0.0024, 0.4073, 0.2123)
      , (506, 0.00292552, 0.4256299, 0.2011692)
      , (507, 0.00383656, 0.4443096, 0.1901196)
      , (508, 0.00517484, 0.4633944, 0.1792254)
      , (509, 0.00698208, 0.4829395, 0.1685608)
      , (510, 0.0093, 0.503, 0.1582)
      , (511, 0.01214949, 0.5235693, 0.1481383)
      , (512, 0.01553588, 0.544512, 0.1383758)
      , (513, 0.01947752, 0.56569, 0.1289942)
      , (514, 0.02399277, 0.5869653, 0.1200751)
      , (515, 0.0291, 0.6082, 0.1117)
      , (516, 0.03481485, 0.6293456, 0.1039048)
      , (517, 0.04112016, 0.6503068, 0.09666748)
      , (518, 0.04798504, 0.6708752, 0.08998272)
      , (519, 0.05537861, 0.6908424, 0.08384531)
      , (520, 0.06327, 0.71, 0.07824999)
      , (521, 0.07163501, 0.7281852, 0.07320899)
      , (522, 0.08046224, 0.7454636, 0.06867816)
      , (523, 0.08973996, 0.7619694, 0.06456784)
      , (524, 0.09945645, 0.7778368, 0.06078835)
      , (525, 0.1096, 0.7932, 0.05725001)
      , (526, 0.1201674, 0.8081104, 0.05390435)
      , (527, 0.1311145, 0.8224962, 0.05074664)
      , (528, 0.1423679, 0.8363068, 0.04775276)
      , (529, 0.1538542, 0.8494916, 0.04489859)
      , (530, 0.1655, 0.862, 0.04216)
      , (531, 0.1772571, 0.8738108, 0.03950728)
      , (532, 0.18914, 0.8849624, 0.03693564)
      , (533, 0.2011694, 0.8954936, 0.03445836)
      , (534, 0.2133658, 0.9054432, 0.03208872)
      , (535, 0.2257499, 0.9148501, 0.02984)
      , (536, 0.2383209, 0.9237348, 0.02771181)
      , (537, 0.2510668, 0.9320924, 0.02569444)
      , (538, 0.2639922, 0.9399226, 0.02378716)
      , (539, 0.2771017, 0.9472252, 0.02198925)
      , (540, 0.2904, 0.954, 0.0203)
      , (541, 0.3038912, 0.9602561, 0.01871805)
      , (542, 0.3175726, 0.9660074, 0.01724036)
      , (543, 0.3314384, 0.9712606, 0.01586364)
      , (544, 0.3454828, 0.9760225, 0.01458461)
      , (545, 0.3597, 0.9803, 0.0134)
      , (546, 0.3740839, 0.9840924, 0.01230723)
      , (547, 0.3886396, 0.9874182, 0.01130188)
      , (548, 0.4033784, 0.9903128, 0.01037792)
      , (549, 0.4183115, 0.9928116, 0.009529306)
      , (550, 0.4334499, 0.9949501, 0.008749999)
      , (551, 0.4487953, 0.9967108, 0.0080352)
      , (552, 0.464336, 0.9980983, 0.0073816)
      , (553, 0.480064, 0.999112, 0.0067854)
      , (554, 0.4959713, 0.9997482, 0.0062428)
      , (555, 0.5120501, 1, 0.005749999)
      , (556, 0.5282959, 0.9998567, 0.0053036)
      , (557, 0.5446916, 0.9993046, 0.0048998)
      , (558, 0.5612094, 0.9983255, 0.0045342)
      , (559, 0.5778215, 0.9968987, 0.0042024)
      , (560, 0.5945, 0.995, 0.0039)
      , (561, 0.6112209, 0.9926005, 0.0036232)
      , (562, 0.6279758, 0.9897426, 0.0033706)
      , (563, 0.6447602, 0.9864444, 0.0031414)
      , (564, 0.6615697, 0.9827241, 0.0029348)
      , (565, 0.6784, 0.9786, 0.002749999)
      , (566, 0.6952392, 0.9740837, 0.0025852)
      , (567, 0.7120586, 0.9691712, 0.0024386)
      , (568, 0.7288284, 0.9638568, 0.0023094)
      , (569, 0.7455188, 0.9581349, 0.0021968)
      , (570, 0.7621, 0.952, 0.0021)
      , (571, 0.7785432, 0.9454504, 0.002017733)
      , (572, 0.7948256, 0.9384992, 0.0019482)
      , (573, 0.8109264, 0.9311628, 0.0018898)
      , (574, 0.8268248, 0.9234576, 0.001840933)
      , (575, 0.8425, 0.9154, 0.0018)
      , (576, 0.8579325, 0.9070064, 0.001766267)
      , (577, 0.8730816, 0.8982772, 0.0017378)
      , (578, 0.8878944, 0.8892048, 0.0017112)
      , (579, 0.9023181, 0.8797816, 0.001683067)
      , (580, 0.9163, 0.87, 0.001650001)
      , (581, 0.9297995, 0.8598613, 0.001610133)
      , (582, 0.9427984, 0.849392, 0.0015644)
      , (583, 0.9552776, 0.838622, 0.0015136)
      , (584, 0.9672179, 0.8275813, 0.001458533)
      , (585, 0.9786, 0.8163, 0.0014)
      , (586, 0.9893856, 0.8047947, 0.001336667)
      , (587, 0.9995488, 0.793082, 0.00127)
      , (588, 1.0090892, 0.781192, 0.001205)
      , (589, 1.0180064, 0.7691547, 0.001146667)
      , (590, 1.0263, 0.757, 0.0011)
      , (591, 1.0339827, 0.7447541, 0.0010688)
      , (592, 1.040986, 0.7324224, 0.0010494)
      , (593, 1.047188, 0.7200036, 0.0010356)
      , (594, 1.0524667, 0.7074965, 0.0010212)
      , (595, 1.0567, 0.6949, 0.001)
      , (596, 1.0597944, 0.6822192, 0.00096864)
      , (597, 1.0617992, 0.6694716, 0.00092992)
      , (598, 1.0628068, 0.6566744, 0.00088688)
      , (599, 1.0629096, 0.6438448, 0.00084256)
      , (600, 1.0622, 0.631, 0.0008)
      , (601, 1.0607352, 0.6181555, 0.00076096)
      , (602, 1.0584436, 0.6053144, 0.00072368)
      , (603, 1.0552244, 0.5924756, 0.00068592)
      , (604, 1.0509768, 0.5796379, 0.00064544)
      , (605, 1.0456, 0.5668, 0.0006)
      , (606, 1.0390369, 0.5539611, 0.0005478667)
      , (607, 1.0313608, 0.5411372, 0.0004916)
      , (608, 1.0226662, 0.5283528, 0.0004354)
      , (609, 1.0130477, 0.5156323, 0.0003834667)
      , (610, 1.0026, 0.503, 0.00034)
      , (611, 0.9913675, 0.4904688, 0.0003072533)
      , (612, 0.9793314, 0.4780304, 0.00028316)
      , (613, 0.9664916, 0.4656776, 0.00026544)
      , (614, 0.9528479, 0.4534032, 0.0002518133)
      , (615, 0.9384, 0.4412, 0.00024)
      , (616, 0.923194, 0.42908, 0.0002295467)
      , (617, 0.907244, 0.417036, 0.00022064)
      , (618, 0.890502, 0.405032, 0.00021196)
      , (619, 0.87292, 0.393032, 0.0002021867)
      , (620, 0.8544499, 0.381, 0.00019)
      , (621, 0.835084, 0.3689184, 0.0001742133)
      , (622, 0.814946, 0.3568272, 0.00015564)
      , (623, 0.794186, 0.3447768, 0.00013596)
      , (624, 0.772954, 0.3328176, 0.0001168533)
      , (625, 0.7514, 0.321, 0.0001)
      , (626, 0.7295836, 0.3093381, 8.613333E-05)
      , (627, 0.7075888, 0.2978504, 7.46E-05)
      , (628, 0.6856022, 0.2865936, 6.5E-05)
      , (629, 0.6638104, 0.2756245, 5.693333E-05)
      , (630, 0.6424, 0.265, 4.999999E-05)
      , (631, 0.6215149, 0.2547632, 4.416E-05)
      , (632, 0.6011138, 0.2448896, 3.948E-05)
      , (633, 0.5811052, 0.2353344, 3.572E-05)
      , (634, 0.5613977, 0.2260528, 3.264E-05)
      , (635, 0.5419, 0.217, 3E-05)
      , (636, 0.5225995, 0.2081616, 2.765333E-05)
      , (637, 0.5035464, 0.1995488, 2.556E-05)
      , (638, 0.4847436, 0.1911552, 2.364E-05)
      , (639, 0.4661939, 0.1829744, 2.181333E-05)
      , (640, 0.4479, 0.175, 2E-05)
      , (641, 0.4298613, 0.1672235, 1.813333E-05)
      , (642, 0.412098, 0.1596464, 1.62E-05)
      , (643, 0.394644, 0.1522776, 1.42E-05)
      , (644, 0.3775333, 0.1451259, 1.213333E-05)
      , (645, 0.3608, 0.1382, 1E-05)
      , (646, 0.3444563, 0.1315003, 7.733333E-06)
      , (647, 0.3285168, 0.1250248, 5.4E-06)
      , (648, 0.3130192, 0.1187792, 3.2E-06)
      , (649, 0.2980011, 0.1127691, 1.333333E-06)
      , (650, 0.2835, 0.107, 0)
      , (651, 0.2695448, 0.1014762, 0)
      , (652, 0.2561184, 0.09618864, 0)
      , (653, 0.2431896, 0.09112296, 0)
      , (654, 0.2307272, 0.08626485, 0)
      , (655, 0.2187, 0.0816, 0)
      , (656, 0.2070971, 0.07712064, 0)
      , (657, 0.1959232, 0.07282552, 0)
      , (658, 0.1851708, 0.06871008, 0)
      , (659, 0.1748323, 0.06476976, 0)
      , (660, 0.1649, 0.061, 0)
      , (661, 0.1553667, 0.05739621, 0)
      , (662, 0.14623, 0.05395504, 0)
      , (663, 0.13749, 0.05067376, 0)
      , (664, 0.1291467, 0.04754965, 0)
      , (665, 0.1212, 0.04458, 0)
      , (666, 0.1136397, 0.04175872, 0)
      , (667, 0.106465, 0.03908496, 0)
      , (668, 0.09969044, 0.03656384, 0)
      , (669, 0.09333061, 0.03420048, 0)
      , (670, 0.0874, 0.032, 0)
      , (671, 0.08190096, 0.02996261, 0)
      , (672, 0.07680428, 0.02807664, 0)
      , (673, 0.07207712, 0.02632936, 0)
      , (674, 0.06768664, 0.02470805, 0)
      , (675, 0.0636, 0.0232, 0)
      , (676, 0.05980685, 0.02180077, 0)
      , (677, 0.05628216, 0.02050112, 0)
      , (678, 0.05297104, 0.01928108, 0)
      , (679, 0.04981861, 0.01812069, 0)
      , (680, 0.04677, 0.017, 0)
      , (681, 0.04378405, 0.01590379, 0)
      , (682, 0.04087536, 0.01483718, 0)
      , (683, 0.03807264, 0.01381068, 0)
      , (684, 0.03540461, 0.01283478, 0)
      , (685, 0.0329, 0.01192, 0)
      , (686, 0.03056419, 0.01106831, 0)
      , (687, 0.02838056, 0.01027339, 0)
      , (688, 0.02634484, 0.009533311, 0)
      , (689, 0.02445275, 0.008846157, 0)
      , (690, 0.0227, 0.00821, 0)
      , (691, 0.02108429, 0.007623781, 0)
      , (692, 0.01959988, 0.007085424, 0)
      , (693, 0.01823732, 0.006591476, 0)
      , (694, 0.01698717, 0.006138485, 0)
      , (695, 0.01584, 0.005723, 0)
      , (696, 0.01479064, 0.005343059, 0)
      , (697, 0.01383132, 0.004995796, 0)
      , (698, 0.01294868, 0.004676404, 0)
      , (699, 0.0121292, 0.004380075, 0)
      , (700, 0.01135916, 0.004102, 0)
      , (701, 0.01062935, 0.003838453, 0)
      , (702, 0.009938846, 0.003589099, 0)
      , (703, 0.009288422, 0.003354219, 0)
      , (704, 0.008678854, 0.003134093, 0)
      , (705, 0.008110916, 0.002929, 0)
      , (706, 0.007582388, 0.002738139, 0)
      , (707, 0.007088746, 0.002559876, 0)
      , (708, 0.006627313, 0.002393244, 0)
      , (709, 0.006195408, 0.002237275, 0)
      , (710, 0.005790346, 0.002091, 0)
      , (711, 0.005409826, 0.001953587, 0)
      , (712, 0.005052583, 0.00182458, 0)
      , (713, 0.004717512, 0.00170358, 0)
      , (714, 0.004403507, 0.001590187, 0)
      , (715, 0.004109457, 0.001484, 0)
      , (716, 0.003833913, 0.001384496, 0)
      , (717, 0.003575748, 0.001291268, 0)
      , (718, 0.003334342, 0.001204092, 0)
      , (719, 0.003109075, 0.001122744, 0)
      , (720, 0.002899327, 0.001047, 0)
      , (721, 0.002704348, 0.0009765896, 0)
      , (722, 0.00252302, 0.0009111088, 0)
      , (723, 0.002354168, 0.0008501332, 0)
      , (724, 0.002196616, 0.0007932384, 0)
      , (725, 0.00204919, 0.00074, 0)
      , (726, 0.00191096, 0.0006900827, 0)
      , (727, 0.001781438, 0.00064331, 0)
      , (728, 0.00166011, 0.000599496, 0)
      , (729, 0.001546459, 0.0005584547, 0)
      , (730, 0.001439971, 0.00052, 0)
      , (731, 0.001340042, 0.0004839136, 0)
      , (732, 0.001246275, 0.0004500528, 0)
      , (733, 0.001158471, 0.0004183452, 0)
      , (734, 0.00107643, 0.0003887184, 0)
      , (735, 0.0009999493, 0.0003611, 0)
      , (736, 0.0009287358, 0.0003353835, 0)
      , (737, 0.0008624332, 0.0003114404, 0)
      , (738, 0.0008007503, 0.0002891656, 0)
      , (739, 0.000743396, 0.0002684539, 0)
      , (740, 0.0006900786, 0.0002492, 0)
      , (741, 0.0006405156, 0.0002313019, 0)
      , (742, 0.0005945021, 0.0002146856, 0)
      , (743, 0.0005518646, 0.0001992884, 0)
      , (744, 0.000512429, 0.0001850475, 0)
      , (745, 0.0004760213, 0.0001719, 0)
      , (746, 0.0004424536, 0.0001597781, 0)
      , (747, 0.0004115117, 0.0001486044, 0)
      , (748, 0.0003829814, 0.0001383016, 0)
      , (749, 0.0003566491, 0.0001287925, 0)
      , (750, 0.0003323011, 0.00012, 0)
      , (751, 0.0003097586, 0.0001118595, 0)
      , (752, 0.0002888871, 0.0001043224, 0)
      , (753, 0.0002695394, 9.73356E-05, 0)
      , (754, 0.0002515682, 9.084587E-05, 0)
      , (755, 0.0002348261, 8.48E-05, 0)
      , (756, 0.000219171, 7.914667E-05, 0)
      , (757, 0.0002045258, 7.3858E-05, 0)
      , (758, 0.0001908405, 6.8916E-05, 0)
      , (759, 0.0001780654, 6.430267E-05, 0)
      , (760, 0.0001661505, 6E-05, 0)
      , (761, 0.0001550236, 5.598187E-05, 0)
      , (762, 0.0001446219, 5.22256E-05, 0)
      , (763, 0.0001349098, 4.87184E-05, 0)
      , (764, 0.000125852, 4.544747E-05, 0)
      , (765, 0.000117413, 4.24E-05, 0)
      , (766, 0.0001095515, 3.956104E-05, 0)
      , (767, 0.0001022245, 3.691512E-05, 0)
      , (768, 9.539445E-05, 3.444868E-05, 0)
      , (769, 8.90239E-05, 3.214816E-05, 0)
      , (770, 8.307527E-05, 3E-05, 0)
      , (771, 7.751269E-05, 2.799125E-05, 0)
      , (772, 7.231304E-05, 2.611356E-05, 0)
      , (773, 6.745778E-05, 2.436024E-05, 0)
      , (774, 6.292844E-05, 2.272461E-05, 0)
      , (775, 5.870652E-05, 2.12E-05, 0)
      , (776, 5.477028E-05, 1.977855E-05, 0)
      , (777, 5.109918E-05, 1.845285E-05, 0)
      , (778, 4.767654E-05, 1.721687E-05, 0)
      , (779, 4.448567E-05, 1.606459E-05, 0)
      , (780, 4.150994E-05, 1.499E-05, 0)
      , (781, 3.873324E-05, 1.398728E-05, 0)
      , (782, 3.614203E-05, 1.305155E-05, 0)
      , (783, 3.372352E-05, 1.217818E-05, 0)
      , (784, 3.146487E-05, 1.136254E-05, 0)
      , (785, 2.935326E-05, 1.06E-05, 0)
      , (786, 2.737573E-05, 9.885877E-06, 0)
      , (787, 2.552433E-05, 9.217304E-06, 0)
      , (788, 2.379376E-05, 8.592362E-06, 0)
      , (789, 2.21787E-05, 8.009133E-06, 0)
      , (790, 2.067383E-05, 7.4657E-06, 0)
      , (791, 1.927226E-05, 6.959567E-06, 0)
      , (792, 1.79664E-05, 6.487995E-06, 0)
      , (793, 1.674991E-05, 6.048699E-06, 0)
      , (794, 1.561648E-05, 5.639396E-06, 0)
      , (795, 1.455977E-05, 5.2578E-06, 0)
      , (796, 1.357387E-05, 4.901771E-06, 0)
      , (797, 1.265436E-05, 4.56972E-06, 0)
      , (798, 1.179723E-05, 4.260194E-06, 0)
      , (799, 1.099844E-05, 3.971739E-06, 0)
      , (800, 1.025398E-05, 3.7029E-06, 0)
      , (801, 9.559646E-06, 3.452163E-06, 0)
      , (802, 8.912044E-06, 3.218302E-06, 0)
      , (803, 8.308358E-06, 3.0003E-06, 0)
      , (804, 7.745769E-06, 2.797139E-06, 0)
      , (805, 7.221456E-06, 2.6078E-06, 0)
      , (806, 6.732475E-06, 2.43122E-06, 0)
      , (807, 6.276423E-06, 2.266531E-06, 0)
      , (808, 5.851304E-06, 2.113013E-06, 0)
      , (809, 5.455118E-06, 1.969943E-06, 0)
      , (810, 5.085868E-06, 1.8366E-06, 0)
      , (811, 4.741466E-06, 1.71223E-06, 0)
      , (812, 4.420236E-06, 1.596228E-06, 0)
      , (813, 4.120783E-06, 1.48809E-06, 0)
      , (814, 3.841716E-06, 1.387314E-06, 0)
      , (815, 3.581652E-06, 1.2934E-06, 0)
      , (816, 3.339127E-06, 1.20582E-06, 0)
      , (817, 3.112949E-06, 1.124143E-06, 0)
      , (818, 2.902121E-06, 1.048009E-06, 0)
      , (819, 2.705645E-06, 9.770578E-07, 0)
      , (820, 2.522525E-06, 9.1093E-07, 0)
      , (821, 2.351726E-06, 8.492513E-07, 0)
      , (822, 2.192415E-06, 7.917212E-07, 0)
      , (823, 2.043902E-06, 7.380904E-07, 0)
      , (824, 1.905497E-06, 6.881098E-07, 0)
      , (825, 1.776509E-06, 6.4153E-07, 0)
      , (826, 1.656215E-06, 5.980895E-07, 0)
      , (827, 1.544022E-06, 5.575746E-07, 0)
      , (828, 1.43944E-06, 5.19808E-07, 0)
      , (829, 1.341977E-06, 4.846123E-07, 0)
      , (830, 1.251141E-06, 4.5181E-07, 0)
      ]
  ]
-}