Group Abstract

Message Boards

WOLFRAM COMMUNITY

9K Views

12 Replies

19 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Biological Sciences Image Processing Mathematics Medical Sciences Calculus Geometry Graphics and Visualization Wolfram Language

Record evenly spaced out points around the perimeter of an image?

Serita Savolainen

Serita Savolainen, Student at Bournemouth University

Posted 9 years ago

I am very new to this software so I unfortunately do not have any examples I could show to represent what I am trying to do. Basically, I am adopting a geometric morphometric approach to determine the sex of a juvenile from the ilium (hip bone). The bones have been photographed in 2 different views, one of the flat surface of the bone and one of the crest of the bone. For the method I am following, I would need to be able to record evenly spaced out points around different parts of the bone, most importantly around the perimeters. It is important that they are evenly spaced, and this is what I am struggling with since I am not too familiar with the software. The numbers of points are mainly 50 or 100 depending on location. Is this possible to do with Mathematica? I know I can do the eigenshape analysis on the software which is what I will use to create discriminant functions. I have included an image as an example, and for that specific image the points would need to go all around the edge of the bone. Also, I would need to be able to record the angle of the greater sciatic notch (the large notch at the top left of the bone), is there a way of doing this on the software as well? For that the original method placed 3 points down at specific locations, but of course it does not have to be done that way if there are other valid ways. Thank you very much in advance to anyone who may be able to help or give some advice on this matter!

POSTED BY: Serita Savolainen

12 Replies

Sort By:

Serita Savolainen

Serita Savolainen, Student at Bournemouth University

Posted 9 years ago

I have finally found a way to calculate functions for the curvatures of the iliac crests. The best fit functions have come up as 5th polynomials. The next thing I need to now do is get some information on the errors of the fit of the function to the points. I saw that you can do this by using `"ParameterTable"` but it does not want to work for me (not sure if that is just because I do not know how to adapt it to my specific graph since the examples are of `NonLinearModelFit`.. So here is what I have so far: poly5fit = Fit[pts, {1, x, x^2, x^3, x^4, x^5}, x] 560.117 - 1.64354 x + 0.00382779 x^2 - 3.9384910^-6 x^3 + 1.9847710^-9 x^4 - 3.87972*10^-13 x^5 Show[ListPlot[pts], Plot[poly5fit, {x, 0, 2000}]] I do not know how to go further to get any information out of this graph however and would greatly appreciate the help! I would like to know if I can somehow make `"ParameterTable"` work in this case, or anything to that effect. How can I go about this? The results that I can get would be something I can use to compare to other results of the same type just for different curves. Furthermore, what is the best and simplest way of comparing 36 functions like this to each other in order to produce a discriminant function that determines the sex of the specimen in question? Thank you very much!

POSTED BY: Serita Savolainen

Frank Kampas

Frank Kampas, Physicist at Large Consulting

Posted 9 years ago

The current entry from the Oxford Dictionary says: The plural of forum is usually spelled forums; the plural fora (as in the original Latin) is chiefly used when talking about a public square in an ancient Roman city.

POSTED BY: Frank Kampas

Daniel Lichtblau

Daniel Lichtblau, Wolfram Research

Posted 9 years ago

Here are some links to past fora discussions that describe ways to approximate derivatives given discrete numerical data. 1 2 3 Curvature approximations could be done as modest variants of these methods.

POSTED BY: Daniel Lichtblau

Serita Savolainen

Serita Savolainen, Student at Bournemouth University

Posted 9 years ago

Thank you very much, I will have a look at those!

POSTED BY: Serita Savolainen

Serita Savolainen

Serita Savolainen, Student at Bournemouth University

Posted 9 years ago

I have a few follow-up questions relating to this topic. I now need to be able to measure curvatures of different parts of the bone. Is this possible to do following the point recording? For example, I would need to measure the curvature of the iliac crest. How should I go about doing this, if it is possible to do on Mathematica? I have attached another image, in which I need to measure the curvatures of the top and bottom of the iliac crest. Also, is there a way of measuring angles? I need to measure the angle of the greater sciatic notch. Thank you very much!

POSTED BY: Serita Savolainen

Sander Huisman

Sander Huisman, University of Twente

Posted 9 years ago

I would start by detecting the edge: img=Import[.......]; img=ImagePad[img,{{-250,0},{0,0}}]; img=ColorNegate[Binarize[img,0.5]]; img=FillingTransform[img]; img=DeleteSmallComponents[img,1000]; img=MorphologicalPerimeter[img,CornerNeighbors->False]; pos=N@PixelValuePositions[img,1]; {len,ord}=FindShortestTour[pos]; pos=pos[[ord]]; {xdata,ydata}=Transpose[pos]; (* add any smoothing function here (like moving average of lowpass filter) *) len=Length[xdata]; xpos=Interpolation[xdata,InterpolationOrder->3]; ypos=Interpolation[ydata,InterpolationOrder->3]; ParametricPlot[{xpos[t],ypos[t]},{t,1,len}]/. Line -> Arrow resulting in: Now we can calculate the distance between each two points: lens={#+1,ArcLength[{xpos[t],ypos[t]},{t,#,#+1}]}&/@Range[0,len-1]; lens=Prepend[lens,{0,0.}]; lens[[All,2]]=Accumulate[lens[[All,2]]]; ListPlot[lens] Resulting in: Now inverting the function and evaluating some 'times': inverselens = Reverse /@ lens; inverselens = Interpolation[inverselens]; times = inverselens /@ Subdivide[1, Max[lens[[All, 2]]], 100]; Graphics[Point[Table[{xpos[t], ypos[t]}, {t, times}]]]

I would start by detecting the edge:

img=Import[.......];
img=ImagePad[img,{{-250,0},{0,0}}];
img=ColorNegate[Binarize[img,0.5]];
img=FillingTransform[img];
img=DeleteSmallComponents[img,1000];
img=MorphologicalPerimeter[img,CornerNeighbors->False];
pos=N@PixelValuePositions[img,1];
{len,ord}=FindShortestTour[pos];
pos=pos[[ord]];


{xdata,ydata}=Transpose[pos];

(* add any smoothing function here (like moving average of lowpass filter) *)
len=Length[xdata];
xpos=Interpolation[xdata,InterpolationOrder->3];
ypos=Interpolation[ydata,InterpolationOrder->3];
ParametricPlot[{xpos[t],ypos[t]},{t,1,len}]/. Line -> Arrow

resulting in:

enter image description here

Now we can calculate the distance between each two points:

lens={#+1,ArcLength[{xpos[t],ypos[t]},{t,#,#+1}]}&/@Range[0,len-1];
lens=Prepend[lens,{0,0.}];
lens[[All,2]]=Accumulate[lens[[All,2]]];
ListPlot[lens]

Resulting in:

enter image description here

Now inverting the function and evaluating some 'times':

inverselens = Reverse /@ lens;
inverselens = Interpolation[inverselens];
times = inverselens /@ Subdivide[1, Max[lens[[All, 2]]], 100];
Graphics[Point[Table[{xpos[t], ypos[t]}, {t, times}]]]

enter image description here