Message Boards Message Boards

GROUPS:
4296 Views
|
17 Replies
|
88 Total Likes
|

Dear all, inspired by another great post of @Anton Antonov and in particular there by a remark of @Vitaliy Kaurov pointing to the art of knitting images I could not resist trying with Mathematica. Clearly - this problem is crying out loudly for Radon transform!

enter image description here

I start by choosing some example image, convert it to inverse grayscale and perform the Radon transform.

ClearAll["Global`*"]
img0 = RemoveBackground[
   ImageTrim[
    ExampleData[{"TestImage", "Girl3"}], {{80, 30}, {250, 240}}], {"Background", {"Uniform", .29}}];
img1 = ImageAdjust[ColorNegate@ColorConvert[RemoveAlphaChannel[img0], "Grayscale"]];
{xDim, yDim} = {180, 400}; (* i.e. angles between 1\[Degree] and 180\[Degree] *)

rd0 = Radon[img1, {xDim, yDim}];
ImageCollage[{img0, ImageAdjust@rd0}, Method -> "Rows", 
 Background -> None, ImagePadding -> 10]

enter image description here

Every column of the Radon image represents a different angle of projection. So next I separate these columns into (here 180) single Radon images and do an inverse Radon transform on each:

maskLine[a_] := Table[If[a == n, 1, 0], {n, 1, xDim}];
maskImg = Table[Image[ConstantArray[maskLine[c], yDim]], {c, 1, xDim}];
rdImgs = rd0 maskImg;
ProgressIndicator[Dynamic[n], {1, xDim}]
invRadImgs = 
  Table[{ImageApply[If[# > 0, #, 0] &, 
     InverseRadon[rdImgs[[n]]]], -(n - 91) \[Degree]}, {n, 1, xDim}];

These data already represent the angle dependent intensities for backpropagation. Now one just has somehow to translate these intensities into discretely spaced lines (because this is the actual task in analogy to the above mentioned knitting ). Here is my simple attempt, which e.g. for 69° gives the following result (I am not really happy with this - there is definitely room for improvement!):

enter image description here

valsAngle[invRads_] := Module[{img, angle, data, l2},
   angle = Last@invRads;
   data = Max /@ (Transpose@*ImageData@*ImageRotate @@ invRads);
   l2 = Round[Length[data]/2];
   data = MapIndexed[{First[#2] - l2, #1} &, data];
   {Select[
     Times @@@ ({#1, 
          If[#2 > .0003, 1, 0]} & @@@ ((Mean /@ # &)@*Transpose /@ 
          Partition[data, 5])), # != 0 &], angle}  (* 
   limiting value of 0.0003 is just empirical! *)
   ];

va = valsAngle /@ invRadImgs;
graphicsData[va_] := Module[{u, angle},
   {u, angle} = va;
   InfiniteLine[# {Cos[angle], -Sin[angle]}, {Sin[angle], 
       Cos[angle]}] & /@ u];

gd = graphicsData /@ va;
Graphics[{Thickness[.0003], gd}, ImageSize -> 600, 
 PlotRange -> {{-170, 170}, {-220, 220}}]

... and the result is a bunch of lines:

enter image description here

17 Replies

Very very neat! Thanks for sharing!

Can color be added, or is that less-than-trivial?

Hi Sander, thanks for your kind words! Color! - well, my background is radiology, and there the world is black and white. But it is a really neat idea! My first guess is to apply the above procedure to each color channel.

In color is also possible, split the image in the RGB channels, convert to lines for each and compose to a color image. enter image description here
enter image description here

I change the algorithm a bit such that the lines have the opacity of the amplitude of the peaks. enter image description here

Results of the black and white and color. enter image description here

Attachments:

Martijn, this is great. I tried that (working on each color channel separately) yesterday night, but this alone does not work, because the lines superimpose each other.

I change the algorithm a bit such that the lines have the opacity of the amplitude of the peaks.

This actually does the trick - terrific idea, thanks for sharing!

Best regards -- Henrik

Thanks I liked the demo very much that I just had to try it in color, very related to CT back projection algorithms, but then enhancing streaking artifacts rather than reducing them.

Posted 3 months ago

very well done (like all your posts:)

here is just another portrait in blue generated with your code

enter image description here

Hi Oliver, nice picture! You are right: How uninspired using just black lines! Regards -- Henrik

Hi Olivier,

Very very nice! Thanks for sharing!

I would like to make an animation with Export []of this, but without success. How did you make this, Can you help me?

Thanks in advance !

Best Regards, Gruß, ...... Jos

Hi Jos, here is my part of the animation code:

index = Round@Subdivide[1, Length[gd], 20];

gifImgs = 
  Table[Graphics[{Thickness[.0003], gd[[;; n]], Thickness[.001], Red, 
     gd[[n]]}, ImageSize -> 600, Frame -> False, 
    PlotRange -> {{-170, 170}, {-220, 220}}], {n, index}];

AppendTo[gifImgs, 
  Graphics[{Thickness[.0003], gd}, ImageSize -> 600, Frame -> False, 
   PlotRange -> {{-170, 170}, {-220, 220}}]];

SetDirectory[NotebookDirectory[]]

Export["ImageOfLines0.gif", gifImgs, "DisplayDurations" -> 0.5]

Admittedly I did the fine tuning (i.e. the adjustment of the display duration at the beginning and at the end) with gimp.

Hi Olivier,

Thanks for your excellent support. This is very much appreciated !

Best Regards, Mit freundlichen Grüßen, ...... Jos

Henrik, this is spectacular! Thank you for following up on those links I posted, this is an amazing solution! So I think projecting the line equations onto a circle will get as the locations for pins if we are to recreate this in a physical model. Wonderful !

Thank you, Vitaliy! It always pays to follow your suggestions. And it is very interesting for me to see how others continue and push this idea much further.

Best regards -- Henrik

The pleasure is all mine, to see how folks have a great time here figuring things out :-) I think this particular idea would make an excellent Wolfram Function Repository item:

https://resources.wolframcloud.com/FunctionRepository

What's great about it - immediate access from inside of Wolfram Language and also proper authorship attribution. I like that people can publish algorithms and refer to them as to journal articles. This is a relevant example by Simon Woods:

https://resources.wolframcloud.com/FunctionRepository/resources/XKCDConvert

Please consider this if you get a moment ;-)

This has a certain "Take On Me" feel to it :)

enter image description here

Fantastic - I am amazed anew!

enter image description here

One more! :)

Posted 7 days ago

Can you use this code in the online version of wolfram?

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract