Tag Info

New answers tagged

0

Since my above comment appears to have answered the question, I'll upgrade it to an answer. The k-means algorithm can get trapped in a local minimum during optimisation - see here - so try using the "RandomSeed" option of ClusteringComponents to vary its initial guess. For instance, this gives the result that one would expect: image = <your image>; ...


2

You can get the old ImageCompose behavior by using Overlay instead: Overlay[{i1, i2}] Edit: As pointed out by the comment by ybeltukov the Head of an Overlay is "Overlay" and therefore doesn't match the Head of ImageCompose, which is "Image". I didn't realize this, because exporting to a .png file did handle the transformation. One can use e.g. ...


16

One can apply here a smooth threshold with the criterion $$ r + b > \alpha g. $$ ImageApply[With[{t = (1 + Tanh[2 (1.5 #[[2]] - #[[1]] - #[[3]])])/2}, # t + Mean[#] {1, 1, 1} (1 - t)] &, im] The same with packed arrays: Image@Transpose[#, {3, 1, 2}] &@ With[{t = (1 + Tanh[2 (1.5 #2 - # - #3)])/ 2}, {# t, #2 t, #3 t} + ...


14

This is a similar idea to ybeltukov's, iteratively splitting rectangles into two smaller rectangles. I've used an integer grid to avoid getting small offsets between adjacent blocks, and a weighted random choice to decide whether to split horizontally or vertically or do nothing. The idea is that long thin rectangles should preferentially be split along the ...


25

An extended comment follows. Mondrian, in the late work referenced by the OP and characterized by primary colored rectangles separated by black lines, employes an extraordinarily sophisticated understanding of perception, color, and light. As background to understand what Mondrian does, I recommend The Interaction on Color, by Joseph Albers and Alfred C. ...


17

Here is my attempt to be Piet Mondrian colors = {RGBColor[0.9, 0.9, 0.9], RGBColor[0.05, 0.05, 0.05], RGBColor[0.8, 0.1, 0.1], RGBColor[0.1, 0.1, 0.5], RGBColor[0.9, 0.7, 0.1]}; split = # /. d : Rectangle[{x1_, y1_}, {x2_, y2_}] :> With[{t = RandomReal@BetaDistribution[10, 10], r = Random[]}, Which[ r < 0.3 (x2 - x1)/(y2 - y1), ...


3

My take on this, with some inspiration from shrx's great answer. I pick points randomly, but weighted by the image gradient to try to get more points on edges in the image. Then I use a Delaunay triangulation so that those edges are maintained in the mesh. Finally I colour it by taking the single pixel value at the centre of each triangle (rather than the ...


6

i = ExampleData[{"TestImage", "Mandrill"}]; id = ImageDimensions[i]; Create some keypoints and use them to make a triangular mesh: xy = ImageKeypoints[i, MaxFeatures -> 50]; m = VoronoiMesh[xy, {0, #} & /@ id]; mt = TriangulateMesh[#, MaxCellMeasure -> ∞, MeshQualityGoal -> "Minimal"] & /@ Map[MeshRegion[MeshCoordinates[m], #] ...


6

The default tolerance (distance) of ColorReplace is such that first and third horses are considered similar: ColorReplace[im3, colors[[2]] -> Red] Use a smaller value for the distance parameter: ColorReplace[im3, { colors[[2]] -> Red, colors[[3]] -> Blue, colors[[4]] -> Green, colors[[5]] -> Yellow }, 0.01 ]


4

What you want to do can be done way easier: i = Binarize@Import["http://i.stack.imgur.com/ZDeYq.jpg"]; Colorize[MorphologicalComponents@i, ColorRules -> {1 -> Red, 2 -> Blue, 3 -> Green, 4 -> Yellow}]


11

im = Binarize@Import["http://i.stack.imgur.com/ZDeYq.jpg"]; Colorize[MorphologicalComponents@im, ColorRules -> {1 -> Red, 2 -> Yellow, 3 -> Blue, 4 -> Green}]


5

I had originally posted this only as a comment, because it was not clear whether the OP wanted something that was exactly like Photoshop's screen blending mode, or whether he just wanted to composite the two images together in a nice way like @belisarius's answer. Now that the OP has clarified that a replication of Photoshop's behaviour is indeed desired, I ...


4

Here's another way of creating false-color Marilyns: take a greyscale image and apply a Cos[] function to the RGB channels, each with a different frequency parameter: i = RemoveAlphaChannel@ColorConvert[ ImageCrop@Import@"http://i.stack.imgur.com/W8hV5.png","Grayscale"]; negFunc[x_, par_] := 1 - Cos[2 Pi par x]; imgNegate[im_, r_] := ...


33

Let's do it Andy's way So you are Andy. Nice to meet you. And you never got those hands on a keyboard. Doesn't matter, I will show you! First you need to go to Marilyn's place. Don't worry, JF isn't there right now. Ask her for a nice photograph and the negatives. i = ImageCrop@Import@"http://i.stack.imgur.com/W8hV5.png" Outstanding picture, good ...


4

Here is an example how to get the rectangle coordinates First we extract the rectangles that don't touch the borders with img = frames[[1]]; rec = SelectComponents[ColorNegate@img, "AdjacentBorderCount", # == 0 &] Then we extract the coordinates of the rectangles with result = ComponentMeasurements[rec, "BoundingBox"] {1 -> {{12., 180.}, ...


16

Alright, instead of separating the picture by graylevels, I tried to get more involved with component detections. I noticed the original painting has a different color for hair, face, mouth, eyes, and clothes. I tried my best to replicate this. i = ImageCrop[Import["http://s2.hubimg.com/u/4262573_f520.jpg"]]; id = ImageDimensions[i]; back := ...


18

Making use of the "Posterization" option in ImageEffect: img = Import@"http://i.stack.imgur.com/yNEqN.png"; awImage := ColorReplace[#, Thread[DominantColors[#] -> RandomColor[4]]] & [ImageEffect[img, {"Posterization", 2}]] GraphicsGrid[Partition[Table[awImage, {8}], 4]]


16

i = Import@"http://i.stack.imgur.com/yNEqN.png"; h = ColorQuantize[ColorSeparate[i, "HSB"][[3]], 4, Dithering -> False]; tr = Array[Thread[Rule[Union@Flatten@ImageData@h,List@@@RandomSample[ColorData[22, "ColorList"], 4]]]&, {4, 4}]; ...


7

The following isn't focused on the Text recognizing part (I'm stealing it from @paw's previous answer) but on separating the ads' text. img = Import["http://i.stack.imgur.com/BO30x.jpg"]; ib = Binarize@img; dsc = DeleteSmallComponents[ColorNegate@ib, 500]; sc = SelectComponents[ColorNegate@dsc, "Rectangularity", # > .9 &]; Column[TextRecognize /@ ...


7

Level adjustments can be done with Mathematica using the ImageAdjust function. But I think Binarizeis good enough for the case you presented. The results are pretty close. img = Import["http://i.stack.imgur.com/BO30x.jpg"]; img2 = Import["http://i.stack.imgur.com/WhtvY.jpg"]; Grid[{{TextRecognize@Binarize[img, 0.38], TextRecognize@Binarize[img2]}}]


3

The discrepancy arises inside the function Image`CompositionOperationsDump`imvQ in which the ImageSize option value for the graphics is extracted using: rdims = Cases[i, rul_Rule /; First[rul] === ImageSize]; Since there is no explicit level specification in the Cases it defaults to {1} and therefore when the ImageSize option is at a deeper level (as in ...


3

You have to convert Transparent into, e.g., the RGB color space: ImagePad[p, 10, ColorConvert[Transparent, "RGB"]] This is due to the fact, that Transparent is GrayLevel[0,0] and is incompatible with the ImageColorSpace of your image p (Automatic, which means that no color space is specified). You can also convert your image into a specific color space, ...


5

(* Two sample images *) a = Image[RandomReal[1, {100, 100, 3}]]; b = Image[Array[If[#1 < #2, RandomReal[.5, 3], {1, 1, 1}] &, {100, 100}]]; (* Calculate*) Timing[ mask = Binarize[b, {1., 1., 1.} == # &]; c = ImageAdd[ImageMultiply[a, mask], ImageMultiply[b, ColorNegate@mask]]; GraphicsRow[{a, b, mask, c}]]


6

The naive method for component-wise Min is img1 = Import["ExampleData/lena.tif"] img2 = ColorNegate[img1] ImageApply[Min /@ Transpose@{##} &, {img1, img2}] // AbsoluteTiming But it is quite slow. However, one can note that $$ \min(A,B) = \frac{A}{2}+\frac{B}{2}-\left|\frac{A}{2}-\frac{B}{2}\right| $$ Therefore, let's try the following ...


2

What datum was used for your geodata? Google Maps uses WGS84/Pseudo-Mercator (http://en.wikipedia.org/wiki/Web_Mercator) and it does not seem to align well with your data. The following was copied from Mark McClure (How to combine more locations (GPS coordinates inside one city) with Google map?) geodata = { {"30\[Degree]16'38.43''N", ...


2

Here's an approach based on wavelets forest = Import["http://i.stack.imgur.com/gPKY5.jpg"]; tiger = Import["http://i.stack.imgur.com/G39md.jpg"]; swd = StationaryWaveletTransform[#, DaubechiesWavelet[8], 3] & /@ {forest, tiger}; forestVals = swd[[1]][{___, 0 | 1 | 2 | 3}, {"Values", {"Image", "ImageFunction" -> Identity}}]; ...


0

This is actually not an answer but a simple review of the answers given above. Screen blending mode is equivalent to Black passing through, White halt, 50% gray half through. So a picture containing four distinct areas, namely transparent, black, 50% gray and white can be used to test the outcomes of the methods given above. The picture tbgw.png below ...


8

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"}; ...


11

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[##]} & @@ ...


9

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


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 ...


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 ...


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 ...


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.


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[ ...


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 ...


5

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


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]



Top 50 recent answers are included