Tag Info

Hot answers tagged

31

First, define the dimensions and colors associated with our matrix: {mheight, mwidth} = mdim = {12, 20}; mdepth = 20; mcolors = Reverse@Array[ Blend[{{0, Darker[Green, 0.9]}, {0.4, Darker[Green]}, {0.6, Darker[Green]}, {0.90, Lighter[Green]}, {1, Lighter[Green, 0.8]}}, #/(mdepth - 1)] &, mdepth, 0]; Next, define some useful ...


29

EDIT: I found a version of the source image with fewer jpeg artifacts. My idea would be to extract pixels along the border of the shadow, inside and outside of the shadow. Then I have a list of pairs of RGB values, and I can find a suitable transformation from "shadowed" pixels to "non-shadowed" pixels. But first, I must find the shadow area. I would ...


23

Forward Mapping One way to do it is to create the texture for one tile and then transform repeated copies of it in a way that resembles the original illusion. First we create the tile: tile = Module[{KeyHole}, KeyHole[base_] := Sequence[ Disk[{0, 1/3} + base, 1/10], Rectangle[{-1/30, 1/15} + base, {1/30, 1/3} + base] ]; ...


18

Edit Old answer follows below The features of your new set are very different from the first image. For example: There are components "touching" the borders. They have "hidden" structures like this: So it needs a different approach: l = {"http://i.stack.imgur.com/OZEvk.png", "http://i.stack.imgur.com/Tl1Pm.png", ...


17

Edit Here is a different approach using Graphics to actually draw some brush strokes. I run a GradientOrientationFilter on a smaller version of the image to estimate the local image gradient, and use that information to create a collection of randomly shaded lines: img = Import["http://i.stack.imgur.com/XwYg7.jpg"]; im = img ~ImageResize~ 200 ...


15

You could start to scrape allowed characters in that font, e.g.: mcolors = Blend[{{0.00, Darker[Green, 0.7]}, {0.90, Darker@Green}, {0.90, Lighter[Green]}, {1.00, Lighter[Green, 0.9]}}, #] &; $unic := $unic = Join[{"\[Wolf]", "\[MathematicaIcon]", "\[HappySmiley]"}, Drop[ToExpression[ "\"" <> StringReplace[#, "U+" -> ...


13

Edit: Shorter ImageTrim version as pointed out by Matthias Odisio Use MorphologicalComponents and utilize ComponentMeasures to extract the "BoundingBox" which is already the row- and column-number you can then feed directly to ImageTake or even better to ImageTrim. ImageTrim has the big advantage that it can handle the bounding box coordinates directly: ...


11

This is a difficult problem, as the referenced literature in the linked SE questions may attest. I can provide some steps towards your goal, but I don't have the full answer. im = ImageTake[Import["http://i.stack.imgur.com/rSOow.png"], {10, -10}, {10, 220}] First, trying to find the shadow mask, ChanVeseBinarize seems to work best here. Note that I ...


11

Your functions take two arguments as input. Yet they return one argument as output. So the output of f cannot serve as the input of g and vice versa. You can't compose the functions with until the outputs of one function can serve as the input for the other function. Reduce your arguments in f, g by placing them in a list. This appears to work: f[{x_, y_}] ...


11

One major improvement to any matching algorithm in this specific case will be to get rid of the diacritical marks in the first list that don't appear in the second list. I'm not aware of any Mathematica function to do that and too lazy to roll a conversion table myself, but there is a simple Java routine to be found here that does this. I slightly modified ...


10

The two standard methods are SlotSequence, and the "injector pattern." Related question on StackOverflow: How to Block Symbols without evaluating them? SlotSequence ClearAll[myBlock] SetAttributes[myBlock, HoldAll] varList = {"a", "b", "c", "d"}; myBlock[args_] := Function[Null, Block[{##}, args], HoldAll] @@ (MapIndexed[Set, Join @@ ...


9

Mathematica has a few very limited 'effects' built-in: i = Import["http://i.stack.imgur.com/XwYg7.jpg"]; oil = ImageEffect[i, {"OilPainting", 4}] boss = ImageEffect[i, {"Embossing", 15}] Combining them: ImageAdjust[ImageCompose[boss, {oil, .5}], {1, 0}] But for the best effects, you'll have to start drinking absinthe...


8

If you create a table like: Table[{10i + j, i, j}, {i, 1, 4}, {j, 1, 3}] that nearly gives you what you want, but you'll notice they are grouped together, but that can be sorted by simply flattening that result appropriately Flatten[Table[{10i + j, i, j}, {i, 1, 4}, {j, 1, 3}], 1]


8

There is one way to produce the expected result with Table pointed out by ssch in the comments, here are another ones, with Array : Array[{10 #1 + #2, #1, #2} &, {4, 3}] // Flatten[#, 1] & or with a powerful function like Outer : Outer[{10 #1 + #2, #1, #2} &, Range[4], Range[3]] // Flatten[#, 1] & {{11, 1, 1}, {12, 1, 2}, {13, 1, 3}, ...


8

You can achieve an effect like this by using CurvatureFlowFilter and GaborFilter. The effects are best viewed in full resolution. Here is the original image: img = Import["http://i.stack.imgur.com/XwYg7.jpg"] Now we smooth is nicely with the CurvatureFlowFilter: imgsmooth = CurvatureFlowFilter[img, 2] And generate a gradient image of the original ...


7

I'd like to add that I personally prefer to deal with lists of symbols rather than lists of strings that are implied to convert into symbols later in functions. That way I get errors from incorrectly formated strings early rather then getting them buried deeply in an application when something runs Symbol[string] or worse ToExpression[string] and expects a ...


7

Just an alternative, the abuse of Hold pattern varList = {"a", "b", "c", "d"}; SetAttributes[myBlock, HoldFirst]; myBlock[args_]:= Hold[Block][ MakeExpression@varList~Hold[Set]~Range@Length@varList // Thread, Hold[args]] // ReleaseHold


7

Nearest automatically uses EditDistance by default: l1 = {"Refresco em Pó TANG de Pêssego 30g", "Refresco em Pó CLIGHT de Maracujá 9g", "Refrigerante ANTARCTICA Soda Limão Garrafa 600ml", "Refresco em Pó CLIGHT de Abacaxi com Hortelã 8g", "Refrigerante ANTARCTICA Guaraná Lata 350ml", "Refresco em Pó CLIGHT de Lima Limão 9g", ...


7

When f and g have been defined this way : f[x_, y_] := {E^x + y, Sin[2 x]} g[x_, y_] := {2 x + Cos[y], E^(x + y)} the problem is that g and h being two-argument functions, then g is called as one-argument (i.e. a list returned by f) function h[x_, y_] := g[f[x, y]]. Instead of redefining f and g you can try another definitions of h as a composition of f ...


6

There are two aspects of this question that distinguish it from previous questions: The request for a general template, as opposed to just a single example. The fact that the given example is a polynomial of degree three, whereas as opposed to the quadratic examples which appear in many places, including Stan's book. To deal with the first issue, in ...


6

Show[ ListPlot3D[correlationMatrix, AxesStyle -> Thickness[0.01], AxesLabel -> {"X", "Y", "Corr(X,Y)"}, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, ColorFunction -> "BrightBands"], ListPointPlot3D @ Tooltip @ Flatten[ MapIndexed[Flatten@{#2, #1} &, correlationMatrix, {2}], 1] ]


5

If you double click an output cell's cell bracket, the input cell grouped together with it will be hidden. This functionality may not be obvious, so it'l good to point out it exists. This is the folded cell:


5

Though not nearly as general as the method using Table here is a faster method for this specific case: Join[#.{{10}, {1}}, #, 2] & @ Tuples @ Range @ {4, 3} {{11, 1, 1}, {12, 1, 2}, {13, 1, 3}, {21, 2, 1}, {22, 2, 2}, {23, 2, 3}, {31, 3, 1}, {32, 3, 2}, {33, 3, 3}, {41, 4, 1}, {42, 4, 2}, {43, 4, 3}} Comparative timings: SetAttributes[timeAvg, ...


5

A little late to the party, but here's a function I wrote to compose arbitrary $\mathbb{R}^M \to \mathbb{R}^P$ functions with $\mathbb{R}^P \to \mathbb{R}^N$ functions: Clear[multiDimComposition] multiDimComposition[flst__]:= With[{fcns = Reverse@List[flst]}, Fold[#2[ Sequence @@ #1 ]&, First[fcns][##], Rest[fcns]]& ] Here's a few examples ...


5

You can use the LCE package by Dr Sandri Marco. It is updated for version 7 and I just tried in on your system for V9 and it worked. Download lcm.zip and use the package as instructed Here is the result of running your system on it on my PC << lce.m ?LCEsC These are the 3 Lyapunov Exponents for the Rossler system: rossler[{x_, y_, z_}] := {-y ...


5

A = {{1, 2, 3}, {2, 3, 4}, {3, 4, 5}}; Join @@ Table[If[a~MemberQ~i, a~Join~{i}, Unevaluated[]], {a, A}, {i, 3}] Join @@ Table[a~Join~{i}, {a, A}, {i, Select[Range@3, a~MemberQ~# &]}] {{1, 2, 3, 1}, {1, 2, 3, 2}, {1, 2, 3, 3}, {2, 3, 4, 2}, {2, 3, 4, 3}, {3, 4, 5, 3}}


5

Some of the other approaches might be much more efficient, but the following shows how one can create something which is probably as easy to read (if one is fluent in Mathematica) as a python list comprehension: SetAttributes[listComprehend, HoldAll] listComprehend[Verbatim[Condition][body_, crit_],iters:({_, __}..)] := Flatten[ Table[ If[crit, ...


4

I found in this answer the function Internal`StringToDouble that does exactly what I was looking for: dataReal = ToString /@ RandomReal[1000, {10^5}]; d1 = Internal`StringToDouble /@ dataReal; // AbsoluteTiming d2 = ToExpression /@ dataReal; // AbsoluteTiming d1 == d2 {0.045391, Null} {0.544008, Null} True As you can see, much faster then ToExpression.


4

The two excellent answers to this question are from Mathematica experts who have trained rigorously for years at secret mountain-top monasteries, on a tungsten-enriched diet, to achieve these levels of effortless mastery. It can be hard for some of the rest of us to unravel their elegant phrasing... I was working along these lines before I had to stop. ...


4

I'm not sure what you are exactly looking for. Anyway, here's my code for computing a point on a Bézier curve using de Casteljau's algorithm. I'm fairly new to Mathematica and I hope I haven't made too many errors. Maybe one of the experienced users can have a look at the code? The code is adapted from a code example of 'The NURBS book'. The same pseudo ...



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