https://community.wolfram.com RSS Feed for Wolfram Community showing questions tagged with Discrete Mathematics sorted by most viewed. https://community.wolfram.com/groups/-/m/t/1733404 # Visualizing the Fourier Syntheisis [Link To GitHub][3] ## Introduction The goal of the project is to generate Visualizations for how the Fourier series creates approximation of curves. The end result is a function that is able to generate two different graphics to show using Circles to represent the trigonometric waves used in the Fourier Series.The Fourier Series in Calculus is the summation of trigonometric waves in order to represent an approximation of a curve. Since the Fourier Series uses trigonometric functions which are created by the rotation of a circle, it is possible to link together multiple rotating circles and recreate the curve. ## Development ### Understanding the General Idea First,I had to learn Calculus and trigonometry in order to understand how the Fourier Series works. At first I wanted a proof of concept that I was able to visualize how the addition of sinusoidal could result in an approximation of the curve. So I spent some time to hard code rotating radii of circles and orbiting circles. I created orbiting circles by setting the centers of successive circles as a sinusoidal functions so that they would be following a track built by the previous circle's circumference. Animate[ Graphics[ { Line[{{0, 0}, {5*Cos[time], 5*Sin[time]}}], Circle[{0, 0}, 5], Circle[{5*Cos[time], 5*Sin[time]}, 3], Line[{{5*Cos[time], 5*Sin[time]}, {3*Cos[2 time] + 5*Cos[time], 3*Sin[2 time] + 5*Sin[time]}}], Circle[{3*Cos[2 time] + 5*Cos[time], 3*Sin[2 time] + 5*Sin[time]},2], Line[{{3*Cos[2 time] + 5*Cos[time], 3*Sin[2 time] + 5*Sin[time]}, {5*Cos[time] + 3*Cos[2 time] + 2 Cos[3 time], 5*Sin[time] + 3*Sin[2 time] + 2 Sin[3 time]}}], } ], {time, 0, 2*Pi}, AnimationRunning -> False] The lines are the rotating arms and connect one center of a circle to the next circle's center. The code above shows the nesting of coordinates to create the moving parts using the "Animate" function. If the x-coordinates use "Cosine" and the y-coordinates use "Sine" functions, then the rotating parts will move counter-clockwise.If you switch the functions, then the arms rotate clockwise. (This information proves to be useful later on in the developing process) ### Creating the Functions I went through many iterations of my code an restarted on a new approach three times. The hardest part of this project was getting the information form the functions to be in a certain format so that it could be displayed in a cohesive manner. This issue rose form creating a generalized function that would work for most if not all scenarios. #### Approach One At first I tried to create multiple helper functions to manipulate the information and create it modular. The code below takes in a radius list, frequency list, and the number of circles needed, and then creates the nested list that is used for the moving objects in the graphics. The function is then called multiple times (I at that time had not optimized by code to run quickly) and used them to create list of Graphics Primitives. This one of the more developed versions of this method where the user physically inputs the amplitude and radii of the waves used to generate the desired function. In earlier versions I had an issue with getting animate to work; when I was not using slots in order to input lists and other information. I later found out that the function "Animate" had a "HoldAll" attribute which meant that it would not evaluate anything that is inputted directly in the Animate. Therefore, I had to adapt my code to evaluate outside the Animate and then be inserted into the Animate function via Slot Machines. ClearAll[fourierSeriesGraphicsV3] fourierSeriesCoordinates[numberCircles_,radiusList_List,frequencyList_List]:= With[ {protoList=MapThread[ {#1*Cos[#2*time],#1*Sin[#2*time]}&,{radiusList,frequencyList}] }, Plus@@@Table[protoList[[;;n]], {n,1,Length[protoList]}]//Prepend[{0,0}] ] fourierSeriesGraphicsV3[numberCircles_,radiusList_List,frequencyList_List]:= With[ { coordinateList=fourierSeriesCoordinates[numberCircles,radiusList,frequencyList], protoList=fourierSeriesCoordinates[numberCircles,radiusList,frequencyList], lastCoordinate=Drop[Apply[List, MapThread[ Circle,{ Drop[ fourierSeriesCoordinates[10,Reverse[Range[10]],Range[10]],-1], Reverse[Range[10]]} ]//Last],-1][[1,2]], circleList=Evaluate[ MapThread[ Circle,{ Drop[fourierSeriesCoordinates[numberCircles,radiusList,frequencyList],-1], radiusList} ] ] }, Animate[ Graphics[{#1,#2,Line[Last[coordinateList],{Total[radiusList]+10,lastCoordinate}]}], {time,0,2*Pi}, AnimationRunning->False]&@Evaluate[ (Line[coordinateList]),(circleList) ] ] ### Approach Two Although the previous method works, it is hard to know exactly if you are creating the desired function,Which means that you need to know what the radii/amplitudes and frequency where before you used this function. Hence my second approach. This approach was more of a function that would be built as an addition to the previous method. The new addition included a function built around the inbuilt function "FourierSeries" that took in function, variable, and number of terms as inputs and returned the equation of the approximation of the function as complex numbers.I had to use the inbuilt function "ComplexExpand" to get the equation in terms of Sine and Cosine. If the input function was even, then the Sine terms would cancel, and if the function is odd, then the Cosine terms canceled out. fourierInputV2[inputFunction_,variableUsing_,numberOfTerms_Integer]:= With[ {protoSeries=FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand, manipulateSeries=Drop[Apply[List,FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand],1], protoCoordinateSeries={ { Select[Drop[Apply[List,FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand],1],!FreeQ[#,Cos]&], Select[Drop[Apply[List,FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand],1],!FreeQ[#,Cos]&]/.Cos->Sin }, { Select[Drop[Apply[List,FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand],1],!FreeQ[#,Sin]&], Select[Drop[Apply[List,FourierSeries[inputFunction,variableUsing,numberOfTerms]//ComplexExpand],1],!FreeQ[#,Sin]&]/.Sin->Cos } } }, Join[ MapThread[List,{ Select[manipulateSeries,!FreeQ[#,Cos]&], Select[manipulateSeries,!FreeQ[#,Cos]&]/.Cos->Sin }], MapThread[List, { Select[manipulateSeries,!FreeQ[#,Sin]&], Select[manipulateSeries,!FreeQ[#,Sin]&]/.Sin->Cos } ] ] ] ### Final Approach And Why it worked #### Creating a New Visual For my final approach, I used a pair of functions called "FourierCosCoefficient" and "FourierSinCoefficient" in order separately get the radii of the circles. Then the many variables are used to artificially stitch together the coefficients and the frequencies; the code is using a descriete Fourier Transform, thus allowing me to artificially generate the frequencies used. Then the artificially generated Fourier series is used to generate coordinates. In the beginning I had the x coordinates to be in terms of Cosine and y coordinates in terms of Sine which caused the rotating parts to move in the counter clockwise direction. This function then creates individual moving plots which are then combined with the circles through the "Show" function to give the illusion that the circles are creating the plots. This function is named "unblendedCosCircleSmoothie" because this function returns the separate waves that were added to create the approximation, hence the "ingredients" in the "smoothie." I created this function as a demonstration to show how separate waves and circles can create function when combined together; the different steps of the process would be a good visual aid in understanding the concept of what the Fourier Series does. Below there is an example of the function that is used for the even functions. For the odd functions I replaced a few operations and switched wherever it Cos to Sine and vise-versa. ![unblend circle][1] ClearAll[unblendedCosCircleSmoothie] unblendedCosCircleSmoothie[function_,variable_Symbol,numCir_Integer]:= Block[ { fourierCoeff=Table[FourierCosCoefficient[function,variable,p],{p,1,numCir}], color=Drop[Hue[#]&/@Range[0,1,(1/numCir)],-1], circleList,basicCoord,manipulatedCoord,maxRadius,lineList,plotList,styledLines,prePlot }, circleList=Circle[{-maxRadius-5,0},#1]&/@Abs@fourierCoeff; basicCoord=MapThread[Times,{fourierCoeff,Cos[Range[numCir]*variable]}]; manipulatedCoord=Transpose[{basicCoord-maxRadius-5,basicCoord/.Cos->Sin}]; maxRadius=Max[Abs@fourierCoeff]; lineList=Line[{{-maxRadius-5,0},#1,{0,#1[[2]]}}]&/@manipulatedCoord/.variable->$time; styledLines=MapThread[Style,{lineList,color}]; prePlot=MapThread[Times,{fourierCoeff,Cos[(Range[numCir]*(variable+$time))-(Pi/2)]}]; plotList=Plot[#1,{variable,0,10},PlotStyle->#2]&@@@(Transpose[{prePlot,color}]); Animate[ Show[ Graphics[{Sequence@@#1,Sequence@@#2},Axes->True], Plot[#3,{variable,0,10},PlotStyle->#4,PlotRange->All],PlotRange->All ], {$time,0,-2Pi},AnimationRunning->False]&@@Evaluate[{circleList,styledLines,prePlot,color}] #### Creating the Nested Visual The following function is structured similar to the previous algorithm. However, the difference is that now the centers of the circles are not static and are changed so that they create a chain. There is an algorithm that takes the set of coordinates and nests them together so that the circles follow an orbit. Another difference in this function is that instead of creating different rotating arms form the origin in order to color them, I was able to insert the entire nested function list into the line which created a line that appeared to be segmented. ![circle chain][2] ClearAll[circleCosSmoothie2] circleCosSmoothie2[function_,variable_Symbol,numCir_Integer]:= Block[{ fourierConstant=FourierCosCoefficient[function,variable,0]//ComplexExpand, fourierCoeff=Table[FourierCosCoefficient[function,variable,p],{p,1,numCir}], basicCoord,manipulatedCoord,lastYCoord,totalRadius,combinedCir,cirCenter, cirArguments,finalPlot,lineSeries,centerOfFirstCir,listOfCoord,lastLinetoYaxis, lastXCoord,plotCoord,plotAllign }, totalRadius=Total[Abs@fourierCoeff]; basicCoord=MapThread[Times,{fourierCoeff,Cos[Range[numCir]*$time]}]; manipulatedCoord=Join[ Take[ Transpose[ {(basicCoord-totalRadius-5)/.Cos->Sin,basicCoord}],1], Drop[Transpose[{basicCoord/.Cos->Sin,basicCoord}],1]]; manipulatedCoord=(Plus@@@Table[ manipulatedCoord[[;;n]], {n,1,Length[manipulatedCoord]}]//Prepend[{-totalRadius-5,0}]); lastYCoord={0,Take[Take[manipulatedCoord,-1]//Flatten,-1]}; plotCoord=Total[MapThread[Times,{fourierCoeff,Cos[((Range[numCir])*(variable+$time))]}]]; cirCenter=Drop[manipulatedCoord,-1]; cirArguments=Transpose[{cirCenter,Abs@fourierCoeff}]; lastLinetoYaxis=Prepend[Take[Take[manipulatedCoord,-1]//Flatten,-1],0]; combinedCir={Circle[#1,#2]}&@@@(#1&/@cirArguments); lineSeries= Line[#1]&@(Append[manipulatedCoord,lastLinetoYaxis]); Animate[ Show[ Graphics[{Sequence@@#1,#2},Axes->True], Plot[#3,{variable,0,3*#4},PlotRange->Full], PlotRange->{{-3*#4,3#4},{-#4,#4}} ], {$time,0,-2Pi},AnimationRunning->False]&@@Evaluate[{combinedCir,lineSeries,plotCoord,totalRadius}] ] #### Making a Funciton that works for all curves ![a non symetirc function][4] Unlike the other functions, this function uses the FourierSeries function and then extracts data from the equation itself (There are more detailed comment on what each step does in the code ). I turn the equation into a list and then separate the sine and cosine terms into different lists. Then a little bit more modification is needed to extract the coefficients which was done by replacing all the terms in a specific pattern to 1 so that it would multiply out and only leave me with the coefficients. Then I have functions similar to the previous ones which create a list of circle and line Graphics Primitives ClearAll[circleSmoothietheRest] circleSmoothietheRest[function_,variable_,numCir_]:= Block[ {proto=FourierSeries[function,variable,numCir]//ComplexExpand,protoList2,cosList,sinList,cosCoeff,sinCoeff, basicCosCoord,basicSinCoord,totalRadius,manipulatedCosCoord,manipulatedSinCoord,manipulatedCoord, lastYCoord,plotCoord,cirCenter,cirArguments,lastLinetoYaxis,combinedCir,lineSeries,range,fourierCoeff}, protoList2=Drop[Apply[List,proto],1]; cosList=Take[protoList2,numCir]; sinList=(Apply[Plus,Partition[Drop[protoList2,numCir],2],{1}]); cosCoeff=ReplaceAll[#1,Cos[x_]->1]&/@cosList; sinCoeff=(ReplaceAll[#1,Sin[x_]->1]&/@sinList); totalRadius=Echo@(Abs@(Total[Abs@cosCoeff]+Total[Abs@sinCoeff])); fourierCoeff=Abs@Join[cosCoeff,sinCoeff]; manipulatedCosCoord=Join[ Take[ Transpose[ {(cosList-10)/.Cos->Sin,cosList}],1], Drop[Transpose[{cosList/.Cos->Sin,cosList}],1]]; manipulatedSinCoord=Join[ Take[ Transpose[ {(sinList-10)/.Sin->Cos,sinList}],1], Drop[Transpose[{sinList/.Sin->Cos,sinList}],1]]; manipulatedCoord=(Join[manipulatedCosCoord,manipulatedSinCoord]/.x->$time); manipulatedCoord=(Plus@@@Table[ manipulatedCoord[[;;n]], {n,1,Length[manipulatedCoord]}]//Prepend[{-10,0}]); lastYCoord={0,Take[Take[manipulatedCoord,-1]//Flatten,-1]}; plotCoord=(Total[cosList]+Total[sinList])/.variable->(variable+$time); cirCenter=Drop[manipulatedCoord,-1]; (*I need to find a way to extract the radii of the Circles*) cirArguments=Transpose[{cirCenter,fourierCoeff}]; lastLinetoYaxis=Prepend[Take[Take[manipulatedCoord,-1]//Flatten,-1],0]; combinedCir={Circle[#1,#2]}&@@@(#1&/@cirArguments); lineSeries= (Line[#1]&@Evaluate[Append[manipulatedCoord,lastLinetoYaxis]]); range=(2Pi)*totalRadius; Animate[ Show[ Graphics[{Sequence@@#1,#2},Axes->True], Plot[#3,{variable,0,30},PlotRange->Full] ], {$time,0,-2Pi},AnimationRunning->False]&@@Evaluate[{combinedCir,lineSeries,plotCoord}] ] #### Putting it All Together This code was written to separate the odd and even functions and use the corresponding function to them; for even functions I used the cosine functions and for the odd functions I used sine functions. I also added a plot of the original function to show how the approximation compares. ClearAll[fourierCircleCookBook] fourierCircleCookBook[function_,variable_Symbol,numCir_Integer]:= Which[ PossibleZeroQ[function-(function/.variable->(-variable))], Row[ {unblendedCosCircleSmoothie[function,variable,numCir], circleCosSmoothie2[function,variable,numCir], Plot[function,{variable,-30,30},PlotStyle->Black,Frame->True,ImageSize->Medium,Axes->False]} ], PossibleZeroQ[function+(function/.variable->(-variable))], Row[ {unblendedSinCircleSmoothie[function,variable,numCir], circleSinSmoothie2[function,variable,numCir], Plot[function,{variable,-30,30},PlotStyle->Black,Frame->True,ImageSize->Medium,Axes->False]} ], True, circleSmoothietheRest[function,variable,numCir] ] ## Further Improvements In the future, I will create a function that identifies the frequencies itself and provides a visual step by step of the built in function. Currently we need to input a function in order to get an output. In the future I want to implement a function that will take in an audio file and filter out the different frequencies and provide a visual for how it does it. [1]: https://github.com/MukilanKarthikeyan/WSSProject-Visualizing-the-Fourier-Series/blob/master/Final%20Project/Final%20Submission/Fourier_parabola_unblend.gif?raw=true [2]: https://github.com/MukilanKarthikeyan/WSSProject-Visualizing-the-Fourier-Series/blob/master/Final%20Project/Final%20Submission/Fourier_parabola.gif?raw=true [3]: https://github.com/MukilanKarthikeyan/WSSProject-Visualizing-the-Fourier-Series [4]:https://github.com/MukilanKarthikeyan/WSSProject-Visualizing-the-Fourier-Series/blob/master/Final%20Project/Final%20Submission/Fourier_randomfunction_combined.gif Mukilan Karthikeyan 2019-07-12T02:07:12Z https://community.wolfram.com/groups/-/m/t/148526 1 ) How to use the math functions over graphs that are not in the data graph of Mathematica? 2 ) How to compute Chromatic Poynomials for a graph introduced by myself ? Reinaldo Giudici 2013-11-04T13:57:36Z https://community.wolfram.com/groups/-/m/t/617724 Input: "factor 25" (http://www.wolframalpha.com/input/?i=factor+25) ----------------------------------------------------------------- **Incorrect result returned:** ![Incorrect prime factorization of 25][1] We should get **5^2** **Using *Mathematica* we get the correct factorization** ![Prime factorization of 25 using **Mathematica**][2] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Captura.PNG&userId=410040 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Captura2.PNG&userId=410040 Why did Wolfram|Alpha return that result? RorriNator 7 2015-11-19T16:46:50Z https://community.wolfram.com/groups/-/m/t/777582 Dear fellow forum members, Who can help me with the following problem? I have a list that looks as follows: **{ {f1,x1,y1}, {f2,x2,y2}, ...}**. I wish to express f as a function of x and y by use of Mathematica's ListInterpolation. The documentation for ListInterpolation tells me that I must use the following syntax: **ListInterpolation[list,{{x1,x2,...},{y1,y2,....}}]**. In other words: it looks as if my data points **must** be defined on all the intersection points of a grid of perpendicular lines in the (x,y)-plane. In the data set I am working with, this is not the case (i.e. the (x,y) in my data set don't form a rectangular grid.) I cannot imagine that Mathematica is so restrictive. There must be a good workaround for this. Does anybody have a good idea? Thanks in advance, René Samson Rene Samson 2016-01-23T19:32:52Z https://community.wolfram.com/groups/-/m/t/128136 I am on a quest to determine the 13th term in [b][url=http://oeis.org/A229024]Sloane's (OEIS) A229024[/url][/b], a sequence that I recently authored. This sequence is all about calculating [b]Total[IntegerDigits[n!][/b] for a reasonably large subset of contiguous n. For the 13th term, n is in the vicinity of 182623000, the factorial of which has more than 1.4*10^9 decimal digits. It takes some 20 minutes for Mathematica to return on my system the sum of the digits of one such n!, so it will take me many months to chart the roughly 15000 sums that I think need to be done. Unfortunately, I am finding that for a random, roughly-2% of the n that I try, Mathematica returns an erroneous result. For example, I get for [b]Total[IntegerDigits[182616009!]][/b] a value of 1600311191. I know that this sum is incorrect because it is not evenly divisible by 9. (It is also significantly smaller than the sum of digits for nearby n-factorial. It appears that [b]IntegerDigits[182616009!][/b] introduces more than a billion [i]additional[/i] trailing zeros preceding the 45653996 trailing zeros that I expect.)  I've reported the bug to Wolfram in the hope that this will be fixed in some future version, assuming of course that it is not my system that is responsible. So what procedure can I use to get a [i]correct[/i] value for [b]Total[IntegerDigits[182616009!]][/b] in the interim? I thought to use [b]DigitCount[182616009!][/b] but [b]Total[RotateRight[DigitCount[182616009!]]*Range[0, 9]][/b] results in the identical incorrect value as before. Hans Havermann 2013-09-23T00:52:55Z https://community.wolfram.com/groups/-/m/t/535997 I am testing sequence prediction. If things happen in a specific sequence, what will the likely next step in the sequence be? Computational power should be included in machine learning algorithms but not even Google's "Prediction API" can solve this simple mathematical exercise. In fact, in my naivety, I reported it as a possible bug and they emailed me: > As far as your example, the Prediction API will not learn that particular pattern because when trying to classify, it will choose from one of the output classes seen in the training set, so without instances of class "10th", it will not even know that such a class exists, does that make sense? I have used two simple data sets. Categorization: catData={ {"1st", "2nd", "3rd", "4th", "5th", "6th", "7th", "8th"}, {"2nd", "3rd", "4th", "5th", "6th", "7th", "8th", "9th"}, {"3rd", "4th", "5th", "6th", "7th", "8th", "9th", "10th"}, {"4th", "5th", "6th", "7th", "8th", "9th", "10th", "1st"}, {"5th", "6th", "7th", "8th", "9th", "10th", "1st", "2nd"}, {"6th", "7th", "8th", "9th", "10th", "1st", "2nd", "3rd"}, {"7th", "8th", "9th", "10th", "1st", "2nd", "3rd", "4th"}, {"8th", "9th", "10th", "1st", "2nd", "3rd", "4th", "5th"}, {"9th", "10th", "1st", "2nd", "3rd", "4th", "5th", "6th"} } c=Classify[catData->1]; Classification request: c[{"1st","2nd","3rd","4th","5th","6th","7th"}] I have purposely left out a sequence pattern starting with "10th" to see if the model can predict it given the right data sample. Expected Result: Output="10th" Unexpected Result: Output="1st" I also attempted this with a regression model. Regression: predictData={ {1,2,3,4,5,6,7,8}, {2,3,4,5,6,7,8,9}, {3,4,5,6,7,8,9,10}, {4,5,6,7,8,9,10,1}, {5,6,7,8,9,10,1,2}, {6,7,8,9,10,1,2,3}, {7,8,9,10,1,2,3,4}, {8,9,10,1,2,3,4,5}, {9,10,1,2,3,4,5,6} } p=Predict[predictData->1]; Prediction request: p[{1,2,3,4,5,6,7}] Expected Result: Output=10 Unexpected Result: Output=6 This represents a real world scenario where I am trying to pick the best option to present to a user based on their past behavior. So the next item is unknown because no user has chosen it before and the classification label hasn't been added to the training yet because it's crowd generated dynamically. However, we don't want to just give them any random option. We want to give them something highly relevant during the first interaction with the system. The whole premise of "prediction" seems to imply the ability to predict a categorical label based on other example labels. In this data set, it should be easy to identify the pattern and auto generate 10th as a category label. In this scenario, mathematics is all that is needed to determine the next item in a sequence. I guess if we have tons of sequences not all in perfect order but close, machine learning algorithms becomes much more useful. If there is already a known solution to this issue, that would be amazing to know. Forgive me for not being trained/educated enough to question why this isn't already built into all machine learning algorithms already. I suppose someone could use transpose to create a model out of the columns in the dataset in addition to the rows. However, in my view, anything related to permutations, shifting, changing, organizing, reordering, etc. of the data to find better predictions should be natively built into the algorithms. Even auto generating new columns/features based on patterns, sequences, math equations, etc. that can be derived from the existing data should be automated. None of these things require human input and are mathematical in nature. I bring this to the Wolfram community because the WL is uniquely positioned to tap into knowledge and computation in order to create drastically superior machine learning functions. If everything can be symbolic, everything can be computed. David Johnston 2015-07-25T16:47:28Z https://community.wolfram.com/groups/-/m/t/612319 Hello, Can anyone tell me how to get Mathematica to draw a Brunnian 5 links. Many thanks. ali cherad 2015-11-13T10:12:00Z 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/1620017 Hello everyone, I’ve just joined the community. On March 5th I'm giving a Meetup group presentation titled "The Greatest Unsolved Problem in Mathematics", which is of course the Riemann hypothesis. I will include many classical images of races between the prime "staircase" and various functions. I also want to include entertaining sounds, so I made this example of how zeta “waves” sum to prime “spikes”. zwave[n_,x_]:=Cos[Im[ZetaZero[n]] Log[x]]; Plot[zwave[1,x],{x,1,10}] Plot[zwave[2,x],{x,1,10}] Plot[Sum[zwave[n,x],{n,1,60}],{x,2,12}] However, I can’t figure out how to turn these plots into sound in a pleasant Hz range. I tried increasing the frequency by using a multiplier inside, but I keep getting something inaudible. Can someone help me create sound out of these plots, and explain what a general strategy might be? P.S. Any contributions of great sounds generated by primes and zeta zeroes would be welcome, and I’ll attribute you in my talk. Greg Keogh 2019-02-25T07:01:37Z https://community.wolfram.com/groups/-/m/t/442573 I know Mathematica has the default function for Fibonacci Serie but I need do a function that calculate any number that I introduce, for example: n=2 fib=[n_]... So the result for the Fibonacci Serie it's 1 (1,1,2,3,5,8...) Please anyone help me to generate this function and please explain why and the stepwise Camilo Pacheco 2015-02-15T20:15:49Z https://community.wolfram.com/groups/-/m/t/571483 Hi everyone, Suppose I have an undirected graph G = Graph[{1 <-> 2, 2 <-> 3, 2 <-> 4, 3 <-> 4}, EdgeLabels -> {1 <-> 2 -> A, 2 <-> 3 -> B, 2 <-> 4 -> C, 3 <-> 4 -> D}] ![enter image description here][1] [1]: /c/portal/getImageAttachment?filename=Graph4.jpg&userId=389289 I used `FindPath[G, 1, 4, Infinity, All]` and got the result as > {{1, 2, 4}, {1, 2, 3, 4}} Although this result is true, I want this result to display possible paths in terms of edges, and not vertices. For above example, I want the result to be > {{A, C}, {A, B, D}} Is there any way to do this? Actually, I have a large graph with **107** possible paths from source node to destination node, and I want to identify those paths with respect to edges. Please help. Thank you. Azhar Uddin Mohammed 2015-09-28T03:48:38Z https://community.wolfram.com/groups/-/m/t/2397426 I am very new to Mathematica and have to rethink my 'procedural' ways of programming. That is not always easy. I am making progress, but here I have no clue, besides going down the 'repeat and if' rabbit hole. I create a list of random integers. I have a Dynamic Slider to adjust delta (between 0 and 20). Let's say the Slider is adjusted to value 10. Now I want all the integers in the list that are 10 or less apart, to become the same integer. E.g. myIntegers = {11,28,66,36,94,8,44} After the 'treatment' the list should be : {11,28,66,**28**,94,**11**,44} The 36 is within 10 from 28 and the 8 is also within 10 from 11, so in both cases the integer within the delta range gets to be the value of the first (36 becomes 28). How could I go about this problem in a functional or symbolic way? B. Cornas 2021-10-31T16:38:00Z https://community.wolfram.com/groups/-/m/t/1395404 Hi Guys! I hope all of you are fine :) Maybe someone can tell me here how can I find with Wolfram Alpha or Mathematica the nth's of larger primes? I used "PrimePi", but "PrimePi" works not with large primes (primes like these 1921773217311523519374373 do not work...too large...). Is there a criterion, method and or a script with which I can find the nth's of larger primes? I have also used the "nthprime" function, but i think this is not what i need, but when there is a method with the nth prime function to find the "th's" of larger primes, can someone here show me, how it works? To better understanding what i mean, here an example: - 2 is the 1(<-i need this number).Primenumber - 3 is the 2(<-i need this number).Primenumber - 5 is the 3(<-i need this number).Primenumber - 7 is the 4(<-i need this number).Primenumber and so on...another example: 19 is the 8th (!) Prime, 23 is the 9th (!) Prime, 29 is the 10th (!) Prime... now i need a function to find which prime is 1921773217311523519374373? I need a function to get that out, i hope anybody here has an idea how can i find with WolframAlpha or Mathematica which/what (!) prime is 1921773217311523519374373. I hope anyone can help me here. Kind regards and best wishes. Nural I. 2018-07-31T18:14:09Z https://community.wolfram.com/groups/-/m/t/356717 Sometimes I need to do **vertex enumerations** on Mathematica. There used to be a `VertexEnum.m` package, even though it is very old and lacks of efficiency. However, after upgrading to *Mathematica 10*, this package doesn't work any more. Are there an latest `VertexEnum.m` package working with the latest version of *Mathematica* or any other packages doing the vertex enumeration job? **Update:** I have fixed the bug in package `VertexEnum.m` and now it works in *Mathematica 10*. But the efficiency of this package drives me crazy. I looked into the package and found that package `VertexEnum.m` have a much more efficient `C` implementation named `cddlib`. It has a prebuilt interface to *Mathematica* called `cddmathlink` or `cddmathlink2`. However, it was compiled about 10 years ago, and dose not work on the lasted *OS X 10.9*. So my question is who has latest version of `cddmathlink` or `cddmathlink2` which works in latest *Mathematica* or who can recompile the interface to *Mathematica* for me on *OS X 10.9*. (I have been trying to recompile it by myself for almost a month, but apparently I'm not that material at all.) For more information about `cddlib`, you may find its homepage [here](http://www.inf.ethz.ch/personal/fukudak/cdd_home/). Han Xiao 2014-09-27T05:22:08Z https://community.wolfram.com/groups/-/m/t/481830 I am writing a function to price European option using backward induction finite difference method. The function is expected to price a European option taking Stock (stock_), age (time_), volatility (vol_), interest rate (int_), contractual expiry (expn_), type of payoff (payoff_),Strike ( strike_), number of asset steps used for evaluation option (nas_). I am expecting function to return price of the option based stock price and age (if option is bought today age is zero). I need help as I am only few weeks into mathematica programming so might be making basic mistakes. My code is as attached. Can anybody opine where I am going wrong. Regards Kausik Datta 2015-04-19T15:10:21Z https://community.wolfram.com/groups/-/m/t/919714 If you're interested in prime number theory and the Riemann hypothesis, I'm guessing you'll probably be interested in the attached document in which I illustrate Fourier series for prime number counting functions including Riemann's prime number counting function and Chebyshev's prime number counting function. I also included a couple of plots from the document below which I believe best illustrate the essence of the information contained within the document. Fourier Series for Riemann's Prime Counting Function: ![Fourier Series for Riemann's Prime Counting Function][1] Fourier Series for Chebyshev's Prime Counting Function: ![Fourier Series for Chebyshev's Prime Counting Function][2] I added the Raspberry Pi group to this post because I created the attached document and performed all of the evaluations contained within the document using the Mathematica version which comes bundled with the Raspbian operating system. A complete evaluation of the attached document takes approximately one hour with Mathematica running on a Raspberry Pi 3 Model B. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dOfjFourierSeries.jpeg&userId=611298 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dOflFourierSeries.jpeg&userId=611298 Steven Clark 2016-09-06T04:29:20Z https://community.wolfram.com/groups/-/m/t/511713 Hi all, I am looking at Hasse Diagrams on the power set of {1, 2, ..., n} (trying to augment this code: http://demonstrations.wolfram.com/HasseDiagramOfPowerSets/ ). I have a subset of the power set, C, and I want to track which elements in the Hasse diagram are connected to each element of C. Ideally, I would like to edit the EdgeColor section of the code to EdgeStyle with a simple pattern, essentially saying "If any node X is connected to any node Y in C, make the line between X and Y be dashed (or another color, etc)." I've experimented using MemberQ PatternTests, but so far nothing has come to fruition. This is one of my first times using Mathematica; any help is greatly appreciated! Thanks Zev Woodstock 2015-06-10T02:37:40Z https://community.wolfram.com/groups/-/m/t/972050 Hello I have an algorithmus which I like to undestand and solve with Mathematica. It is about cooking. You need at least 18 people for it. Each group (2 people) are cooking either appetizer, main dish or dessert at their place. 2 other groups are visiting them. For the other two courses the group is the invited to another hosts' homes. Each location you meet new people (2 new groups). That means at the end you met 6 groups (12 people). Its a lot of fun. I want to organize this for my birthday party. Goal is it, to maximise the happinies factor. Only this way you can make sure, that in each different location you will see new people that you will not meet in the 2 other locations. ![enter image description here][2] There are some constrains which we have to consider: I like to know how to handle this problem with Mathematica. Where do I start? Which equation do I have to solve here? I don't see what I realy need to do... As I sad, you need minimum 18 people. That means we have 9 teams and 3 major groups. Ok, but I don't know what to do next and how I implement this in Mathematica. I guess it should not be so difficult but I need some help from you! Peter Parker 2016-11-30T23:26:19Z https://community.wolfram.com/groups/-/m/t/906971 Hello, big fan of Wolfram here, but I'm new. I'm using the Wolfram Development Platform. I wanted to inquire about the use of set-builder notation in the wolfram language. I've been over the documentation but I'm having some trouble. How would I enter the following simple statement in the Wolfram language? E = { 2n : ![enter image description here][1] } Additionally, how would I have wolfram return a random member of this set for n<1000? Thank you. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Inline6.gif&userId=906955 B M 2016-08-17T17:54:47Z https://community.wolfram.com/groups/-/m/t/917888 Hi all! I'm new to the Wolfram Forum community and it is a pleasure to be here. I have a quick question for those who have expertise in the use of Mathematica.... Is Mathematica able to solve the following system of recurrence relations? I'm looking for a "closed-form" formula for w(2n+1). ------------------------------------------------- For n greater than or equal to 3, w(2n+1) = a(n+1), a(n) = 3*a(n-1) + a(n-2) - a(n-3), a(0) = 1, a(1) = 2, a(2) = 7, w(1) = 2, w(3) = 7, and w(5) = 22. Any help is greatly appreciated! Sincerely, Richard M. Low richard.low@sjsu.edu Richard Low 2016-09-02T22:27:52Z