aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Task/Closest-pair-problem/Mathematica/closest-pair-problem-1.math Normal file
View file

@ -0,0 +1,4 @@
nearestPair[data_] :=
Block[{pos, dist = N[Outer[EuclideanDistance, data, data, 1]]},
pos = Position[dist, Min[DeleteCases[Flatten[dist], 0.]]];
data[[pos[[1]]]]]

6
Task/Closest-pair-problem/Mathematica/closest-pair-problem-2.math Normal file
View file

@ -0,0 +1,6 @@
nearestPair[{{0.748501, 4.09624}, {3.00302, 5.26164}, {3.61878,
9.52232}, {7.46911, 4.71611}, {5.7819, 2.69367}, {2.34709,
8.74782}, {2.87169, 5.97774}, {6.33101, 0.463131}, {7.46489,
4.6268}, {1.45428, 0.087596}}]
{{7.46911, 4.71611}, {7.46489, 4.6268}}

41
Task/Closest-pair-problem/Mathematica/closest-pair-problem-3.math Normal file
View file

@ -0,0 +1,41 @@
closestPair[ptsIn_] :=
Module[{xP, yP,
pts},(*Top level function.Sorts the pts by x and by y and then \
calls closestPairR[]*)pts = N[ptsIn];
xP = Sort[pts, #1[[1]] < #2[[1]] &];
yP = Sort[pts, #1[[2]] < #2[[2]] &];
closestPairR[xP, yP]]
closestPairR[xP_, yP_] :=
Module[{n, mid, xL, xR, xm, yL, yR, dL, pairL, dmin, pairMin, yS, nS,
closest, closestP, k,
cDist},(*where xP is P(1).. P(n) sorted by x coordinate,
and yP is P(1).. P(n) sorted by y coordinate (ascending order)*)
n = Length[xP];
If[n <= 3,(*Brute Force*)
Piecewise[{{{\[Infinity], {}},
n < 2}, {{EuclideanDistance[xP[[1]], xP[[2]]], {xP[[1]],
xP[[2]]}},
n == 2}, {Last@
MinimalBy[{{EuclideanDistance[xP[[1]], xP[[2]]], {xP[[1]],
xP[[2]]}}, {EuclideanDistance[xP[[1]], xP[[3]]], {xP[[1]],
xP[[3]]}}, {EuclideanDistance[xP[[3]], xP[[2]]], {xP[[3]],
xP[[2]]}}}, First], n == 3}}], mid = Ceiling[n/2];
xL = xP[[1 ;; mid]];
xR = xP[[mid + 1 ;; n]];
xm = xP[[mid]];
yL = Select[yP, #[[1]] <= xm[[1]] &];
yR = Select[yP, #[[1]] > xm[[1]] &];
{dL, pairL} = closestPairR[xL, yL];
{dmin, pairMin} = closestPairR[xR, yR];
If[dL < dmin, {dmin, pairMin} = {dL, pairL}];
yS = Select[yP, Abs[#[[1]] - xm[[1]]] <= dmin &];
nS = Length[yS];
{closest, closestP} = {dmin, pairMin};
Table[k = i + 1;
While[(k <= nS) && (yS[[k, 2]] - yS[[i, 2]] < dmin),
cDist = EuclideanDistance[yS[[k]], yS[[i]]];
If[cDist <
closest, {closest, closestP} = {cDist, {yS[[k]], yS[[i]]}}];
k = k + 1], {i, 1, nS - 1}];
{closest, closestP}](*end if*)]

6
Task/Closest-pair-problem/Mathematica/closest-pair-problem-4.math Normal file
View file

@ -0,0 +1,6 @@
closestPair[{{0.748501, 4.09624}, {3.00302, 5.26164}, {3.61878,
9.52232}, {7.46911, 4.71611}, {5.7819, 2.69367}, {2.34709,
8.74782}, {2.87169, 5.97774}, {6.33101, 0.463131}, {7.46489,
4.6268}, {1.45428, 0.087596}}]
{0.0894096, {{7.46489, 4.6268}, {7.46911, 4.71611}}}