如何使ImageTransformation产生一个变形版本的图像

Question

我正在尝试使用ImageTransformation函数来尝试制作图像的变形版本，但到目前为止进展有限。我的目标是使用在柱面镜中反射的图像得到的结果，图像在中心镜周围弯曲约270度。 wikipedia article有几个很好的例子（我也借用了Holbein的头骨）。

i = Import["../Desktop/Holbein_Skull.jpg"];

i = ImageResize[i, 120]
f[x_, y_] := {(2 (y - 0.3) Cos [1.5 x]), (2 (y - 0.3) Sin [1.5 x])};
ImageTransformation[i, f[#[[1]], #[[2]]] &, Padding -> White] 

但是我无法说服Mathematica向我展示整个图像，或者正确地弯曲它。变形图像应该围绕放置在图像中心“内部”的镜子，但它不会。我通过将其放入一个操作（并将分辨率降低:)来找到常量的合适值。我正在使用公式：

x1 = a(y + b) cos(kx)
y1 = a(y + b) sin(kx)

非常感谢任何产生更好结果的帮助！

Answer 1

在ImageTransformation[f,img]中，函数f使得结果图像中的点{x,y}与f[{x,y}]中的img相对应。由于生成的图像基本上是img的极坐标变换，f应该是逆极坐标变换，因此您可以执行类似

的操作

anamorphic[img_, angle_: 270 Degree] :=
  Module[{dim = ImageDimensions[img], rInner = 1, rOuter},
    rOuter = rInner (1 + angle dim[[2]]/dim[[1]]);
    ImageTransformation[img,
      Function[{pt}, {ArcTan[-#2, #1] & @@ pt, Norm[pt]}],
      DataRange -> {{-angle/2, angle/2}, {rInner, rOuter}},
      PlotRange -> {{-rOuter, rOuter}, {-rOuter, rOuter}},
      Padding -> White
    ]
  ]

生成的图像类似于

anamorphic[ExampleData[{"TestImage", "Lena"}]]

请注意，您可以使用ParametricPlot和TextureCoordinateFunction获得类似的结果，例如

anamorphic2[img_Image, angle_: 270 Degree] := 
  Module[{rInner = 1,rOuter},
    rOuter = rInner (1 + angle #2/#1 & @@ ImageDimensions[img]);
    ParametricPlot[{r Sin[t], -r Cos[t]}, {t, -angle/2, angle/2}, 
      {r, rInner, rOuter}, 
      TextureCoordinateFunction -> ({#3, #4} &),
      PlotStyle -> {Opacity[1], Texture[img]},
      Mesh -> None, Axes -> False,
      BoundaryStyle -> None,
      Frame -> False
    ]
  ]
anamorphic2[ExampleData[{"TestImage", "Lena"}]]

修改

在回答Mr.Wizard的问题时，如果您无法访问ImageTransformation或Texture，您可以手动转换图像数据

anamorph3[img_, angle_: 270 Degree, imgWidth_: 512] :=
 Module[{data, f, matrix, dim, rOuter, rInner = 1.},
  dim = ImageDimensions[img];
  rOuter = rInner (1 + angle #2/#1 & @@ dim);
  data = Table[
      ListInterpolation[#[[All, All, i]], 
        {{rOuter, rInner}, {-angle/2, angle/2}}], {i, 3}] &@ImageData[img];
  f[i_, j_] := If[Abs[j] <= angle/2 && rInner <= i <= rOuter, 
    Through[data[i, j]], {1., 1., 1.}];
  Image@Table[f[Sqrt[i^2 + j^2], ArcTan[i, -j]], 
   {i, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)},
   {j, -rOuter, rOuter, 2 rOuter/(imgWidth - 1)}]]

请注意，这假设img有三个频道。如果图像具有更少或更多的通道，则需要调整代码。