5
$\begingroup$

I have a set of points in 2D generated by doing a DimensionReduce on a list of colors:

colors = RandomColor[100];
coords = DimensionReduce[colors, 2, Method -> "TSNE"];
ListPlot[Thread[Style[coords, colors, PointSize -> .05]]]

enter image description here

However, I would like to arrange these points into a regular 2D grid (or other lattice) while maintaining neighbourhoods as much as possible, to make something like this:

enter image description here

(this is just a mockup)

Is there a function to provide this transformation? Or am I better off writing something to shuffle the colors in a grid to minimise neighbor distances? Here's my crude attempt at such a process:

dm = DistanceMatrix[colors, DistanceFunction -> ColorDistance];
g = System`GridGraph[{10, 10}, VertexSize -> .8];
adj = AdjacencyMatrix@g;
vneighbors = 
  GatherBy[Position[adj // Normal, 1], First][[;; , ;; , 2]];
vlabels = Range[100];
Fold[SetProperty[{#1, #2}, 
   VertexStyle -> colors[[vlabels[[#2]]]]] &, g, Range[100]]

enter image description here

Do[
  While[{swapi, swapj} = RandomInteger[{1, 100}, 2]; swapi == swapj];
  cost = Total@
     dm[[vlabels[[swapi]], vlabels[[vneighbors[[swapi]]]]]] + 
    Total@dm[[vlabels[[swapj]], vlabels[[vneighbors[[swapj]]]]]];
  swapcost = 
   Total@dm[[vlabels[[swapj]], vlabels[[vneighbors[[swapi]]]]]] + 
    Total@dm[[vlabels[[swapi]], vlabels[[vneighbors[[swapj]]]]]];
  If[cost > swapcost, temp = vlabels[[swapi]]; 
   vlabels[[swapi]] = vlabels[[swapj]]; vlabels[[swapj]] = temp], 
  10000];
Fold[SetProperty[{#1, #2}, 
   VertexStyle -> colors[[vlabels[[#2]]]]] &, g, Range[100]]

enter image description here

Is something like this the best solution to the problem? There must be something cleverer Mathematica can give me.

$\endgroup$
8
$\begingroup$

enter image description here

It is hard to understand what you mean, but here is a simple take. Round can take an arbitrary step. That makes a grid of an arbitrary step.

colors=RandomColor[100];
coords=DimensionReduce[colors,2,Method->"TSNE"];

gridStep=.5;

ListPlot[
    Thread[Style[Round[coords,gridStep],colors]],
PlotStyle->PointSize[.03],
Frame->True,
FrameTicks->{Range[-10,10,gridStep],Range[-10,10,gridStep]},
GridLines->{Range[-10,10,gridStep],Range[-10,10,gridStep]},
GridLinesStyle->Directive[Gray, Dashed]]
$\endgroup$
  • $\begingroup$ You're right the question was super unclear. I've made a mockup to try and illustrate what I'm after. I want to transform the data such that it's uniformly distributed across a grid or lattice. $\endgroup$ – Crêpo Sep 20 '19 at 0:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.