Tag Info

Hot answers tagged

10

Here's how you might approach your problem using direct manipulation of pixel data. First create your graphics: InsertImage = DensityPlot[Sqrt[1 - x^2 - y^2], {x, -1, 1}, {y, -1, 1}, Frame -> False, ColorFunction -> (Opacity[Max[Re[#], 0], GrayLevel[Max[Re[#], 0]]] &), ImageSize -> 20, Background -> Opacity[0, Black]] Now rasterize ...


9

Just for the sake of the argument: Your approach needs about 3.2 seconds for 200 insertions on my machine. Consider this {alpha, col} = Transpose[ Table[{Boole[Im[#] == 0], Max[Re[#], 0]} &@Sqrt[1 - x^2 - y^2], {x, -1, 1, 2/33.}, {y, -1, 1, 2/33.}], {2, 3, 1}]; inset = SetAlphaChannel[Image[col], Image[alpha]]; spiral = Table[{256, 256} + ...


9

This seems to work: ImageTransformation[polar, {ArcTan @@ (radius - #), Norm[# - radius]} &, {2 radius, 2 radius}, DataRange -> {{-180 \[Degree], 180 \[Degree]}, {1, radius}}, PlotRange -> {{0, 2 radius}, {0, 2 radius}}] Notes: Don't call ArcTan[y/x]. You'd only get an angle between -90°..90°. There's an overload ArcTan[x,y] that ...


7

getBlacks[x_Image] := Binarize[x, .005] isolateTiger[x_Image] := Erosion[getBlacks[x], 2] getAreaToChange[tig_Image, fst_Image] := ImageMultiply[fst, Blur[ColorNegate@isolateTiger[tig], 30]] addImages[tig_Image, fst_Image] := ImageAdd[getAreaToChange[tig, fst], tig] GraphicsRow[{#, getBlacks@#, isolateTiger@#, getAreaToChange[##], addImages[##]} & @@ ...


6

You need to select a new data structure. As Leonid Shifrin has written Append[list, element] has a complexity proportional to Length[list] while Append[association, key -> value] is roughly constant time. Another data structure with this same property is linked lists: {newImage, {prevImage, {prevPrevImage,{}}} Any of these two could be used for ...


5

“Tilt-shift” effect depends on the mask. Here is a full blown app with downloadable source code: Digital Tilt-Shift Photography


4

Here is an example returning 9 lines without additional points: i = Import["http://goo.gl/5R4MAl"]; ii = Closing[Binarize[GradientFilter[ColorNegate@Binarize[i, .55], 2], 0.1], 1]; foo = Select[ImageLines[ii, Segmented -> True], EuclideanDistance @@ #[[1]] > 100 &]; Show[i, Graphics[{Thick, Orange, Line /@ foo}]] Here are the details for foo: ...


4

Here's how I'd approach it. Basically, use DownValues and DumpSave: frame[1] = (*picture1*); frame[2] = (*picture2*); DumpSave["filepath.mx",frame] With a fresh Kernel: Get[filepath.mx]; Length@DownValues@frame 2 Also, Obligatory warning about DumpSave: It's platform and version specific.


4

ImageAdd does the job. Blend allows you to adjust the blending level. ImageAdd[tiger, background]


3

According to the documentation the coordinate system used by ImageTransformation uses $(w,h)=(1,\alpha)$ where $\alpha$ is the aspect ratio. I'll use an image with aspect ratio 1: img = ExampleData[{"TestImage", "Lena"}]; aspectRatio = Divide @@ ImageDimensions[img] (* Out: 1 *) In order to translate the image we can move each pixel 25% downwards and to ...


3

You can fit your data to a plane surface and use ComponentMeasurements to detect the bumps on the surface. data3Ds = Round[data3D, 0.02] // DeleteDuplicates; plane = LinearModelFit[data3D, {x, y}, {x, y}] data3Dp = ParallelMap[{#[[1]], #[[2]], #[[3]] - plane[#[[1]], #[[2]]]} &, data3Ds]; projection = Rasterize[ ...


2

With SelectComponents you can do it like this: selectBorder[border_] := SelectComponents[ m, "AdjacentBorders", MemberQ[#, border] & ] So that selectBorder /@ {Left, Right, Top, Bottom} gives But there's a problem, as you can see. AdjacentBorder doesn't count elements that don't touch their borders. So a harder question is not how you can ...


2

You can use for example ImageSubtract as follow: j = Import@"http://i.imgur.com/AC0bvkG.png"; k = Binarize[j, FindThreshold[j]]; l = SelectComponents[k, "FilledCircularity", -7]; m = ImageCrop[l]; comp = ComponentMeasurements[m, {"AdjacentBorders", "BoundingBox"}] /. {{_, Right} | {Right, _} -> {Right}, {_, Left} | {Left, _} -> {Left}}; imgdim ...


2

Although I think belisarius's result is prettier your example image clearly has the background visible through the dark parts of the tiger image, and since you wrote that you want "the same result in Mathematica" I propose this as a starting point: {img1, img2} = Import /@ {"http://i.stack.imgur.com/gPKY5.jpg", "http://i.stack.imgur.com/G39md.jpg"}; ...


2

If you're using Mathematica 10, you can also use the new Association feature: frame = Association[]; frame[1] = (*picture1*); frame[2] = (*picture2*); In some ways, associations behave more like lists than downvalues: for example, functions like Map and Select work on them directly. If you assign a different variable to an association, you'll get a copy ...


1

I was always under the impression that a tilt-shift effect was achieved by blurring the top and bottom of a picture. This is supposed to imitate a shallow depth of field. mask = Image @ Table[With[{c = 150 - 50 x/300}, Abs[y - c]/c], {y, 300}, {x, 300}]; ImageFilter[Mean@Flatten@# &, image, 5, Masking -> mask]


1

This will not work on version 9... Because there are too much points (about 300295) my laptop can not handle the whole data. The main idea is to use Delaunay triangulation DelaunayMesh in Mathematica. dat = data3D[[1 ;; 3000, All]]; mesh = DelaunayMesh[dat]; HighlightMesh[mesh, {Style[0, Directive[PointSize[Medium], Black]], Style[2, Opacity[0.1]]}] ...


1

After some further experimentation it turns out that the sluggishness of the locators in the LocatorPane can be overcome by eliminating the explicit Return statement from the PlotLabelerFunction. I changed the code as follows: (* updated Dynamic Overlay Code *) Dynamic[ Which[ (* this Which statement is used for responding to toggling of label ...



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