https://community.wolfram.com RSS Feed for Wolfram Community showing questions tagged with Wolfram Science sorted by most likes. https://community.wolfram.com/groups/-/m/t/121507 [b]With 5 point-source lights in a square room, what is the optimal configuration for even lighting?[/b] To make this question concrete, say that each wall has length 1, the room has no height (i.e., two dimensional) and we have five identical lights that are pointsized and want to know the optimal placement that maximizes even lighting.  That could mean [mcode]f = 1/((x - x1)^2 + (y - y1)^2) + 1/((x - x2)^2 + (y - y2)^2) + 1/((x - x3)^2 + (y - y3)^2) + 1/((x - x4)^2 + (y - y4)^2) + 1/((x - x5)^2 + (y - y5)^2);[/mcode] a) maximizing the value of the minimal illumination [mcode]Minimize[f, {x,0,1},{y,0,1}][/mcode]or an integral measure like b) maximizing the total illumination where the brightest areas are considered as being some default value, e.g., the value of [mcode]Integrate[Min[f, f0], {x,0,1},{y,0,1}][/mcode] For an example configuration of light sources with [mcode]f = With[{n = 5}, Sum[1/((x - (.5 + .45 Cos[2 Pi i/n]))^2 + (y - (.5 + .45 Sin[2 Pi i/n]))^2), {i, 0, n - 1}]] [/mcode]and then here is the minimum illumination [mcode]NMinimize[{f, 0 <= x <= 1 && 0 <= y <= 1}, {x, y}] (*{14.349, {x -> 1., y -> 1.}}*) [/mcode]and here that point is shown on a contour plot [img=width: 360px; height: 359px;]/c/portal/getImageAttachment?filename=lights5.jpg&userId=23275[/img] For that configuration here is the integral (which I had to approximate with a Sum) [mcode]Sum[Min[1.2 (14.349), f], {x, 0.0001, 1, .01}, {y, 0.0001, 1, .01}]/10^4 (*17.2146*) [/mcode]I'd be interested in optimization approaches, but also aesthetic approaches, e.g., symmetries, angles, shadows, or patterns made by contour lines. To generalize, not only other numbers of lights, but try tacking on albedo of 50% so the wall reflect half of the light they receive. Todd Rowland 2013-09-10T16:45:23Z https://community.wolfram.com/groups/-/m/t/587818 I would like to measure how complex various networks are. There are certainly many approaches, but I am interested in what we can do with tools available in the Wolfram Language. There are many discussions in the [New Kind of Science][1] book about networks. But since its publication Wolfram Language evolved significantly. Imagine we have something more general, like a mixed multi-edge graph: network[v_, e_] := Graph[RandomInteger[{1, v}, {e, 2}] /. {x_Integer, y_Integer} :> RandomChoice[{DirectedEdge[x, y], UndirectedEdge[x, y]}]] SeedRandom[131]; g = network[20, 60] ![enter image description here][2] Symmetries should affect complexity, and some general measure should detect that in, say, pure trees or symmetric and/or planar graphs: TreeGraph[RandomInteger[#] <-> # + 1 & /@ Range[0, 100], GraphLayout -> "RadialDrawing"] ![enter image description here][3] GraphData["IcosahedralGraph"] ![enter image description here][4] **Does anyone know or have any ideas for some complexity measure that we can quickly compute with Wolfram Language?** Perhaps [@Hector Zenil][at0], [@Todd Rowland][at1] or [@Marco Thiel][at2] could point to the right direction. Maybe there were some [Wolfram Science Summer School][5] projects about this. [at0]: http://community.wolfram.com/web/hectorz [at1]: http://community.wolfram.com/web/rowland [at2]: http://community.wolfram.com/web/mthiel [1]: https://www.wolframscience.com/nksonline/toc.html [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=q34t5wrhgsfdas.png&userId=11733 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ertq354thrwgdsf.png&userId=11733 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3q4t5htrwgdfavsdc.svg&userId=11733 [5]: https://www.wolframscience.com/summerschool Vitaliy Kaurov 2015-10-21T22:10:32Z 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/1154374 The [Kolakoski Sequence](http://mathworld.wolfram.com/KolakoskiSequence.html) was recently in the news. It starts out as > 1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1 2 1 1 2 1 2 2 1 1 2 1 1 2 1 2 2 1 2 2 1 1 2 1 2 2 1 2 1 1 2 1 1 2 2 1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 1 2 2 1 2 1 1 2 2 1 2 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 2 1 2 1 1 2 1 2 2 1 2 2 1 1 2 1 1 2 1 2 . . . n = 10; ko = Prepend[Nest[Flatten[Partition[#, 2] /. {{2, 2} -> {2, 2, 1, 1}, {2, 1} -> {2, 2, 1}, {1, 2} -> {2, 1, 1}, {1, 1} -> {2, 1}}] &, {2, 2}, n], 1]; Try doing Length/@Split[ko] on that, and you get the same sequence. It is self-descriptive. I bumped the code up to n=32 to get 1058436 terms. What is the behavior of 1 and 2 over that range? ListPlot[FoldList[Plus, 0, 2 (ko - 3/2)], Joined -> True, AspectRatio -> 1/7] ![Kolakowski sequence][1] Seems pretty chaotic. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=kolakowski.jpg&userId=21530 Ed Pegg 2017-07-27T22:13:10Z https://community.wolfram.com/groups/-/m/t/1935252  ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4908ScreenShot2020-04-13at2.04.56PM.jpg&userId=20103 [2]: https://www.wolframcloud.com/obj/9985d16c-0cd1-44b6-8bd3-c5e0f60f3781 Silvia Hao 2020-04-13T17:14:26Z https://community.wolfram.com/groups/-/m/t/942423 Wikipedia article [Letter frequency][1] states that according to widely recognized analysis of Concise Oxford dictionary, the sequence of English alphabet letters sorted according to their frequency is: > **etaoinshrdlcumwfgypbvkjxqz** ![enter image description here][2] Other sources ( [1][3], [2][4] ) give similar results. I noticed [@Marco Thiel][at0] used `WordList` in [this post][5] and obtained a different result. My own effort with the larger dictionary of `DictionaryLookup` yields also a different result. The question is: **How can we reproduce standard letter-frequencies in English language and are these results truly standard ?** I will show my analysis below. First of all a few assumptions: - While dictionaries vary in sizes and exact content, we assume due to their large sizes some approximate universal statistics should emerge for all of them. For example, is it just to assume that most frequent letter is "e" for any published large English dictionary? - Count only non-repeating words. Different "InflectedForms" of the same root are fine to count. This is what makes difference between letter frequencies of English Language and of English text corpus. Because "the" being most frequent word adds a higher value to letter "t" frequency, for instance, in the text corpus. But here, and I assume in the mentioned Wikipedia sources, we assume letter frequencies of English Language are in question. And thus we are looking at non-repeating words to guarantee independence LETTER-frequencies from WORD-frequencies. And another question is: **are these assumptions aligned with calculations mentioned in Wikipedia?** I will use `DictionaryLookup` and first get all words in English dictionary: rawENG = DictionaryLookup[]; rawENG // Length Out[]= 92518 Let's split complex words, delete duplicates, delete single letters, and lower-case: splitENG=Select[Union[Flatten[StringCases[ToLowerCase[rawENG],LetterCharacter..]]],StringLength[#]>1&]; splitENG//Length Out[]= 90813 It still contain non standard English characters: nonREG = Complement[Union[Flatten[ToLowerCase[Characters[splitENG]]]],Alphabet[]] Out[]= {"á", "à", "â", "å", "ä", "ç", "é", "è", "ê", "í", "ï", "ñ", "ó", "ô", "ö", "û", "ü"} Deleting words that contain non standard English characters: dicENG=DeleteCases[splitENG,x_/;ContainsAny[Characters[x],nonREG]]; dicENG//Length RandomSample[dicENG,10] Out[]= 90613 Out[]= {"industrialism", "mathias", "tokenism", "showing", "schmo", "delighting", "seahorse", "longings", "shushing", "interdenominational"} we still get quite large dictionary with more than 90,000 words. Sorted frequencies of letters in this English dictionary: singENGfreq = SortBy[Tally[Flatten[Characters[dicENG]]], Last] {{"q",1419},{"j",1586},{"x",2069},{"z",3380},{"w",6899},{"k",7411},{"v",7774},{"f",10267}, {"y",12242},{"b",15053},{"h",17717},{"m",20785},{"p",21409},{"g",22682},{"u",25434}, {"d",28939},{"c",30597},{"l",40397},{"o",46441},{"t",50834},{"n",54596},{"r",55354}, {"a",59513},{"i",66084},{"s",66365},{"e",87107}} We see the sorted sequence is different from Wikipedia. While "e" is by far the most frequent, "t" lost badly its 2nd place. **So what is the reason and how we can reproduce standard result?** BarChart[singENGfreq[[All, 2]], BarOrigin -> Left, BaseStyle -> 15, ChartLabels -> singENGfreq[[All, 1]], AspectRatio -> 1, PlotTheme -> "Detailed"] ![enter image description here][6] [at0]: http://community.wolfram.com/web/mthiel [1]: https://en.wikipedia.org/wiki/Letter_frequency [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=English_letter_frequency_%28frequency%29.svg&userId=11733 [3]: http://letterfrequency.org/ [4]: https://www.math.cornell.edu/~mec/2003-2004/cryptography/subs/frequencies.html [5]: http://community.wolfram.com/groups/-/m/t/905462 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=asdfwefs2sr45wt.png&userId=11733 Vitaliy Kaurov 2016-10-13T11:10:20Z https://community.wolfram.com/groups/-/m/t/57342 We are looking into numerical solution of nonlinear Klein Gordon equation in 3+1 dimensions with periodic boundary conditions. We use a Gaussian as an initial condition. The problem could be solved for a small interval of time t=1. However NDSolve fails and show a ndsz error for higher values of t. We are attaching some plots for the solution we obtained so far.[mcode]l=5;k=1;Tf=1;u4[x_,y_,z_,t_]:=Exp[-x^2-y^2-z^2];dim4=NDSolve[{D[u[x,y,z,t],{t,2}]-D[u[x,y,z,t],{x,2}]-D[u[x,y,z,t],{y,2}]+D[u[x,y,z,t],{z,2}]+u[x,y,z,t]-k (u[x,y,z,t])^3==0,u[x,y,z,0]==u4[x,y,z,0],Derivative[0,0,0,1][u][x,y,z,0]==Derivative[0,0,0,1][u4][x,y,z,0],u[-l,y,z,t]==u[l,y,z,t],u[x,-l,z,t]==u[x,l,z,t],u[x,y,-l,t]==u[x,y,l,t]},u,{t,0,Tf},{x,-l,l},{y,-l,l},{z,-l,l}, Method->{"MethodOfLines","SpatialDiscretization"->{"TensorProductGrid","DifferenceOrder"->"Pseudospectral"}}][/mcode]We look at a plot for a fixed value of t and z. Its a slice of the four dimensional space which is seen.[mcode]DensityPlot[Evaluate[u[x,y,0,1]/.dim4],{x,-l,l},{y,-l,l},PlotRange->All,ColorFunction->"DarkRainbow",PlotPoints->40] [/mcode][img=width: 360px; height: 356px;]/c/portal/getImageAttachment?filename=a.png&userId=56051[/img] When we try to solve it for larger time intervals we end up with an error as shown below.[mcode]l=5;k=1;Tf=2;u4[x_,y_,z_,t_]:=Exp[-x^2-y^2-z^2];dim2=NDSolve[{D[u[x,y,z,t],{t,2}]-D[u[x,y,z,t],{x,2}]-D[u[x,y,z,t],{y,2}]+D[u[x,y,z,t],{z,2}]+u[x,y,z,t]-k (u[x,y,z,t])^3==0,u[x,y,z,0]==u4[x,y,z,0],Derivative[0,0,0,1][u][x,y,z,0]==Derivative[0,0,0,1][u4][x,y,z,0],u[-l,y,z,t]==u[l,y,z,t],u[x,-l,z,t]==u[x,l,z,t],u[x,y,-l,t]==u[x,y,l,t]},u,{t,0,Tf},{x,-l,l},{y,-l,l},{z,-l,l},Method->{"MethodOfLines","SpatialDiscretization"->{"TensorProductGrid","DifferenceOrder"->"Pseudospectral"}}] [/mcode]We get the follwing error for large time interval.[mcode]NDSolve::ndsz: At t == 1.7240917274928276`, step size is effectively zero; singularity or stiff system suspected.[/mcode]It will be great if some one help me out with this. Arnab Kar 2013-07-12T05:29:42Z https://community.wolfram.com/groups/-/m/t/559147 UPDATED: More graphs added and some corrections. A famous open problem is the [Degree diameter problem][1]. What is the largest regular graph with a [given degree and diameter][2]? Of the known solutions, we have two good pictures. Grid[Transpose[{GraphData[#], #} & /@ {"PetersenGraph", "HoffmanSingletonGraph"}]] ![Petersen and Hoffman-Singleton][3] I found the Hoffman-Singleton embedding myself, and it's widely used now. But it's a challenge to find nice embeddings for highly-connected non-planar graphs. With Hoffman-Singleton I could confidently start with the assumption that some sort of symmetrical representation had to exist. Here are some edge lists for graphs we don't have good pictures for. degreediameter33 = {{1, 2}, {1, 14}, {1, 20}, {2, 3}, {2, 8}, {3, 4}, {3, 18}, {4, 5}, {4, 11}, {5, 6}, {5, 15}, {6, 7}, {6, 19}, {7, 8}, {7, 12}, {8, 9}, {9, 10}, {9, 16}, {10, 11}, {10, 20}, {11, 12}, {12, 13}, {13, 14}, {13, 17}, {14, 15}, {15, 16}, {16, 17}, {17, 18}, {18, 19}, {19, 20}}; degreediameter34 = {{1,2},{1,36},{1,37},{2,3},{2,14},{3,4},{3,29},{4,5},{4,34},{5,6},{5,21},{6,7},{6,26},{7,8},{7,38},{8,9},{8,15},{9,10},{9,35},{10,11},{10,28},{11,12},{11,20},{12,13},{12,32},{13,14},{13,25},{14,15},{15,16},{16,17},{16,22},{17,18},{17,33},{18,19},{18,27},{19,20},{19,37},{20,21},{21,22},{22,23},{23,24},{23,30},{24,25},{24,36},{25,26},{26,27},{27,28},{28,29},{29,30},{30,31},{31,32},{31,38},{32,33},{33,34},{34,35},{35,36},{37,38}}; degreediameter35 = {{1,26},{1,41},{1,43},{2,30},{2,39},{2,44},{3,31},{3,34},{3,45},{4,23},{4,29},{4,46},{5,33},{5,42},{5,47},{6,34},{6,37},{6,48},{7,26},{7,32},{7,49},{8,24},{8,36},{8,50},{9,37},{9,40},{9,51},{10,29},{10,35},{10,52},{11,27},{11,39},{11,53},{12,22},{12,40},{12,54},{13,32},{13,38},{13,55},{14,30},{14,42},{14,56},{15,22},{15,25},{15,57},{16,35},{16,41},{16,58},{17,24},{17,33},{17,59},{18,25},{18,28},{18,60},{19,23},{19,38},{19,61},{20,27},{20,36},{20,62},{21,28},{21,31},{21,63},{22,43},{23,44},{24,45},{25,46},{26,47},{27,48},{28,49},{29,50},{30,51},{31,52},{32,53},{33,54},{34,55},{35,56},{36,57},{37,58},{38,59},{39,60},{40,61},{41,62},{42,63},{43,64},{44,64},{45,64},{46,65},{47,65},{48,65},{49,66},{50,66},{51,66},{52,67},{53,67},{54,67},{55,68},{56,68},{57,68},{58,69},{59,69},{60,69},{61,70},{62,70},{63,70}}; degreediameter42 = {{1,2},{1,4},{1,12},{1,13},{2,3},{2,8},{2,11},{3,4},{3,6},{3,15},{4,5},{4,10},{5,6},{5,8},{5,14},{6,7},{6,12},{7,8},{7,10},{7,13},{8,9},{9,10},{9,12},{9,15},{10,11},{11,12},{11,14},{13,14},{13,15},{14,15}}; degreediameter43 = {{1,2},{1,6},{1,26},{1,38},{2,3},{2,4},{2,5},{3,20},{3,24},{3,31},{4,13},{4,19},{4,25},{5,14},{5,18},{5,36},{6,7},{6,11},{6,35},{7,8},{7,9},{7,10},{8,25},{8,29},{8,39},{9,18},{9,24},{9,30},{10,19},{10,23},{10,31},{11,12},{11,16},{11,32},{12,13},{12,14},{12,15},{13,30},{13,34},{14,23},{14,29},{15,24},{15,28},{15,39},{16,17},{16,21},{16,38},{17,18},{17,19},{17,20},{18,33},{19,28},{20,29},{20,34},{21,22},{21,26},{21,35},{22,23},{22,24},{22,25},{23,37},{25,33},{26,27},{26,32},{27,28},{27,29},{27,30},{28,36},{30,37},{31,32},{31,41},{32,33},{33,40},{34,35},{34,41},{35,36},{36,40},{37,38},{37,41},{38,39},{39,40},{40,41}}; degreediameter44 = {{1,32},{1,50},{1,66},{1,92},{2,31},{2,49},{2,65},{2,91},{3,34},{3,52},{3,68},{3,94},{4,33},{4,51},{4,67},{4,93},{5,36},{5,54},{5,70},{5,96},{6,35},{6,53},{6,69},{6,95},{7,38},{7,56},{7,58},{7,98},{8,37},{8,55},{8,57},{8,97},{9,40},{9,44},{9,60},{9,86},{10,39},{10,43},{10,59},{10,85},{11,42},{11,46},{11,62},{11,88},{12,41},{12,45},{12,61},{12,87},{13,30},{13,48},{13,64},{13,90},{14,29},{14,47},{14,63},{14,89},{15,36},{15,64},{15,74},{15,95},{16,35},{16,63},{16,73},{16,96},{17,38},{17,66},{17,76},{17,97},{18,37},{18,65},{18,75},{18,98},{19,40},{19,68},{19,78},{19,85},{20,39},{20,67},{20,77},{20,86},{21,42},{21,70},{21,80},{21,87},{22,41},{22,69},{22,79},{22,88},{23,30},{23,58},{23,82},{23,89},{24,29},{24,57},{24,81},{24,90},{25,32},{25,60},{25,84},{25,91},{26,31},{26,59},{26,83},{26,92},{27,34},{27,62},{27,72},{27,93},{28,33},{28,61},{28,71},{28,94},{29,50},{29,79},{30,49},{30,80},{31,52},{31,81},{32,51},{32,82},{33,54},{33,83},{34,53},{34,84},{35,56},{35,71},{36,55},{36,72},{37,44},{37,73},{38,43},{38,74},{39,46},{39,75},{40,45},{40,76},{41,48},{41,77},{42,47},{42,78},{43,62},{43,90},{44,61},{44,89},{45,64},{45,92},{46,63},{46,91},{47,66},{47,94},{48,65},{48,93},{49,68},{49,96},{50,67},{50,95},{51,70},{51,98},{52,69},{52,97},{53,58},{53,86},{54,57},{54,85},{55,60},{55,88},{56,59},{56,87},{57,84},{58,83},{59,72},{60,71},{61,74},{62,73},{63,76},{64,75},{65,78},{66,77},{67,80},{68,79},{69,82},{70,81},{71,90},{72,89},{73,92},{74,91},{75,94},{76,93},{77,96},{78,95},{79,98},{80,97},{81,86},{82,85},{83,88},{84,87}}; degreediameter52 = {{1,4},{1,6},{1,7},{1,8},{1,9},{2,3},{2,5},{2,7},{2,8},{2,9},{3,6},{3,10},{3,11},{3,12},{4,5},{4,10},{4,11},{4,12},{5,13},{5,14},{5,15},{6,13},{6,14},{6,15},{7,16},{7,20},{7,23},{8,17},{8,21},{8,24},{9,18},{9,19},{9,22},{10,17},{10,19},{10,23},{11,18},{11,20},{11,24},{12,16},{12,21},{12,22},{13,17},{13,20},{13,22},{14,18},{14,21},{14,23},{15,16},{15,19},{15,24},{16,17},{16,18},{17,18},{19,20},{19,21},{20,21},{22,23},{22,24},{23,24}}; degreediameter62 = {{1,2},{1,3},{1,4},{1,19},{1,21},{1,30},{2,5},{2,6},{2,18},{2,24},{2,28},{3,7},{3,8},{3,20},{3,22},{3,29},{4,9},{4,10},{4,17},{4,23},{4,27},{5,10},{5,11},{5,14},{5,22},{5,26},{6,7},{6,12},{6,15},{6,25},{6,27},{7,13},{7,16},{7,23},{7,26},{8,9},{8,11},{8,14},{8,25},{8,28},{9,12},{9,15},{9,24},{9,26},{10,13},{10,16},{10,25},{10,29},{11,12},{11,20},{11,23},{11,30},{12,17},{12,21},{12,29},{13,14},{13,17},{13,24},{13,30},{14,18},{14,21},{14,27},{15,16},{15,18},{15,22},{15,30},{16,20},{16,21},{16,28},{17,19},{17,22},{17,28},{18,19},{18,23},{18,29},{19,20},{19,25},{19,26},{20,24},{20,27},{21,26},{21,31},{22,27},{22,31},{23,28},{23,31},{24,29},{24,31},{25,30},{25,31},{26,32},{27,32},{28,32},{29,32},{30,32},{31,32}}; degreediameter63 = {{1,39},{1,47},{1,53},{1,91},{1,106},{1,108},{2,40},{2,48},{2,54},{2,92},{2,107},{2,109},{3,41},{3,49},{3,55},{3,93},{3,108},{3,110},{4,42},{4,50},{4,56},{4,94},{4,109},{4,111},{5,43},{5,51},{5,57},{5,75},{5,95},{5,110},{6,44},{6,52},{6,58},{6,76},{6,96},{6,111},{7,45},{7,53},{7,59},{7,75},{7,77},{7,97},{8,46},{8,54},{8,60},{8,76},{8,78},{8,98},{9,47},{9,55},{9,61},{9,77},{9,79},{9,99},{10,48},{10,56},{10,62},{10,78},{10,80},{10,100},{11,49},{11,57},{11,63},{11,79},{11,81},{11,101},{12,50},{12,58},{12,64},{12,80},{12,82},{12,102},{13,51},{13,59},{13,65},{13,81},{13,83},{13,103},{14,52},{14,60},{14,66},{14,82},{14,84},{14,104},{15,53},{15,61},{15,67},{15,83},{15,85},{15,105},{16,54},{16,62},{16,68},{16,84},{16,86},{16,106},{17,55},{17,63},{17,69},{17,85},{17,87},{17,107},{18,56},{18,64},{18,70},{18,86},{18,88},{18,108},{19,57},{19,65},{19,71},{19,87},{19,89},{19,109},{20,58},{20,66},{20,72},{20,88},{20,90},{20,110},{21,59},{21,67},{21,73},{21,89},{21,91},{21,111},{22,60},{22,68},{22,74},{22,75},{22,90},{22,92},{23,38},{23,61},{23,69},{23,76},{23,91},{23,93},{24,39},{24,62},{24,70},{24,77},{24,92},{24,94},{25,40},{25,63},{25,71},{25,78},{25,93},{25,95},{26,41},{26,64},{26,72},{26,79},{26,94},{26,96},{27,42},{27,65},{27,73},{27,80},{27,95},{27,97},{28,43},{28,66},{28,74},{28,81},{28,96},{28,98},{29,38},{29,44},{29,67},{29,82},{29,97},{29,99},{30,39},{30,45},{30,68},{30,83},{30,98},{30,100},{31,40},{31,46},{31,69},{31,84},{31,99},{31,101},{32,41},{32,47},{32,70},{32,85},{32,100},{32,102},{33,42},{33,48},{33,71},{33,86},{33,101},{33,103},{34,43},{34,49},{34,72},{34,87},{34,102},{34,104},{35,44},{35,50},{35,73},{35,88},{35,103},{35,105},{36,45},{36,51},{36,74},{36,89},{36,104},{36,106},{37,38},{37,46},{37,52},{37,90},{37,105},{37,107},{38,79},{38,98},{38,103},{39,80},{39,99},{39,104},{40,81},{40,100},{40,105},{41,82},{41,101},{41,106},{42,83},{42,102},{42,107},{43,84},{43,103},{43,108},{44,85},{44,104},{44,109},{45,86},{45,105},{45,110},{46,87},{46,106},{46,111},{47,75},{47,88},{47,107},{48,76},{48,89},{48,108},{49,77},{49,90},{49,109},{50,78},{50,91},{50,110},{51,79},{51,92},{51,111},{52,75},{52,80},{52,93},{53,76},{53,81},{53,94},{54,77},{54,82},{54,95},{55,78},{55,83},{55,96},{56,79},{56,84},{56,97},{57,80},{57,85},{57,98},{58,81},{58,86},{58,99},{59,82},{59,87},{59,100},{60,83},{60,88},{60,101},{61,84},{61,89},{61,102},{62,85},{62,90},{62,103},{63,86},{63,91},{63,104},{64,87},{64,92},{64,105},{65,88},{65,93},{65,106},{66,89},{66,94},{66,107},{67,90},{67,95},{67,108},{68,91},{68,96},{68,109},{69,92},{69,97},{69,110},{70,93},{70,98},{70,111},{71,75},{71,94},{71,99},{72,76},{72,95},{72,100},{73,77},{73,96},{73,101},{74,78},{74,97},{74,102}}; degreediameter82 = {{1,9},{1,11},{1,17},{1,30},{1,36},{1,42},{1,48},{1,54},{2,3},{2,10},{2,17},{2,24},{2,31},{2,38},{2,45},{2,52},{3,10},{3,11},{3,12},{3,13},{3,14},{3,15},{3,16},{4,9},{4,10},{4,23},{4,29},{4,35},{4,41},{4,47},{4,53},{5,6},{5,10},{5,20},{5,30},{5,33},{5,43},{5,46},{5,56},{6,10},{6,19},{6,28},{6,37},{6,39},{6,48},{6,57},{7,8},{7,10},{7,22},{7,27},{7,32},{7,44},{7,49},{7,54},{8,10},{8,21},{8,25},{8,36},{8,40},{8,51},{8,55},{9,10},{9,18},{9,26},{9,34},{9,42},{9,50},{11,16},{11,23},{11,30},{11,37},{11,44},{11,51},{12,13},{12,20},{12,27},{12,34},{12,41},{12,48},{12,55},{13,19},{13,26},{13,33},{13,40},{13,47},{13,54},{14,15},{14,22},{14,29},{14,36},{14,43},{14,50},{14,57},{15,21},{15,28},{15,35},{15,42},{15,49},{15,56},{16,18},{16,25},{16,32},{16,39},{16,46},{16,53},{17,52},{17,53},{17,54},{17,55},{17,56},{17,57},{18,22},{18,28},{18,34},{18,40},{18,46},{18,52},{19,23},{19,26},{19,36},{19,39},{19,49},{19,52},{20,21},{20,30},{20,32},{20,41},{20,50},{20,52},{21,25},{21,37},{21,42},{21,47},{21,52},{22,29},{22,33},{22,44},{22,48},{22,52},{23,27},{23,35},{23,43},{23,51},{23,52},{24,31},{24,32},{24,33},{24,34},{24,35},{24,36},{24,37},{25,26},{25,31},{25,43},{25,48},{25,53},{26,31},{26,44},{26,50},{26,56},{27,31},{27,42},{27,46},{27,57},{28,31},{28,41},{28,51},{28,54},{29,30},{29,31},{29,39},{29,47},{29,55},{30,31},{30,40},{30,49},{32,35},{32,39},{32,50},{32,54},{33,42},{33,51},{33,53},{34,37},{34,43},{34,49},{34,55},{35,40},{35,48},{35,56},{36,41},{36,46},{37,44},{37,47},{37,57},{38,45},{38,46},{38,47},{38,48},{38,49},{38,50},{38,51},{39,42},{39,45},{39,55},{40,45},{40,57},{41,44},{41,45},{41,53},{42,45},{43,45},{43,54},{44,45},{44,56},{46,47},{46,56},{47,54},{49,53},{50,51},{50,57},{51,55},{53,57},{55,56}}; Here is what those graphs look like in an untamed state. ![degree diameter graphs][4] Can anyone find improved pictures for these graphs? The attached notebook has larger untamed degree-diameter graphs. [1]: https://en.wikipedia.org/wiki/Degree_diameter_problem [2]: http://maite71.upc.es/grup_de_grafs/table_g.html/ [3]: /c/portal/getImageAttachment?filename=petersenhoffman.gif&userId=21530 [4]: /c/portal/getImageAttachment?filename=degdiam.gif&userId=21530 Ed Pegg 2015-09-03T20:44:21Z https://community.wolfram.com/groups/-/m/t/184401 Hello friends, thank you for helping me with this issue...     I want to reproduce the animations of the Conway´s game of life in Mathematica. You can find the description and the rules in Wikipedia (http://en.wikipedia.org/wiki/Conway%27s_Game_of_Life)     I first started defining a grid with dimensions II vs JJ, being these values predefined in the sheet. The initial values in the sheet, a[ i,j ], are defined also (a[ i,j ]=1 is a "live" cell, and a[ i,j ]=0 is a "dead" cell). The values of a outside the grid are defined as zero, as follows: [mcode] Table[a[0, j] = 0, {j, 0, JJ+1, 1}] Table[a[i, 0] = 0, {i, 0, II+1, 1}] Table[a[II + 1, j] = 0, {j, 0, JJ+1, 1}] Table[a[i, JJ + 1] = 0, {i,0, II+1, 1}] a[II + 1, JJ + 1] = 0[/mcode]    The following values of a, denoted as s, are defined according to the game´s rules, and depends of the value of the eight neighbours (remember a value of 1 for a live cell and 0 for a dead cell); that is, the value of s[ i,j ], depends of the eight-term sum: [mcode] sum = a[i - 1, j - 1] + a[i - 1, j] + a[i - 1, j + 1] + a[i, j + 1] + a[i + 1, j + 1] + a[i + 1, j] + a[i + 1, j - 1] + a[i, j - 1][/mcode] the value of s[ i,j ] is then: [mcode] s[i_, j_] := If[1 <= a[i, j] <= 1, Which[sum <= 1, s[i, j] = 0, 2 <= sum <= 3, s[i, j] = 1, 4 <= sum, s[i, j] = 0], If[3 <= sum <= 3, s[i, j] = 1, s[i, j] = 0]][/mcode]     In order to repeat the last command successively, I set the new values of a to be the values of s [mcode] Clear[a] a=s Table[a[0, j] = 0, {j, 0, JJ+1, 1}] Table[a[i, 0] = 0, {i, 0, II+1, 1}] Table[a[II + 1, j] = 0, {j, 0, JJ+1, 1}] Table[a[i, JJ + 1] = 0, {i,0, II+1, 1}] a[II + 1, JJ + 1] = 0[/mcode]    The problem appears when I try to recalculate the values of s, using the conditional functions: it gives me the same values of s obtained the last time the function was used. Why does this happen??    I tried to reset the values of s (Clear ) before evaluating the expression containing the conditional functions, but it also resets the values of a. Can I avoid this situation, and reset only the values of s, maintaining the values of a unaffected??    Thank you so much, and dont hesitate to email me if you need further information, or a copy of the sheet. Thanksss    Daniel    cricricombowino@gmail.com Daniel Branco 2014-01-11T18:57:41Z https://community.wolfram.com/groups/-/m/t/153068 I have a project for find a rate of people movement using a video recording. That was one of the projects that i have to submit aside my PhD research. > The Main Objective that i had been asked to present is to visualise the data of a complex behaviour that happens in a spesific streets of (cars-busses-pedisterian). And I tackled this point by extracting the data from a recorded video and not by mimicing the behaviour through simulations > I didn't focus on counting the people (even it is possiple as i tried it and still need to be developed) but aiming to return movment patterns on where the people stands/pass more in the street which can be applied in the future for redesigning the place elements (shades - seats ...etc). > and there is some impediments in this technique till now such as : if the movie had been recorded in a sunny day, the shadows will be taken into account [list] [*]If the people who wear gray, they are the same as street. [*]As much height/angle of the camera as much accurate patterns .... etc. [/list]Anyway, mainly i make a differenceimage function between a frame without people in the street, and "others many frames may be 200 to 1000", So i would like to find a way to make my code faster) how to compile this kind of Mathematica functions of "image processing" _for example [mcode]frame1 = 10050; frame2 = 10118; f = Colorize[ ColorNegate[ ArrayPlot[ Mean[Table[ h = Import[ "C:\\MVI_5002.mov", {"ImageList", 10000}]; hh = Import[ "C:\\MVI_5002.mov", {"ImageList", t}]; hhh = ImageDifference[h, hh]; Morphh = MorphologicalBinarize[hhh, {0.1, .8}]; ImageData[Morphh], {t, frame1, frame2}]], ImageSize -> 1000]], ColorFunction -> "Rainbow"]; Export["C:\\render\\" <> ToString[r1] <> "-" <> ToString[r3] <> ".tif", f];[/mcode] [b]================ UPDATE ==================== [/b] Here is the result after this discussion and my further efforts: [img]http://community.wolfram.com/c/portal/getImageAttachment?filename=2013-12-13_11-04-04.png&userId=11733[/img] Mohamed Zaghloul 2013-11-13T19:01:35Z https://community.wolfram.com/groups/-/m/t/1729355 ![enter image description here][1] ##Overview## Everyone has different ideas about what a Quantum Cellular Automaton (QCA) should do. In my opinion, a QCA takes in a quantum state and evolves it using quantum operations that are dependent on its neighbours. This is analogous to the classical CA where classical states (0 or 1) are evolved using classical operations dependent on their neighbours. We define two types of QCA models that could be used to explore. We also show several applications to physics by slightly modifying the QCA model. The first model is based on the quantum teleportation protocol, the second is evolving a tensor product. However, there were many failed models before these two that I will talk about as well. QCA’s can also be applied to physical systems. Applications in physics include showing the evolution of a quantum state (includes simulating a CNOT gate), showing a coupled two-state system, showing precession of a two state system in a magnetic field, and showing a simple (NN) Heisenberg spin chain. ##?QCA Teleportation Model## This model starts with a list of two state systems (qubits). $$ \alpha _1\text{$|$0$>$+}\beta _1\text{$|$1$>$,}\alpha _2\text{$|$0$>$+}\beta _2\text{$|$1$>$,...} $$ The nearest neighbour of a given qubit is "teleported" to the next state using the quantum teleportation protocol. First, a \[CapitalPhi]^+ bell state is introduced. The \[CapitalPhi]^+ state is then combined with the nearest neighbour qubit, creating a quantum system with 3 qubits. Periodic boundary conditions are applied. The nearest neighbour qubit and one of the entangled qubits in the system is put through a CNOT gate, effectively entangling the two. Then the nearest neighbour qubit is put through a Hadamard gate to ensure both exist in the same basis. Then both (nearest neighbour and one of the entangled) are measured using any arbitrary measurement, here I used measurement in \[Sigma]^x basis. Depending on the measurement obtained above, the nearest neighbour qubit is teleported by transforming the third entangled qubit, allowing us to perform further operations on it later. Also, based on the measurement an operation is chosen for the j^th qubit. There are four possible outcomes: 00, 01, 10, 11. A list of operators is defined. One of the operators is then applied based on the measurement applied. Operators can be any combination of four matrices, a possible combination is to use PauliX, PauliY, PauliZ, and Hadamard. The function is mapped across the entire list of qubits, and a new state is created. The state is then evolved several times, depending on the number of steps (n). This gives a list of states very much like a CA. To visualize these states, I created some type of RGB scheme. Here is what four of the states look like. ?![enter image description here][2] The rest are combinations of these colours. Finally the QuantumCellularAutomataTeleport function can be created. QuantumCellularAutomataTeleport[{operatorHadamard, operatorPauliX, operatorPauliY, operatorPauliZ}, 50] ?![enter image description here][3] The result looks random, but actually isn't, as told by a randomness tester. The test it failed is the run length test. This could mean that there is unusual clustering of similar states, which is something we can sort of see in the picture. It would be interesting to explore why this happens. ##Quantum Cellular Automata Tensor Model## Another model for the QCA includes evolving an entire state together instead of separate qubits individually. This would be analogous to having some sort of spin chain system. A state of N qubits is taken. I will let N = 3. $$ c_1\text{$|$000$>$+}c_2\text{$|$001$>$+}c_3\text{$|$010$>$+}c_4\text{$|$011$>$+}c_5\text{$|$100$>$+}c_6\text{$|$101$>$+}c_7\text{$|$110$>$+}c_8\text{$|$111$>$} $$ The state vector of this is the coefficients c1 … c8. The way this model would work is by applying a composition of operations applied on a qubit and its neighbour. There are N qubits and k is the number of operators. For j in range {1,...,N} compute the operator for the jth qubit by the following, apply it to the jth qubit. Do this for all j in N, then add all the resulting states. $$\left(\sum _{j=1}^N u^{k-1}{}_j u^{k-1}{}_{j+1} u^k{}_j u^k{}_{j+1}\text{...}u_j u_{j+1}\right)$$ Now, instead of choosing from a list of operators we are composing a list of operators and applying them repeatedly. An interesting thing to examine about this type of QCA is the probability of being in a given state. This would be the norm of the coefficient of each possible state squared. Plotting several of these along with their corresponding QCA’s leads to this. ![enter image description here][1] When I show these results to physicists, it makes sense. They talk about an "equilibrium" state that the system reaches or of an oscillating equilibrium state (like that produced SqrtNOT). However, from a linear algebra perspective this is not immediately obvious. How can applying any arbitrary combination of operators onto any initial vector result in period behaviour? Not even periodic, but result in probabilities of being in each state that are constant for most of the time. However, the physics behind this makes sense. The relationship between the computational complexity of the inverse operation (the operation that will go from the equilibrium state to the initial state) and the time it takes for the system to reach equilibrium could potentially have a significant relationship. However, the effect we see here is analogous to thermalization. Plotting the norms of a given state against time gives a plot that shows behaviour analogous to thermalization. This can be further analyzed for different types of states. ![enter image description here][5] ##Physical Systems## This model can also be applied to physical systems. This includes the evolution of a two-state system, as well as precession in a magnetic field. I took a two level system Hamiltonian, and created an operator that would time evolve it. The time evolution operator depends on the coupling constant (t) and epsilon, I took different values for each and displayed the results using a QCA. showQubitEvolution[operatorTime, onequbit, matrixHamiltonian] ?![enter image description here][6] $epsilon = 2; matrixHamiltonian = {{$epsilon,$t},{$t,-$epsilon}}; ?![enter image description here][7] $t = 0.5; matrixHamiltonian = {{$epsilon,$t},{$t,-$epsilon}}; ![enter image description here][8] ##Failed Models## There were several models that failed as well. I have them in my gitHub, but here is an explanation for one of them. This model formulates QCAs using a two qubits per cell system. Each time step has an interaction step followed by an evaluation step. Each cell has a "state" qubit and a "control" qubit. First, the state qubit on the right is composed with the control qubit in the middle using some operator (e.g. CNOT) and the control qubit is partial traced out. Then, that control qubit is composed with the state qubit on the left using some operator and partial traced out again. This is the end of the interaction step. Now, we take the state qubit of the middle cell and the new control qubit and compose them using some operator (e.g.. Fourier) to get the new cell, this is the evaluation step. This is then repeated for all cells in the row. The arrows represent partial traces, and lines represent operations. ?![enter image description here][9] The issue arisen with this model was the inability to apply a quantum partial trace to the control qubit after it had been in an impure state with the state qubit. So the evolution only worked for simple quantum gates that did not produce any sort of real interaction between the state and control qubit, which is the whole point of a QCA. However, if this could be done without taking a partial trace of the qubits, this model is still possible. ##Future Works## For the future, a definite relationship between the time taken to evolve into an equilibrium state and the computational complexity of the evolution of the state into the equilibrium state. It would also be useful to explore more rules and gather data to explore the relationship further. There were also a couple of failed models that should be revisited and attempts could be made to implement them. It is also possible to explore further physics applications including simulating NMR and more complicated Heisenberg spin chains. [GitHub Repo][10] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=picture.png&userId=1726595 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.52.35PM.png&userId=1726595 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.55.24PM.png&userId=1726595 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=picture.png&userId=1726595 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.56.43PM.png&userId=1726595 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.57.08PM.png&userId=1726595 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.57.38PM.png&userId=1726595 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.58.05PM.png&userId=1726595 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-10at12.58.29PM.png&userId=1726595 [10]: https://github.com/ruhishah/WSS-Template Ruhi Shah 2019-07-10T17:37:01Z https://community.wolfram.com/groups/-/m/t/1374274 ![Cellular Automaton with an infinite initial condition][1] #Introduction Mathematician David Hilbert came up with the following thought experiment: In an hotel of infinitely many rooms that is full, find a way to accomodate infinitely many new guests. His idea was to show that infinity can behave in counterintuitive ways. I've implemented a way to work with this kind of concepts using the Wolfram Language. Computer languages are usually constrained to lists of finite size subjected to operations. For example, one may join, partition, sum, or nest them, and get a finite list as a result. Even though explicit infinite lists cannot be implemented in a computer, in this project I aim to provide the Wolfram Language with a symbolic calculus for lists of (countably) infinite length. That is, one would be able to treat expressions referring to infinite lists as arguments of operations, e.g, the infinite list of the roots of the natural numbers. The main idea is to treat infinite lists as symbolical objects within the Wolfram Language, consisting of a generating rule for the elements on the list, where operations on infinite lists modify the generating functions, and values are only computed when explicitly asked for. All infinite lists are countably infinite. #Basic list operations Most of the operations are extensions of the already existing Mathematica fucntions for lists. First I define the infinite list of the integers: myInfiniteList= InfiniteRange[{-Infinity, Infinity}] InfinitePrint[myInfiniteList] InfinitePrint is a helpful tool to visualize some elements of infinite lists {...,-5,-4,-3,-2,-1,0,1,2,3,4,5,...} We can reverse this list, or drop all the negative elements to get the infinite list of the natural numbers. InfiniteReverse[myInfiniteList]//InfinitePrint (naturalNumbers=InfiniteDrop[myInfiniteList,{-Infinity,-1}]) //InfinitePrint and we get {...,5,4,3,2,1,0,-1,-2,-3,-4,-5,...} {1,2,3,4,5,...} With InfiniteSelect, we can obtain the prime numbers InfiniteSelect[naturalNumbers,PrimeQ]//InfinitePrint with result {2,3,5,7,11,...} #Infinite Matrices and Graphs With the help of infinite lists, it is possible to work with matrices, which are nested infinite lists. myInfiniteMatrix = InfiniteMatrix[ Function[{i, j}, "[row " <> ToString[i] <> ",col " <> ToString[j] <> "]"]]; (*Take the first rows and columns*) InfiniteTake[myInfiniteMatrix, 2, 3] // MatrixForm InfiniteTake[myInfiniteMatrix, 4, 4] // MatrixForm This is the infinite matrix that has "row i col j" in position $i,j$ ![Parts of the Infinite matrix][2] Infinite matrices allow us to work with infinite graphs! We can consider the graph with vertices the natural numbers, and where every number is connected its divisors myGraphMatrix = InfiniteMatrix[ Function[{x, y}, If[Mod[x, y] == 0, 1, 0]]]; Below is an animation of successive subgraphs from 1 vertex to 14 vertices. Of course, the number 1 is always at the center of the graph. ![subgraphs][3] #Applications to Cellular Automata A neat application is that now we can have Cellular Automata that admit infinite initial conditions! For example, rule 90 gives interesting results: (*Initial condition with a black cell every 7 cells*) myInitialCondition = InfiniteList[0, Function[x, If[Mod[x, 7] == 0, 1, 0]]]; (*With a widht of 40 cells to either side, plot the first 10 steps*) InfiniteCellularAutomatonPlot[90, myInitialCondition, 40, 10] ![Rule 90. Initial condition: Black cell every seven spaces][4] For a slightly more complicated result, consider an initial condition where only the cells in absolute prime number position (like 2 and -3) are black. This is the picture at the beginning of the post. ![Initial conditions are primes][5] Notice there are differences if one uses the implemented Cellular Automata function with a similar but finite initial condition. Notice the extremes of the images below. First with infinite initial condition: ![Rule 90. Initial condition: Black cell every seven spaces][6] Now with finite initial condition where there is a black cell every 7 cells, but only in a finite range and the rest is white. ![rule 90 finite initial condition][7] #Conclusions and Future I have extended most of the basic Mathematica functions for lists to infinite lists through symbolic manipulation, though partial explicit numerical results can be obtained. Two non trivial applications of this results are the capacity to define infinite graphs, and to work with Cellular Automata with an infinite initial condition. It is still pendant to extend other Mathematica functions for finite lists to work with this project's approach for infinite lists in an optimal way. Also, an implementation could be explored for systems that in principle accept infinite initial conditions. Please correct all my typos and grammatical mistakes, as English is not my native language :) #References [Hilbert's Parados of the Grand Hotel][8] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=CAinitialcondition-primes.png&userId=1363203 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=infinitematrix.png&userId=1363203 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=graphs.gif&userId=1363203 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rule90sevenspaces.png&userId=1363203 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=CAinitialcondition-primes.png&userId=1363203 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rule90sevenspaces.png&userId=1363203 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rule90finiteinitialcondition.png&userId=1363203 [8]: https://en.wikipedia.org/wiki/Hilbert%27s_paradox_of_the_Grand_Hotel Luis Antonio Vasquez Reina 2018-07-10T20:30:52Z https://community.wolfram.com/groups/-/m/t/1955357 I'm interested in following the progress on the Wolfram Physics Project as presented on wolframphysics.org. But I'm not as interested in other Wolfram Language/Cloud/Mathematica/etc. info. Is there some mailing list or RSS feed I can subscribe to so that I can hear about new articles, preprints, etc. related to the physics project, but *not* other Wolfram marketing/updates? Maksym Taran 2020-04-25T23:13:26Z https://community.wolfram.com/groups/-/m/t/1875994 *MODERATOR NOTE: coronavirus resources & updates:* https://wolfr.am/coronavirus ---------- &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/b2db6345-ed79-4883-8ee2-25b0d16a47e8 Mohammad Bahrami 2020-02-10T20:01:11Z https://community.wolfram.com/groups/-/m/t/404292 Does anyone have an idea for an efficient implementation of [Jaro–Winkler distance][1]? If there is a built in function with a different name it would be great, please let me know. If not, perhaps a modification of [Levenshtein][2] or similar would do or a compiled version (not sure which functions to use to make it compilable). I know good etiquette is to show some code, but I have to compare millions of strings pairwise and need the most efficient approach. Any advice would be appreciated - thanks in advance! BTW does anyone see any link between Shannon Entropy and Levenshtein and similar distances? Is it possible to talk about distance metric between strings in terms of information change needed to turn one string into the other? [1]: https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance [2]: http://reference.wolfram.com/language/ref/EditDistance.html Sam Carrettie 2014-12-09T02:00:25Z https://community.wolfram.com/groups/-/m/t/1037946 What do you think of the idea of automatically judging if a piece of data was beautiful? This could mean the data in an image (ImageData) or maybe the result of a computation (e.g. CellularAutomaton), or anything, although I am thinking of a list or an array of numbers primarily. My first thought was that there are many filters for image processing, but I don't know which might be useful. The next thing I think of is mathematical transforms. For example, taking the Fourier or Hadamard transform you expect the coefficients to decay, and if they don't then that would not be nice. This code deletes the constant term and does some measure of the variance, using Mean as a shortcut to counting the 0's and 1's, those closer to the min than the max respectively without knowing the length or dimension. (Note Fourier does not assume the size is a power of 2 but Hadamard does.) FourierBeauty[list_] := Mean[1. - Round[Rescale[Abs[Rest[Flatten[Fourier[list]]]]]]] Maybe for an image this might not be bad. Here is what it picks out of the ExampleData test images: Grid[{#, ExampleData[#]} & /@ MaximalBy[ExampleData["TestImage"], FourierBeauty[ ImageData[ Binarize[ ImageResize[ ColorConvert[ExampleData[#], "Grayscale"], {64, 64}]]]] &], Frame -> All] ![enter image description here][1] but here are the CAs it likes the most. MaximalBy[Range[0, 255], Sum[FourierBeauty[ CellularAutomaton[#, RandomInteger[1, 2^8], {{0, 2^8 - 1}}]], 100] &]->{1, 3, 5, 17, 57, 87, 119, 127} [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fourier-beauty-image.jpg&userId=23275 Todd Rowland 2017-03-23T02:46:11Z https://community.wolfram.com/groups/-/m/t/138207 Following up on Bernat's posting here [url=http://community.wolfram.com/groups/-/m/t/136023?p_p_auth=2Af2XNsw]http://community.wolfram.com/groups/-/m/t/136023?p_p_auth=2Af2XNsw[/url], I attempted my first cut on simulating an ant colony hunting for food. The code runs too slow, it processes 3.5 cycles (ticks) per second for 25 ants. Would be very grateful for ideas on how to:[list=1] [*]Improve performance of the code. [*]Mathematica Functions/Ideas for adding diffusion to the pheromone field (represented by a matrix) without adding excessive performance cost (played with converting the matrix to an image > blurring > converting it back to a matrix) which adds and excessive time penalty. [/list]Hope the code is clear enough. As written it takes 517 seconds in my PC.[mcode](*Define the world size*) ymax = 200; xmax = 400; (*Locate the colony somwhere in the world*) nest = {RandomInteger[{1, xmax}], RandomInteger[{1, ymax}]}; maxAnts = 25; ticks = 1; maxSteps = 2000; maxSpeed = 6; maxAngle = 13 \[Pi]/16; maxFoodPiles = 8; smellRange = 12; pheromoneDeposit = 1; foodMultiplier = 1000; pheromoneMultiplier = 10; fieldCaptureInterval = 10; discriminationFactor = 16; noFood = 0; withFood = 1; antSymbol = \[Infinity]; evaporationRate = ConstantArray[(1 - 0.005), {xmax, ymax}]; pheromoneField = ConstantArray[0., {xmax, ymax}]; pheromoneField[[First@nest, Last@nest]] = 100000; (*Added a lot of pheromone at the nest to 'help' the ants \ get back to the nest*) foodField = ConstantArray[0., {xmax, ymax}]; (*Scatter the food in the world*) foodPiles = Transpose[{RandomInteger[{1, xmax}, maxFoodPiles], RandomInteger[{1, ymax}, maxFoodPiles]}]; (foodField[[#[[1]], #[[2]]]] = 10) & /@ foodPiles; (*We'll record the history of the fields in these variables*) pheromoneHistory = {pheromoneField}; foodHistory = {foodField}; (*Functions*) (*Find out all positions that the ant will step as it moves \ forward/Keep ants within the world*) calculateLoc[location_, direction_, steps_] := Module[{loc, result = {}}, Do[loc = Flatten[ location + Round[{temp*Cos[direction], temp*Sin[direction]}]]; loc = Min[#] & /@ Transpose[{loc, {xmax, ymax}}]; loc = Max[#] & /@ Transpose[{loc, {1, 1}}]; result = Append[result, loc], {temp, steps}]; result] (*Return the distribution probability of the direction that the ant \ will head to*) (*It will add the smell of pheromones + food if no food is being \ carried *) probDist[location_, direction_, hasFood_, range_, angle_, steps_] := Module[{dist, total, bins, vals}, dist = Flatten[ Table[{direction + y , Flatten[location + Round[{x*Cos[direction + y ], x*Sin[direction + y ]}]]}, {y, -angle/2, angle/2, angle/steps}, {x, 1, range, 1}], 1]; dist = DeleteCases[dist, Alternatives[{_, {a_ /; a < 1, _}}, {_, {a_ /; a > xmax, _}}, {_, {_, b_ /; b < 1}}, {_, {_, b_ /; b > ymax}}]]; (dist[[#, 2]] = ((1 - hasFood) foodMultiplier foodField[[ First@dist[[#, 2]], Last@dist[[#, 2]]]] + pheromoneField[[First@dist[[#, 2]], Last@dist[[#, 2]]]])) & /@ Range[Length[dist]]; bins = Union[dist[[All, 1]]]; vals = Cases[dist, {#, y_} -> y] & /@ bins; vals = (Total[#] & /@ vals); total = Total[vals]; If[total == 0, UniformDistribution[{direction - angle/2, direction + angle/2}], EmpiricalDistribution[Rule[vals, bins]]]] (*Routine Determines where the ant should head next*) (*Also updates the pheromone field*) update[agent[id_, symbol_, location_, direction_, hasFood_]] := Module[{temp, dist, dir, speed, loc, path, status, foundDestination, multiplier}, dir = RandomVariate[ probDist[location, direction, hasFood, smellRange, maxAngle, discriminationFactor]]; speed = RandomVariate[UniformDistribution[{1, maxSpeed}], 1]; loc = calculateLoc[location, dir, speed]; status = hasFood; If[status == noFood, multiplier = 1; foundDestination = Select[loc, foodField[[#[[1]], #[[2]]]] > 0 &]; If[Length@foundDestination != 0, status = withFood; dir = dir + \[Pi]; multiplier = pheromoneMultiplier; foundDestination = First@foundDestination; foodField[[foundDestination[[1]], foundDestination[[2]]]] = foodField[[foundDestination[[1]], foundDestination[[2]]]] - 1;], multiplier = pheromoneMultiplier; foundDestination = Cases[loc, nest]; If[Length@foundDestination != 0, status = noFood; dir = dir + \[Pi]; multiplier = 1;] ] (pheromoneField[[#[[1]], #[[2]]]] = pheromoneField[[#[[1]], #[[2]]]] + multiplier pheromoneDeposit) & /@ loc; agent[id, symbol, Last@loc, dir, status]] update[agentList_List] := Module[{set = update[#] & /@ agentList}, pheromoneField = evaporationRate pheromoneField; If[Mod[ticks, fieldCaptureInterval] == 0, pheromoneHistory = Append[pheromoneHistory, pheromoneField]; foodHistory = Append[foodHistory, foodField];]; ticks++; set] (*Routines to display the ants in the animate section. Regretably \ can't be used due to memory leak*) display[agent[id_, symbol_, location_, direction_, hasFood_]] := Text[Rotate[symbol, direction], location] display[list_] := Module[{lst = display[#] & /@ list}, Graphics[lst]] (*initialize ants*) (*Initialize the colony - in which direction will the ants start \ walking out*) ants = Table[ agent[id, antSymbol, nest, RandomVariate[UniformDistribution[{0, 2 \[Pi]}]], noFood], {id, maxAnts}]; antHistory = NestList[update, ants, maxSteps]; // AbsoluteTiming (*Did the ants eat the food? Check status of the food piles and how \ the pheromone field changed with time*) foodField[[#[[1]], #[[2]]]] & /@ foodPiles Manipulate[ Show[ColorNegate@ImageRotate@Image@pheromoneHistory[[i]], Graphics[{Red, PointSize[Large], Point[nest], PointSize[Medium], Blue, Point[foodPiles]}]], {i, 1, Length@pheromoneHistory, 1}] [/mcode][img=width: 800px; height: 557px;]/c/portal/getImageAttachment?filename=ants.gif&userId=78214[/img] Diego Zviovich 2013-10-12T21:08:11Z https://community.wolfram.com/groups/-/m/t/2346160 I've watched this live minting (Stephen Wolfram's Picks of Cellular Automata from the Computational Universe): https://youtu.be/pMfrRFNCKhE and looks like it uses the Cardano blockchain, but I can't find it in the Cardano blockchain explorer. I asked for it on the Youtube video, I sent a question about it to [SUPPORT][1] and I asked a question on the Tweet at https://twitter.com/manofstring/status/1425921930834714629 but so far all messages from me are ignored. Does someone here have the information where I can find the NFT, and maybe even buy it? [1]: https://liveminting.com/contact Frank Buss 2021-08-19T18:04:58Z https://community.wolfram.com/groups/-/m/t/2135059 There appears to be a mistake in the definition of causal invariance ([Some Quantum Mechanical Properties of the Wolfram Model][1]): >Definition 22. A multiway system is “causal invariant” if and only if the causal networks associated with all paths through the multiway system are (eventually) isomorphic as directed, acyclic graphs. Consider a pair of string substitution rules A->AB, A->AC with the starting string "A". At each step of the evolution we can choose whether we generate B or C, and the multiway graph for this rule looks like a binary tree. A causal graph for any update order will always look like a single chain, ![enter image description here][2], and therefore, all paths are isomorphic as directed, acyclic graphs, and the system must be causally invariant according to the definition. On the other hand, the system is not confluent (Gorard says that confluence is a necessary condition for causal invariance in his presentations), and appears to contradict the whole intuition of a causally invariant system, that was built before that. A definition, corresponding to the intent of causal invariance should look more like this: "A multiway system is “causal invariant” if and only if the causal networks associated with all paths through the multiway system are (eventually) identical." It would help though to clarify what does it mean that two causal graphs are "identical" (isomorphism is necessary, but, clearly, not sufficient). Does this look correct? [1]: https://content.wolfram.com/uploads/sites/13/2020/07/29-2-2.pdf [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=chain.png&userId=1943781 Pavlo Bulanchuk 2020-12-10T15:29:07Z https://community.wolfram.com/groups/-/m/t/2098937 OK, so I feel like I have a pretty good grasp on the rules surrounding how nodes work, but this question is a little different, I want to know what a node actually represents in rule space. Are they little processors being co-opted out of an endless block of computronium? Are they deformations in some kind of computational topology? Why do they seem to be freely created and destroyed without cost? The same questions could technically be applied to edges, etc. If nodes aren't free or infinitely created, does that mean there is an infinite Turing tape out there (infinite free storage to store node states) chunking away? That feels less elegant to my flavor receptors. Also, is there a way rules can influence other rules? Can universes rub against each other? Steal each other's computational power? Is there some kind of conservation law at work for computation, nodes, or storage? When connections pop up between existing nodes that had no previous connection, how does a node "know" how to form that new edge? Or is each possible unique computational state always existing somewhere and does the processing of these hypergraphs just weave patterns among these nodes? These are the questions I've got burning in my mind right now. And others, but I'm trying not to be too overwhelming. Michael Leza 2020-10-21T00:37:30Z