https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Symbolic Computations sorted by most likes. https://community.wolfram.com/groups/-/m/t/2399430 *SUPPLEMENTARY WOLFRAM MATERIALS for the ARTICLE:* > Sergio Manzetti, Alexander Trounev (2021). > A Navier-Stokes model for Rogue wave simulation. > ResearchGate, Technical Report. https://www.researchgate.net/publication/354527324 ------ ![enter image description here][1] ABSTRACT -------------------------------------- Rogue waves are anomalous phenomena occurring over large sea bodies, where they are said appear out of nowhere and disappear without a trace. Simulations of rogue waves have been carried over the last 40 years, with several models published. In this paper we investigate the formation of rogue waves by two models: I. the Navier-Stokes equation where we take into account density and viscosity gradient on the air-water interface due to diffusion and II. a Korteveg de Vries-type model for quantum jumps which we developed earlier. We derive also a stable fluids algorithm which we use to compute nonlinear waves interaction produced by the wind. The results are discussed and compared. This code solves problem of viscous incompressible flow with gravitational force in a rectangle with periodic boundary condition on the left and right side and with Dirichlet condition on the top and bottom side. In the initial condition fluid velocity is periodic wave, and density has unit step like distribution on the air/water interface. Some other application of this code has been discussed on https://mathematica.stackexchange.com/questions/246091/stable-fluids-code-for-electromagnetic-mixture-application This model has been discussed in our report [A Navier-Stokes model for Rogue wave simulation][2] Two phase model of air-water interface -------------------------------------- Let us consider the system of equations describing nonlinear waves on the air-water interface. As it well known the air and the water can be considered as viscous incompressible fluids with density $\rho_a, \rho_w$, and dynamical viscosity $\mu_a, \mu_w$ consequently. Taking into account the gravity force and diffusion on the air-water interface, we have $$\nabla.\bf{u}=0\\ \frac{\partial \mathbf{u}}{\partial t}+(\mathbf{u}.\nabla)\mathbf{u}+\frac{\nabla P}{\rho_i}=\nu_i\nabla ^2\mathbf{u}+\mathbf{f}\\\ \frac{\partial \phi}{\partial t} +(\mathbf{u}.\nabla)\phi=\frac{\nu_i}{Sc_i}\nabla ^2\phi\\ $$ Here it is indicated $\rho_i, i=a,w $ - air and water density, $\mathbf{u}=(u_x,u_y)$ - flow velocity, $P$ - pressure; $\bf{f}$ - force acting on the volume of the air-water mixture; $\phi$ - the interface function describing the averaged density of the air-water mixture; $Sc_i$ - analog of the Schmidt number characterized water diffusion in the air and air diffusion in the water. Note that we considered averaged effect of mass transfer on the air-water interface including drops and bubbles. Let us define the Cartesian coordinate system so that the $y$ axis is directed against the direction of the gravitational acceleration vector and the $x$ axis is parallel to horizon. Let suppose that the water surface relief is described by the equation $y=r(t,x,y)$ - Figure 1. ![Figure 1. Flow geometry on the air-water interface with waves of small (left) and large (right) amplitude][3] We set the boundary conditions for the flow parameters on the top and bottom part of the boundary layer and periodic boundary conditions by coordinate $x$ as follows: $$ y=0: \mathbf{u}=0,\phi=\rho_w\\ y=H: \mathbf{u}=(U_0,0), \phi=\rho_a\\ \mathbf{u}(t,0,y)=\mathbf{u}(t,L,y)\\ \phi(t,0,y)=\phi(t,L,y). $$ Here $H$ is the height of the boundary layer,$U_0$ is the wind velocity, $L$ is the period of the wave tray. We assume that at the initial time the flow velocity and interface function are given by $$ t=0, y<H/2:u_x = 0, u_y=V_0 \sin(2 \pi n x/L), \phi =\rho_w\\ t=0, y\ge H/2: u_x=U_0, u_y=V_0\sin (2 \pi n x/L), \phi =\rho_a\\ $$ This problem can be solved with using numerical methods and an appropriate turbulence model. We have used stable fluids algorithm (Stam1999, Stam 2000) to solve 2D Navier-Stokes equations and to simulate nonlinear waves interaction on the air-water interface with a given wind velocity on the top of the boundary layer. While in the standard gravity wave theory the air-water interface is considered mainly as a potential flow, in our approach we take into account velocity, viscosity and density gradients on the interface. Since air/water density ratio is about $10^{-3}$ we have some challenging numerical problem. To solve this problem we made some simplifications in the basic Navier-Stokes equations. First, we suppose that velocity is a continues field at $t>0$ so that flow in the water and flow in the air is an united flow continuously distributed from the bottom to the top and the periodic one in the $x$ direction. We neglect by the surface tension due to large scale of the waves. Therefore we don't need any boundary condition on the air-water interface. Second, at $t>0$ we introduce continues density as $\rho=\phi$ to compute velocity field on every step. Third, we use stable fluid algorithm in time in the very specific order described below. Stable fluids algorithm ----------------------- 1) Solve advection equation with using boundary conditions, initial data from the previous step, and an implicit algorithm $$ \frac{\partial \mathbf{u}_1}{\partial t}+(\mathbf{u}_1.\nabla) \bf{u}_1=0 $$ 2) Solve diffusion equation with $\nu_i=\nu_i(\phi)$, initial data $\mathbf{u}_1$, boundary conditions and with using, for example, Gauss-Seidel relaxation algorithm $$ \frac{\partial \mathbf {u}_2}{\partial t}-\nu_i \nabla^2 \mathbf{u}_2=0$$ here $$\nu_i(\phi)=\nu_w \phi ^k, k=-0.4029$$ for the air temperature of 20C. 3) Add force to the velocity field from the previous step as follows $$ \mathbf{u}_3=\mathbf{u}_2+\mathbf{f} dt\\ $$ To simulate force acting on the volume of air-water mixture we used approximation $$ f_y=-\frac{(\rho_w-\phi)(\phi-\rho_w/2)(\phi-\rho_a)}{\rho_w^2(\rho_w-\rho_a)Fr^2} $$ 4) Make projection step. Here we can use two models. First model is standard projection (Stam 1999) by solving Poison equation $$ t>0, \nabla^2 q=\nabla . \bf{u}_3\\ \bf{u}_4=\bf{u}_3-\nabla q $$ Note, that this step allows us to define divergent free velocity field. 5) Update velocity field $\bf{u}_4\longrightarrow \bf{u}_5$ with using boundary conditions. 6) Make diffusion step with interface function by solving diffusion equation with initial condition from the previous step, with boundary conditions, and with $\nu=\nu_i(\phi)/Sc$ as follows $$ \frac{\partial \phi_1}{\partial t}-\nu \nabla^2 \phi_1=0 $$ 7) Make advection step by solving advection equation with initial data from step 6 with boundary conditions using an implicit algorithm (from step 1, for example), $$ \frac{\partial \phi_2}{\partial t}+(\bf{u}_5.\nabla) \phi_2=0 $$ 8) Update interface function with boundary conditions. 9) Return to step 1 with updated velocity and interface function. This algorithm can be also used in some different order, for example, in the beginning we can compute step 3 (Stam1999). Also we can make steps 6-8 first, and then compute velocity field with steps 1-5. The question about stability of the stable fluids algorithm not really solved yet. From our experience, we can't do arbitrary time step, but $dt$ is limiting by the grid size as usual for more precise computation. In our computations we have used $dt=2/N$ for $N\times N$ grid. In general case the numerical solution depends on the Froude number $Fr=\frac{U_0}{\sqrt{g L}}$, Reynolds number $Re=\frac{U_0 L}{\nu_w}$, Schmidt number and number of waves in the initial data. In our computations we fixed the Froude number, so that we can put $H=L=1$. We also fixed the Reynolds number, therefore we can put $U_0=1.5, V_0=0.5$. The algorithm 1-9 has been implemented with FDM and compiled to C with using Mathematica 12.3. Code to simulate air/water interface with $Re=10^4, Fr=1$ ---- rhoWater20C = 1.027; nuW20C = 0.01007; rhoAir20C = 0.001204; nuA20C = 0.151;dif = 1/10000; pec = .1; U0 = 1.5; V0 = .5; dn0 = 0.997658; dn1 = 0.514102; kap = 1; n = 81; Fr = 1; F0 = 1; n1 = n + 1; sm = 600; r = 20; den = ConstantArray[dn1 (1 + dn0 Tanh[-kap Range[-n1/2, n1/2]]), n1];u0 = ConstantArray[0, {n1, n1}]; Do[ u0[[i, j]] = U0 (1 + Tanh[kap (j - n1/2)])/2;, {i, n1}, {j, n1}]; v0 = ConstantArray[0., {n1, n1}]; Do[ v0[[i, j]] = V0 Sin[10 Pi (i - 1)/n];, {i, n1}, {j, n1}];periodic[n_, up_, ud_, ub_] := Module[{bd = ub}, Do[bd[[1, i]] = .5 (bd[[n, i]] + bd[[2, i]]); bd[[n + 1, i]] = bd[[1, i]]; bd[[i, 1]] = ud; bd[[i, n + 1]] = up;, {i, 2, n}]; bd[[1, 1]] = .5 (bd[[2, 1]] + bd[[1, 2]]); bd[[n + 1, n + 1]] = .5 (bd[[n, n + 1]] + bd[[n + 1, n]]); bd[[n + 1, 1]] = .5 (bd[[n, 1]] + bd[[n + 1, 2]]); bd[[1, n + 1]] = .5 (bd[[1, n]] + bd[[2, n + 1]]); bd]; diffuse[n_, r_, a_, c_, c0_] := Module[{c1 = c}, Do[Do[Do[ c1[[i, j]] = (c0[[i, j]] + (a/den[[i, j]]^.4029) (c1[[i - 1, j]] + c1[[i + 1, j]] + c1[[i, j - 1]] + c1[[i, j + 1]]))/(1 + 4 a/den[[i, j]]^.4029);, {j, 2, n}];, {i, 2, n}]; Do[c1[[1, i]] = c1[[n, i]]; c1[[n + 1, i]] = c1[[2, i]]; c1[[i, 1]] = c0[[i, 1]]; c1[[i, n + 1]] = c0[[i, n + 1]];, {i, 2, n}]; c1[[1, 1]] = .5 (c1[[2, 1]] + c1[[1, 2]]); c1[[n + 1, n + 1]] = .5 (c1[[n, n + 1]] + c1[[n + 1, n]]); c1[[n + 1, 1]] = .5 (c1[[n, 1]] + c1[[n + 1, 2]]); c1[[1, n + 1]] = .5 (c1[[1, n]] + c1[[2, n + 1]]);, {k, 0, r}]; c1]; advect[n_, d0_, u_, v_, dt_] := Module[{x, y, d1, dt0, i0, i1, j0, j1, s0, s1, t0, t1}, d1 = ConstantArray[0, {n + 1, n + 1}]; dt0 = dt n; Do[Do[x = i - dt0 u[[i, j]]; y = j - dt0 v[[i, j]]; i0 = Which[x <= 1, 1, 1 < x < n, Floor[x], True, n]; i1 = i0 + 1; j0 = Which[y <= 1, 1, 1 < y < n, Floor[y], True, n]; j1 = j0 + 1; s1 = x - i0; s0 = 1 - s1; t1 = y - j0; t0 = 1 - t1; d1[[i, j]] = s0 (t0 d0[[i0, j0]] + t1 d0[[i0, j1]]) + s1 (t0 d0[[i1, j0]] + t1 d0[[i1, j1]]);, {j, 1, n + 1}];, {i, 1, n + 1}]; d1]; project[n_, r_, u0_, v0_, u_, v_] := Module[{ux = u, vy = v, div, p}, p = ConstantArray[0, {n + 1, n + 1}]; div = ConstantArray[0, {n + 1, n + 1}]; ux = ConstantArray[0, {n + 1, n + 1}]; vy = ConstantArray[0, {n + 1, n + 1}]; Do[div[[i, j]] = -.5/ n (u0[[i + 1, j]] - u0[[i - 1, j]] + v0[[i, 1 + j]] - v0[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; Do[Do[Do[ p[[i, j]] = (div[[i, j]] + (p[[i - 1, j]] + p[[i + 1, j]] + p[[i, j - 1]] + p[[i, j + 1]]))/4;, {j, 2, n}], {i, 2, n}];, {k, 0, r}]; Do[ux[[i, j]] = u0[[i, j]] - .5 n (p[[i + 1, j]] - p[[i - 1, j]]); vy[[i, j]] = v0[[i, j]] - .5 n (p[[i, j + 1]] - p[[i, j - 1]]);, {i, 2, n}, {j, 2, n}]; {ux, vy}]; Fx[t_, x_, y_] := 0; Fy[t_, x_, y_] := -1/Fr^2; onestep[n_, step_, r_, a_, uin_, vin_, dt_, c_] := Module[{u1, v1, f1, f2, u, v, u0, v0}, f1 = ConstantArray[0, {n + 1, n + 1}]; f2 = ConstantArray[0., {n + 1, n + 1}]; u0 = ConstantArray[0., {n + 1, n + 1}]; v0 = ConstantArray[0., {n + 1, n + 1}]; u = ConstantArray[0., {n + 1, n + 1}]; v = ConstantArray[0., {n + 1, n + 1}]; u1 = ConstantArray[0., {n + 1, n + 1}]; v1 = ConstantArray[0., {n + 1, n + 1}]; u0 = uin; v0 = vin; Do[ f2[[i, j]] = 1/Fr^2 (den[[i, j]] - rhoWater20C/2) (rhoWater20C - den[[i, j]]) (den[[i, j]] - rhoAir20C)/(rhoWater20C - rhoAir20C)/rhoWater20C^2;, {i, 2, n}, {j, 2, n}]; v0 += f2 dt; u0 = advect[n, u0, u0, v0, dt]; v0 = advect[n, v0, u0, v0, dt]; mnV = 0; u0 = periodic[n, U0, 0, u0]; v0 = periodic[n, mnV, mnV, v0]; u0 = diffuse[n, r, a, c, u0]; v0 = diffuse[n, r, a, c, v0]; u0 = periodic[n, U0, 0, u0]; v0 = periodic[n, mnV, mnV, v0]; {u1, v1} = project[n, r, u0, v0, u, v]; u0 = periodic[n, U0, 0, u1]; v0 = periodic[n, mnV, mnV, v1]; {u0, v0}] cf = With[{cg = Compile`GetElement, hp = HoldPattern, dv = DownValues}, Hold@Compile[{{u0argu, _Real, 2}, {v0argu, _Real, 2}, {denargu, _Real, 2}, {sm, _Integer}, {n, _Integer}, {r, _Integer}, dif, pec, F0}, Module[{u0 = u0argu, v0 = v0argu, uu, vv, dd, den = denargu, c = Table[0., {n + 1}, {n + 1}], dt = 40./n^2, a, dnup = den[[1, n + 1]], dnd = den[[1, 1]]}, a = dt dif n n; uu = vv = dd = Table[0., {sm + 1}, {n + 1}, {n + 1}]; Do[ den = advect[n, den, u0, v0, dt]; den = periodic[n, dnup, dnd, den]; den = diffuse[n, r, a/pec, c, den]; den = periodic[n, dnup, dnd, den]; dd[[step + 1]] = den; {u0, v0} = onestep[n, step, r, a, u0, v0, dt, c]; uu[[step + 1]] = u0; vv[[step + 1]] = v0;, {step, 0, sm}]; {uu, vv, dd}], CompilationTarget -> C, RuntimeOptions -> "Speed"] /. dv@onestep /. Flatten[dv /@ {Fx, Fy, advect, diffuse, periodic, project}] /. hp@ConstantArray[c_, {i_, j_}] :> Table[0., {i}, {j}] /. hp@Part[a__] :> cg[a] /. hp[cg[a__] = rhs_] :> (Part[a] = rhs) // ReleaseHold]; Visualization ------------- rst = cf[u0, v0, den, sm, n, r, dif, pec, F0];Do[lstu[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[1, k, i, j]]}, {i, n1}, {j, n1}], 1]; lstv[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[2, k, i, j]]}, {i, n1}, {j, n1}], 1];, {k, sm}]; Do[Uvel[i] = Interpolation[lstu[i], InterpolationOrder -> 3];, {i, 1, sm}]; Do[Vvel[i] = Interpolation[lstv[i], InterpolationOrder -> 3];, {i, 1, sm}]; Do[lst4[k] = Flatten[Table[{{(i - 1)/n, (j - 1)/n}, rst[[3, k, i, j]]}, {i, n1}, {j, n1}], 1];, {k, sm}]; Do[rh[k] = Interpolation[lst4[k], InterpolationOrder -> 3];, {k, sm}];{ContourPlot[Uvel[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Vvel[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[1 - rh[10][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Uvel[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[Vvel[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 15, ContourStyle -> Yellow, PlotLegends -> Automatic], ContourPlot[1 - rh[sm][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 8, ContourStyle -> Yellow, PlotLegends -> Automatic]} In this Figure are shown velocity components $u_x$ (left), $u_y$ (middle) and 1- density (right) on step 10 (upper line) and on final step $sm=600$ ![Figure 2][4] UPDATE ---------- Next step is to animate wave transformation using interface function. We can show velocity field over density as follows Show[ContourPlot[1 - rh[sm][x, y]/rhoWater20C, {x, 0, 1}, {y, 0, 1}, PlotRange -> All, ColorFunction -> "BlueGreenYellow", Contours -> 8, ContourStyle -> Yellow, Frame -> False, PlotLegends -> Automatic], StreamPlot[{Uvel[sm][x, y], Vvel[sm][x, y]}, {x, 0, 1}, {y, 0, 1}, PlotRange -> All, StreamColorFunction -> None, VectorPoints -> Fine, VectorColorFunction -> Hue, PlotLegends -> Automatic, StreamColorFunctionScaling -> True, StreamStyle -> LightGray]] ![Figure 3][5] We can also compute frames for animation with using interface function frames=Table[ContourPlot[1 - rh[i][x, y], {x, 0, 1}, {y, 0, 1}, ColorFunction -> "BlueGreenYellow", Frame -> False, PlotRange -> All, ImageSize -> Small, MaxRecursion -> 2, Contours -> 8, ContourStyle -> Yellow, PlotLabel -> i], {i, 20, sm, 20}]; Animate[frames] ![Figure 4][6] References ---------- Jos Stam. Stable fluids. In Computer Graphics Proceedings Annual Conference Series, Los Angeles, Aug. 3–8, 199. Jos Stam. Interacting with smoke and fire in real time. Communications of the ACM, 43(7):77–83, July 2000. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=RogueWave.gif&userId=11733 [2]: https://www.researchgate.net/publication/354527324_A_Navier-Stokes_model_for_Rogue_wave_simulation [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure1.jpg&userId=1218692 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure2.jpg&userId=1218692 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Figure3.jpg&userId=1218692 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Fr3v3.AW1300Q5.gif&userId=1218692 Alexander Trounev 2021-11-03T06:49:53Z https://community.wolfram.com/groups/-/m/t/1063480 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/373ccb1d-e97f-40ec-aa0a-0d3001c4728d Mariusz Iwaniuk 2017-04-16T22:38:51Z https://community.wolfram.com/groups/-/m/t/2975371 A Wolfram U Daily Study Group on "Solving ODEs and PDEs" begins on Monday, August 8, 2023. Join me and a cohort of fellow enthusiasts to learn about the techniques for solving ordinary differential equations (ODEs) and partial differential equations (PDEs) using Wolfram Language. Learn how to use the DSolve (for symbolic solutions) and the NDSolve (a general numerical differential equation solver) functions. Topics covered include the numerical method of lines, the finite element method (FEM), the use and construction of meshes, boundary value problems and eigenvalue problems. Participate in live Q&A and review your understanding through interactive in-session polls. Complete quizzes at the end of the study group to get your certificate of program completion. August 7-11, 2023, 11am-12pm CT (4-5pm GMT) > [**REGISTER HERE**][1] Please feel free to use this thread to collaborate and share ideas, materials and links to other resources with fellow learners. I look forward to seeing you online! ![enter image description here][2] [1]: https://www.bigmarker.com/series/daily-study-group-wsg41 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WolframUBanner.jpeg&userId=20103 Luke Titus 2023-07-24T18:32:33Z https://community.wolfram.com/groups/-/m/t/2850347 ![enter image description here][1] **This is a call for univariate indefinite or definite exact integrals that cannot immediately computed in Mathematica and Wolfram Language.** Submitted integrals will be collected for potential new event where they will be discussed and solved. You may refer to our previous event, which is showcased on the Wolfram Community post: https://community.wolfram.com/groups/-/m/t/2821053. Do you have an integral that cannot be computed directly using [ **Integrate** ][2]? Does the following apply to this integral? ## Submission rules DOs - Univariate (terms in a single variable) - Exact (use only symbols, integers, or exact fractions). - Definite integrals ([1][3], [2][4]) - Indefinite Integrals ([1][5], [2][6]) - Keep comments directly related to the topics. ## Submission rules DON'Ts - Don't submit those that Mathematica / Wolfram Language can do directly using Integrate[ ]. - Don't submit numerical integrals (NIntegrate[ ]) - Don't submit decimal approximate numbers in Integrate[ ]. - Don't submit images, only copyable code. > **If you have such an integral - please put it in a comment below!** ## Examples of submission formats **You can add a notebook with your integral:** &[Wolfram Notebook][7] **You can post a formatted code:** Integrate[Gamma[s] z^-s, s] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Integratecall2.png&userId=20103 [2]: https://reference.wolfram.com/language/ref/Integrate.html [3]: https://mathworld.wolfram.com/DefiniteIntegral.html [4]: https://reference.wolfram.com/language/tutorial/Calculus.html#28510 [5]: https://mathworld.wolfram.com/IndefiniteIntegral.html [6]: https://reference.wolfram.com/language/tutorial/Calculus.html#6667 [7]: https://www.wolframcloud.com/obj/5dc8fa8f-22d3-4f02-baa1-38f86e43ab9b Oleg Marichev 2023-03-13T15:01:44Z https://community.wolfram.com/groups/-/m/t/546818 [Crossposting][1] here to get a wider opinion. So, given some data, *Mathematica* 10.2 can now attempt to figure out what probability distribution might have produced it. Cool! But suppose that, instead of having data, we have something that is in some ways better -- a formula. Let's call it $f$. We suspect -- perhaps because $f$ is non-negative over some domain and because the integral of $f$ over that domain is 1 -- that $f$ is actually the PDF of some distribution (Normal, Lognormal, Gamma, Weibull, etc.) or some relatively simple transform of that distribution. Is there any way that *Mathematica* can help figure out the distribution (or simple transform) whose PDF is the same as $f$? Example: Consider the following formula: 1/(2*E^((-m + Log[5])^2/8)*Sqrt[2*Pi]) $$\frac{e^{-\frac{1}{8} (\log (5)-m)^2}}{2 \sqrt{2 \pi }}$$ As it happens -- and as I discovered with some research and guesswork -- this formula is the PDF of `NormalDistribution[Log[5], 2]` evaluated at $m$. But is there a better way than staring or guessing to discover this fact? That is, help me write `FindExactDistribution[f_, params_]`. Notes --- - The motivation for the problem comes from thinking about Conjugate Prior distributions but I suspect it might have a more general application. - One could start with mapping PDF evaluated at $m$ over a variety of continuous distributions. And if I did this I would at some point get to what I will call $g$, which is the PDF or the `NormalDistribution` with parameters $a$ and $b$ evaluated at $m$. 1/(b*E^((-a + m)^2/(2*b^2))*Sqrt[2*Pi]) $$\frac{e^{-\frac{(m-a)^2}{2 b^2}}}{\sqrt{2 \pi } b}$$ But unless I knew that if I replaced $a$ by `Log[5]` and $b$ by $2$ that I would get $f$, this fact would not mean a lot to me. I suppose I could look at the `TreeForm` of $f$ and $g$ and I would notice certain similarities, and that might be a hint, but I am not sure how to make much progress beyond that observation. Ultimately, the problem looks to be about finding substitutions in parts of a tree ($g$) which, after evaluation, yield a tree that matches a target $f$. I have the suspicion that this is a difficult problem with an NKS flavor but one for which *Mathematica* and its ability to transform expressions might be well suited. [1]: http://mathematica.stackexchange.com/q/91408/13 Seth Chandler 2015-08-12T18:27:19Z https://community.wolfram.com/groups/-/m/t/1664846 [GeometricScene][1] and [FindGeometricConjectures][2] are two of my favorite new functions in Wolfram Language V12. V12 provides innovative automated capabilities to draw and reason about abstractly described scenes in the plane. I also remember that I'd proved famous theorems of geometry over many days when I was a junior high school student. I will show nine theorems, including those in the Documentation Center and [WOLFRAM blog][3]. ## Thaless Theorem ## If A, B, and C are distinct points on a circle where the line AC is a diameter, then the angle \[Angle]ABC is a right angle. gs = GeometricScene[{"A", "B", "C", "O"}, {Triangle[{"A", "B", "C"}], CircleThrough[{"A", "B", "C"}, "O"], "O" == Midpoint[{"A", "C"}], Style[Line[{"A", "B"}], Orange], Style[Line[{"B", "C"}], Orange] } ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][4] ![enter image description here][5] ## Napoleons Theorem ## If regular triangles are constructed on the sides of any triangle, either all outward or all inward, the lines connecting the centres of those regular triangles themselves form an regular triangle. gs = GeometricScene[{"C", "B", "A", "C'", "B'", "A'", "Oc", "Ob", "Oa"}, {Triangle[{"C", "B", "A"}], TC == Triangle[{"A", "B", "C'"}], TB == Triangle[{"C", "A", "B'"}], TA == Triangle[{"B", "C", "A'"}], GeometricAssertion[{TC, TB, TA}, "Regular"], "Oc" == TriangleCenter[TC, "Centroid"], "Ob" == TriangleCenter[TB, "Centroid"], "Oa" == TriangleCenter[TA, "Centroid"], Style[Triangle[{"Oc", "Ob", "Oa"}], Orange]} ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][6] ![enter image description here][7] ## Finsler-Hadwiger Theorem ## ABCD and A BB CC DD are two squares with common vertex A. Let Q and S be the midpoints of BB D and DD B respectively, and let R and T be the centers of the two squares. Then the quadrilateral QRST is a square as well. gs = GeometricScene[{"A", "B", "C", "D", "BB", "CC", "DD", "Q", "R", "S", "T"}, {GeometricAssertion[{Polygon[{"A", "B", "C", "D"}], Polygon[{"A", "BB", "CC", "DD"}]}, "Regular", "Counterclockwise"], "Q" == Midpoint[{"BB", "D"}], "R" == Midpoint[{"A", "C"}], "S" == Midpoint[{"B", "DD"}], "T" == Midpoint[{"A", "CC"}], Style[Polygon[{"Q", "R", "S", "T"}], Orange]}]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][8] ![enter image description here][9] ## Echols Theorem ## The midpoints of AD, BE, and CF in two equilateral triangles ABC and DEF form a regular triangle. gs = GeometricScene[{"A", "B", "C", "D", "E", "F", "L", "M", "N"}, {T1 == Triangle[{"A", "B", "C"}], T2 == Triangle[{"D", "E", "F"}], GeometricAssertion[{T1, T2}, "Regular"], "L" == Midpoint[{"A", "D"}], "M" == Midpoint[{"B", "E"}], "N" == Midpoint[{"C", "F"}], Style[Triangle[{"L", "M", "N"}], Orange] } ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][10] ![enter image description here][11] ## Simson Theorem & Steiner Theorem ## Simson's Theorem states that ABC and a point P on its circumcircle, the three closest points to P on lines AB, AC, and BC are collinear. Steiner's Theorem states that if the vertical center of triangle ABC is H, the Simson line passes through the midpoint of PH. gs = GeometricScene[{"A", "B", "C", "P", "L", "M", "N", "H", "S"}, {CircleThrough[{"P", "A", "B", "C"}], "L" \[Element] InfiniteLine[{"B", "C"}], "M" \[Element] InfiniteLine[{"C", "A"}], "N" \[Element] InfiniteLine[{"A", "B"}], PlanarAngle[{"P", "L", "B"}] == 90 \[Degree], PlanarAngle[{"P", "M", "C"}] == 90 \[Degree], PlanarAngle[{"P", "N", "A"}] == 90 \[Degree], Style[InfiniteLine[{"L", "M"}], Orange], GeometricAssertion[{InfiniteLine[{"A", "H"}], Line[{"B", "C"}]}, "Perpendicular"], GeometricAssertion[{InfiniteLine[{"B", "H"}], Line[{"A", "C"}]}, "Perpendicular"], Style[Line[{"P", "H"}], Orange], Line[{"P", "S", "H"}], Line[{"L", "S", "M"}] } ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][12] ![enter image description here][13] ## Aubel Theorem ## Starting with a given quadrilateral (a polygon having four sides), construct a square on each side.The two line segments between the centers of opposite squares are of equal lengths and are at right angles to one another. gs = GeometricScene[{"A", "B", "C", "D", "A'", "A''", "B'", "B''", "C'", "C''", "D'", "D''", "Oa", "Ob", "Oc", "Od"}, {GeometricAssertion[Polygon[{"A", "B", "C", "D"}], "Convex"], GeometricAssertion[{pa = Polygon[{"A", "B", "A'", "A''"}], pb = Polygon[{"B", "C", "B'", "B''"}], pc = Polygon[{"C", "D", "C'", "C''"}], pd = Polygon[{"D", "A", "D'", "D''"}]}, "Regular", "Counterclockwise"], "Oa" == Midpoint[{"A", "A'"}], "Ob" == Midpoint[{"B", "B'"}], "Oc" == Midpoint[{"C", "C'"}], "Od" == Midpoint[{"D", "D'"}], Style[Line[{"Oa", "Oc"}], Orange], Style[Line[{"Ob", "Od"}], Orange]} ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][14] ![enter image description here][15] ## Brahmagupta Theorem ## If a cyclic quadrilateral has perpendicular diagonals, then the perpendicular to a side from the point of intersection of the diagonals always bisects the opposite side. gs = GeometricScene[{"A", "B", "C", "D", "E", "M"}, {Polygon[{"A", "B", "C", "D"}], CircleThrough[{"A", "B", "C", "D"}], GeometricAssertion[{Line[{"A", "C"}], Line[{"B", "D"}]}, "Perpendicular"], Line[{"A", "E", "C"}], Line[{"B", "E", "D"}], "M" == Midpoint[{"A", "B"}], Style[InfiniteLine[{"M", "E"}], Orange], Style[Line[{"C", "D"}], Orange] } ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][16] ![enter image description here][17] ## Morley Theorem ## In any triangle, the three points of intersection of the adjacent angle trisectors form a regular triangle. gs = GeometricScene[{"A", "B", "C", "D", "E", "F"}, {Triangle[{"A", "B", "C"}], PlanarAngle[{"A", "B", "F"}] == PlanarAngle[{"A", "B", "C"}]/3, PlanarAngle[{"F", "A", "B"}] == PlanarAngle[{"C", "A", "B"}]/3, PlanarAngle[{"C", "B", "D"}] == PlanarAngle[{"C", "B", "A"}]/3, PlanarAngle[{"B", "C", "D"}] == PlanarAngle[{"B", "C", "A"}]/3, PlanarAngle[{"A", "C", "E"}] == PlanarAngle[{"A", "C", "B"}]/3, PlanarAngle[{"C", "A", "E"}] == PlanarAngle[{"C", "A", "B"}]/3, "D" \[Element] Triangle[{"A", "B", "C"}], "E" \[Element] Triangle[{"A", "B", "C"}], "F" \[Element] Triangle[{"A", "B", "C"}], Style[Triangle[{"D", "E", "F"}], Orange] } ]; RandomInstance[gs] FindGeometricConjectures[gs]["Conclusions"] ![enter image description here][18] ![enter image description here][19] [1]: https://reference.wolfram.com/language/ref/GeometricScene.html [2]: https://reference.wolfram.com/language/ref/FindGeometricConjectures.html [3]: https://blog.wolfram.com/2019/04/16/version-12-launches-today-big-jump-for-wolfram-language-and-mathematica/ [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=122401.jpg&userId=1013863 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=801502.jpg&userId=1013863 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=508803.jpg&userId=1013863 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=222204.jpg&userId=1013863 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=289105.jpg&userId=1013863 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=932006.jpg&userId=1013863 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=876507.jpg&userId=1013863 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=184108.jpg&userId=1013863 [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=350909.jpg&userId=1013863 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=500710.jpg&userId=1013863 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=318711.jpg&userId=1013863 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=254812.jpg&userId=1013863 [16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=308813.jpg&userId=1013863 [17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=934714.jpg&userId=1013863 [18]: https://community.wolfram.com//c/portal/getImageAttachment?filename=367015.jpg&userId=1013863 [19]: https://community.wolfram.com//c/portal/getImageAttachment?filename=16.jpg&userId=1013863 Kotaro Okazaki 2019-04-20T14:42:58Z https://community.wolfram.com/groups/-/m/t/1056910 There is a simple matrix operation that other scientific computing systems typically have and Mathematica sorely lacks: **Replace the diagonal of a matrix with all zeros.** Or more generally, replace the diagonal with some given values. I am not sure why this is missing from Mathematica. Perhaps it is considered trivial to implement. To show that it isn't, I challenge the readers of this forum to post an implementation which is: - As efficient as possible—it should be fast and not use too much memory - As general as possible—it should work with all sorts of matrices that can be used in Mathematica Think through your submission before you post it. I expect that I will be able to point out problems in the first few submissions. If not, and I am proven wrong, then I will be happy to learn new methods of doing this. *If you agree that this functionality needs to be added to the next version of Mathematica, upvote this post!* Szabolcs Horvát 2017-04-08T12:12:41Z https://community.wolfram.com/groups/-/m/t/3166670 ![ Cover of Wolfram Media book Introduction to Calculus: fundamental concepts and applications with videos and course by Devendra Kapadia ][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1618main.png&userId=20103 [2]: https://www.wolframcloud.com/obj/0a6c30a9-26cc-435a-8dee-a6203560d6cb Devendra Kapadia 2024-04-29T19:58:52Z https://community.wolfram.com/groups/-/m/t/415820 Very nice palindromic binary year for everybody! IntegerDigits[2015, 2] `{1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1}` Jose Martin-Garcia 2015-01-02T23:57:16Z https://community.wolfram.com/groups/-/m/t/2961701 [![enter image description here][1]][2] &[Wolfram Notebook][3] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=43t45h545qerfgvfdsfh.jpg&userId=11733 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=43t45h545qerfgvfdsfh.jpg&userId=11733 [3]: https://www.wolframcloud.com/obj/ec0d857e-09b2-4862-87b8-0d0c23869f69 Vitaliy Kaurov 2023-07-13T17:19:37Z https://community.wolfram.com/groups/-/m/t/966115 ![Envelopes of conic sections][1] **Move Along** Consider a circle of latitude at height $z=-3/4$ on the unit sphere. The orthogonal complements of unit vectors on the circle are planes through the origin in $\mathbb{R}^3$, which we can also interpret as lines in $\mathbb{RP}^2$, the real projective plane. In order to visualize these lines, take the intersection of the planes with the plane $z=1$. These lines will form the envelope of a circle in the $z=1$ plane. Now, as we rotate the unit sphere around the $y$-axis, the lines in the $z=1$ plane will form the envelopes of a family of conics. What the animation actually shows are the points of intersections of the lines corresponding to 50 equally-spaced points on this rotating circle on the unit sphere. Here's the code: DynamicModule[{m, p, a, \[Theta] = 0., t = \[Pi]/1., r = -0.75, lines, linepairs, dots, cols = RGBColor /@ {"#E84A5F", "#2A363B"}}, Manipulate[ m = RotationMatrix[t, {Cos[\[Theta]] Sin[\[Phi]], Sin[\[Theta]] Sin[\[Phi]], Cos[\[Phi]]}]; p[s_] = m.{Sqrt[1 - r^2] Cos[s], Sqrt[1 - r^2] Sin[s], r}; a = m.{0, 0, 1}; lines = Table[InfiniteLine[{{-p[s][[3]]/p[s][[1]], 0}, {0, -p[s][[3]]/p[s][[2]]}}], {s, 0, 2 \[Pi] - 2 \[Pi]/50, 2 \[Pi]/50}]; linepairs = Subsets[lines, {2}]; dots = DeleteCases[RegionIntersection @@ # & /@ linepairs, EmptyRegion[2]]; Graphics[{White, PointSize[.005], cols[[1]], dots}, ImageSize -> 540, Frame -> False, Background -> cols[[-1]], PlotRange -> 5], {\[Phi], 0., \[Pi]/2}] ] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=lines26r2.gif&userId=610054 Clayton Shonkwiler 2016-11-19T05:47:40Z https://community.wolfram.com/groups/-/m/t/1718762 ####*Please download the notebook at the end of the discussion including dynamic feature*#### ---------- ![simulation][1] July 4th is a fabulous holiday season for American families to enjoy the summer with road trip and BBQ party. You can use a deck of poker to entertain your kids and family friends with [James Grime's][2] new card trick on [Numberphile][3]. ##Background## You are given $10$ cards, from Ace to 10. Shuffle them and split them into $2$ rows with five cards in each. Sort one row in ascending order, the other in descending order. Both orders are oriented from left to right. Calculate the absolute values of the difference between two rows and add them up. You can play the poker game multiple times and you will find the sum is always $25$. If you do not have poker at hand, please take a look at the animation above. ##Code## Let's work on the problem with Mathematica to help us understand. In the code I use the icons from this website: $icon="https://www.iconfinder.com/icons/1331558/card_game_diamond_gambling_game_jewelry_poker_sport_icon"; then I directly assign them to `spade` and `diamond` in a notebook: ![spadediamond][4] Use `Framed` to create a nice and simple poker card: cardpicture1[{suit_, val_}] := Framed[Column[{val, suit}, Center, 0, ItemSize -> {6, 2}, ItemStyle -> Directive[24, "Label", Bold]], RoundingRadius -> 8] ![poker][5] Use `Map` to create a list of poker cards: n=10; numbers = Range[n]; pokers1 = AssociationMap[cardpicture1[{spade, #}] &, numbers]; differences = AssociationMap[cardpicture1[{diamond, #}] &, numbers]; Now lets shuffle the deck of 10 cards: shuffle=Permute[numbers,RandomPermutation[10]] (* {3,6,7,5,9,10,8,4,1,2} *) I use this generic permutation method because you can replace `numbers` with other list like 10 prime numbers. Then split it into two rows {row1,row2}={#[[1;;n/2]],#[[n/2+1;;]]}&[shuffle] (* {{3,6,7,5,9},{10,8,4,1,2}} *) Style[Grid[Map[pokers1, {row1, row2}, {2}]], ImageSizeMultipliers -> {1, 1}] ![deck][6] The last two steps are to sort two rows and find the sum of the absolute values of the pairwise differences between the two rows. I use `Grid` an `Style` to make the output neat. With[{r1=Sort@row1,r2=Sort[row2,Greater]}, Module[{sum},sum=Inactive[Plus]@@Abs[r2-r1]; Style[Grid[{ pokers1/@r1, pokers1/@r2, (differences/@Abs[r2-r1]), {Null,SpanFromLeft}, {Style[Row@{sum," = ",Activate[sum]},Large,Italic],SpanFromLeft}}], ImageSizeMultipliers->{1, 1}] ] ] ![sorteddeck][7] ##Proof## You might already notice I have variables like `pokers1` and `cardpicture1` in the code above. I am definitely hiding from something from you. The companion pokers I have, namely `pokers2`, is a deck of super power cards of which the styles get updated given the face value greater than $5$: pokers2 = AssociationMap[cardpicture2[{spade, #}] &, numbers]; where cardpicture2[{suit_, val_}] := Framed[Column[{val, suit}, Center, 0, ItemSize -> {6, 2}, ItemStyle -> Directive[24, "Label", Bold]], FrameStyle -> Directive[If[val > 5, Dashed, Black]], RoundingRadius -> 8] Once we use the super power card, we can see a pattern matches exactly what James claimed in the Numberphile video (using contradiction of stacking dashed/purple numbered card): ![hint][8] Lets take look at one frame: ![direction][9] The third diamond line is from the following flipping transition (dash-solid or purple-black) ![transition][10] $ 25 = 7 + 3 + 2 + 5 + 8$ $ = (10 - 3) + (8 - 5 ) + (6 - 4 )+ (7 - 2 ) + (9 - 1) $ $= (10 + 9 + 8 + 7 + 6) -(1 + 2 + 3 + 4 + 5)$ The sorted rows tells you that all dashed card must sit together. Same happens to the solid line cards. Therefore there is exactly one transition from solid -> dash or dash -> solid in each row. If dashed cards overlapping vertically means we either have at least 6 such cards or one row is not properly sorted. This is contradiction. ##Comment## There are nice functions used here - Use `Inactive[Plus]@@{...}` and then to active the sum expression with `Activate[]`: prints nice hold sum formula and delayed evaluation - `AssociationMap` to create key-poker face dictionary - Animation is generated by [Refresh][11]. Attached at the end of the thread. - Poker design code is from [this demonstration][12] Code snippet just for the calculation (minimum visualization): n = 12; {row1, row2} = {#[[1 ;; n/2]], #[[n/2 + 1 ;;]]} &[Permute[Range[n], RandomPermutation[n]]] f[m_] := If[m > n/2, Framed[m], m] {Grid[{row1,row2}],Sequence@@With[{r1=Sort@row1,r2=Reverse@Sort@row2},{Grid[Map[f,{r1,r2},{2}]],Abs[r1-r2]//Total}]} ![shortcode][13] Formula: Sum[k, {k, 2*m}] - 2*Sum[k, {k, m}] // Simplify (* m^2 *) [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=simulation.gif&userId=23928 [2]: http://bit.ly/grimevideos [3]: https://www.youtube.com/watch?v=_Wv_qw3nQnI [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=input.png&userId=23928 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=input2.png&userId=23928 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=usdeck.png&userId=23928 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=sdeck.png&userId=23928 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=simulation_hint.gif&userId=23928 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=labeld2.png&userId=23928 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=labeld3.png&userId=23928 [11]: https://reference.wolfram.com/language/ref/Refresh.html#Examples [12]: http://demonstrations.wolfram.com/Poker/ [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=quick.png&userId=23928 Shenghui Yang 2019-07-03T18:35:12Z https://community.wolfram.com/groups/-/m/t/1032663 Teaching programing and assessing learning progress is often a very custom task. I wanted to create a completely automated "practically" infinite stream of random puzzles that guide a leaner towards improving programing skills. I think the major problem is content creation. To test whether the learner knows a programming concept, an exercise needs to be wisely designed. And it is better to have a randomized set of such exercises to definitely test the knowledge and exclude guesses and cheating and so on. Often creating such educational materials is very tedious, time consuming, and manual. Exactly like creating good documentation. I will explain one simple idea of using docs to make an educational game. This is just a barebone prototype to clearly follow the inner workings (try it out & share: https://wolfr.am/bughunter ). Please comment with feedback on how we can develop this idea further. [![enter image description here][1]][3] # Introduction: efficient use of resources The docs are the finest wealth and depth of information and should be explored beyond their regular usage. Manual painstaking time consuming effort of creating good programing documentation should be used to its fullest potential. An automated game play would be a novel take on docs. We can use existing code examples in docs to randomly pull pieces of code and make programing exercises automatically. Being able to read code and find bugs is, in my experience, one of the most enlightening practices. The goal of the linked above game is to find a defect of the input code (bug) and fix it. Hence, the "bug hunter". There are just 2 possible outcomes of a single game cycle, --- and after each you can "try again": ![enter image description here][4] # Core game code: making puzzles Wolfram Language (WL) documentation is one of the best I've seen. It has pages and pages of examples starting from simple ones and going though the all details of the usage. Moreover the docs are written in WL itself and furthermore, WL can access docs and even has internal self-knowledge of its structure via WolframLanguageData. For instance, this is how you can show a relationship community graph for symbols related to `GatherBy`: WolframLanguageData["GatherBy", "RelationshipCommunityGraph"] ![enter image description here][5] We can use `WolframLanguageData` to access docs examples and then drop some parts of the code. The puzzle is then for the learner to find what is missing. For the sake of clarity designing a small working prototype lets limit test WL functions and corresponding docs' pages to some small number. So out of ~5000 (and we [just released a new addition][6]): WolframLanguageData[] // Length `4838` built in symbols I just take 30 functions = {"Append", "Apply", "Array", "Cases", "Delete", "DeleteCases", "Drop", "Except", "Flatten", "FlattenAt", "Fold", "Inner", "Insert", "Join", "ListConvolve", "Map", "MapThread", "Nest", "Outer", "Partition", "Prepend", "ReplacePart", "Reverse", "RotateLeft", "RotateRight", "Select", "Sort", "Split", "Thread", "Transpose"}; functions // Length 30 that are listed on a [very old but neat animated page][7] of some essential core-language collection. I will also add some "sugar syntax" to potential removable parts of code: sugar = {"@@", "@", "/@", "@@@", "#", "^", "&"}; So, for instance, out of the following [example in docs][8] we could remove a small part to make a puzzle: ![enter image description here][9] Here is an example of "sugar syntax" removal, which for novice programmers would be harder to solve: ![enter image description here][10] Next step is to define a function that can check if a string is a built-in symbol (function, all 5000) or if it is some of sugar syntax we defined above: ClearAll[ExampleHeads]; ExampleHeads[e_]:= Select[ Cases[e,_String, Infinity], (NameQ["System`"<>#]||MemberQ[sugar,#])&&#=!="Input"& ] Next function essentially makes a single quiz question. First it randomly picks a function from list of 30 symbols we defined. Then it goes to the doc page of that symbol to the section called "Basic Examples". It finds a random example and removes a random part out of it: ranquiz[]:=Module[ {ranfun=RandomChoice[functions],ranexa,ranhead}, ranexa=RandomChoice[WolframLanguageData[ranfun,"DocumentationBasicExamples"]][[-2;;-1]]; ranhead=RandomChoice[ExampleHeads[ranexa[[1]]]]; { ReplacePart[#,Position[#,ranhead]->""]&@ranexa[[1]], ranexa[[2]], ranhead, ranfun } ] Now we will define a few simple variables and tools. # Image variables I keep marveling how convenient it is that Mathematica front end can make images to be part of code. This makes notebooks a great IDE: ![enter image description here][11] # Databin for tracking stats It is important to have statistics of your learning game: to understand how to improve it where the education process should go. [Wolfram Datadrop][12] is an amazing tool for these purposes. [![enter image description here][13]][14] We define the databin as bin = CreateDatabin[<|"Name" -> "BugHunter"|>] # Deploy game to the web To make an actual application usable by everyone with internet access I will use [Wolfram Development Platform][15] and [Wolfram Cloud][16]. First I define a function that will build the "result of the game" web page. It will check is answer is wrong or right and give differently designed pages accordingly. quiz[answer_String,check_String,fun_String]:= ( DatabinAdd[Databin["kd3hO19q"],{answer,check,fun}]; Grid[{ {If[answer===check, Grid[{{Style["Right! You got the bug!",40,Darker@Red,FontFamily->"Chalkduster"]},{First[imgs]}}], Grid[{{Style["Wrong! The bug got you!",40,Darker@Red,FontFamily->"Chalkduster"]},{Last[imgs]}}] ]}, {Row[ {Hyperlink["Try again","https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter"], "|", hyperlink["Documentation","http://reference.wolfram.com/language/ref/"<>fun<>".html"], "|", hyperlink["Fun hint","http://reference.wolfram.com/legacy/flash/animations/"<>fun<>".html"]}, Spacer[10] ]}, {Style["===================================================="]}, {hyperlink["An Elementary Introduction to the Wolfram Language","https://www.wolfram.com/language/elementary-introduction"]}, {hyperlink["Fast introduction for programmers","http://www.wolfram.com/language/fast-introduction-for-programmers/en"]}, {logo} }] ) This function is used inside `CloudDeploy[...FormFunction[...]...]` construct to actually deploy the application. `FormFunction` builds a query form, a web user interface to formulate a question and to get user's answer. Note for random variables to function properly `Delayed` is used as a wrapper for `FormFunction`. CloudDeploy[Delayed[ quizloc=ranquiz[]; FormFunction[ {{"code",None} -> "String", {"x",None}-><| "Input"->StringRiffle[quizloc[[3;;4]],","], "Interpreter"->DelimitedSequence["String"], "Control"->Function[Annotation[InputField[##],{"class"->"sr-only"},"HTMLAttrs"]]|>}, quiz[#code,#x[[1]],#x[[2]]]&, AppearanceRules-> <| "Title" -> Grid[{{title}},Alignment->Center], "MetaTitle"->"BUG HUNTER", "Description"-> Grid[{ {Style["Type the missing part of input code",15, Darker@Red,FontFamily->"Ayuthaya"]}, {Rasterize@Grid[{ {"In[1]:=",quizloc[[1]]}, {"Out[1]=",quizloc[[2]]}},Alignment->Left]} }] |>]], "bughunter", Permissions->"Public" ] The result of the deployment is a cloud object at a URL: CloudObject[https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter] with the short version: URLShorten["https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter", "bughunter"] https://wolfr.am/bughunter And we are done! You can go at the above URL and play. # Further thoughts Here are some key points and further thoughts. ## Advantages: - Automation of content: NO new manual resource development, use existing code bases. - Automation of testing: NO manual labor of grading. - Quality of testing: NO multiple choice, NO guessing. - Quality of grading: almost 100% exact detection of mistakes and correct solutions. - Fight cheating: clear to identify question type "find missing code part" helps to ban help from friendly forums (such as this one). - Almost infinite variability of examples if whole docs system is engaged. - High range from very easy to very hard examples (exclusion of multiple functions and syntax can make this really hard). ## Improvements: - Flexible scoring system based on function usage frequencies. - Optional placeholder as hint where the code is missing. - Using network of related functions (see above) to move smoothly through the topical domains. - Using functions frequency to feed easier or harder exercises based on test progress. ***Please comment with your own thoughts and games and code!*** [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-17at10.37.46AM.png&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at6.49.58PM.png&userId=11733 [3]: https://www.wolframcloud.com/objects/user-3c5d3268-040e-45d5-8ac1-25476e7870da/bughunter [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at6.58.45PM.png&userId=11733 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sgfq354ythwrgsf.png&userId=11733 [6]: http://blog.wolfram.com/2017/03/16/the-rd-pipeline-continues-launching-version-11-1/ [7]: http://reference.wolfram.com/legacy/flash/ [8]: http://reference.wolfram.com/language/ref/Except.html [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.21.05PM.png&userId=11733 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.25.52PM.png&userId=11733 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.34.59PM.png&userId=11733 [12]: https://datadrop.wolframcloud.com/ [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-03-16at7.41.35PM.png&userId=11733 [14]: https://datadrop.wolframcloud.com/ [15]: https://www.wolfram.com/development-platform/ [16]: http://www.wolfram.com/cloud/ Vitaliy Kaurov 2017-03-17T01:13:24Z https://community.wolfram.com/groups/-/m/t/2261402 [![An introduction to computational origami][1]][2] &[Wolfram Notebook][3] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2609Image20210506191938.png&userId=20103 [2]: https://doi.org/10.1007/978-3-319-59189-6 [3]: https://www.wolframcloud.com/obj/6c662c7b-30c4-4b47-8b41-4d4c079cea79 Tetsuo Ida 2021-05-06T17:25:34Z https://community.wolfram.com/groups/-/m/t/2071183 **Intro** I am helping a friend gather the same data points from a large number of web pages that have the same structure, but inconsistent HTML syntax. So, I thought Wolfram's pattern matching capabilities would make this easy. And it has, to a certain extent. I have a solution now, but I would like to know if there is a better way. I would appreciate any constructive criticism you might have. **Challenge** Pull a handful of field labels from over a thousand HTML pages. For testing purposes, here are a few of the variations that appear in the files: html = " <input type=\"radio\" id=\"field_1\" name=\"choices\" value=\"1\"> <label for=\"field_1\">Field 1</label> <input type=\"radio\" id=\"field_2\" name=\"choices\" value=\"2\"> <label for=\"field_2\">Field 2</label> <input type=\"radio\" id=\"field_3\" name=\"choices\" value=\"3\"> <label for =\"field_3\">Field 3</label> <input type=\"radio\" id=\"field_4\" name=\"choices\" value=\"4\"> <label for='field_4'>Field 4</label> <input type=\"radio\" id=\"field_5\" name=\"choices\" value=\"5\"> <label for='field_5'>Field 5</label> <input type=\"radio\" id=\"field_6\" name=\"choices\" value=\"6\"> <label for ='field_6'>Field 6</label> <input type=\"radio\" id=\"field_7\" name=\"choices\" value=\"7\"> <label for=field_7>Field 7</label> <input type=\"radio\" id=\"field_8\" name=\"choices\" value=\"8\"> <label for=field_8>Field 8</label> <input type=\"radio\" id=\"field_8\" name=\"choices\" value=\"9\"> <label for =field_9>Field 9</label> "; **Solution** Our first challenge is attribute names (keys) might be single quoted, double quoted or not quoted at all. To handle this let's create a pattern for HTML quotes: htmlQuoteCharacterPattern = "\"" | "'"; Next, we know that while our attribute names must always be followed by a space or equals. So, we need another pattern. This time we use a look ahead regular expression: htmlEndOfAttributeKeyPattern = RegularExpression["(?=(>|\\s|=))"]; And, we now that attribute values end with either whitespace or a >. Again we use a look ahead regular expression: htmlEndOfAttributeValuePattern = RegularExpression["(?=(>|\\s))"]; Now we we have almost everything we need to create patterns for attribute keys. But, to future-proof our solution, I want to create a pattern for the attribute key that allows me to specify either a string or a pattern for the key name: htmlQuotedAttributeKeyPattern[pattern_?matchStringPatternQ] := StringExpression[ WhitespaceCharacter ..., htmlQuoteCharacterPattern, pattern, htmlQuoteCharacterPattern, htmlEndOfAttributeKeyPattern ]; htmlUnquotedAttributeKeyPattern[pattern_?matchStringPatternQ] := StringExpression[ WhitespaceCharacter ..., pattern, htmlEndOfAttributeKeyPattern ]; htmlAttributeKeyPattern[pattern_?matchStringPatternQ] := (htmlQuotedAttributeKeyPattern[pattern] | htmlUnquotedAttributeKeyPattern[pattern]); As you can see, we now have functions that take either a String or a String expression. So, let's create that pattern: matchStringPatternQ = MatchQ[#, _String | _StringExpression] &; **Testing the Solution** We can now test our solution against the data above: StringCases[ html, "<label" ~~ htmlAttributeKeyValuePattern["for", "field_" ~~ DigitCharacter] ~~ ">" ~~ s : Except["<"] .. :> s ] returns, as expected: {"Field 1", "Field 2", "Field 3", "Field 4", "Field 5", "Field 6", "Field 7", "Field 8", "Field 9"} And, StringCases[ html, "<label" ~~ htmlAttributeKeyValuePattern["for", "field_5"] ~~ ">" ~~ s : Except["<"] .. :> s ] returns, as expected: {"Field 5"} **Conclusion** I am mostly happy with the above solution, but I know I will need to continue to extend it. While I will not have to handle every type of HTML, I do need a robust way to surgically extract interesting pieces of information. Before I spend too much additional time extending this solution, I would like to know if I'm on the a good track. I would also like to know if this is something that others have to do often as well? Would it be worth polishing this to the point that they can be published in the Resource Function Repository? Thanks for reading. Feedback on this approach will be greatly appreciated. Have a great and safe week. Mike Besso 2020-09-05T15:51:14Z https://community.wolfram.com/groups/-/m/t/215591 Recently we had a question about [url=http://community.wolfram.com/groups/-/m/t/214433]Sorting synonyms[/url]. That was needed to shorten a phrase - in order to fit in 140 characters of a tweet. Here is a stab at a more general problem of automation of text shortening. So what is more suitable for a Sunday evening than linguistic optimization in search of the global minimum of a text length? I first will show you the result and then explain how it works. Of course it is not perfect, but requires just a few manual adjustments. It all depends on shortening rules and they can be made more sophisticated to perfect automation. So here are a few examples: A poem by classic Chinese poet, musician and painter Wang Wei who lived in 8th century. What is cool is that poetry translations can be quite arbitrary and you can consider this to be Wolfram Language meditations on translation of classic Chinese ;-)[mcode]text = "All alone in a foreign land, I am twice as homesick on this day, when brothers carry dogwood up the mountain, each of them a branch and my branch missing."; text // StringLength Out[]= 154[/mcode] Shorten it:[mcode]RePhrase[text, ss, 5][/mcode][quote]"all solo in a alien land, i am twice as homesick on this day, when pal carry cornel up the wad, each of them a branch and my branch missing."[/quote][mcode]In[]= % // StringLength Out[]= 140[/mcode] A quote by Einstein:[mcode]text = "The language of mathematics is even more inborn and universal than the language of music; a mathematical formula is crystal clear and independent of all sense organs."; text // StringLength Out[] = 166[/mcode] Shorten it:[mcode]RePhrase[text, ss, 5][/mcode][quote]the words of math is even more innate and general than the words of music; a numerical rule is quartz clear and main of all sense organs.[/quote][mcode]In[]= % // StringLength Out[]= 137[/mcode] A tweet based on [url=http://www.britannica.com/EBchecked/topic/458757/physics]Encyclopedia Britannica[/url] definition of physics:[mcode]text = "I want to learn physics, a science that deals with the structure of matter and the interactions between the fundamental constituents of the observable universe!"; text // StringLength Out[] = 160[/mcode] Shorten it:[mcode]RePhrase[text, ss, 5][/mcode][quote]i want to learn physics, a skill that deals with the structure of matter and the interaction 'tween the key part of the evident world![/quote][mcode]In[]= % // StringLength Out[]= 134[/mcode] Of course, as I said, a few corrections needed that can be easily done manually – but we did save a lot of space – even for hash-tags ;-) Now, how it works. First of all we would need a set of characters based on which we will split a string into separate words, which later will be replaced by short synonyms. These characters are easy to get – I also added to them black space.[mcode]ss = Complement[#, Cases[#, _?LetterQ]] &@CharacterRange["!", "~"]~Join~{" "} Out[]= {"!", "@", "#", "%", "^", "&", "*", "(", ")", "_", "-", "+", "=", "~", "`", "{", "[", "}", "]", "|", "\\", "<", ">", ".", ",", ";", "\"", "?", "'", "/", ":", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "$", " "}[/mcode] A better way to do this - as advised by Michael in the comments:[mcode]ss = Select[CharacterRange[" ", "~"], ! LetterQ@# &]~Join~{" "}[/mcode] Let me know if you have other ideas how to get special character list. Now we define a function that returns a sorted by string length list of synonyms for a given word based on a few rules. Specifically, synonyms are returned only if (otherwise the original word itself is returned) [list] [*]Word is longer than n (say 5) characters [*]Word is not ending on –ing – those are easy to confuse with a different part of speech – verb versus adjective [*]Word is not a verb – those have too many special forms [*]Word generally has at least one synonym [/list][mcode]SynSort[w_, n_] := Sort[ With[ {r = WordData[w, "Synonyms", "List"]}, If[StringLength[w] < n || StringTake[w, {-3, -1}] == "ing" || MemberQ[WordData[w, "PartsOfSpeech"], "Verb"] || r == {} || Head[r] == WordData, {w}, {w}~Join~r, {w}~Join~r] ] , StringLength[#1] < StringLength[#2] &][/mcode] Built-in knowledge of WordData was used to find synonyms and assess grammatical properties of words. Define a function that actually replaces longer words with shorter synonyms. We need to go ToLowerCase – capitalized WL strings do not have synonyms. Also note Thread[ss -> ss] option to StringSplit that allows to keep original punctuation. [mcode]RePhrase[txt_, ss_, n_] := StringJoin[First[SynSort[#, n]] & /@ StringSplit[ToLowerCase@txt, Thread[ss -> ss]]][/mcode] And that’s it! Do not forget that to tweet you do not even have to leave – just [url=http://community.wolfram.com/groups/-/m/t/157716]use this[/url] on Raspberry Pi:[mcode]SendMessage["Twitter", "...TEXT..."][/mcode] One thing to remember that some nice short synonyms can be reached only in a few steps of synonym network. We did not use it here but it could improve things. For example “faux” is not a direct synonym of "fictitious" but a cousin.  [mcode]WordData["fictitious", "Synonyms", "List"] Out[]= {"assumed", "fabricated", "false", "fancied", "fictional", "fictive", "pretended", "put on", "sham"} Graph[Union[Sort /@ Flatten[Rest[NestList[Union[Flatten[Thread[# <-> WordData[#, "Synonyms", "List"]] & /@ Last /@ #]] &, {"" <-> "fictitious"}, 2]]]], VertexLabels -> Placed["Name", Below], VertexStyle -> {Opacity[.5], "fictitious" -> Red, "faux" -> Green}, BaseStyle -> EdgeForm[], EdgeStyle -> Opacity[.5], VertexSize -> {"fictitious" -> {"Scaled", .03}, "faux" -> {"Scaled", .03}}][/mcode] [img]/c/portal/getImageAttachment?filename=dsf3445trgb45wtrgbf.png&userId=11733[/img] Notebook is attached for convenience.  Vitaliy Kaurov 2014-03-10T02:53:33Z https://community.wolfram.com/groups/-/m/t/1187128 [Code Golf][1] is a fun coding competition with participants aiming for the shortest possible code that implements an algorithm. But please feel free to post ANY code that solves the problem - just to have fun! ---------- **GOAL: write compact Wolfram Language (WL) code that generates TeX code given below to render fractal known as Sierpinski Triangle.** ---------- I've recently seen a tremendously lengthy TeX code that produced a nicely rendered [Sierpinski triangle][2] posted by [@Szabolcs Horvát][at0] on social media. Because Wolfram Community has built-in MathML plugin (based on LaTeX ) we can see result right here! $${{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}^{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}_{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}}^{{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}^{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}_{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}}_{{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}^{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}_{{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}^{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}_{{{x}^{x}_{x}}^{{x}^{x}_{x}}_{{x}^{x}_{x}}}}}$$ with the TeX code being: ![enter image description here][3] # Update: BTW see a similar discussion [**here**][4]. [at0]: http://community.wolfram.com/web/szhorvat [1]: https://en.wikipedia.org/wiki/Code_golf [2]: http://mathworld.wolfram.com/SierpinskiSieve.html [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-09-18at5.14.33PM.png&userId=11733 [4]: https://codegolf.stackexchange.com/q/138245/4997 Vitaliy Kaurov 2017-09-18T21:58:05Z https://community.wolfram.com/groups/-/m/t/980264 *NOTE: package and examples notebooks are attached at the end of this post* ---------- If you square a surd, and then take the square root, you just get it back. But how do you take the ? if you expand it after you square it? ![enter image description here][1] Sometimes FullSimplify is smart enough: ![enter image description here][2] Usually, it isn’t: ![enter image description here][3] ![enter image description here][4] Corey Ziegler Hunts wrote a big heuristic package to **denest** radicals: ![enter image description here][5] (Why “Strad”?) But usually radicals don’t **denest**: ![enter image description here][6] When they do, the result can be startling: ![enter image description here][7] Can this be right? ![enter image description here][8] Yep. Hopefully this will be obsoleted by Mathematica's developers. But maybe not. I confess near total ignorance of Galois theory, which underlies all the **denesting** papers. But those papers never exhibit any cool new **denestings**! SAGE and Maple are rumored to **denest**, but again, where are goodies like ![enter image description here][9] There are some issues. If there is no **denesting**, it can take infeasibly long to give up. And it doesn't listify. It misconstrues lists. Illustrating the widespread underuse of denesting, [Theta Function](https://en.wikipedia.org/wiki/Theta_function) gives: ![enter image description here][10] ![enter image description here][11] Tsk. ![enter image description here][12] Is it possible for the nth root of a real binomial to denest to more than five terms? I've never seen one. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.02.59AM.png&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.05.03AM.png&userId=11733 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.11.57AM.png&userId=11733 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.13.18AM.png&userId=11733 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.15.04AM.png&userId=11733 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.18.09AM.png&userId=11733 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.21.46AM.png&userId=11733 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.23.18AM.png&userId=11733 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at11.30.09AM.png&userId=11733 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at3.28.43PM.png&userId=11733 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at3.32.31PM.png&userId=11733 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2016-12-13at3.35.03PM.png&userId=11733 Bill Gosper 2016-12-13T17:39:45Z https://community.wolfram.com/groups/-/m/t/2726860 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/d0094aa1-c4bc-47eb-b693-6f30a4f26f3c Hanfeng Zhai 2022-12-12T15:08:24Z https://community.wolfram.com/groups/-/m/t/2406638 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/3f8cce09-cf45-450e-a27f-41eab038dac5 [Original NB]: https://www.wolframcloud.com/obj/177f4cd5-e401-4b1f-84ba-905244d26dae Maher Kuzbari 2021-11-14T12:38:52Z