# Tag Info

69

This answer evolved over time and got quite long in the process. I've created a cleaned-up, restructured version as an answer to a very similar question on dsp.stackexchange. Here's my quick&dirty solution. It's a bit similar to @azdahak's answer, but it uses an approximate mapping instead of cylindrical coordinates. On the other hand, there are no ...

18

The idea is quite simple: Since any great circle can be parametrized as $\cos(\theta)u + \sin(\theta)v$ where $u$ and $v$ are two orthonormal vectors. One can start with $u=\{1,0,0\}, v=\{0,1,0\}$ and use RotationTransform to get out of the xy plane, then use RotationTransform again to spin around the z-axis to get all great circles with desired inclination. ...

16

This is just a quick sketching out of an answer (rescales galore!) textOnCurve[text_, f_, n_, p_: 0.01] := Text[Rotate[text, ArcTan @@ (f[Rescale[n + p, {0, 1}, {p, 1 - p}]] - f[Rescale[n - p, {0, 1}, {p, 1 - p}]])], f[n]] textCurve[string_, f_, stylef_: (# &), range_: {0, 1}] := With[{chars = ...

14

Here's a simple method that seems to work. Call the grid above img. Find the best/strongest line in the image: lines = ImageLines[img, MaxFeatures -> 1] We'll need the slope of this line - here's a function to do that slope[s_, e_] := ArcTan@@(e - s); (shorter version thanks to nikie). This can be applied as slopeLine = First[slope @@@ lines] For ...

14

lin[cam_, obj_][t_] := cam t + (1 - t) obj s[cam_, obj_] := First@Solve[lin[cam, obj][t][[3]] == 0, t]; tr[cam_, obj_] := lin[cam, obj][t] /. s[cam, obj] // FullSimplify And that's it: tr[ ] i your transformation function. Let's test it with a Rubik's cube, simulating the video you linked. The following boring part is building the cube. We will make only ...

13

Here's my stab at it, using a cylindrical projection, and TextureCoordinateFunction with a fitting parameter. Replace IMG in the code with the actual photo. The last command is a manual crop. result=With[{para = 1.69}, ParametricPlot3D[{Cos[u], Sin[u], v}, {u, 0, Pi}, {v, 0, Pi}, PlotStyle -> Texture[ImageReflect[IMG, Left -> Right]], Mesh -> ...

13

Here is a static solution to the problem. It shows a mesh on the sphere that represents the normal lat-long coordinate system. A function representing the equator. equator[θ_] := {Cos[θ], Sin[θ], 0} A function and a plot representing the inclined circle. Note that the inclination is accomplished by a rotation of the equator about the x-axis. ...

11

Here's another way...Text[] has a direction argument, so ArcTan is not necessary. txt1 = "Now we can follow" // Characters; txt2 = "an arbitrary path" // Characters; f[t_] := {Cos[2 \[Pi] t], Sin[6 \[Pi] t]}; totalarclength = NIntegrate[Sqrt[f'[\[Tau]].f'[\[Tau]]], {\[Tau], 0, 1}]; invarclength = First@NDSolve[{D[$t[s], s] == 1/Sqrt[f'[$t[s]].f'[$t[s]]], ... 10 If you have v9, here's an alternative solution: first I calculate the gradient and gradient orientation for each pixel gray = ColorConvert[img, "Grayscale"]; orientation = GradientOrientationFilter[gray, 3]; gradient = GradientFilter[gray, 3]; then I create a weighted histogram from those: wd = WeightedData[Flatten[ImageData[orientation]], ... 10 try: f = FindGeometricTransform[pointSetNoise, pointSetPerfect] I know it's too short for an answer, but that's it. The result can be tested like this: ListPlot[{f[[2]][pointSetPerfect], pointSetNoise}, Axes -> False, Frame -> True] 9 Great answers have already appeared. In the spirit of demonstrating multiple solutions to a problem with Mathematica, I would like to offer one using a different approach. First, some geometric analysis. This great circle bounds a hemisphere lying in a half-space determined by a normal direction to the circle's plane. Letting$\theta\$ be the latitude at ...

9

RotationTransform[a Pi, {1, 0, 0}] is nothing more than a matrix, so you can compose/combine such functions using matrix multiplication. For example: Graphics3D[{EdgeForm[None], GeometricTransformation[Cylinder[], RotationTransform[.5 Pi, {1, 0, 0}].RotationTransform[0.2 Pi, {0, 1, 0}].RotationTransform[0.1 Pi, {0, 1, 0}]]}] In the above code ...

8

@nikie gave a very nice answer. This is a complement to it. One remaining challenge is compensating for the distortion close to the left and right edges of the image, visible for example here (image taken from nikie's post): The magnitude of the distortion cannot be estimated in the general case without having some information about what's on the label. ...

7

this approach looks promising: labelphoto = Import["/Users/acl/Desktop/labelimage.png"] label = Import["/Users/acl/Desktop/FMALS.gif"] and then locate corresponding points as follows: images = {label, labelphoto}; matches = ImageCorrespondingPoints @@ images MapThread[ Show[#1, Graphics[{Red, MapIndexed[Inset[#2[[1]], #1] & , #2]}]] &, ...

7

As an addition to @bills's answer you can rotate by the mean of the slope of all the detected lines. slopeLine = slope @@@ lines meanslope = Mean@Join[Select[slopeLine, # > -1 &], Select[slopeLine, # < -1 &] + Pi/2] ImageRotate[img, -meanslope]

7

Here is a method based on image manipulations, which means I pre-suppose a certain pixel resolution with which the crash is detected: tip[rg_] := {EdgeForm[Thin], FaceForm[White], Polygon[{{0, 4}, {0, 0.2}, {0.5 - rg, 0}, {0.5 + rg, 0}, {1, 0.2}, {1, 4}}], FaceForm[Black], Rectangle[{0.4, 0}, {0.6, 1}]}; box = {EdgeForm[Thin], FaceForm[Blue], ...

7

Use Composition: Manipulate[Graphics3D[{EdgeForm[None], GeometricTransformation[Cylinder[], Composition[ RotationTransform[a Pi, {1, 0, 0}], RotationTransform[b Pi, {0, 1, 0}], RotationTransform[c Pi, {0, 1, 0}]]]}], {{a, 0}, -1, 1}, {{b, 0}, -1, 1}, {{c, 0}, -1, 1}, SaveDefinitions -> True] (I'm not sure which order you ...

6

This works by making an interpolation function in initialization, which represents the surface. Each time the prob is moved, it finds the Euclidean distance between the current tip position and the surface at the x-coordinates at the time. It checks that this distance is not smaller than some crash tolerance constant value set in the initialization. (This ...

6

Surely a better solution exists! Assuming m your matrix. m = RandomReal[1, {1000, 1000}]; pat = Array[(-1)^# &, First@Dimensions[m]]; B1 = (pat #) & /@ Reverse[m, {1, 2}]; // AbsoluteTiming {0.124800, Null} Though Table is intuitive but will be pretty slow for big lists. u = Length[m]; B = Table[ m[[u - r, u - s]]*(-1)^(s + 1), {r, 0, u - ...

5

On many platforms, matrix operations are really fast, so using them is a good idea. (You have to get their dimensions correct, though!) SparseArray objects are likely to be efficient in RAM and time usage. All we have to do is code the rules used to generate the right and left matrices: arrange[c_] := Block[{m, n, sa}, {m, n} = Dimensions[c]; ...

5

If you did want to transform the plot, you can use something like: Manipulate[ Plot[(1 - p2)^2/(p2^2 + (1 - p2)^2), {p2, 0, 1}, AxesLabel -> {"p2", "p1"}, PlotRange -> {-1, 1}] /. Line[a__] :> Line @ Map[{(#[[1]] - γ)/(1 - γ), (#[[2]] - γ)/(1 - γ)} &, a], {γ, -1, 0.5}] which transforms the points that define the Line.

5

You probably want to transform the function, not the plot: f[p2_] := (1 - p2)^2/(p2^2 + (1 - p2)^2) Plot[f[p2], {p2, 0, 1}, AxesLabel -> {"p2", "p1"}] t[p2_, g_] := (f[(p2 - g)/(1 - g)] - g)/(1 - g) Manipulate[Plot[t[p2, g], {p2, 0, 1}, AxesLabel -> {"p2", "p1"}], {g, 0, 0.999}]

5

Testing overlapping polygons One can use the testpoint function from this answer to 9405, which I will call inPolygonQ: inPolygonQ[poly_?MatrixQ, pt_?VectorQ] := Round[(Total @ Mod[(# - RotateRight[#]) &@ (ArcTan @@ (pt - #) & /@ poly), 2 Pi, -Pi]/2/Pi)] != 0; In V8/V9, there is the undocumented function GraphicsMeshInPolygonQ which may ...

4

Here is my solution using RevolutionPlot3D to draw the disk layers, it's faster; First convert the image to data rows: imgd = Map[First[#] &, ImageData[ColorConvert[img, "Grayscale"]], {2}]; rows = Reverse /@ Transpose[imgd]; Define the function to draw the disk slices: ClearAll[disk] disk[row_List, nPoints_] := Module[{ lr = Length[row]}, ...

4

If the problem is that the transformation function is slow to compute, a simple way to create and use a look-up table is to memoize the function: (* create an example image *) image = RandomImage[1, {30, 20}, ColorSpace -> "RGB"] ~ ImageResize ~ Scaled[10] (* define the transformation function with memoization *) mem : func[{x_, y_}] := mem = {x + 0.01 ...

4

ImageTransformation works with functions, not tables. It should be straightforward to define a function that carries out the same transformation as the table, but you will need to be aware that the #[[1]] and #[[2]] arguments go from 0 to 1 (across the image) so you will need to design the function to handle this input range. For example, you might want a ...

3

You could use Reverse for the first part and define a helper function to do the rest : rM[avector_, {m1_, m2_}] := Module[{nc, local, rules}, nc = Length[avector]/2; local = {m1, m2} # & /@ Partition[avector, 2]; Flatten[ReplacePart[local, (# -> local[[ nc + 1 - #]]) & /@ Range[nc]], 1] ] The argument {m1, m2} will be used to multiply ...

3

arrngF1 = MapAt[-1 # &, #[[Range[Dimensions[#][[1]], 1, -1], Join @@ Reverse@Partition[Range[Dimensions[#][[2]]], {2}]]], {;; , 2 ;; ;; 2}] &; arrngF2 = Module[{temp = #[[Range[Dimensions[#][[1]], 1, -1], Join @@ Reverse@Partition[Range[Dimensions[#][[2]]], {2}]]]}, temp[[;; , 2 ;; ;; 2]] = (-1) temp[[;; , 2 ;; ;; 2]]; temp] &; ...

3

I'd say this is the sort of thing LinearFractionalTransform[] was designed for: With[{γ = 2/3}, MapAt[GeometricTransformation[#, LinearFractionalTransform[{IdentityMatrix[2], {-γ, -γ}, {0, 0}, 1 - γ}]] &, Plot[(1 - p2)^2/(p2^2 + (1 - p2)^2), {p2, 0, 1}, AxesLabel -> {"p2", "p1"}, PlotRange -> All], 1]] ...

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