-- | &
--
module Data.CG.Minus.Colour.RYB where
import Data.List {- base -}
import qualified Data.Fixed as F {- base -}
import qualified Data.Colour.SRGB as SRGB {- colour -}
type R = Double
type RYB = (R,R,R)
type RGB = (R,R,R)
type RGB_U8 = (Int,Int,Int)
t3_to_list :: (t,t,t) -> [t]
t3_to_list (p,q,r) = [p,q,r]
t3_from_list :: [t] -> (t, t, t)
t3_from_list l =
case l of
[p,q,r] -> (p,q,r)
_ -> error "t3_from_list"
ryb_clr :: [(String,[R])]
ryb_clr =
[("white", [1,1,1])
,("red", [1,0,0])
,("yellow", [1,1,0])
,("blue", [0.163,0.373,0.6])
,("violet", [0.5,0,0.5])
,("green", [0,0.66,0.2])
,("orange", [1,0.5,0])
,("black", [0.2,0.094,0.0])]
ryb_clr_ix :: String -> Int -> R
ryb_clr_ix nm ix = maybe (error "ryb_clr_ix") (!! ix) (lookup nm ryb_clr)
unit_to_u8 :: R -> Int
unit_to_u8 = floor . (* 255.0)
t3_unit_to_u8 :: (R,R,R) -> (Int,Int,Int)
t3_unit_to_u8 (p,q,r) = (unit_to_u8 p,unit_to_u8 q,unit_to_u8 r)
rgb_to_u8 :: RGB -> RGB_U8
rgb_to_u8 = t3_unit_to_u8
-- > map (ryb_to_u8 . ryb_to_rgb) [(0,0,0),(1,1,1),(1,0,0),(0,1,0),(0,0,1)]
-- > ryb_to_rgb (0,1,1) == (0.0,0.66,0.2) -- green
-- > ryb_to_rgb (0,0.5,1) -- cyan = blue+green = (0,1,2)
ryb_to_rgb :: RYB -> RGB
ryb_to_rgb (r, y, b) =
let f ix =
ryb_clr_ix "white" ix * (1-r) * (1 - b) * (1 - y) +
ryb_clr_ix "red" ix * r * (1 - b) * (1 - y) +
ryb_clr_ix "blue" ix * (1-r) * b * (1 - y) +
ryb_clr_ix "violet" ix * r * b * (1 - y) +
ryb_clr_ix "yellow" ix * (1-r) * (1 - b) * y +
ryb_clr_ix "orange" ix * r * (1 - b) * y +
ryb_clr_ix "green" ix * (1-r) * b * y +
ryb_clr_ix "black" ix * r * b * y
in t3_from_list (map f [0..2])
-- > map (euclidian_distance [0,1,0]) [[1,1,0],[0,1,0],[1,1,1],[0.5,0.5,0.5]] == [1,0,2,0.75]
euclidian_distance :: Floating t => [t] -> [t] -> t
euclidian_distance p1 =
let f x1 x2 = (x2 - x1) ** 2
in sum . zipWith f p1
euclidian_distance_t3 :: Floating t => (t,t,t) -> (t,t,t) -> t
euclidian_distance_t3 (p1,p2,p3) (q1,q2,q3) =
let f x1 x2 = (x2 - x1) ** 2
in f p1 q1 + f p2 q2 + f p3 q3
euclidian_distance_t3_set :: Floating t => [(t,t,t)] -> (t,t,t) -> t
euclidian_distance_t3_set l x = sum (map (euclidian_distance_t3 x) l)
int_to_r :: Int -> R
int_to_r = fromIntegral
-- > map n_triples [8,27,64,125,216,343,512]
n_triples :: Int -> (R,R)
n_triples k =
let fceil = int_to_r . ceiling
b = fceil (int_to_r k ** (1/3))
n = (b ** 3)
in (b,n)
-- > gen_triples 8 == [(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1)]
gen_triples :: Int -> [RYB]
gen_triples k =
let ffloor = int_to_r . floor
(base,base_n) = n_triples k
(%) = F.mod'
f n = (ffloor (n / (base * base)) / (base - 1)
,ffloor ((n / base) % base) / (base - 1)
,ffloor (n % base) / (base - 1))
in map f [0 .. base_n - 1]
-- > most_distant_set [(0,0,0)] (gen_triples 8)
most_distant_set :: (Ord t, Floating t) => [(t,t,t)] -> [(t,t,t)] -> ((t,t,t),[(t,t,t)])
most_distant_set x l =
let d = map (euclidian_distance_t3_set x) l
z = maximum d
in case find ((== z) . fst) (zip d l) of
Just (_,e) -> (e,delete e l)
Nothing -> error "most_distant_set"
distance_step :: (Ord t, Floating t) => [(t,t,t)] -> [(t,t,t)] -> [(t,t,t)]
distance_step lhs rhs =
case rhs of
[] -> []
_ -> let (e,rhs') = most_distant_set lhs rhs
in e : distance_step (e:lhs) rhs'
-- > map (rgb_to_u8 . ryb_to_rgb) (distance_sort (gen_triples 8))
distance_sort :: (Ord t, Floating t) => [(t,t,t)] -> [(t,t,t)]
distance_sort l =
case l of
e:l' -> e : distance_step [e] l'
_ -> error "distance_sort"
-- > ryb_colour_gen 8 == [(0,0,0),(1,1,1),(0,0,1),(1,1,0),(0,1,0),(1,0,1),(0,1,1),(1,0,0)]
ryb_colour_gen :: Int -> [RYB]
ryb_colour_gen = distance_sort . gen_triples
rgb_colour_gen :: Int -> [RGB]
rgb_colour_gen = map ryb_to_rgb . ryb_colour_gen
-- > rgb_u8_colour_gen 27
rgb_u8_colour_gen :: Int -> [RGB_U8]
rgb_u8_colour_gen = map rgb_to_u8 . rgb_colour_gen
colour_gen :: Int -> [SRGB.Colour R]
colour_gen = map (\(r,g,b) -> SRGB.sRGB r g b) . rgb_colour_gen