8

There are many kinds of distances. One of them is Biharmonic Distance where I got the the image below from:

There are the numerous examples of biharmonic distance.

The biharmonic examples are on the left, and the author kept his promise in the paper that this distance keeps a fantastic balance between local properties of the underlying space as well global properties. I am slowly working my way through the paper and terms to be able to write a Mathematica program that can calculate biharmonic distance, but I am not a professional Mathematician/Mechanical Engineer. So a lot of the terms I don't understand without great difficulty in the paper, and I thought that this would be nice to share because it would be great if Mathematica had a function like BiharmonicPointDistance[spatialDataPoints,pointSource] which would give the results in the images above. But there also might be shortcuts built into the Wolfram Language that would make recomputing this easier.

Examples of the family of curves that I am interested in are shown below:

This is a circular sheet with dents in it.

This is a different circular sheet with dents in it.

which were all created with the code:

populateEllipse[center_, a_, b_, r_, pointQuantity_, maxAttempts_] :=
Module[
  {initialEllipse, ellipse, reg, pts = {}, n = 1, ellipseGraphics, parametricForms = {}, \[Theta], axes},
  ellipse = Disk[center, {a, b}];
  reg = RegionErosion[ellipse, r];

initialEllipse = {center[[1]] + a Cos[t], center[[2]] + b Sin[t]};

While[Length[pts] < pointQuantity && n <= maxAttempts, pts = RandomPointConfiguration[HardcorePointProcess[pointQuantity, 2 r, 2], reg]; n++; If[Length[pts["Points"]] > 0, Break[]]; (* Adjusted to exit loop if pts found *) ];

pts = If[Length[pts["Points"]] > pointQuantity, Take[pts["Points"], pointQuantity], pts["Points"]];

(* Generate ellipses and store parametric forms *) ellipseGraphics = Graphics[{ Style[ellipse, FaceForm[None], EdgeForm[Black]], (axes = r RandomReal[{r, 2r}, 2]; [Theta] = RandomReal[{0, 2 [Pi]}]; AppendTo[parametricForms, {#[[1]] + axes[[1]] Cos[t] Cos[[Theta]] - axes[[2]] Sin[t] Sin[[Theta]], #[[2]] + axes[[1]] Cos[t] Sin[[Theta]] + axes[[2]] Sin[t] Cos[[Theta]]}]; GeometricTransformation[Disk[#, axes], RotationTransform[[Theta], #]] ) & /@ pts }];

(* Return both initial ellipse and parametric forms for further use *) {initialEllipse, parametricForms} ]

divyEllipsePerimeter[pointQuantity_,parametricForm_]:= Module[{points,plot}, points=Cases[ Normal@ (plot = ParametricPlot[ parametricForm, {t, 0, 2 Pi}, Mesh -> pointQuantity, MeshFunctions -> {"ArcLength"} ]), Point[l_] -> l, Infinity] ];

(* Define a function to append a unique negative z-value to each tuple within a sublist *) modifySublist[sublist_] := Module[{z = -RandomReal[]}, Table[Append[sublist[[i]], z], {i, 1, Length[sublist]}] ];

ellipseQuantity=6; samplePoints=300; diskHeight=RandomReal[{.5,2}]; stored=populateEllipse[{0,0},8,5,.55,ellipseQuantity,50]; upperTopLayer=Table[Append[divyEllipsePerimeter[samplePoints,stored[[1]]][[i]], 0], {i, 1, samplePoints}]; lowerTopLayer=Map[modifySublist,Partition[divyEllipsePerimeter[samplePoints,stored[[2]]],samplePoints]]; topLayercentroids=Map[Mean,lowerTopLayer]; topLayer=Partition[Flatten[Join[upperTopLayer,lowerTopLayer,topLayercentroids]],3]; bottomLayer= Map[{#[[1]], #[[2]], #[[3]] -diskHeight} &, topLayer]; surfacePoints=Join[topLayer,bottomLayer];

ListPlot3D[topLayer,Axes->False,Boxed->False,ColorFunction -> "GrayTones"]

which was motivated by Tad's answer from a previous post.

Henrik Schumacher
  • 106,770
  • 7
  • 179
  • 309
Teg Louis
  • 176
  • 3
  • 20
  • 1
    Not the harmonic distance, but related (an probably a solution to you problem): https://mathematica.stackexchange.com/a/175570/38178 – Henrik Schumacher Mar 13 '24 at 00:59
  • @HenrikSchumacher I know all 3 distances use the Laplace Beltrami Operator. And I know the paths are unique for biharmonic unlike geodesic. So I am trying to understand that. I will look at your link. Thanks. – Teg Louis Mar 13 '24 at 01:30
  • 1
    Why we need to use Ellipse in Biharmonic Distance ? – cvgmt Mar 13 '24 at 04:15
  • @cvgmt It is not needed to calculate Biharmonic Distance. It is just that the surfaces that I am studying for fun are caused by half-ball bearings on thin, circular plates. And I am trying to find properties on general surfaces that would include weights with elliptical bases. – Teg Louis Mar 13 '24 at 04:42
  • Unlike the original paper mentioned in the OP, I found a super cool paper: Mesh-free Discrete Laplace–Beltrami Operator. If this applies, it would mean that we could obtain a good result without using a mesh. I am going to try and amalgamate the algorithms. – Teg Louis Mar 22 '24 at 00:20
  • @cvgmt The entire reason why I ask this questions about ellipses, circles, balls, or half-ball bearings in my questions is that I am curious if there is a relationship between the Shortest Tour and some contour when I have this situation this. – Teg Louis Mar 22 '24 at 23:40
  • 1
    In your BiharmonicPointDistance[spatialDataPoints, pointSource] what are spatialDataPoints and what are pointSource? – azerbajdzan Mar 23 '24 at 11:15
  • 1
    There is a MATLAB code not too long. Have you tried to rewrite it in Mathematica? https://gfx.cs.princeton.edu/pubs/Lipman_2010_BD/index.php – azerbajdzan Mar 23 '24 at 13:04
  • @azerbajdzan Thank you. It is not too long. I will study it and try. But I still feel there are parts that I don't understand. I will be meeting with an Engineering professor at a local university to help me. – Teg Louis Mar 24 '24 at 01:07
  • @azerbajdzan pointSource would be the chosen point in space that all the other points are compared to. spatialDataPoints are the discrete points that are assumed to be part of a surface, like the 3D points that make up the chair or bird in the photo. – Teg Louis Mar 24 '24 at 01:10

0 Answers0