# [GIF] Square Grid (Schwarz–Christoffel mapping from circle to square)

Posted 10 months ago
4250 Views
|
10 Replies
|
23 Total Likes
|
 Square GridThis shows a parametrized version of the SchwarzChristoffel transformation between the circle and the square. To implement this, first of all we need the Cayley transformation between the upper half-plane and the unit disk: Cayley[z_] := (z - I)/(z + I); Now, I took some inspiration from a Math StackExchange answer of Lukas Geyer to realize that this particular SchwarzChristoffel mapping could be implemented using the Weierstrass $\wp$-function. We need to determine the specific parameters that will give us our map: g2[ω1_, ω2_] := Block[{a, b, τ, q}, τ = ω2/ω1; q = E^(π I τ); a = EllipticTheta[2, q]; b = EllipticTheta[3, q]; 4/3 (π/ω1)^4 (a^8 - a^4 b^4 + b^8) ]; g3[ω1_, ω2_] := Block[{a, b, τ, q}, τ = ω2/ω1; q = E^(π I τ); a = EllipticTheta[2, q]; b = EllipticTheta[3, q]; 8/27 (π/ω1)^6 (a^12 - 3/2 a^8 b^4 - 3/2 a^4 b^8 + b^12) ]; And then it's basically just a matter of choosing colors and fiddling with the interpolation: DynamicModule[{invts = {g2[2., 2. I], g3[2., 2. I]}, s, width = .012, n = 8, c, cols = RGBColor /@ {"#21243d", "#88e1f2"}}, s = WeierstrassP[1, invts]; Manipulate[ c = 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s] &[(1 + I)/2]; Graphics[{FaceForm[cols[[-1]]], Table[ Polygon[ Join @@ Transpose[ Table[ ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s]] & /@ {x + I (y - width), 1 - x + I (y + width)}, {x, -width, 1 + width, (1 + 2 width)/100}]]], {y, 0., 1, 1/n}], Table[ Polygon[ Join @@ Transpose[ Table[ ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s]] & /@ {x - width + I y, x + width + I (1 - y)}, {y, -width, 1 + width, (1 + 2 width)/100}]]], {x, 0., 1, 1/n}]}, ImageSize -> 540, PlotRange -> Sqrt[3], Background -> cols[[1]]], {t, 0, ?}] ] 
10 Replies
Sort By:
Posted 10 months ago
 - Congratulations! This post is now featured in our Staff Pick column as distinguished by a badge on your profile of a Featured Contributor! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!
Posted 10 months ago
 Very beautiful! The GiF animation looks very smooth. Is it just replacing Manipulate with Table and then Export or is there more to it? It would be great to see the actual complete exporting code too. My GiFs look a bit more choppy -- not sure how to fix that, would be nice to learn general good practices. Thanks for sharing btw, Clayton, I really enjoy your works popping up here :-)
Posted 10 months ago
 It's basically replacing Manipulate with Table and then Export.The only real trick is to make "DisplayDurations" smaller. "DisplayDurations" specifies how long each frame should be displayed; the default, I think, is not to specify anything, so then you just fall back to the default of the web browser you're viewing the GIF in, which is typically something like 1/10 second. This indeed makes for very choppy animations.When possible I try to use "DisplayDurations" -> 1/50, so the animation is at 50 fps (which, due to the vagaries of the GIF format, is the maximum possible), but this obviously requires more frames and hence a larger filesize. To reduce the size I'll sometimes drop down to "DisplayDurations" -> 3/100 (again, due to the GIF format, the durations have to be multiples of 1/100), or about 33 fps, but this is about as low as I'm willing to go.I didn't in this case, but sometimes I also need to postprocess the GIF in gifsicle or Gifski to try to reduce filesize in more sophisticated ways.Anyway, here's the code I used to export the GIF: squircle = Block[{invts = {g2[2., 2. I], g3[2., 2. I]}, s, width = .012, n = 8, c, cols = RGBColor /@ {"#21243d", "#88e1f2"}}, s = WeierstrassP[1, invts]; ParallelTable[ c = 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s] &[(1 + I)/2]; Graphics[ {FaceForm[cols[[-1]]], Table[ Polygon[ Join @@ Transpose[ Table[ ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s]] & /@ {x + I (y - width), 1 - x + I (y + width)}, {x, -width, 1 + width, (1 + 2 width)/100}]]], {y, 0., 1, 1/n}], Table[ Polygon[ Join @@ Transpose[ Table[ ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[-WeierstrassP[#, invts]/s]] & /@ {x - width + I y, x + width + I (1 - y)},{y, -width, 1 + width, (1 + 2 width)/100}]]], {x, 0., 1, 1/n}]}, ImageSize -> 540, PlotRange -> Sqrt[3], Background -> cols[[1]]], {t, 0., ? - #, #}] &[?/150] ]; Export[NotebookDirectory[] <> "squircle.gif", squircle, "AnimationRepetitions" -> Infinity, "DisplayDurations" -> 1/50] 
Posted 9 months ago
 Hi Clayton, the GIF is as always beautiful. And thank you a lot for sharing those super useful tips! They will surely be very handy if I need to make GIFs in the future!
Posted 9 months ago
 Thanks!
Posted 10 months ago
 Super cool GIFs you make, Clayton! I always use the "Online GIF maker and image editor" at EZGIF.com Did you ever try this? It is very easy to use and gives you complete control after you have created a GIF file in Mathematica.
Posted 10 months ago
 No, it's based on ImageMagick, gifsicle, and ffmpeg, all of which I have installed already, so I prefer to just apply them directly myself.
Posted 10 months ago
 Thank you very much for the wonderful presentation Clayton!
 A quick note, as someone who occasionally fiddles with special functions:The g2[] and g3[] functions in Clayton's post are effectively scaled versions of the built-in functions WeierstrassInvariantG2[] and WeierstrassInvariantG3[].Additionally, the mapping under consideration involves (a scaled version of) the lemniscatic case of the $\wp$ function, such that a lot of things greatly simplify. In fact, one could avoid the Weierstrass functionality altogether, and just use Jacobi elliptic functions with parameter $m=\frac12$ instead, through well-known relations between them and the lemniscatic case of the $\wp$ function. Taking the Jacobi route has the advantage of being slightly more efficient in numerically evaluating the expressions involved.More concretely, here is a simplified version of Clayton's original code: DynamicModule[{ell = Function[z, 1 - 2 JacobiNS[EllipticK[1/2] z, 1/2]^2], width = .012, n = 8, cols = RGBColor /@ {"#21243d", "#88e1f2"}}, Manipulate[Graphics[With[{c = 2 Cos[t] ((1 + I)/2)}, {FaceForm[cols[[-1]]], Table[Polygon[Join @@ Transpose[ Table[ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[ell[#]]] & /@ {x +I (y - width), 1 - x + I (y + width)}, {x, -width, 1 + width, (1 + 2 width)/100}]]], {y, 0., 1, 1/n}], Table[Polygon[Join @@ Transpose[ Table[ReIm[-c + 2 Cos[t] # + Sin[t] Cayley[ell[#]]] & /@ {x - width + I y, x + width + I (1 - y)}, {y, -width, 1 + width, (1 + 2 width)/100}]]], {x, 0., 1, 1/n}]}], ImageSize -> 540, PlotRange -> Sqrt[3], Background -> cols[[1]]], {t, 0, π}]]