# VertexColors seems to blend colours unevenly

VertexColors seems to blend colours unevenly, often with a "stripe" between vertices. Compare:

mix4[n_, col_] :=
ArrayPlot[Table[Blend[{#, #2}, t], {t, 0, 1, 1/n}] & @@@
Thread[Table[Blend[{#, #2}, t], {t, 0, 1, 1/n}] & @@@
{#, Reverse@#2} & @@ Partition[col,2]], Frame -> False];

(*
cols = RandomColor[4];
Grid[{{
Graphics[ Polygon[CirclePoints[4], VertexColors -> Part[cols, {3, 4, 1, 2}]]], mix4[100, cols]
}}]
*)


I would like to create polygons without the "stripe" that is characteristic of VertexColors. Is there any way of doing that?

• This happens because the system uses linear interpolation over triangles. One (tedious) way to avoid it is to use a higher resolution than just the 4 corner points, and specify the colour at each point. One way is ArrayPlot, as you show here. Another way is to use DensityPlot, or to use DiscretizeRegion on your polygon and specify the colour at each internal vertex. Commented Sep 21, 2021 at 16:58
• Commented Sep 22, 2021 at 11:34

Modifying @kglr 's code here, I have made a slight improvement, thanks to @Szabolcs ' comment:

n=5; cols={Red,Green,Blue,Yellow,Magenta};
mreg=DiscretizeRegion[Region[ Polygon[CirclePoints[n]]], MaxCellMeasure -> .5];
mc = MeshCoordinates[mreg];polys= MeshCells[mreg,2];

Grid[{{
Graphics[ Polygon[CirclePoints[n], VertexColors ->Join[cols,{Blend[cols]}]]],
Graphics[{EdgeForm[],  GraphicsComplex[mc, polys, VertexColors ->Join[cols,{Blend[cols]}]]}]
}}]


The rather long running time for

n=5;c=30; cols={Red,Green,Blue,Yellow,Magenta};pts=CirclePoints[n];
array=Select[Flatten[Table[{a,b},{a,-1,1,1/c},{b,-1,1,1/c}],1],
RegionMember[Polygon[N@CirclePoints[n]],N@#]&];
allpts=Flatten[Table[{Blend[cols,1/If[#==0,.001,#]&@
EuclideanDistance[t,#]&/@pts],Point@t},{t,array}],1];
Graphics[{PointSize[1./c],allpts,
EdgeForm[{White,Thickness[.1]}],Opacity[0],
Polygon[1.1N@CirclePoints[n]]}]


gives closer to desired result though.

Just for fun:

hex[cols_,n1_]:=Module[{n,c,k,pts,array},
n=6;c=3.5;k=(n1-1)c;pts=CirclePoints[n];
array={(#-k)/k,(#2+2)/k}&@@@#&/@DeleteDuplicates[Flatten[Table[CirclePoints[
{Sqrt[3] (1 j + k - 2 ) + Sqrt[3] (1 j + l - 2 ),3 k - 2 - 3 l},
{2, Pi/2}, 6], {j, #}, {k, #}, {l, #}],2],Sort@#==Sort@#2&]&@n1;
Graphics[{Flatten[Table[{Blend[cols,1/If[#==0,.001,#]&@
EuclideanDistance[Mean@t,#]^2&/@pts],Polygon@t},{t,array}],1]}]];

(*hex[{Red,Green,Blue,Yellow,Magenta,Orange},5]*)