# Tag Info

24

The following is something I made while trying to solve another (similar) problem (* FindCurvedPath Replacement*) ClearAll[findCurvedPath2, findClosedPath2]; findClosedPath2[inptList_] := Append[#, #[[1]]] &@findCurvedPath2[inptList] findCurvedPath2[inptList_] := Block[{\$RecursionLimit = Round[2.1 Length@inptList], ...

12

Since your image is binary, you can just pick out the top-most point in each column of the data matrix: img = Import["http://i.stack.imgur.com/Z7rKJ.jpg"]; dat = Transpose[ImageData@EdgeDetect[img]]; {c, r} = Dimensions[dat]; points = r - Min[Flatten@Position[dat[[#]], 1]] & /@ Range[c]; np = Interpolation[points, InterpolationOrder -> 1]; ...

11

I was stuck for a while with a not really acceptable result, but then @belisarius posted his answer and I was able to refine my code with the usage of his findCurvedPath2 function. So I am able to post my solution to the problem. First, import and process the image: img = Binarize@Import["http://i.stack.imgur.com/Z7rKJ.jpg", "JPEG"]; imgc = ...

9

The key idea to make this simpler is to apply a polar transform: img = Import["http://i.stack.imgur.com/Y6oab.gif"]; center = 0.5 ImageDimensions[img]; maxR = 200; polarToCart = center + {Cos[#[[1]]], Sin[#[[1]]]}*#[[2]] &; polar = ImageTransformation[Binarize[img], polarToCart, {360, maxR}, PlotRange -> {{0, 2 \[Pi]}, {0, maxR}}, DataRange ...

5

This is not an area I am familiar with but for fun here is approximation of the average thickness of annular region. This uses a lot version 10 functionality. Importing the image: img = Import["http://i.stack.imgur.com/7BQEI.jpg"] Using coordinate tools to calibrate image (cal is collected end points of ruler): cal = {{1000., 9.333333333333314}, ...

5

First of all, I think your mask calculation is wrong: That's because Mathematica array indices are row, column, 1-based, and data[[1,1]] is at the top-left corner of the image, while coordinates are x,y, 0-based and {0,0} is at the bottom-left corner. So the right way to build these masks would be: masks = Table[ Boole[InPolyQ[#, {j - 1, imgD - i}]], ...

3

data = RandomInteger[1, {300, 300}]; Image[data] or Graphics[Raster[data]] You can also try: ArrayPlot[data] RandomImage[BernoulliDistribution[1/2], {300, 300}] etc.

3

You can use Colorize for this Colorize[RandomImage[1, {10, 10}], ColorFunction -> (Piecewise[ {{ColorData["AlpineColors"][#], 0 < # < .5}, {ColorData["SouthwestColors"][#], .5 < # < 1}}] &)]

3

Edit: At the end of this post, you will find an implementation with Nearest which is as fast as Nikies solution. The unfortunate thing is, that my first idea was to use Nearest but I somehow did not time it correctly. Since I wanted to answer to this comment and show that my implementation is faster, I timed it again - this time correctly - and I have to ...

2

Those listed below might more like a suggestion than an answer with a lot of handwork. First import the img downloaded from your link. img1 = Import@"D:\\...\\lteiaq94pImage2.png"; img2 = Import@"D:\\...\\peadtydo9Image1.png"; Binarize them with carefully chosed parameters: img1bin = Erosion[Binarize[img1, 0.2], 0.4]; img2bin = Erosion[Binarize[img2, ...

2

Here is something 1000 x faster. Usage pic = RandomImage[1, {100, 100}] Colorize[pic, ColorFunction -> colorF] // Timing Colorize[pic, ColorFunction -> (If[# < .5, Blend["AlpineColors", 2 #], Blend["SouthwestColors", 2 # - 1]] &)] // Timing True It is quite general, you can use arbitrary set of schemes: pic = ...

2

After you draw one or more selection rectangles and click away from the image they are still there suspended in a xenon mist but they are only visible if you look dead ahead use the selection tool. We can extract that data from the underlying Cell expression with this Button: Button["Copy ImageMarkers", Cases[ NotebookRead[SelectedNotebook[]], ...

1

One approach: ImageApply[ List @@ Piecewise[{ {ColorData["AlpineColors"][2 #], 0 < # < .5}, {ColorData["SouthwestColors"][2 # - 1 ], .5 < # < 1} }] &, Image[RandomReal[1, {10, 10}]]] or Image[Map[ List @@ Piecewise[{ {ColorData["AlpineColors"][2 #], 0 < # < .5}, ...

1

ListDensityPlot[Table[RandomInteger[{0, 1}], {100}, {100}], InterpolationOrder -> 0, ColorFunction -> GrayLevel]

1

You can use Rasterize[plot,"Image"] on each frame as paw suggested. img = Image3D[RandomReal[1, {5, 10, 10}]] imageList = Most@ParallelTable[ Rasterize[ Image3D[img, ViewPoint -> {2.5 Cos[θ], 2.5 Sin[θ], 2}, ViewAngle -> 30 Degree], "Image"], {θ, 0, 2 Pi, 0.01 Pi}]; ListAnimate[imageList] Export["animation.avi", imageList]; ...

1

There's a really nice paper on this subject by Bennink et al. (2007) titled "Warping a Neuro-Anatomy Atlas on 3D MRI Data with Radial Basis Functions". The Appendix to the paper includes a Mathematica code. See: https://www.google.com/?gws_rd=ssl#q=warping+a+neuroanatomy+atlas

1

ArrayPlot is not designed for 1:1 mapping of array values to pixels, in fact in typical usage (small array) ArrayPlot generates a raster that is much larger than the input array dimensions. You may get what you want using the PixelConstrained option: ArrayPlot[ data , PixelConstrained -> 1, Frame -> False] ImageDimensions@% == ...

Only top voted, non community-wiki answers of a minimum length are eligible