# map distortions in colour wheel as a function

It appears that Adobe have distorted their colour distribution

screenshot of image from Adobe Color:

evenly distributed colour wheel:

How can I use mathematica to map the colours and plot the correlations?

The values from the LCh colour wheel are given here as {0, 24, 38, 53, 65, 80, 90, 100, 115, 130, 145, 162, 180, 204, 218, \ 233, 260, 270, 280, 295, 310, 325, 342}, and I would like to see how cloely it actually matches that, and use the analysis to create a wheel similar to the one on the Adobe site.

Colour wheel code:

With[{rotate = Pi/3},
Graphics[{Rotate[
Apply[Polygon[{{0, 0}, First[#1], First[#2]},
VertexColors -> Hue /@ {{0, 0, 1}, Last[#1], Last[#2]}] &,
Partition[(Append[#1, First[#1]] &)[
Table[{r*{Cos[phi], Sin[phi]}, phi/(2*Pi)}, {phi, 0, 2*Pi,
0.1}, {r, 0, 1, 0.1}][[All, -1, {1, 2}]]], 2, 1], {1}],
rotate, {0, 0}], EdgeForm[Directive[White]], White,
Thickness[.005],
Rotate[Line /@ ({{0,
0}, #2*{Cos[360*#1*Degree],
Sin[360*#1*Degree]}} & @@ # & /@ #), rotate, {0, 0}],
Disk[#2*{Cos[360*#1*Degree], Sin[360*#1*Degree]},
0.1]}] &) @@ #1 &) /@ #, rotate, {0, 0}]},
ImageSize -> 275]] &@({#/3 + 1/6, 1, 1} & /@ Range@3)

• Perhaps there's something useful in ChromanticityPlot. It takes a ColorSpace option, and one of the values can be AdobeRGB, which I assume is what they are using in their color wheel. Commented Mar 17, 2021 at 12:16

Is't a bit of guesswork here, but taking the pixel values from the Adobe screenshot and cleaning them up a bit with Piecewise

img = Import["https://i.sstatic.net/eUqU3.png"];
pix[image_, px_] := (Evaluate[
InputForm[
ColorConvert[PixelValue[image, px], "HSB"]]][[1, #1]] &) /@
Range[3];
coords = ((CirclePoints[360] + 1.25) 240);
valsA = pix[img, #] & /@ coords;
(*Hue[#[[1]],1,1]&/@valsA*)
Show[ListLinePlot@valsA[[All, 1]],
Plot[Piecewise[{{x/(2160/7) + 2/3, 0 <= x < 60}, {x/180 + 19/36,
55 <= x < 85}, {x/720 - 17/144,
85 <= x < 225}, {x /(8100/31) - 2/3,
225 <= x < 260}, {x /300 - 218/405, 260 <= x < 360}}], {x, 0,
360}, PlotStyle -> Red]]


one can then use the piecewise function to generate a colour wheel that correlates to Adobe's:

func[x_] := 360 Piecewise[{{x/(2160/7) + 2/3, 0 <= x < 60}, {x/180 + 19/36,
55 <= x < 85}, {x/720 - 17/144,
85 <= x < 225}, {x/(8100/31) - 2/3,
225 <= x < 260}, {x/300 - 218/405, 260 <= x < 360}}];
With[{sectors = 360}, angle = 2 Pi/sectors;
Graphics[{Rotate[
{i, Table[func[360 x/(2 Pi)]/360, {x, 1/sectors, 2 Pi,
2 Pi/(sectors)}]}],
Table[Disk[{0, 0}, 1, {i angle, (i + 1) angle}], {i, 0,
sectors - 1}]}, -Pi/2]}]]


though this is simpler still:

fun[x_] := Piecewise[{{x/(4 Pi), 0 <= x < (2 Pi) 14/36}, {x/(4 Pi),
0 <= x < (2 Pi) 14/36}, {10 x/51 + 7/36 - 70 Pi/459,
Pi 28/36 <=
x < (2 Pi) 67/72}, {(29/(5 Pi) - 26/17) x - (53/5 -
52 Pi/17), (2 Pi) 67/72 <= x < 2 Pi}}];
With[{sectors = 360}, angle = 2 Pi/sectors;
Graphics[{Flatten@
Table[fun[x], {x, 1/sectors, 2 Pi, 2 Pi/(sectors)}]}],
Table[Disk[{0, 0}, 1, {i angle, (i + 1) angle}], {i, 0,
sectors - 1}]}}]]


which is actually quite close to a very simple function:

Plot[{fun[x], x/(2 Pi), x^2/(2 Pi)^2}, {x, 0, 2 Pi}]


and using fun[x_]:=x^2/(2 Pi)^2 is almost identical:

Row[{cwf[secondaries, 200, funcAdobe],
cwf[secondaries, 200, funcA1[#, Pi/2] &],
cwf[secondaries, 200, funcA1[#, 2] &]}]


comparison with ChromaticityPlot:

rain = Table[ColorData["Rainbow"][i], {i, 0, 1, 1/1000}];
rainh = cc /@ rain;
Row[{cwf[rainh, 200, funcAdobe, .02, 0], cwf[rainh, 200, funcA1[#, 1] &, .02, 0], ChromaticityPlot[rain, ImageSize->250]}]


cc[colour_] := (Evaluate[InputForm[ColorConvert[colour, "HSB"]]][[
1, #1]] &) /@ Range[3];
cwf[list_, width_, f_, dotwidth_, edgeform_] := Quiet@With[{
pts =  Append[#, First[#]] &@
Table[{r {Cos[phi], Sin[phi]}, f@phi}, {phi, 0,
2 Pi, .1}, {r, 0, 1, .1}]},
Graphics[{
Polygon[{{0, 0}, First[#1], First[#2]},
VertexColors -> (Hue /@ {{0, 0, 1}, Last[#1],
Last[#2]})] & @@@
Partition[pts[[All, -1, {1, 2}]], 2, 1],
EdgeForm[
Directive[If[edgeform == 0, Opacity[0], Opacity[1]],
White]],
Disk[#2 {Cos[Last@(x /. Solve[f[x] == #, x])],
Sin[Last@(x /. Solve[f[x] == #, x])]},
dotwidth]} & @@ # & /@ #}, ImageSize -> width]] &@list;
cwf[list_, width_, f_] := cwf[list, width, f, .1, 1];
cwf[list_, width_] :=  Module[{g}, g[x_] := x/(2 Pi); cwf[list, width, g]];
cwf[list_] := Module[{g}, g[x_] := x/(2 Pi); cwf[list, 300, g]];
func[x_] := (x)/(2 Pi); funcA[x_] := (x)^2/(2 Pi)^2;
funcA1[x_, n_] := (x)^N[n]/(2 Pi)^N[n];
funcAdobe[x_] := Piecewise[{{x/(4 Pi), 0 <= x < (2 Pi) 14/36}, {x/(4 Pi),
0 <= x < (2 Pi) 14/36}, {10 x/51 + 7/36 - 70 Pi/459,
Pi 28/36 <=
x < (2 Pi) 67/72}, {(29/(5 Pi) - 26/17) x - (53/5 -
52 Pi/17), (2 Pi) 67/72 <= x < 2 Pi}}];