How to find a line which has the minimum total distance to separate two cluster points

Question

Suppose I have two cluster points

SeedRandom[2]
pts = RandomReal[1, {50, 2}];
cluster = FindClusters[pts, 2, RandomSeeding -> 1];
ListPlot[cluster]

I want to find a line to separate this two cluster point sets,and this line has the minimum total distance with all points. I think Mathematica maybe have some in-built methods can implement it.This is my current try

trainning = Flatten[MapIndexed[Thread[#1 -> First[#2]] &, cluster]];
c = Classify[trainning, Method -> "SupportVectorMachine"];
ClassifierInformation[c, "Function"]

Missing[PropertyNotAvailable,Function]

But I cannot get an available result.So I have to implement it manually.

sol = ArgMin[{Total[Abs[a # - #2 + b]/Sqrt[a^2 + 1] & @@@ pts], 
   a # + b < #2 & @@@ Last[cluster], 
   a # + b > #2 & @@@ First[cluster]}, {a, b}];
Show[ContourPlot[
  Evaluate[# x + #2 == y & @@ sol], {x, 0, 1}, {y, 0, 1}], 
 ListPlot[cluster]]

I will get the result and some error information simultaneously.I cannot sure the result is what I want exactly.I mean I don't know the total distance is smallest or not.Is there better solution can do this?

Answer 1

As indicated by your comment you are not strictly looking for the line that has the minimum total distance with all points. If you just like to find a line that separates your data well you could use a SVM. Since I haven't played to much with Classify to be able and tell how easy it is to get the parameters out, I though of another similar approach. I will show how to solve this with the simplest neural net possible: a single perceptron.

The perceptron is simply:

p = NetChain[{1, LogisticSigmoid}, "Input" -> 2, "Output" -> NetDecoder["Scalar"]]

To generate the training data we assign the the label 0 to the first and the label 1 to the second cluster.

trainingData = cluster // MapIndexed[Thread[Rule[#1, First@#2 - 1]] &] // Flatten

Now we can train our perceptron with

trained = NetTrain[perceptron, trainingData ]

and extract the weights and bias term with

{{{w1, w2}}, {bias}} = NetExtract[trained, {{ 1, "Weights"}, {1, "Biases"}}]

The line defined by $w_1 \cdot x + w_2 \cdot y + bias$ can be plotted together with the original points via

Show[ListPlot[cluster], Plot[y /. Solve[w1 x + w2 y + bias == 0, y], {x, 0, 1}]]

Answer 2

here is an implementation as a standard constrained optimization

d[a_?NumericQ, b_?NumericQ] := 
 Total[RegionDistance[Line[{{0, a}, {1, b}}]] /@ pts]
result = FindMinimum[{d[a, b],
   And @@ (Interpolation[{{ 0, a}, {1, b}}, 
           InterpolationOrder -> 1][#[[1]]] >= #[[2]] & /@ 
       cluster[[1]]) &&
    And @@ (Interpolation[{{ 0, a}, {1, b}}, 
           InterpolationOrder -> 1][#[[1]]] <= #[[2]] & /@ 
       cluster[[2]]) && 0 < a < 1 && 0 < b < 1}, {{a, .5}, {b, .5}}, 
  MaxIterations -> 2000]

{11.6243, {a -> 0.509647, b -> 0.390072}}

 Show[{ListPlot[cluster], 
    Graphics[Line[{{ 0, a}, {1, b}} /. result[[2]]]]}]

this does throw convergence warnings, so i guess we are left wondering if it is actually a global minimum.