Я сделал небольшую программу для проверки работоспособности задействованных функций и обнаружил, что вы должны быть очень осторожны с процессом минимизации.
Ниже вы можете увидеть два набора графиков, показывающих распределение точек, функцию минимизации в евклидовом случае и функцию, соответствующую «торической метрике».
Как вы можете видеть, евклидово расстояние очень хорошо себя ведет, в то время как торик представляет несколько локальных минимумов, которые затрудняют поиск глобальных минимумов. Кроме того, глобальный минимум в торическом случае не является уникальным.
На всякий случай программа на Mathematica выглядит так:
Clear["Global`*"];
(*Define non wrapping distance for dimension n*)
nwd[p1_, p2_, n_] := (p1[[n]] - p2[[n]])^2;
(*Define wrapping distance for dimension n *)
wd[p1_, p2_, max_,n_] := (max[[n]] - Max[p1[[n]], p2[[n]]] + Min[p1[[n]], p2[[n]]])^2;
(*Define minimal distance*)
dist[p1_, p2_, max_] :=
Min[nwd[p1, p2, 1], wd[p1, p2, max, 1]] +
Min[nwd[p1, p2, 2], wd[p1, p2, max, 2]];
(*Define Euclidean distance*)
euclDist[p1_, p2_, max_] := nwd[p1, p2, 1] + nwd[p1, p2, 2];
(*Set torus dimensions *)
MaxX = 20;
MaxY = 15;
(*Examples of Points sets *)
lCircle =
Table[{10 Cos[fi] + 10, 5 Sin[fi] + 10}, {fi, 0, 2 Pi - .0001, Pi/20}];
lRect = Join[
Table[{3, y}, {y, MaxY - 1}],
Table[{MaxX - 1, y}, {y, MaxY - 1}],
Table[{x, MaxY/2}, {x, MaxY - 1}],
Table[{x, MaxY - 1}, {x, MaxX - 1}],
Table[{x, 1}, {x, MaxX - 1}]];
(*Find Euclidean Center of mass *)
feucl = FindMinimum[{Total[
euclDist[#, {a, b}, {MaxX, MaxY}] & /@ lRect], 0 <= a <= MaxX,
0 <= b <= MaxY}, {{a, 10}, {b, 10}}]
(*Find Toric Center of mass *)
ftoric = FindMinimum[{Total[dist[#, {a, b}, {MaxX, MaxY}] & /@ lRect],
0 <= a <= MaxX, 0 <= b <= MaxY}, {{a, 10}, {b, 10}}]