Tag Info

New answers tagged

0

ListCurvePathPlot[ ] might work where the directions and distances are within its limits: i = Thinning[Binarize@Import@"http://i.stack.imgur.com/CKwCQ.png"] pts = Position[ImageData[i], 1, {2}]; Framed@ListCurvePathPlot[pts, Axes -> False]


1

It appears that among other optimizations ImageApply uses a kind of memoization but that it is inactive in the second example. With a small change to the definition we can see how many times the function is actually applied: qX[x_] := (Sow @ x; Piecewise[{{0., x <= 1/3.}, {.5, x <= 2/3.}, {1., x <= 1.}}, 0]) SetAttributes[qX, Listable] The ...


2

The function q3[#] & is not Listable and because the Interleaving option value is True by default, there is not much optimization that can be figured out automatically. Setting the Listable attribute whenever possible will help. Working with "Bit", "Byte", or "Bit16" data types will be faster, too. In this very case, ImageApply[q3, img] and ...


18

This is a 2D Gaussian random field with a $1/k^2$ spectrum and linear dispersion $\omega \propto k$. I clip the field to positive values and square root it to give an edge to the "clouds". n = 256; k2 = Outer[Plus, #, #] &[RotateRight[N@Range[-n, n - 1, 2]/n, n/2]^2]; spectrum = With[{d := RandomReal[NormalDistribution[], {n, n}]}, (1/n) (d + I ...


7

It seems, that a pure function calling a Listable one breaks internal optimization in Mathematica's ImageApply. Compare: t = Abs[Sqrt[#]] &; (* pure function *) q[x_] := Abs[Sqrt[x]]; (* "standard" function, implicitly listable *) SetAttributes[h, Listable]; h[x_] := Abs[Sqrt[x]]; (* explicitly listable function *) First /@ { ...


3

I'm not too sure why one is so much slower than the other, but your second (slower) method can be improved by compilation (inspired by this answer). q3Compile = Compile[{{x, _Real}}, Piecewise[{{0., x <= 1/3.}, {.5, x <= 2/3.}, {1., x <= 1.}}, 0], RuntimeAttributes -> {Listable} ]; img = ExampleData[{"TestImage", "Apples"}] ...


3

I would use some edge-preserving filter (like CurvatureFlowFilter) to get a smooth image before feeding to LocalAdaptiveBinarize: img = Import["Test.tif"] smoothimg = CurvatureFlowFilter[img, 2] biimg = LocalAdaptiveBinarize[smoothimg, 10, {1, 0, .05}] mask = Dilation[biimg, DiskMatrix[1]]; cleanimg = ImageMultiply[img, mask] ...


0

First I'll import your image: img = Import["http://i.stack.imgur.com/JU26d.png"] As I mentioned in my comment, the image is too dark to detect the central circle. There is only a one-bit difference between the inside and the outside, and amount of noise is too large. Colorize[ImageData[img, Automatic]] (In the future I'd suggest marking three ...


2

Using a set-up similar to Taiki, but taking literally the OP's request for 2D slices instead of the thin 3D slices in the OP's code: SeedRandom[1]; xrange = {-5, 5}; yrange = {-5, 5}; zrange = {-5, 5}; cylinders = Table[Cylinder[ Table[RandomReal /@ {xrange, yrange, zrange}, {2}]], {10}]; plots = Block[{reg}, reg = Compile @@ {{x, y, z}, ...


3

Let me present a geometric approach. xrange = {-5, 5}; yrange = {-4, 4}; zrange = {-3, 3}; rrange = {1/2, 1}; xrangeext = {-#, #} &@ Max[rrange] + xrange; yrangeext = {-#, #} &@ Max[rrange] + yrange; zrangeext = {-#, #} &@ Max[rrange] + zrange; cylinders = Table[ Cylinder[Table[RandomReal /@ {xrange, yrange, zrange}, {2}], RandomReal[rrange]], ...


0

Click and drop your figure or name it myFig. Then ImageTake[myFig, {120, 500}, {130, 530}]


1

ℛ = ImplicitRegion[x^2 + y^2 <= 1 && Abs[z] < 5, {x, y, z}]; RegionPlot3D[ℛ, PlotPoints -> 100, PlotRange -> {{-2, 2}, {-2, 2}, {-6, 6}}] // Quiet slice =RegionIntersection[ℛ, ImplicitRegion[x^2 + y^2 < 2 && Abs[z - .5] < .01, {x, y, z}]]; RegionPlot3D[slice, PlotPoints -> 100, PlotRange -> {{-2, 2}, ...


3

You probably won't achieve exactly the same effect in Mathematica as you will with GIMP, but I think this is pretty close: ColorConvert[ ImageAdjust[ MeanShiftFilter[ImageAdjust[ImageAdjust[image, {0, 0, 2}]], 5, .1], {1, 0}], "Grayscale"]


13

MorphologicalBinarize and ColorNegate it. We use Manipulate to choose the finest parameter. img = Image[ Import["https://maps.googleapis.com/maps/api/staticmap?center=+51.\ 5+-0.116667&zoom=10&size=600x600&scale=2&style=feature:road.highway%\ 7Ccolor:0x000000%7Cweight:1%7Cvisibility:on"], ImageSize -> Medium]; Manipulate[ ...


2

One way of getting this to work is by using the Locator as a Control of Manipulate. For the convenience of easier spotting the replaced pixel I have cropped and magnified the image. image = ExampleData[{"TestImage", "Lena"}]; img = ImageCrop[image, 100]; Manipulate[ Row@{img, Dynamic@(new = ReplacePixelValue[new, pt -> 0])} // Magnify[#, 10] ...


5

Well I decided to give it a bit of a go...First import the image and convert to grayscale, then crop to focus on the area of interest. Then I used a LaplacianGaussianFilter, which is often used in blob detection. img = ImageAdjust@ColorConvert[Import["http://i.imgur.com/4lDwE33.jpg"], "Grayscale"]; smallimg = ImageAdjust@ImageTake[img, {200, 500}, {200, ...


6

If ImageMeasurements didn't exist we could have used this one-liner: Total[#]/Length[#] &@Flatten[ImageData[img], 1] ImageData will give you a matrix of RGB vectors, Flatten[...,1] will then give you a one-dimensional list of RGB vectors. Total adds them together, by dividing by the number of RGB vectors we get the mean. Also take a look at ...


8

There are ImageMeasurements for this: ImageMeasurements[image, "Mean"] (* {0.427958, 0.559264, 0.130725} *)



Top 50 recent answers are included