diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog for color +## 0.1.2 + +* Fix `YCbCr` conversion to derived RGB color spaces +* Fix conversion of `toWord64 (1 :: Double)` and `toWord632 (1 :: Float)`. +* Addition of `xyzColorMatchingFunctions` and `spectralPowerDistributions` + ## 0.1.1 * Addition of `Graphics.Color.Illuminant.Wikipedia` module diff --git a/Color.cabal b/Color.cabal --- a/Color.cabal +++ b/Color.cabal @@ -1,5 +1,5 @@ name: Color -version: 0.1.1 +version: 0.1.2 synopsis: Color spaces and conversions between them description: Please see the README on GitHub at homepage: https://github.com/lehins/Color @@ -11,7 +11,8 @@ category: Graphics extra-source-files: README.md , CHANGELOG.md -cabal-version: >=1.10 +extra-doc-files: files/*.svg +cabal-version: >=1.18 build-type: Custom tested-with: GHC == 8.4.3 , GHC == 8.4.4 @@ -19,6 +20,7 @@ , GHC == 8.6.4 , GHC == 8.6.5 , GHC == 8.8.1 + , GHC == 8.8.2 custom-setup setup-depends: @@ -68,7 +70,6 @@ -- , Graphics.Color.Space.RGB.AdobeWideGamut -- , Graphics.Color.Space.RGB.ProPhoto -- , Graphics.Color.Space.RGB.DCI_P3 - -- , Graphics.Color.Space.LMS , Graphics.Color.Standard.RAL , Graphics.Pixel @@ -103,24 +104,38 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Main.hs - other-modules: Graphics.Color.Illuminant.WikipediaSpec + other-modules: Graphics.Color.Algebra.ElevatorSpec + , Graphics.Color.Illuminant.CIE1931Spec + , Graphics.Color.Illuminant.CIE1964Spec + , Graphics.Color.Illuminant.Common + , Graphics.Color.Illuminant.WikipediaSpec , Graphics.Color.Model.Common , Graphics.Color.Model.CMYKSpec , Graphics.Color.Model.HSISpec , Graphics.Color.Model.HSLSpec , Graphics.Color.Model.HSVSpec , Graphics.Color.Model.RGBSpec + , Graphics.Color.Model.YCbCrSpec , Graphics.Color.Space.Common , Graphics.Color.Space.CIE1976.LABSpec + , Graphics.Color.Space.RGB.AdobeRGBSpec , Graphics.Color.Space.RGB.SRGBSpec + , Graphics.Color.Space.RGB.Derived.AdobeRGBSpec , Graphics.Color.Space.RGB.Derived.SRGBSpec + , Graphics.Color.Space.RGB.ITU.Rec470Spec + , Graphics.Color.Space.RGB.ITU.Rec601Spec , Graphics.Color.Space.RGB.ITU.Rec709Spec - , Graphics.Color.Space.YUV.YCbCrSpec + , Graphics.Color.Space.RGB.Alternative.CMYKSpec + , Graphics.Color.Space.RGB.Alternative.HSISpec + , Graphics.Color.Space.RGB.Alternative.HSLSpec + , Graphics.Color.Space.RGB.Alternative.HSVSpec + , Graphics.Color.Space.RGB.Alternative.YCbCrSpec , Graphics.Color.Standard.RALSpec , Spec - build-depends: HUnit - , QuickCheck - , base >= 4.8 && < 5 + build-depends: JuicyPixels + , HUnit + , QuickCheck > 2.13 + , base >= 4.8 && < 5 , Color , colour , hspec diff --git a/files/colorMatchingFunctions.svg b/files/colorMatchingFunctions.svg new file mode 100644 --- /dev/null +++ b/files/colorMatchingFunctions.svg @@ -0,0 +1,1 @@ +x̄(λ)ȳ(λ)z̄(λ)Color matching functions360380400420440460480500520540560580600620640660680700720740760780800λ (nm)0.00.20.40.60.81.01.21.41.61.8Response diff --git a/files/spectralPowerDistributions.svg b/files/spectralPowerDistributions.svg new file mode 100644 --- /dev/null +++ b/files/spectralPowerDistributions.svg @@ -0,0 +1,1 @@ +S0S1S2Component300350400450500550600650700750800850Wavelength-20020406080100120140SPDs diff --git a/src/Graphics/Color/Adaptation/VonKries.hs b/src/Graphics/Color/Adaptation/VonKries.hs --- a/src/Graphics/Color/Adaptation/VonKries.hs +++ b/src/Graphics/Color/Adaptation/VonKries.hs @@ -41,6 +41,7 @@ import Graphics.Color.Space.Internal import Data.Typeable + data VonKries = VonKries -- ^ VonKries chromatic adaptation transform matrix @@ -167,7 +168,6 @@ ICAT im3x3 = icat :: ICAT t e wpTest = coerce (whitePointTristimulus :: Color (XYZ it) e) wpRef = coerce (whitePointTristimulus :: Color (XYZ ir) e) -{-# NOINLINE adaptationMatrix #-} vonKriesAdaptation :: ChromaticAdaptation 'VonKries it ir e => Adaptation 'VonKries it ir e vonKriesAdaptation = adaptationMatrix diff --git a/src/Graphics/Color/Algebra/Elevator.hs b/src/Graphics/Color/Algebra/Elevator.hs --- a/src/Graphics/Color/Algebra/Elevator.hs +++ b/src/Graphics/Color/Algebra/Elevator.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 800 - {-# OPTIONS_GHC -Wno-redundant-constraints #-} -#endif -- | -- Module : Graphics.Color.Algebra.Elevator -- Copyright : (c) Alexey Kuleshevich 2018-2019 @@ -94,17 +92,56 @@ {-# INLINE squashTo1 #-} -- | Convert to integral streaching it's value up to a maximum value. -stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b +stretch :: forall a b. (RealFloat a, Integral b, Bounded b) => a -> b stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e) {-# INLINE stretch #-} - -- | Clamp a value to @[0, 1]@ range. -clamp01 :: (Ord a, Floating a) => a -> a +clamp01 :: RealFloat a => a -> a clamp01 !x = min (max 0 x) 1 {-# INLINE clamp01 #-} +float2Word32 :: Float -> Word32 +float2Word32 d' + | d' <= 0 = 0 + | d > 4.294967e9 = maxBound + | otherwise = round d + where + d = maxWord32 * d' +{-# INLINE float2Word32 #-} + +-- | Same as: +-- λ> fromIntegral (maxBound :: Word32) :: Float +-- 4.2949673e9 +maxWord32 :: Float +maxWord32 = F# 4.2949673e9# +{-# INLINE maxWord32 #-} + +double2Word64 :: Double -> Word64 +double2Word64 d' + | d' <= 0 = 0 + | d > 1.844674407370955e19 = maxBound + | otherwise = round d + where + d = maxWord64 * d' +{-# INLINE double2Word64 #-} + +-- | Differs from `fromIntegral` due to: https://gitlab.haskell.org/ghc/ghc/issues/17782 +-- +-- λ> fromIntegral (maxBound :: Word64) :: Double +-- 1.844674407370955e19 +maxWord64 :: Double +maxWord64 = D# 1.8446744073709552e19## +{-# INLINE maxWord64 #-} + +{-# RULES +"fromRealFloat :: Double -> Word" fromRealFloat = fromDouble :: Double -> Word +"fromRealFloat :: Double -> Word64" fromRealFloat = fromDouble :: Double -> Word64 +"fromRealFloat :: Float -> Word32" fromRealFloat = float2Word32 + #-} + + -- | Values between @[0, 255]]@ instance Elevator Word8 where maxValue = maxBound @@ -197,7 +234,7 @@ {-# INLINE toFloat #-} toDouble = squashTo1 {-# INLINE toDouble #-} - fromDouble = toWord64 + fromDouble = double2Word64 {-# INLINE fromDouble #-} toRealFloat = squashTo1 {-# INLINE toRealFloat #-} @@ -210,8 +247,16 @@ minValue = minBound #if WORD_SIZE_IN_BITS < 64 fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'} + toWord64 = dropDown + {-# INLINE toWord64 #-} + fromDouble = stretch + {-# INLINE fromDouble #-} #else fieldFormat _ = defFieldFormat { fmtWidth = Just 20, fmtChar = 'd'} + toWord64 (W64# w#) = (W# w#) + {-# INLINE toWord64 #-} + fromDouble = toWord64 . double2Word64 + {-# INLINE fromDouble #-} #endif toWord8 = dropDown {-# INLINE toWord8 #-} @@ -219,17 +264,13 @@ {-# INLINE toWord16 #-} toWord32 = dropDown {-# INLINE toWord32 #-} - toWord64 = fromIntegral - {-# INLINE toWord64 #-} toFloat = squashTo1 {-# INLINE toFloat #-} toDouble = squashTo1 {-# INLINE toDouble #-} - fromDouble = stretch . clamp01 - {-# INLINE fromDouble #-} toRealFloat = squashTo1 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} -- | Values between @[0, 127]@ @@ -249,7 +290,7 @@ {-# INLINE toFloat #-} toRealFloat = squashTo1 . max 0 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} @@ -270,7 +311,7 @@ {-# INLINE toFloat #-} toRealFloat = squashTo1 . max 0 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} @@ -291,7 +332,7 @@ {-# INLINE toFloat #-} toRealFloat = squashTo1 . max 0 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} @@ -312,7 +353,7 @@ {-# INLINE toFloat #-} toRealFloat = squashTo1 . max 0 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} @@ -322,8 +363,12 @@ minValue = 0 #if WORD_SIZE_IN_BITS < 64 fieldFormat _ = defFieldFormat { fmtWidth = Just 10, fmtChar = 'd'} + toWord64 = dropDown . max 0 + {-# INLINE toWord64 #-} #else fieldFormat _ = defFieldFormat { fmtWidth = Just 19, fmtChar = 'd'} + toWord64 = fromIntegral . max 0 + {-# INLINE toWord64 #-} #endif toWord8 = dropDown . max 0 {-# INLINE toWord8 #-} @@ -331,13 +376,11 @@ {-# INLINE toWord16 #-} toWord32 = dropDown . max 0 {-# INLINE toWord32 #-} - toWord64 = fromIntegral . max 0 - {-# INLINE toWord64 #-} toFloat = squashTo1 . max 0 {-# INLINE toFloat #-} toRealFloat = squashTo1 . max 0 {-# INLINE toRealFloat #-} - fromRealFloat = stretch . clamp01 + fromRealFloat = stretch {-# INLINE fromRealFloat #-} @@ -346,13 +389,13 @@ maxValue = 1 minValue = 0 fieldFormat _ = defFieldFormat { fmtWidth = Just 9, fmtPrecision = Just 6, fmtChar = 'f'} - toWord8 = stretch . clamp01 + toWord8 = stretch {-# INLINE toWord8 #-} - toWord16 = stretch . clamp01 + toWord16 = stretch {-# INLINE toWord16 #-} - toWord32 = stretch . clamp01 + toWord32 = float2Word32 {-# INLINE toWord32 #-} - toWord64 = stretch . clamp01 + toWord64 = stretch {-# INLINE toWord64 #-} toFloat = id {-# INLINE toFloat #-} @@ -370,14 +413,14 @@ instance Elevator Double where maxValue = 1 minValue = 0 - fieldFormat _ = defFieldFormat { fmtWidth = Just 15, fmtPrecision = Just 12, fmtChar = 'f'} - toWord8 = stretch . clamp01 + fieldFormat _ = defFieldFormat { fmtWidth = Just 15, fmtPrecision = Just 12, fmtChar = 'f' } + toWord8 = stretch {-# INLINE toWord8 #-} - toWord16 = stretch . clamp01 + toWord16 = stretch {-# INLINE toWord16 #-} - toWord32 = stretch . clamp01 + toWord32 = stretch {-# INLINE toWord32 #-} - toWord64 = stretch . clamp01 + toWord64 = double2Word64 {-# INLINE toWord64 #-} toFloat = double2Float {-# INLINE toFloat #-} @@ -398,6 +441,7 @@ "fromRealFloat :: Double -> Float" fromRealFloat = double2Float "fromRealFloat :: Float -> Double" fromRealFloat = float2Double #-} + -- | Discards imaginary part and changes precision of real part. diff --git a/src/Graphics/Color/Illuminant/CIE1931.hs b/src/Graphics/Color/Illuminant/CIE1931.hs --- a/src/Graphics/Color/Illuminant/CIE1931.hs +++ b/src/Graphics/Color/Illuminant/CIE1931.hs @@ -12,13 +12,19 @@ -- module Graphics.Color.Illuminant.CIE1931 ( CIE1931(..) - , wavelengths + , 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 @@ -26,6 +32,7 @@ -- ^ Original radiation constant c2 -> CCT (i :: k) rectifyColorTemperature cct c2 = CCT (fromIntegral cct * 1.4388 / c2) + --CCT (fromIntegral cct * 1.438776877 / c2) <-- Planckian radiation constant from 2018 -- | @[x=0.44758, y=0.40745]@ - CIE 1931 2° Observer - @@ -402,10 +409,30 @@ -- instance Illuminant 'DCI_P3 where -- whitePoint = WhitePoint 0.314 0.351 - - wavelengths :: [(Double, V3 Double)] -wavelengths = +wavelengths = 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 = [ (300, V3 0.04 0.02 0.00) , (305, V3 3.02 2.26 1.00) , (310, V3 6.00 4.50 2.00) @@ -514,3 +541,577 @@ , (825, V3 60.40 -9.55 6.30) , (830, V3 61.90 -9.80 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.png) +-- +-- @since 0.1.2 +xyzColorMatchingFunctions :: [(Double, V3 Double, V2 Double)] +xyzColorMatchingFunctions = + [ (l, V3 x' y' z', V2 x y) + | (l, x', y', z', x, y) <- + [ (380, 0.001368, 0.000039, 0.006450, 0.17411, 0.00496) + , (385, 0.002236, 0.000064, 0.010550, 0.17401, 0.00498) + , (390, 0.004243, 0.000120, 0.020050, 0.17380, 0.00492) + , (395, 0.007650, 0.000217, 0.036210, 0.17356, 0.00492) + , (400, 0.014310, 0.000396, 0.067850, 0.17334, 0.00480) + , (405, 0.023190, 0.000640, 0.110200, 0.17302, 0.00478) + , (410, 0.043510, 0.001210, 0.207400, 0.17258, 0.00480) + , (415, 0.077630, 0.002180, 0.371300, 0.17209, 0.00483) + , (420, 0.134380, 0.004000, 0.645600, 0.17141, 0.00510) + , (425, 0.214770, 0.007300, 1.039050, 0.17030, 0.00579) + , (430, 0.283900, 0.011600, 1.385600, 0.16888, 0.00690) + , (435, 0.328500, 0.016840, 1.622960, 0.16690, 0.00856) + , (440, 0.348280, 0.023000, 1.747060, 0.16441, 0.01086) + , (445, 0.348060, 0.029800, 1.782600, 0.16110, 0.01379) + , (450, 0.336200, 0.038000, 1.772110, 0.15664, 0.01770) + , (455, 0.318700, 0.048000, 1.744100, 0.15099, 0.02274) + , (460, 0.290800, 0.060000, 1.669200, 0.14396, 0.02970) + , (465, 0.251100, 0.073900, 1.528100, 0.13550, 0.03988) + , (470, 0.195360, 0.090980, 1.287640, 0.12412, 0.05780) + , (475, 0.142100, 0.112600, 1.041900, 0.10959, 0.08684) + , (480, 0.095640, 0.139020, 0.812950, 0.09129, 0.13270) + , (485, 0.057950, 0.169300, 0.616200, 0.06871, 0.20072) + , (490, 0.032010, 0.208020, 0.465180, 0.04539, 0.29498) + , (495, 0.014700, 0.258600, 0.353300, 0.02346, 0.41270) + , (500, 0.004900, 0.323000, 0.272000, 0.00817, 0.53842) + , (505, 0.002400, 0.407300, 0.212300, 0.00386, 0.65482) + , (510, 0.009300, 0.503000, 0.158200, 0.01387, 0.75019) + , (515, 0.029100, 0.608200, 0.111700, 0.03885, 0.81202) + , (520, 0.063270, 0.710000, 0.078250, 0.07430, 0.83380) + , (525, 0.109600, 0.793200, 0.057250, 0.11416, 0.82621) + , (530, 0.165500, 0.862000, 0.042160, 0.15472, 0.80586) + , (535, 0.225750, 0.914850, 0.029840, 0.19288, 0.78163) + , (540, 0.290400, 0.954000, 0.020300, 0.22962, 0.75433) + , (545, 0.359700, 0.980300, 0.013400, 0.26578, 0.72432) + , (550, 0.433450, 0.994950, 0.008750, 0.30160, 0.69231) + , (555, 0.512050, 1.000000, 0.005750, 0.33736, 0.65885) + , (560, 0.594500, 0.995000, 0.003900, 0.37310, 0.62445) + , (565, 0.678400, 0.978600, 0.002750, 0.40874, 0.58961) + , (570, 0.762100, 0.952000, 0.002100, 0.44406, 0.55471) + , (575, 0.842500, 0.915400, 0.001800, 0.47877, 0.52020) + , (580, 0.916300, 0.870000, 0.001650, 0.51249, 0.48659) + , (585, 0.978600, 0.816300, 0.001400, 0.54479, 0.45443) + , (590, 1.026300, 0.757000, 0.001100, 0.57515, 0.42423) + , (595, 1.056700, 0.694900, 0.001000, 0.60293, 0.39650) + , (600, 1.062200, 0.631000, 0.000800, 0.62704, 0.37249) + , (605, 1.045600, 0.566800, 0.000600, 0.64823, 0.35139) + , (610, 1.002600, 0.503000, 0.000340, 0.66576, 0.33401) + , (615, 0.938400, 0.441200, 0.000240, 0.68008, 0.31975) + , (620, 0.854450, 0.381000, 0.000190, 0.69150, 0.30834) + , (625, 0.751400, 0.321000, 0.000100, 0.70061, 0.29930) + , (630, 0.642400, 0.265000, 0.000050, 0.70792, 0.29203) + , (635, 0.541900, 0.217000, 0.000030, 0.71403, 0.28593) + , (640, 0.447900, 0.175000, 0.000020, 0.71903, 0.28093) + , (645, 0.360800, 0.138200, 0.000010, 0.72303, 0.27695) + , (650, 0.283500, 0.107000, 0.000000, 0.72599, 0.27401) + , (655, 0.218700, 0.081600, 0.000000, 0.72827, 0.27173) + , (660, 0.164900, 0.061000, 0.000000, 0.72997, 0.27003) + , (665, 0.121200, 0.044580, 0.000000, 0.73109, 0.26891) + , (670, 0.087400, 0.032000, 0.000000, 0.73199, 0.26801) + , (675, 0.063600, 0.023200, 0.000000, 0.73272, 0.26728) + , (680, 0.046770, 0.017000, 0.000000, 0.73342, 0.26658) + , (685, 0.032900, 0.011920, 0.000000, 0.73405, 0.26595) + , (690, 0.022700, 0.008210, 0.000000, 0.73439, 0.26561) + , (695, 0.015840, 0.005723, 0.000000, 0.73459, 0.26541) + , (700, 0.011359, 0.004102, 0.000000, 0.73469, 0.26531) + , (705, 0.008111, 0.002929, 0.000000, 0.73469, 0.26531) + , (710, 0.005790, 0.002091, 0.000000, 0.73469, 0.26531) + , (715, 0.004109, 0.001484, 0.000000, 0.73469, 0.26531) + , (720, 0.002899, 0.001047, 0.000000, 0.73469, 0.26531) + , (725, 0.002049, 0.000740, 0.000000, 0.73469, 0.26531) + , (730, 0.001440, 0.000520, 0.000000, 0.73469, 0.26531) + , (735, 0.001000, 0.000361, 0.000000, 0.73469, 0.26531) + , (740, 0.000690, 0.000249, 0.000000, 0.73469, 0.26531) + , (745, 0.000476, 0.000172, 0.000000, 0.73469, 0.26531) + , (750, 0.000332, 0.000120, 0.000000, 0.73469, 0.26531) + , (755, 0.000235, 0.000085, 0.000000, 0.73469, 0.26531) + , (760, 0.000166, 0.000060, 0.000000, 0.73469, 0.26531) + , (765, 0.000117, 0.000042, 0.000000, 0.73469, 0.26531) + , (770, 0.000083, 0.000030, 0.000000, 0.73469, 0.26531) + , (775, 0.000059, 0.000021, 0.000000, 0.73469, 0.26531) + , (780, 0.000042, 0.000015, 0.000000, 0.73469, 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) + ] + ] +-} diff --git a/src/Graphics/Color/Model/CMYK.hs b/src/Graphics/Color/Model/CMYK.hs --- a/src/Graphics/Color/Model/CMYK.hs +++ b/src/Graphics/Color/Model/CMYK.hs @@ -94,21 +94,22 @@ poke p (ColorCMYK c m y k) = poke4 p c m y k {-# INLINE poke #-} -cmyk2rgb :: Num e => Color CMYK e -> Color RGB e -cmyk2rgb (ColorCMYK c m y k) = ColorRGB r g b +cmyk2rgb :: (RealFloat e, Elevator e) => Color CMYK e -> Color RGB e +cmyk2rgb (ColorCMYK c m y k) = ColorRGB (clamp01 r) (clamp01 g) (clamp01 b) where - !r = (1 - c) * (1 - k) - !g = (1 - m) * (1 - k) - !b = (1 - y) * (1 - k) + !k' = maxValue - k + !r = (maxValue - c) * k' + !g = (maxValue - m) * k' + !b = (maxValue - y) * k' {-# INLINE cmyk2rgb #-} -rgb2cmyk :: (Ord e, Fractional e) => Color RGB e -> Color CMYK e +rgb2cmyk :: (RealFloat e, Elevator e) => Color RGB e -> Color CMYK e rgb2cmyk (ColorRGB r g b) = ColorCMYK c m y k where !c = (k' - r) / k' !m = (k' - g) / k' !y = (k' - b) / k' - !k = 1 - k' + !k = maxValue - k' !k' = max r (max g b) {-# INLINE rgb2cmyk #-} diff --git a/src/Graphics/Color/Model/Internal.hs b/src/Graphics/Color/Model/Internal.hs --- a/src/Graphics/Color/Model/Internal.hs +++ b/src/Graphics/Color/Model/Internal.hs @@ -215,7 +215,7 @@ [] -> id (x:xs) -> foldl' (\facc y -> facc . (channelSeparator :) . toShowS y) (toShowS x) xs --- TODO: consolidate those helpers inot algebra by means of: V2, V3, V4 and V5. +-- TODO: consolidate those helpers into algebra by means of: V2, V3, V4 and V5. -- Foldable helpers. foldr3 :: (e -> a -> a) -> a -> e -> e -> e -> a diff --git a/src/Graphics/Color/Model/YCbCr.hs b/src/Graphics/Color/Model/YCbCr.hs --- a/src/Graphics/Color/Model/YCbCr.hs +++ b/src/Graphics/Color/Model/YCbCr.hs @@ -81,20 +81,20 @@ rgb2ycbcr :: (Elevator e', Elevator e, RealFloat e) => Color RGB e' -> Weights e -> Color YCbCr e -rgb2ycbcr rgb' weights@(Weights (V3 kr _ kb)) = ColorYCbCr y cb cr +rgb2ycbcr rgb' weights@(Weights (V3 kr _ kb)) = ColorYCbCr y' cb cr where - rgb@(ColorRGB r _ b) = toRealFloat <$> rgb' - ColorY y = rgb2y rgb weights - !cb = 0.5 + 0.5 * (b - y) / (1 - kb) - !cr = 0.5 + 0.5 * (r - y) / (1 - kr) + rgb@(ColorRGB r' _ b') = toRealFloat <$> rgb' + ColorY y' = rgb2y rgb weights + !cb = 0.5 + 0.5 * (b' - y') / (1 - kb) + !cr = 0.5 + 0.5 * (r' - y') / (1 - kr) {-# INLINE rgb2ycbcr #-} ycbcr2rgb :: (Elevator e', Elevator e, RealFloat e) => Color YCbCr e' -> Weights e -> Color RGB e -ycbcr2rgb ycbcr (Weights (V3 kr kg kb)) = ColorRGB r g b +ycbcr2rgb ycbcr (Weights (V3 kr kg kb)) = ColorRGB r' g' b' where - ColorYCbCr y cb cr = toRealFloat <$> ycbcr - !r = y + (2 - 2 * kr) * cr - !b = y + (2 - 2 * kb) * cb - !g = (y - kr * r - kb * b) / kg + ColorYCbCr y' cb cr = toRealFloat <$> ycbcr + !r' = clamp01 (y' + (2 - 2 * kr) * (cr - 0.5)) + !b' = clamp01 (y' + (2 - 2 * kb) * (cb - 0.5)) + !g' = clamp01 ((y' - kr * r' - kb * b') / kg) {-# INLINE ycbcr2rgb #-} diff --git a/src/Graphics/Color/Space.hs b/src/Graphics/Color/Space.hs --- a/src/Graphics/Color/Space.hs +++ b/src/Graphics/Color/Space.hs @@ -32,7 +32,7 @@ convertColor = fromColorXYZ . (toColorXYZ :: Color cs' e -> Color (XYZ i) Double) {-# INLINE convertColor #-} --- | Same as `convertColor`, but use 32but `Float` asn an intermediary precision +-- | Same as `convertColor`, but use 32bit `Float` as an intermediary precision -- -- @since 0.1.1 convertColorFloat :: diff --git a/src/Graphics/Color/Space/Internal.hs b/src/Graphics/Color/Space/Internal.hs --- a/src/Graphics/Color/Space/Internal.hs +++ b/src/Graphics/Color/Space/Internal.hs @@ -34,7 +34,6 @@ , primaryTristimulus , Illuminant(..) , WhitePoint(.., WhitePoint) - , Tristimulus(..) , xWhitePoint , yWhitePoint , zWhitePoint @@ -147,8 +146,9 @@ colorTemperature = CCT (fromIntegral (natVal (Proxy :: Proxy (Temperature i)))) -newtype WhitePoint (i :: k) e = WhitePointChromaticity (Chromaticity i e) - deriving (Eq) +newtype WhitePoint (i :: k) e = + WhitePointChromaticity (Chromaticity i e) + deriving (Eq) instance (Illuminant i, Elevator e) => Show (WhitePoint (i :: k) e) where showsPrec n (WhitePointChromaticity wp) @@ -162,10 +162,6 @@ pattern WhitePoint x y <- (coerce -> (V2 x y)) where WhitePoint x y = coerce (V2 x y) {-# COMPLETE WhitePoint #-} - - -newtype Tristimulus i e = Tristimulus (Color (XYZ i) e) - deriving (Show, Eq, Ord, Functor, Applicative) -- | @x@ value of a `WhitePoint` -- diff --git a/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs b/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs --- a/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs +++ b/src/Graphics/Color/Space/RGB/Alternative/YCbCr.hs @@ -24,6 +24,10 @@ , pattern ColorYCbCrA , YCbCr , Color(YCbCr) + , ycbcr2srgb + , srgb2ycbcr + , toColorYCbCr + , fromColorYCbCr , module Graphics.Color.Space ) where @@ -86,9 +90,9 @@ instance Elevator e => ColorSpace (YCbCr SRGB) D65 e where type BaseModel (YCbCr SRGB) = CM.YCbCr type BaseSpace (YCbCr SRGB) = SRGB - toBaseSpace = fmap fromRealFloat . ycbcr2rgb . fmap toFloat + toBaseSpace = fmap fromRealFloat . ycbcr2srgb . fmap toFloat {-# INLINE toBaseSpace #-} - fromBaseSpace = fmap fromRealFloat . rgb2ycbcr . fmap toFloat + fromBaseSpace = fmap fromRealFloat . srgb2ycbcr . fmap toFloat {-# INLINE fromBaseSpace #-} luminance = luminance . toBaseSpace {-# INLINE luminance #-} @@ -106,27 +110,33 @@ {-# INLINE luminance #-} --- | Source: ITU-T Rec. T.871 -ycbcr2rgb :: (RedGreenBlue cs i, Ord e, Floating e) => Color (YCbCr cs) e -> Color cs e -ycbcr2rgb (ColorYCbCr y cb cr) = ColorRGB r g b +-- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871 +-- +-- @since 0.1.3 +ycbcr2srgb :: (RedGreenBlue cs i, RealFloat e) => Color (YCbCr cs) e -> Color cs e +ycbcr2srgb (ColorYCbCr y' cb cr) = ColorRGB r' g' b' where !cb05 = cb - 0.5 !cr05 = cr - 0.5 - !r = clamp01 (y + 1.402 * cr05) - !g = clamp01 (y - 0.344136 * cb05 - 0.714136 * cr05) - !b = clamp01 (y + 1.772 * cb05) -{-# INLINE ycbcr2rgb #-} + !r' = clamp01 (y' + 1.402 * cr05) + !g' = clamp01 (y' - 0.344136 * cb05 - 0.714136 * cr05) + !b' = clamp01 (y' + 1.772 * cb05) +{-# INLINE ycbcr2srgb #-} --- | Source: ITU-T Rec. T.871 -rgb2ycbcr :: (RedGreenBlue cs i, Floating e) => Color cs e -> Color (YCbCr cs) e -rgb2ycbcr (ColorRGB r g b) = ColorYCbCr y cb cr +-- | This conversion is only correct for sRGB and Rec601. Source: ITU-T Rec. T.871 +-- +-- @since 0.1.3 +srgb2ycbcr :: (RedGreenBlue cs i, RealFloat e) => Color cs e -> Color (YCbCr cs) e +srgb2ycbcr (ColorRGB r' g' b') = ColorYCbCr y' cb cr where - !y = 0.299 * r + 0.587 * g + 0.114 * b - !cb = 0.5 - 0.168736 * r - 0.331264 * g + 0.5 * b - !cr = 0.5 + 0.5 * r - 0.418688 * g - 0.081312 * b -{-# INLINE rgb2ycbcr #-} - + !y' = 0.299 * r' + 0.587 * g' + 0.114 * b' + !cb = 0.5 - 0.168736 * r' - 0.331264 * g' + 0.5 * b' + !cr = 0.5 + 0.5 * r' - 0.418688 * g' - 0.081312 * b' +{-# INLINE srgb2ycbcr #-} +-- | Convert any RGB color space that has `Luma` specified to `YCbCr` +-- +-- @since 0.1.3 toColorYCbCr :: forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e) => Color cs e' @@ -136,6 +146,9 @@ !weights = rgbLumaWeights rgb {-# INLINE toColorYCbCr #-} +-- | Convert `YCbCr` to the base RGB color space, which must have `Luma` implemented. +-- +-- @since 0.1.3 fromColorYCbCr :: forall cs i e' e. (Luma cs, RedGreenBlue cs i, Elevator e', Elevator e, RealFloat e) => Color (YCbCr cs) e' diff --git a/src/Graphics/Pixel.hs b/src/Graphics/Pixel.hs --- a/src/Graphics/Pixel.hs +++ b/src/Graphics/Pixel.hs @@ -23,12 +23,14 @@ , toPixelF , toPixelD , module Graphics.Color.Model + , module Graphics.Color.Algebra.Binary ) where +import Graphics.Color.Algebra.Binary import Graphics.Color.Model import Graphics.Pixel.Internal --- | Constructor for a pixel with single channel. +-- | Constructor for a grayscale pixel with single channel. -- -- @since 0.1.0 pattern PixelY :: e -> Pixel Y e @@ -78,7 +80,7 @@ {-# COMPLETE PixelYCbCr #-} --- | Constructor for a pixel with a luminocity and transparency channels. +-- | Constructor for a grayscale pixel with a transparency channel. -- -- @since 0.1.0 pattern PixelYA :: e -> e -> Pixel (Alpha Y) e diff --git a/src/Graphics/Pixel/ColorSpace.hs b/src/Graphics/Pixel/ColorSpace.hs --- a/src/Graphics/Pixel/ColorSpace.hs +++ b/src/Graphics/Pixel/ColorSpace.hs @@ -46,12 +46,15 @@ , AdobeRGB -- * Re-export of color space , module Graphics.Color.Space + , module Graphics.Color.Space.RGB.Alternative + , module Graphics.Color.Algebra.Binary ) where import Data.Coerce import Graphics.Color.Adaptation.VonKries import Graphics.Color.Model.Alpha import Graphics.Color.Model.Internal +import Graphics.Color.Algebra.Binary import qualified Graphics.Color.Model.RGB as CM import Graphics.Color.Space import Graphics.Color.Space.RGB.AdobeRGB @@ -76,7 +79,6 @@ convertPixel = liftPixel convert {-# INLINE convertPixel #-} - -- | Constructor for a pixel in @sRGB@ color space -- -- @since 0.1.0 @@ -91,14 +93,14 @@ pattern PixelSRGBA r g b a = Pixel (Alpha (SRGB (CM.ColorRGB r g b)) a) {-# COMPLETE PixelSRGBA #-} --- | Constructor for a pixel with Luminocity +-- | Constructor for a pixel with Luminance -- -- @since 0.1.0 pattern PixelY :: e -> Pixel (Y i) e pattern PixelY y = Pixel (Y y) {-# COMPLETE PixelY #-} --- | Constructor for a pixel with Luminocity and Alpha channel +-- | Constructor for a pixel with Luminance and Alpha channel -- -- @since 0.1.0 pattern PixelYA :: e -> e -> Pixel (Alpha (Y i)) e @@ -214,7 +216,7 @@ pattern PixelYCbCrA y cb cr a = Pixel (ColorYCbCrA y cb cr a) {-# COMPLETE PixelYCbCrA #-} --- | Compute luminance pixel of a pixel color +-- | Compute luminance of a pixel color -- -- @since 0.1.0 toPixelY :: ColorSpace cs i e => Pixel cs e -> Pixel (Y i) e diff --git a/tests/Graphics/Color/Algebra/ElevatorSpec.hs b/tests/Graphics/Color/Algebra/ElevatorSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Algebra/ElevatorSpec.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Graphics.Color.Algebra.ElevatorSpec (spec) where + +import Data.Int +import Data.Proxy +import Graphics.Color.Algebra +import Graphics.Color.Model.Common + +eprop :: (Testable prop, Elevator a, Random a) => String -> (a -> prop) -> Spec +eprop name = prop name . forAll arbitraryElevator + +prop_NegativeBecomesPositive :: (Show a, Ord a, Num a) => (b -> a) -> Negative b -> Property +prop_NegativeBecomesPositive f (Negative val) = property $ f val `shouldSatisfy` (>= 0) + +specNegativeBecomesPositive :: forall a . (Ord a, Elevator a, Arbitrary a) => Proxy a -> Spec +specNegativeBecomesPositive _ = do + prop "fromRealFloat :: Float" $ prop_NegativeBecomesPositive (fromRealFloat :: Float -> a) + prop "fromDouble" $ prop_NegativeBecomesPositive (fromDouble :: Double -> a) + prop "fromRealFloat :: Double" $ prop_NegativeBecomesPositive (fromRealFloat :: Double -> a) + prop "toFloat" $ prop_NegativeBecomesPositive (toFloat :: a -> Float) + prop "toDouble" $ prop_NegativeBecomesPositive (toDouble :: a -> Double) + prop "toRealFloat :: Float" $ prop_NegativeBecomesPositive (toRealFloat :: a -> Float) + prop "toRealFloat :: Double" $ prop_NegativeBecomesPositive (toRealFloat :: a -> Double) + +prop_NegativeBecomesZero :: (Show a, Ord a, Num a) => (b -> a) -> Negative b -> Property +prop_NegativeBecomesZero f (Negative val) = property $ f val `shouldSatisfy` (== 0) + +specNegativeBecomesZero :: forall a . (Ord a, Elevator a) => Proxy a -> Spec +specNegativeBecomesZero _ = do + prop "fromRealFloat :: Float" $ prop_NegativeBecomesZero (fromRealFloat :: Float -> a) + prop "fromDouble" $ prop_NegativeBecomesZero (fromDouble :: Double -> a) + prop "fromRealFloat :: Double" $ prop_NegativeBecomesZero (fromRealFloat :: Double -> a) + +spec :: Spec +spec = + describe "Elevator" $ do + describe "Word8" $ do + specNegativeBecomesZero (Proxy :: Proxy Word8) + eprop "toWord8" $ \(e :: Word8) -> e === toWord8 e + eprop "toWord8 . toWord16" $ \(e :: Word8) -> e === toWord8 (toWord16 e) + eprop "toWord8 . toWord32" $ \(e :: Word8) -> e === toWord8 (toWord32 e) + eprop "toWord8 . toWord64" $ \(e :: Word8) -> e === toWord8 (toWord64 e) + eprop "toWord8 . toFloat" $ \(e :: Word8) -> e === toWord8 (toFloat e) + eprop "toWord8 . toDouble" $ \(e :: Word8) -> e === toWord8 (toDouble e) + eprop "toWord8 . toFloat :: Float" $ \(e :: Word8) -> e === toWord8 (toFloat e :: Float) + eprop "toWord8 . toRealFloat :: Float" $ \(e :: Word8) -> + e === toWord8 (toRealFloat e :: Float) + eprop "toWord8 . toRealFloat :: Double" $ \(e :: Word8) -> + e === toWord8 (toRealFloat e :: Double) + eprop "fromRealFloat . toFloat :: Float" $ \(e :: Word8) -> e === fromRealFloat (toFloat e) + eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Word8) -> + e === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word8) -> + e === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Word8) -> e === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Word8) -> e === fromRealFloat (toDouble e) + eprop "read . toShowS" $ \(e :: Word8) -> e === read (toShowS e "") + describe "Word16" $ do + specNegativeBecomesZero (Proxy :: Proxy Word16) + eprop "toWord16" $ \(e :: Word16) -> e === toWord16 e + eprop "toWord16 . toWord32" $ \(e :: Word16) -> e === toWord16 (toWord32 e) + eprop "toWord16 . toWord64" $ \(e :: Word16) -> e === toWord16 (toWord64 e) + eprop "toWord16 . toFloat" $ \(e :: Word16) -> e === toWord16 (toFloat e) + eprop "toWord16 . toDouble" $ \(e :: Word16) -> e === toWord16 (toDouble e) + eprop "toWord16 . toRealFloat :: Float" $ \(e :: Word16) -> + e === toWord16 (toRealFloat e :: Float) + eprop "toWord16 . toRealFloat :: Double" $ \(e :: Word16) -> + e === toWord16 (toRealFloat e :: Double) + eprop "fromRealFloat . toFloat :: Float" $ \(e :: Word16) -> e === fromRealFloat (toFloat e) + eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Word16) -> + e === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word16) -> + e === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Word16) -> e === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Word16) -> e === fromRealFloat (toDouble e) + eprop "read . toShowS" $ \(e :: Word16) -> e === read (toShowS e "") + describe "Word32" $ do + specNegativeBecomesZero (Proxy :: Proxy Word32) + eprop "toWord32" $ \(e :: Word32) -> e === toWord32 e + eprop "toWord32 . toWord64" $ \(e :: Word32) -> e === toWord32 (toWord64 e) + prop "toWord32 . toFloat" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === toWord32 (toFloat e) + eprop "toWord32 . toDouble" $ \(e :: Word32) -> e === toWord32 (toDouble e) + prop "toWord32 . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === toWord32 (toRealFloat e :: Float) + eprop "toWord32 . toRealFloat :: Double" $ \(e :: Word32) -> + e === toWord32 (toRealFloat e :: Double) + prop "fromRealFloat . toFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> e === fromRealFloat (toFloat e :: Float) + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word32) -> + e === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Word32) -> + e === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Word32) -> e === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Word32) -> e === fromRealFloat (toDouble e) + eprop "read . toShowS" $ \(e :: Word32) -> e === read (toShowS e "") + describe "Word64" $ do + specNegativeBecomesZero (Proxy :: Proxy Word64) + eprop "toWord64" $ \(e :: Word64) -> e === toWord64 e + prop "toWord64 . toFloat" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word64) -> e === toWord64 (toFloat e) + prop "toWord64 . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word64) -> + shouldBeApproxIntegral 1 e (toWord64 (toDouble e)) + prop "toWord64 . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word64) -> e === toWord64 (toRealFloat e :: Float) + prop "toWord64 . toRealFloat :: Double" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word64) -> + shouldBeApproxIntegral 1 e (toWord64 (toRealFloat e :: Double)) + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word64) -> + e === fromRealFloat (toRealFloat e :: Float) + prop "fromRealFloat . toRealFloat :: Double" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word64) -> + e === fromRealFloat (toRealFloat e :: Double) + prop "fromDouble . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word64) -> + shouldBeApproxIntegral 1 e (fromDouble (toDouble e)) + prop "fromRealFloat . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word64) -> + shouldBeApproxIntegral 1 e (fromRealFloat (toDouble e)) + eprop "read . toShowS" $ \(e :: Word64) -> e === read (toShowS e "") + describe "Word" $ do + specNegativeBecomesZero (Proxy :: Proxy Word) + eprop "toWord64" $ \(e :: Word) -> fromIntegral e === toWord64 e + prop "toWord64 . toFloat" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word) -> fromIntegral e === toWord64 (toFloat e) + prop "toWord64 . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word) -> + shouldBeApproxIntegral 1 (fromIntegral e) (toWord64 (toDouble e)) + prop "toWord64 . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word) -> + fromIntegral e === toWord64 (toRealFloat e :: Float) + prop "toWord64 . toRealFloat :: Double" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word) -> + shouldBeApproxIntegral 1 (fromIntegral e) (toWord64 (toRealFloat e :: Double)) + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word) -> + e === fromRealFloat (toRealFloat e :: Float) + prop "fromRealFloat . toRealFloat :: Double" $ + forAll (choose (0, maxFloatI)) $ \(e :: Word) -> + e === fromRealFloat (toRealFloat e :: Double) + prop "fromDouble . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word) -> + shouldBeApproxIntegral 1 e (fromDouble (toDouble e)) + prop "fromRealFloat . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Word) -> + shouldBeApproxIntegral 1 e (fromRealFloat (toDouble e)) + eprop "read . toShowS" $ \(e :: Word) -> e === read (toShowS e "") + describe "Float" $ do + eprop "fromRealFloat . toFloat" $ \(e :: Float) -> e === fromRealFloat (toFloat e) + eprop "fromRealFloat . toDouble" $ \(e :: Float) -> e === fromRealFloat (toDouble e) + eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Float) -> + e === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Float) -> + e === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Float) -> e === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Float) -> e === fromRealFloat (toDouble e) + --eprop "read . toShowS" $ \(e :: Float) -> e === read (toShowS e "") + it "toWord32 (maxBound edge case)" $ toWord32 (1 :: Float) `shouldBe` maxBound + describe "Double" $ do + eprop "fromRealFloat . toDouble" $ \(e :: Double) -> e === fromRealFloat (toDouble e) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Double) -> + e === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Double) -> e === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Double) -> e === fromRealFloat (toDouble e) + it "toWord64 (maxBound edge case)" $ toWord64 (1 :: Double) `shouldBe` maxBound + let pos :: (Integral a, Num b) => a -> b + pos = fromIntegral . max 0 + describe "Int8" $ do + specNegativeBecomesPositive (Proxy :: Proxy Int8) + eprop "toWord8" $ \(e :: Int8) -> pos e === toWord8 e + eprop "fromRealFloat . toFloat :: Float" $ \(e :: Int8) -> + (pos e :: Int8) === fromRealFloat (toFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Int8) -> + (pos e :: Int8) === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int8) -> + (pos e :: Int8) === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Int8) -> (pos e :: Int8) === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Int8) -> + (pos e :: Int8) === fromRealFloat (toDouble e) + eprop "read . toShowS" $ \(e :: Int8) -> e === read (toShowS e "") + describe "Int16" $ do + specNegativeBecomesPositive (Proxy :: Proxy Int16) + eprop "toWord16" $ \(e :: Int16) -> pos e === toWord16 e + eprop "fromRealFloat . toFloat :: Float" $ \(e :: Int16) -> + (pos e :: Int16) === fromRealFloat (toFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Float" $ \(e :: Int16) -> + (pos e :: Int16) === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int16) -> + (pos e :: Int16) === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Int16) -> (pos e :: Int16) === fromDouble (toDouble e) + eprop "fromRealFloat . toDouble" $ \(e :: Int16) -> + (pos e :: Int16) === fromRealFloat (toDouble e) + eprop "read . toShowS" $ \(e :: Int16) -> e === read (toShowS e "") + describe "Int32" $ do + specNegativeBecomesPositive (Proxy :: Proxy Int32) + eprop "toWord32" $ \(e :: Int32) -> pos e === toWord32 e + prop "fromRealFloat . toFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Int32) -> + (pos e :: Int32) === fromRealFloat (toFloat e) + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Int32) -> + (pos e :: Int32) === fromRealFloat (toRealFloat e :: Float) + eprop "fromRealFloat . toRealFloat :: Double" $ \(e :: Int32) -> + (pos e :: Int32) === fromRealFloat (toRealFloat e :: Double) + eprop "fromDouble . toDouble" $ \(e :: Int32) -> (pos e :: Int32) === fromDouble (toDouble e) + eprop "read . toShowS" $ \(e :: Int32) -> e === read (toShowS e "") + describe "Int64" $ do + specNegativeBecomesPositive (Proxy :: Proxy Int64) + eprop "toWord64" $ \(e :: Int64) -> pos e === toWord64 e + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Int64) -> + (pos e :: Int64) === fromRealFloat (toRealFloat e :: Float) + prop "fromRealFloat . toRealFloat :: Double" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Int64) -> + shouldBeApproxIntegral 1 (pos e :: Int64) (fromRealFloat (toRealFloat e :: Double)) + prop "fromDouble . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Int64) -> + shouldBeApproxIntegral 1 (pos e) (fromDouble (toDouble e) :: Int64) + eprop "read . toShowS" $ \(e :: Int64) -> e === read (toShowS e "") + describe "Int" $ do + specNegativeBecomesPositive (Proxy :: Proxy Int) + prop "fromRealFloat . toRealFloat :: Float" $ + forAll (choose (0, maxFloatI)) $ \(e :: Int) -> + (pos e :: Int) === fromRealFloat (toRealFloat e :: Float) + prop "fromRealFloat . toRealFloat :: Double" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Int) -> + shouldBeApproxIntegral 1 (pos e :: Int) (fromRealFloat (toRealFloat e :: Double)) + prop "fromDouble . toDouble" $ + forAll (choose (0, maxDoubleI)) $ \(e :: Int) -> + shouldBeApproxIntegral 1 (pos e) (fromDouble (toDouble e) :: Int) + eprop "read . toShowS" $ \(e :: Int) -> e === read (toShowS e "") + where + maxFloatI, maxDoubleI :: Integral a => a + maxFloatI = 2 ^ (24 :: Int) + maxDoubleI = 2 ^ (54 :: Int) diff --git a/tests/Graphics/Color/Illuminant/CIE1931Spec.hs b/tests/Graphics/Color/Illuminant/CIE1931Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Illuminant/CIE1931Spec.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Illuminant.CIE1931Spec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Illuminant.Common +import Graphics.Color.Illuminant.CIE1931 + +spec :: Spec +spec = + describe "Wikipedia" $ do + describe "IlluminantSpec" $ do + illuminantSpec @'A + illuminantSpec @'B + illuminantSpec @'C + illuminantSpec @'D50 + illuminantSpec @'D55 + illuminantSpec @'D60 + illuminantSpec @'D65 + illuminantSpec @'D75 + illuminantSpec @'E + illuminantSpec @'FL1 + illuminantSpec @'FL2 + illuminantSpec @'FL3 + illuminantSpec @'FL4 + illuminantSpec @'FL5 + illuminantSpec @'FL6 + illuminantSpec @'FL7 + illuminantSpec @'FL8 + illuminantSpec @'FL9 + illuminantSpec @'FL10 + illuminantSpec @'FL11 + illuminantSpec @'FL12 + illuminantSpec @'FL3_1 + illuminantSpec @'FL3_2 + illuminantSpec @'FL3_3 + illuminantSpec @'FL3_4 + illuminantSpec @'FL3_5 + illuminantSpec @'FL3_6 + illuminantSpec @'FL3_7 + illuminantSpec @'FL3_8 + illuminantSpec @'FL3_9 + illuminantSpec @'FL3_10 + illuminantSpec @'FL3_11 + illuminantSpec @'FL3_12 + illuminantSpec @'FL3_13 + illuminantSpec @'FL3_14 + illuminantSpec @'FL3_15 + illuminantSpec @'HP1 + illuminantSpec @'HP2 + illuminantSpec @'HP3 + illuminantSpec @'HP4 + illuminantSpec @'HP5 + describe "Derived Classes" $ do + let is = [A .. HP5] + it "Bounded" $ [minBound .. maxBound] `shouldBe` is + it "Enum" $ forM_ is $ \ i -> toEnum (fromEnum i) `shouldBe` i + it "Read . Show" $ forM_ is $ \ i -> read (show i) `shouldBe` i + it "Read . Show" $ read (show is) `shouldBe` (is :: [CIE1931]) + + +daylightChromaticityY :: RealFloat a => a -> a +daylightChromaticityY x = 2.87 * x - 3 * x ^ (2 :: Int) - 0.275 + + +daylightChromaticityX_4000to7000K :: Fractional a => a -> a +daylightChromaticityX_4000to7000K t = + 0.244063 + + 0.09911 * 10 ^ (3 :: Int) / t + + 2.96780 * 10 ^ (6 :: Int) / (t ^ (2 :: Int)) + - 4.60700 * 10 ^ (9 :: Int) / (t ^ (3 :: Int)) + +daylightChromaticityX_7000to25000K :: Fractional a => a -> a +daylightChromaticityX_7000to25000K t = + 0.237040 + + 0.24748 * 10 ^ (3 :: Int) / t + + 1.90180 * 10 ^ (6 :: Int) / (t ^ (2 :: Int)) + - 2.00640 * 10 ^ (9 :: Int) / (t ^ (3 :: Int)) + +_chromaticity :: (Show e, RealFloat e) => e -> V2 e +_chromaticity t = V2 x y + where + x + | 4000 <= t && t < 7000 = daylightChromaticityX_4000to7000K t + | 7000 <= t && t <= 25000 = daylightChromaticityX_7000to25000K t + | otherwise = error $ "Invalid temperature: " ++ show t + y = daylightChromaticityY x + + + +_ts :: [Double] +_ts = + [ unCCT (colorTemperature :: CCT 'D50) + , unCCT (colorTemperature :: CCT 'D55) + , unCCT (colorTemperature :: CCT 'D60) + , unCCT (colorTemperature :: CCT 'D65) + , unCCT (colorTemperature :: CCT 'D75) + ] diff --git a/tests/Graphics/Color/Illuminant/CIE1964Spec.hs b/tests/Graphics/Color/Illuminant/CIE1964Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Illuminant/CIE1964Spec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Illuminant.CIE1964Spec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Illuminant.Common +import Graphics.Color.Illuminant.CIE1964 + +spec :: Spec +spec = + describe "Wikipedia" $ do + describe "IlluminantSpec" $ do + illuminantSpec @'A + illuminantSpec @'B + illuminantSpec @'C + illuminantSpec @'D50 + illuminantSpec @'D55 + illuminantSpec @'D60 + illuminantSpec @'D65 + illuminantSpec @'D75 + illuminantSpec @'E + illuminantSpec @'FL1 + illuminantSpec @'FL2 + illuminantSpec @'FL3 + illuminantSpec @'FL4 + illuminantSpec @'FL5 + illuminantSpec @'FL6 + illuminantSpec @'FL7 + illuminantSpec @'FL8 + illuminantSpec @'FL9 + illuminantSpec @'FL10 + illuminantSpec @'FL11 + illuminantSpec @'FL12 + describe "Derived Classes" $ do + let is = [A .. FL12] + it "Bounded" $ [minBound .. maxBound] `shouldBe` is + it "Enum" $ forM_ is $ \ i -> toEnum (fromEnum i) `shouldBe` i + it "Read . Show" $ forM_ is $ \ i -> read (show i) `shouldBe` i + it "Read . Show" $ read (show is) `shouldBe` (is :: [CIE1964]) diff --git a/tests/Graphics/Color/Illuminant/Common.hs b/tests/Graphics/Color/Illuminant/Common.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Illuminant/Common.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Illuminant.Common + ( illuminantSpec + ) where + +import Data.Proxy +import Graphics.Color.Space +import Graphics.Color.Model.Common + + +colorTemperatureExpectation :: + forall i. Illuminant i + => Expectation +colorTemperatureExpectation = + round (unCCT (colorTemperature :: CCT i)) `shouldBe` natVal (Proxy :: Proxy (Temperature i)) + + +illuminantSpec :: + forall i. (Illuminant i) + => Spec +illuminantSpec = + let wp = whitePoint :: WhitePoint i Double + in describe (showsType (Proxy :: Proxy i) "") $ do + it "colorTemperature" $ colorTemperatureExpectation @i + it "tristimulus to chromaticity" $ + fromColorXYZ (whitePointTristimulus :: Color (XYZ i) Double) `epsilonEqColorDouble` + case wp of + WhitePointChromaticity (Chromaticity c) -> c + prop "whitePointXZ" $ forAll arbitraryElevator $ \ vY -> + sum (whitePointXZ vY wp) `epsilonEqDouble` vY / yWhitePoint wp diff --git a/tests/Graphics/Color/Illuminant/WikipediaSpec.hs b/tests/Graphics/Color/Illuminant/WikipediaSpec.hs --- a/tests/Graphics/Color/Illuminant/WikipediaSpec.hs +++ b/tests/Graphics/Color/Illuminant/WikipediaSpec.hs @@ -1,11 +1,13 @@ -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} module Graphics.Color.Illuminant.WikipediaSpec (spec) where import Data.Proxy import Graphics.Color.Space.Common +import Graphics.Color.Illuminant.Common import Graphics.Color.Illuminant.Wikipedia import qualified Data.Colour.CIE as Colour import qualified Data.Colour.CIE.Illuminant as Colour @@ -28,6 +30,27 @@ spec :: Spec spec = describe "Wikipedia" $ do + describe "IlluminantSpec" $ do + illuminantSpec @'A + illuminantSpec @'B + illuminantSpec @'C + illuminantSpec @'D50 + illuminantSpec @'D55 + illuminantSpec @'D65 + illuminantSpec @'D75 + illuminantSpec @'E + illuminantSpec @'F1 + illuminantSpec @'F12 + illuminantSpec @'F3 + illuminantSpec @'F4 + illuminantSpec @'F5 + illuminantSpec @'F6 + illuminantSpec @'F7 + illuminantSpec @'F8 + illuminantSpec @'F9 + illuminantSpec @'F10 + illuminantSpec @'F11 + illuminantSpec @'F12 describe "Match 'colour' package" $ do Colour.chromaCoords Colour.a `shouldMatch` (whitePoint :: WhitePoint 'A Double) Colour.chromaCoords Colour.b `shouldMatch` (whitePoint :: WhitePoint 'B Double) diff --git a/tests/Graphics/Color/Model/CMYKSpec.hs b/tests/Graphics/Color/Model/CMYKSpec.hs --- a/tests/Graphics/Color/Model/CMYKSpec.hs +++ b/tests/Graphics/Color/Model/CMYKSpec.hs @@ -7,6 +7,7 @@ import Graphics.Color.Model import Graphics.Color.Model.Common import Graphics.Color.Model.RGBSpec () +import qualified Codec.Picture.Types as JuicyPixels instance (Elevator e, Random e) => Arbitrary (Color CMYK e) where arbitrary = @@ -19,3 +20,21 @@ colorModelSpec @CMYK @Word "CMYK" prop "rgb2cmyk . cmyk2rgb" $ \(rgb :: Color RGB Double) -> rgb `epsilonEqColor` cmyk2rgb (rgb2cmyk rgb) + describe "Match JuicyPixels" $ do + prop "rgb2cmyk" $ \(rgb@(ColorRGB r g b) :: Color RGB Word8) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelRGB8 r g b) of + JuicyPixels.PixelCMYK8 c m y k -> + toWord8 <$> rgb2cmyk (toFloat <$> rgb) `approxIntegralColorExpect1` ColorCMYK c m y k + prop "cmyk2rgb" $ \(cmyk@(ColorCMYK c m y k) :: Color CMYK Word8) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelCMYK8 c m y k) of + JuicyPixels.PixelRGB8 r g b -> + toWord8 <$> cmyk2rgb (toFloat <$> cmyk) `approxIntegralColorExpect1` ColorRGB r g b + + prop "cmyk2rgb - 16bit" $ \(cmyk@(ColorCMYK c m y k) :: Color CMYK Word16) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelCMYK16 c m y k) of + JuicyPixels.PixelRGB16 r g b -> + approxIntegralColorExpect 2 (toWord16 <$> cmyk2rgb (toFloat <$> cmyk)) (ColorRGB r g b) + prop "rgb2cmyk - 16bit" $ \(rgb@(ColorRGB r g b) :: Color RGB Word16) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelRGB16 r g b) of + JuicyPixels.PixelCMYK16 c m y k -> + toWord16 <$> rgb2cmyk (toFloat <$> rgb) `approxIntegralColorExpect1` ColorCMYK c m y k diff --git a/tests/Graphics/Color/Model/Common.hs b/tests/Graphics/Color/Model/Common.hs --- a/tests/Graphics/Color/Model/Common.hs +++ b/tests/Graphics/Color/Model/Common.hs @@ -13,19 +13,25 @@ , epsilonColorExpect , epsilonColorIxSpec , epsilonEq + , epsilonEqFloat + , epsilonEqDouble , epsilonEqColor , epsilonEqColorFloat , epsilonEqColorDouble , epsilonEqColorTol , epsilonEqColorTolIx + -- * Integral + , shouldBeApproxIntegral + , approxIntegralColorExpect + , approxIntegralColorExpect1 , arbitraryElevator , module Test.Hspec , module Test.Hspec.QuickCheck , module Test.QuickCheck , module System.Random + , module F ) where -import Control.Applicative import Data.Proxy import Data.Foldable as F import Graphics.Color.Model @@ -37,6 +43,8 @@ import Control.Monad +infix 1 `epsilonEqFloat`, `epsilonEqDouble`, `approxIntegralColorExpect1` + izipWithM_ :: Applicative m => (Int -> a -> b -> m c) -> [a] -> [b] -> m () izipWithM_ f xs = zipWithM_ (uncurry f) (zip [0..] xs) @@ -56,19 +64,55 @@ arbitraryElevator :: (Elevator e, Random e) => Gen e arbitraryElevator = choose (minValue, maxValue) +shouldBeApproxIntegral :: + (HasCallStack, Show a, Integral a) + => Word8 -- ^ Epsilon, a maximum tolerated error. + -> a -- ^ Tested value. + -> a -- ^ Expected result. + -> Expectation +shouldBeApproxIntegral epsilon result expected + | result == expected = pure () + | otherwise = + assertBool + (concat + [show result, " /= ", show expected, " (Tolerance: ", show diff, " > ", show epsilon, ")"]) + (diff <= fromIntegral epsilon) + where + diff + | result > expected = result - expected + | otherwise = expected - result + +approxIntegralColorExpect :: + (HasCallStack, ColorModel cs e, Integral e) => Word8 -> Color cs e -> Color cs e -> Expectation +approxIntegralColorExpect epsilon x y = + zipWithM_ (shouldBeApproxIntegral epsilon) (F.toList x) (F.toList y) + +approxIntegralColorExpect1 :: + (HasCallStack, ColorModel cs e, Integral e) => Color cs e -> Color cs e -> Expectation +approxIntegralColorExpect1 = approxIntegralColorExpect 1 + epsilonExpect :: (HasCallStack, Show a, RealFloat a) => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored. -> a -- ^ Expected result. -> a -- ^ Tested value. -> Expectation -epsilonExpect epsilon x y - | isNaN x = y `shouldSatisfy` isNaN - | x == y = pure () - | otherwise = - assertBool - (concat [show x, " /= ", show y, "\nTolerance: ", show diff, " > ", show n]) - (diff <= n) +epsilonExpect epsilon x y = + forM_ (epsilonMaybeEq epsilon x y) $ \errMsg -> + expectationFailure $ "Expected: " ++ show x ++ " but got: " ++ show y ++ "\n " ++ errMsg + + +epsilonMaybeEq :: + (Show a, RealFloat a) + => a -- ^ Epsilon, a maximum tolerated error. Sign is ignored. + -> a -- ^ Expected result. + -> a -- ^ Tested value. + -> Maybe String +epsilonMaybeEq epsilon x y + | isNaN x && not (isNaN y) = Just $ "Expected NaN, but got: " ++ show y + | x == y = Nothing + | diff > n = Just $ concat [show x, " /= ", show y, " (Tolerance: ", show diff, " > ", show n, ")"] + | otherwise = Nothing where (absx, absy) = (abs x, abs y) n = epsilon * (1 + max absx absy) @@ -76,7 +120,10 @@ epsilonColorExpect :: (HasCallStack, ColorModel cs e, RealFloat e) => e -> Color cs e -> Color cs e -> Expectation -epsilonColorExpect epsilon x y = zipWithM_ (epsilonExpect epsilon) (F.toList x) (F.toList y) +epsilonColorExpect epsilon x y = + forM_ (zipWithM (epsilonMaybeEq epsilon) (F.toList x) (F.toList y)) $ \errMsgs -> + expectationFailure $ + "Expected: " ++ show x ++ " but got: " ++ show y ++ "\n" ++ unlines (map (" " ++) errMsgs) epsilonColorIxSpec :: (HasCallStack, ColorModel cs e, RealFloat e) @@ -86,7 +133,7 @@ -> Color cs e -> Spec epsilonColorIxSpec epsilon ix x y = - it ("Index: " ++ show ix) $ zipWithM_ (epsilonExpect epsilon) (F.toList x) (F.toList y) + it ("Index: " ++ show ix) $ epsilonColorExpect epsilon x y epsilonEq :: @@ -95,8 +142,25 @@ -> a -- ^ Expected result. -> a -- ^ Tested value. -> Property -epsilonEq epsilon x y = once $ epsilonExpect epsilon x y +epsilonEq epsilon x y = property $ epsilonExpect epsilon x y +epsilonEqDouble :: + Double -- ^ Expected result. + -> Double -- ^ Tested value. + -> Property +epsilonEqDouble = epsilonEq epsilon + where + epsilon = 1e-12 + +epsilonEqFloat :: + Float -- ^ Expected result. + -> Float -- ^ Tested value. + -> Property +epsilonEqFloat = epsilonEq epsilon + where + epsilon = 1e-6 + + epsilonEqColor :: (ColorModel cs e, RealFloat e) => Color cs e -> Color cs e -> Property epsilonEqColor = epsilonEqColorTol epsilon where @@ -107,14 +171,14 @@ where epsilon = 1e-12 - epsilonEqColorFloat :: ColorModel cs Float => Color cs Float -> Color cs Float -> Property epsilonEqColorFloat = epsilonEqColorTol epsilon where epsilon = 1e-6 epsilonEqColorTol :: (ColorModel cs e, RealFloat e) => e -> Color cs e -> Color cs e -> Property -epsilonEqColorTol epsilon x y = conjoin $ F.toList $ liftA2 (epsilonEq epsilon) x y +epsilonEqColorTol epsilon x y = property $ epsilonColorExpect epsilon x y + --conjoin $ F.toList $ liftA2 (epsilonEq epsilon) x y -- | Same as `epsilonEqColorTol` but with indexed counterexample. epsilonEqColorTolIx :: @@ -136,4 +200,4 @@ colorModelSpec name = describe "ColorModel" $ do toFromComponentsSpec @cs @e - it "name" $ showsColorModelName (Proxy :: Proxy (Color cs e)) "" `shouldStartWith` name + it "Model Name" $ showsColorModelName (Proxy :: Proxy (Color cs e)) "" `shouldStartWith` name diff --git a/tests/Graphics/Color/Model/YCbCrSpec.hs b/tests/Graphics/Color/Model/YCbCrSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Model/YCbCrSpec.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Model.YCbCrSpec (spec) where + +import Graphics.Color.Model +import Graphics.Color.Model.Common +import Graphics.Color.Model.RGBSpec () + +instance (Elevator e, Random e) => Arbitrary (Color YCbCr e) where + arbitrary = + ColorYCbCr <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +spec :: Spec +spec = + describe "YCbCr" $ + colorModelSpec @YCbCr @Word "YCbCr" diff --git a/tests/Graphics/Color/Space/Common.hs b/tests/Graphics/Color/Space/Common.hs --- a/tests/Graphics/Color/Space/Common.hs +++ b/tests/Graphics/Color/Space/Common.hs @@ -9,7 +9,9 @@ , module Graphics.Color.Model.Common , colorSpaceSpec , colorSpaceLenientSpec + , colorSpaceCommonSpec , prop_toFromColorXYZ + , prop_LuminanceColorXYZ , prop_toFromLenientColorXYZ , prop_toFromBaseSpace ) where @@ -40,6 +42,10 @@ prop_toFromLenientColorXYZ epsilon c = epsilonEqColorTol epsilon c (fromColorXYZ (toColorXYZ c :: Color (XYZ i) Double)) +prop_LuminanceColorXYZ :: forall cs i e . ColorSpace cs i e => Color cs e -> Property +prop_LuminanceColorXYZ c = + (luminance c :: Color (Y i) Float) `epsilonEqColor` + luminance (toColorXYZ c :: Color (XYZ i) Float) prop_toFromBaseSpace :: forall cs i e. (ColorSpace cs i e, ColorSpace (BaseSpace cs) i e, RealFloat e) @@ -47,6 +53,14 @@ -> Property prop_toFromBaseSpace c = c `epsilonEqColor` fromBaseSpace (toBaseSpace c) +prop_toFromBaseSpaceLenient :: + forall cs i e. (ColorSpace cs i e, ColorSpace (BaseSpace cs) i e, RealFloat e) + => e + -> Color cs e + -> Property +prop_toFromBaseSpaceLenient epsilon c = epsilonEqColorTol epsilon c $ fromBaseSpace (toBaseSpace c) + + prop_toFromBaseModel :: forall cs i e. ColorSpace cs i e => Color cs e @@ -55,15 +69,12 @@ colorSpaceCommonSpec :: forall cs i e. - (Arbitrary (Color cs e), ColorSpace (BaseSpace cs) i e, ColorSpace cs i e, RealFloat e) + (Arbitrary (Color cs e), ColorSpace cs i e) => Spec -> Spec colorSpaceCommonSpec extra = describe "ColorSpace" $ do - prop "luminance . toColorXYZ" $ \(c :: Color cs e) -> - (luminance c :: Color (Y i) Float) `epsilonEqColor` - luminance (toColorXYZ c :: Color (XYZ i) Float) + prop "luminance . toColorXYZ" $ prop_LuminanceColorXYZ @cs @i @e prop "toFromBaseModel" $ prop_toFromBaseModel @cs @i @e - prop "toFromBaseSpace" $ prop_toFromBaseSpace @cs @i @e extra colorSpaceSpec :: @@ -71,7 +82,8 @@ (Arbitrary (Color cs e), ColorSpace (BaseSpace cs) i e, ColorSpace cs i e, RealFloat e) => Spec colorSpaceSpec = - colorSpaceCommonSpec @cs @i @e $ + colorSpaceCommonSpec @cs @i @e $ do + prop "toFromBaseSpace" $ prop_toFromBaseSpace @cs @i @e prop "toFromColorXYZ" $ prop_toFromColorXYZ @cs @i @e colorSpaceLenientSpec :: @@ -81,5 +93,6 @@ -> Spec colorSpaceLenientSpec tol = let tolStr = "(lenient=" ++ show tol ++ ")" - in colorSpaceCommonSpec @cs @i @e $ + in colorSpaceCommonSpec @cs @i @e $ do + prop ("toFromBaseSpace " ++ tolStr) $ prop_toFromBaseSpaceLenient @cs @i @e tol prop ("toFromColorXYZ " ++ tolStr) $ prop_toFromLenientColorXYZ @cs @i @e tol diff --git a/tests/Graphics/Color/Space/RGB/AdobeRGBSpec.hs b/tests/Graphics/Color/Space/RGB/AdobeRGBSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/AdobeRGBSpec.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.AdobeRGBSpec (spec, arbitraryElevator) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.AdobeRGB + +instance (Elevator e, Random e) => Arbitrary (Color AdobeRGB e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + + +spec :: Spec +spec = describe "AdobeRGB" $ do + colorModelSpec @AdobeRGB @Word "AdobeRGB" + colorSpaceLenientSpec @AdobeRGB @_ @Float 0.00001 diff --git a/tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs b/tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Alternative/CMYKSpec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Alternative.CMYKSpec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.SRGB +import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived +import Graphics.Color.Space.RGB.Alternative.CMYK +import Graphics.Color.Space.RGB.Derived.SRGBSpec () + + +instance (Elevator e, Random e) => Arbitrary (Color (CMYK cs) e) where + arbitrary = + ColorCMYK <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator <*> + arbitraryElevator + +spec :: Spec +spec = + describe "CMYK" $ do + colorModelSpec @(CMYK (Derived.SRGB D65)) @Word "CMYK" + colorSpaceCommonSpec @(CMYK (Derived.SRGB D65)) @_ @Double $ pure () + -- Arbitrary inverse CMYKtoSRGB is not true. + prop "sRGBtoCMYK" $ \ (srgb :: Color (Derived.SRGB D65) Double) -> + toBaseSpace (fromBaseSpace srgb :: Color (CMYK (Derived.SRGB D65)) Double) + `epsilonEqColor` srgb diff --git a/tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs b/tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Alternative/HSISpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Alternative.HSISpec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.SRGB +import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived +import Graphics.Color.Space.RGB.Alternative.HSI +import Graphics.Color.Space.RGB.SRGBSpec () +import Graphics.Color.Space.RGB.Derived.SRGBSpec () + + +instance (Elevator e, Random e) => Arbitrary (Color (HSI cs) e) where + arbitrary = ColorHSI <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +spec :: Spec +spec = + describe "HSI" $ do + describe "Derived-sRGB" $ do + colorModelSpec @(HSI (Derived.SRGB D65)) @Word "HSI" + colorSpaceSpec @(HSI (Derived.SRGB D65)) @_ @Double diff --git a/tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs b/tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Alternative/HSLSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Alternative.HSLSpec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.SRGB +import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived +import Graphics.Color.Space.RGB.Alternative.HSL +import Graphics.Color.Space.RGB.SRGBSpec () +import Graphics.Color.Space.RGB.Derived.SRGBSpec () + + +instance (Elevator e, Random e) => Arbitrary (Color (HSL cs) e) where + arbitrary = ColorHSL <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +spec :: Spec +spec = + describe "HSL" $ do + describe "Derived-sRGB" $ do + colorModelSpec @(HSL (Derived.SRGB D65)) @Word "HSL" + colorSpaceSpec @(HSL (Derived.SRGB D65)) @_ @Double diff --git a/tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs b/tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Alternative/HSVSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Alternative.HSVSpec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.SRGB +import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived +import Graphics.Color.Space.RGB.Alternative.HSV +import Graphics.Color.Space.RGB.SRGBSpec () +import Graphics.Color.Space.RGB.Derived.SRGBSpec () + + +instance (Elevator e, Random e) => Arbitrary (Color (HSV cs) e) where + arbitrary = ColorHSV <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +spec :: Spec +spec = + describe "HSV" $ do + describe "Derived-sRGB" $ do + colorModelSpec @(HSV (Derived.SRGB D65)) @Word "HSV" + colorSpaceSpec @(HSV (Derived.SRGB D65)) @_ @Double diff --git a/tests/Graphics/Color/Space/RGB/Alternative/YCbCrSpec.hs b/tests/Graphics/Color/Space/RGB/Alternative/YCbCrSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Alternative/YCbCrSpec.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Alternative.YCbCrSpec (spec) where + +import qualified Codec.Picture.Types as JuicyPixels +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.SRGB +import qualified Graphics.Color.Space.RGB.Derived.SRGB as Derived +import Graphics.Color.Space.RGB.Alternative.YCbCr +import Graphics.Color.Space.RGB.SRGBSpec () +import Graphics.Color.Space.RGB.Derived.SRGBSpec () + + +instance (Elevator e, Random e) => Arbitrary (Color (YCbCr cs) e) where + arbitrary = + ColorYCbCr <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +-- Accurate roundtrip to/from both XYZ and SRGB is not possible due to the nature of the +-- algorithm. +spec :: Spec +spec = + describe "YCbCr" $ do + describe "sRGB" $ do + colorModelSpec @(YCbCr SRGB) @Word "YCbCr" + colorSpaceCommonSpec @(YCbCr SRGB) @_ @Double $ pure () + describe "Derived-sRGB" $ do + colorModelSpec @(YCbCr (Derived.SRGB D65)) @Word "YCbCr" + colorSpaceCommonSpec @(YCbCr (Derived.SRGB D65)) @_ @Double $ pure () + prop "toColorYCbCr . toColorYCbCr" $ \(rgb :: Color (Derived.SRGB D65) Double) -> + rgb `epsilonEqColor` + fromColorYCbCr (toColorYCbCr rgb :: Color (YCbCr (Derived.SRGB D65)) Double) + prop "toColorYCbCr == srgb2ycbcr" $ \(rgb :: Color SRGB Double) -> + srgb2ycbcr rgb `epsilonEqColor` + (toColorYCbCr rgb :: Color (YCbCr SRGB) Double) + prop "fromColorYCbCr == ycbcr2srgb" $ \(ycbcr :: Color (YCbCr SRGB) Double) -> + ycbcr2srgb ycbcr `epsilonEqColor` (fromColorYCbCr ycbcr :: Color SRGB Double) + describe "Match JuicyPixels" $ do + prop "rgb2ycbcr" $ \(rgb@(ColorRGB r g b) :: Color SRGB Word8) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelRGB8 r g b) of + JuicyPixels.PixelYCbCr8 y cb cr -> + (fromBaseSpace rgb :: Color (YCbCr SRGB) Word8) + `approxIntegralColorExpect1` ColorYCbCr y cb cr + prop "ycbcr2rgb" $ \(ycbcr@(ColorYCbCr y cb cr) :: Color (YCbCr SRGB) Word8) -> + case JuicyPixels.convertPixel (JuicyPixels.PixelYCbCr8 y cb cr) of + JuicyPixels.PixelRGB8 r g b -> + (toBaseSpace ycbcr) `approxIntegralColorExpect1` ColorRGB r g b diff --git a/tests/Graphics/Color/Space/RGB/Derived/AdobeRGBSpec.hs b/tests/Graphics/Color/Space/RGB/Derived/AdobeRGBSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/Derived/AdobeRGBSpec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.Derived.AdobeRGBSpec (spec) where + +import Graphics.Color.Illuminant.CIE1931 +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.Derived.AdobeRGB + +instance (Elevator e, Random e, Illuminant i) => Arbitrary (Color (AdobeRGB (i :: k)) e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + + +spec :: Spec +spec = describe "AdobeRGB" $ do + colorModelSpec @(AdobeRGB 'D65) @Word "AdobeRGB" + colorSpaceSpec @(AdobeRGB 'D65) @_ @Float diff --git a/tests/Graphics/Color/Space/RGB/ITU/Rec470Spec.hs b/tests/Graphics/Color/Space/RGB/ITU/Rec470Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/ITU/Rec470Spec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.ITU.Rec470Spec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.ITU.Rec470 + +instance (Elevator e, Random e) => Arbitrary (Color BT470_525 e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +instance (Elevator e, Random e) => Arbitrary (Color BT470_625 e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + + +spec :: Spec +spec = do + describe "Rec470 (525)" $ do + colorModelSpec @BT470_525 @Word "BT470_525" + colorSpaceSpec @BT470_525 @_ @Float + describe "Rec470 (625)" $ do + colorModelSpec @BT470_625 @Word "BT470_625" + colorSpaceSpec @BT470_625 @_ @Float diff --git a/tests/Graphics/Color/Space/RGB/ITU/Rec601Spec.hs b/tests/Graphics/Color/Space/RGB/ITU/Rec601Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Graphics/Color/Space/RGB/ITU/Rec601Spec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module Graphics.Color.Space.RGB.ITU.Rec601Spec (spec) where + +import Graphics.Color.Space.Common +import Graphics.Color.Space.RGB.ITU.Rec601 + +instance (Elevator e, Random e) => Arbitrary (Color BT601_525 e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + +instance (Elevator e, Random e) => Arbitrary (Color BT601_625 e) where + arbitrary = ColorRGB <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator + + +spec :: Spec +spec = do + describe "Rec601 (525)" $ do + colorModelSpec @BT601_525 @Word "BT601_525" + colorSpaceSpec @BT601_525 @_ @Float + describe "Rec601 (625)" $ do + colorModelSpec @BT601_625 @Word "BT601_625" + colorSpaceSpec @BT601_625 @_ @Float diff --git a/tests/Graphics/Color/Space/YUV/YCbCrSpec.hs b/tests/Graphics/Color/Space/YUV/YCbCrSpec.hs deleted file mode 100644 --- a/tests/Graphics/Color/Space/YUV/YCbCrSpec.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeApplications #-} -module Graphics.Color.Space.YUV.YCbCrSpec (spec) where - -import Graphics.Color.Space.Common --- import Graphics.Color.Space.YCbCr --- import Graphics.Color.Space.RGBSpec () - --- instance (Elevator e, Random e) => Arbitrary (Color YCbCr e) where --- arbitrary = ColorYCbCr <$> arbitraryElevator <*> arbitraryElevator <*> arbitraryElevator - -spec :: Spec -spec = pure () - -- describe "YCbCr" $ do - -- colorModelSpec @YCbCr @Word - -- it "rgb2ycbcr . ycbcr2rgb" $ - -- property $ \rgb -> epsilonEqColorTol (1e-5 :: Double) rgb (ycbcr2rgb (rgb2ycbcr rgb)) diff --git a/tests/Graphics/Color/Standard/RALSpec.hs b/tests/Graphics/Color/Standard/RALSpec.hs --- a/tests/Graphics/Color/Standard/RALSpec.hs +++ b/tests/Graphics/Color/Standard/RALSpec.hs @@ -8,7 +8,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -59,6 +58,7 @@ let (srgbs, _hsls, _cmyks) = unzip3 ralAlternatives describe "Matches sRGB" $ specMatchLists ["luminousBrightOrange", "pastelGreen"] shouldBe srgbs ralColors' + -- xdescribe "Matches CMYK" $ specMatchLists [] shouldBe cmyks ralColors' -- xdescribe "Matches HSL" $ specMatchLists [] shouldBe hsls ralColors'