如何使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] 

但我無法說服數學給我看整個圖像，或者正確地彎曲。變形圖像應該圍繞放置在圖像中心「內」的鏡子，但不會。我通過將它放在一個操作中（並將分辨率降低:)來爲常量找到合適的值。我正在使用公式：

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

任何幫助產生更好的結果將不勝感激！

Answer 1

在ImageTransformation[f,img]中，函數f使得得到的圖像中的點{x,y}對應於img中的f[{x,y}]。由於得到的圖像基本上是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有三個通道。如果圖像具有更少或更多的通道，則需要修改代碼。