# Knitting images

Posted 11 days ago
765 Views
|
16 Replies
|
79 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! 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] 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!): 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:
16 Replies
Sort By:
Posted 11 days ago
 Very very neat! Thanks for sharing!Can color be added, or is that less-than-trivial?
Posted 11 days ago
 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.
Posted 9 days ago
 In color is also possible, split the image in the RGB channels, convert to lines for each and compose to a color image. I change the algorithm a bit such that the lines have the opacity of the amplitude of the peaks. Results of the black and white and color. Attachments:
Posted 9 days ago
 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
Posted 9 days ago
 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 11 days ago
 very well done (like all your posts:)here is just another portrait in blue generated with your code
Posted 10 days ago
 Hi Oliver, nice picture! You are right: How uninspired using just black lines! Regards -- Henrik
Posted 10 days ago
 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
Posted 10 days ago
 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.
Posted 10 days ago
 Hi Olivier,Thanks for your excellent support. This is very much appreciated !Best Regards, Mit freundlichen Grüßen, ...... Jos
Posted 9 days ago
 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 !
Posted 9 days ago
 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
Posted 9 days ago
 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/FunctionRepositoryWhat'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/XKCDConvertPlease consider this if you get a moment ;-)
Posted 8 days ago
 This has a certain "Take On Me" feel to it :)