Message Boards Message Boards

0
|
7827 Views
|
12 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Can Mathematica suss out a pattern in several functions, predict next one?

Posted 11 years ago
So, I have several functions I've been working on, and was hoping to find a more general form. I guess they're maybe a series, of sorts, or could be.

I've been a bit out of the Mathematics game since High School and a little bit in College. So, I'm a bit rusty on my terminology, etc.

Here are a couple examples:
PolarPlot[(Abs[Cos[0]] + Abs[Cos[2 Pi/4]]) / ((Abs[Cos[x]] + Abs[Cos[x + 2 Pi/4]])), {x, 0, 2 Pi}]
PolarPlot[(Abs[Cos[Pi/6]] + Abs[Cos[3 Pi/6]] + Abs[Cos[5 Pi/6]]) / (Abs[Cos[x + Pi/6]] + Abs[Cos[x + 3 Pi/6]] + Abs[Cos[x + 5 Pi/6]]), {x, 0, 2 Pi}]
PolarPlot[(Abs[Cos[0]] + Abs[Cos[2 Pi/8]] + Abs[Cos[4 Pi/8]] + Abs[Cos[6 Pi/8]]) / (Abs[Cos[x]] + Abs[Cos[x + 2 Pi/8]] + Abs[Cos[x + 4 Pi/8]] + Abs[Cos[x + 6 Pi/8]]), {x, 0, 2 Pi}]
PolarPlot[(Abs[Cos[Pi/10]] + Abs[Cos[3 Pi/10]] + Abs[Cos[5 Pi/10]] + Abs[Cos[7 Pi/10]] + Abs[Cos[9 Pi/10]]) / (Abs[Cos[x + Pi/10]] + Abs[Cos[x + 3 Pi/10]] + Abs[Cos[x + 5 Pi/10]] + Abs[Cos[x + 7 Pi/10]] + Abs[Cos[x + 9 Pi/10]]), {x, 0, 2 Pi}]
PolarPlot[(Abs[Cos[0 Pi/12]] + Abs[Cos[2 Pi/12]] + Abs[Cos[4 Pi/12]] + Abs[Cos[6 Pi/12]] + Abs[Cos[8 Pi/12]] + Abs[Cos[10 Pi/12]])/(Abs[Cos[x + 0 Pi/12]] + Abs[Cos[x + 2 Pi/12]] + Abs[Cos[x + 4 Pi/12]] + Abs[Cos[x + 6 Pi/12]] + Abs[Cos[x + 8 Pi/12]] + Abs[Cos[x + 10 Pi/12]]), {x, 0, 2 Pi}]

What I'm hoping to do is to generalize these.

That is, my hope is that each of these corresponds to a specific iteration of some super-function. Such that maybe by specifying a certain variable, it would reproduce the associated function.

It would be cool if Mathematica could take these individual functions and compare them and generalize them for me. It's save a considerable amount of work and maybe let me get at some other related problems more quickly.

So, what Mathematica function(s), if any, are capable of this?

It seems to me like maybe we should be able to rewrite JUST the functions being plotted above as something like:
f(4) = (Abs[Cos[0 Pi/4]] + Abs[Cos[2 Pi/4]]) / ((Abs[Cos] + Abs[Cos[x + 2 Pi/4]]))
f(6) = (Abs[Cos[Pi/6]] + Abs[Cos[3 Pi/6]] + Abs[Cos[5 Pi/6]]) / (Abs[Cos[x + Pi/6]] + Abs[Cos[x + 3 Pi/6]] + Abs[Cos[x + 5 Pi/6]])
f(8) = (Abs[Cos[0 Pi/8]] + Abs[Cos[2 Pi/8]] + Abs[Cos[4 Pi/8]] + Abs[Cos[6 Pi/8]]) / (Abs[Cos] + Abs[Cos[x + 2 Pi/8]] + Abs[Cos[x + 4 Pi/8]] + Abs[Cos[x + 6 Pi/8]])
f(10) = (Abs[Cos[Pi/10]] + Abs[Cos[3 Pi/10]] + Abs[Cos[5 Pi/10]] + Abs[Cos[7 Pi/10]] + Abs[Cos[9 Pi/10]]) / (Abs[Cos[x + Pi/10]] + Abs[Cos[x + 3 Pi/10]] + Abs[Cos[x + 5 Pi/10]] + Abs[Cos[x + 7 Pi/10]] + Abs[Cos[x + 9 Pi/10]])
f(12) = (Abs[Cos[0 Pi/12]] + Abs[Cos[2 Pi/12]] + Abs[Cos[4 Pi/12]] + Abs[Cos[6 Pi/12]] + Abs[Cos[8 Pi/12]] + Abs[Cos[10 Pi/12]])/(Abs[Cos[x + 0 Pi/12]] + Abs[Cos[x + 2 Pi/12]] + Abs[Cos[x + 4 Pi/12]] + Abs[Cos[x + 6 Pi/12]] + Abs[Cos[x + 8 Pi/12]] + Abs[Cos[x + 10 Pi/12]])

The question is can Mathematica then use those 5 examples of the "series" (I have more examples, up through at least about f(20) ...) and be able to predict the equivalent form of f(14), f(16), f(18), ..., f(n)? Actually, I'd be really interested if it managed to come up with any of the intermediate f's of "odd" values >= 3, as I've had no luck with figuring those out as of yet (or whether they're even possible, though I suspect they should be).

How would I go about this? It's been so long since I've had to try and do this kind of thing, I've all but forgotten how... Which sucks, 'cause way back when, I used to be pretty good at this kind of thing, when it was all fresh in my head.

Thoughts? Seems like this would/could/should be something Mathematica can handle. I just don't know what functions and parameters to use to even get it to try.

Thanks,
~MG
POSTED BY: Michael Gmirkin
12 Replies
Posted 11 years ago
Funny, somehow, I was working on something and accidentally got it to evaluate and then hold form correctly, thus:

HoldForm[PolarPlot[{(Abs[Cos[4Pi/4]]+Abs[Cos[6Pi/4]])/((Abs[Cos[x+4Pi/4]]+Abs[Cos[x+6Pi/4]])),
(Abs[Cos[5Pi/6]]+Abs[Cos[7Pi/6]]+Abs[Cos[9Pi/6]])/(Abs[Cos[x+5Pi/6]]+Abs[Cos[x+7Pi/6]]+Abs[Cos[x+9Pi/6]]),
(Abs[Cos[6Pi/8]]+Abs[Cos[8Pi/8]]+Abs[Cos[10Pi/8]]+Abs[Cos[12Pi/8]])/(Abs[Cos[x+6Pi/8]]+Abs[Cos[x+8Pi/8]]+Abs[Cos[x+10Pi/8]]+Abs[Cos[x+12Pi/8]]),
(Abs[Cos[7Pi/10]]+Abs[Cos[9Pi/10]]+Abs[Cos[11Pi/10]]+Abs[Cos[13Pi/10]]+Abs[Cos[15Pi/10]])/(Abs[Cos[x+7Pi/10]]+Abs[Cos[x+9Pi/10]]+Abs[Cos[x+11Pi/10]]+Abs[Cos[x+13Pi/10]]+Abs[Cos[x+15Pi/10]])},{x,0,2Pi}]]

Wasn't even thinking it would do that, but somehow it did. Rather than actually plotting the graphs, it just put the functions in their proper form.

Ohh, wait, I see I just copied the written out versions I was using to multi-plot several polygons on the same graph. D'oh! So, it's still not actually spitting things out from the Sigma function, just properly displaying the hand-written versions. *Sigh*

Ohh well, useful anyway to see it in standard form rather than input form. ^_^ Guess I'll use that for now, unless anyone has a suggestion on how to have it output the results of the Sigma function without "simplifying."

On another note, is it possible to somehow make mathematica fill in unknown iterations of a "sequence" if one supplies it with known values of specific positions?

I'd kind of like to be able to say positions, 2 ,4, 6, 8, 10 are these fuctions. Tell me what iterations 1, 3, 5 , 7, 9 are. Don't suppose Mathematica can do that somehow?

Best,
~MG
POSTED BY: Michael Gmirkin
Posted 11 years ago
@Ilian: Okay, I tried HoldForm[] but it didn't do what I was hoping.

v=14 (*v=number of vertices of the polygon.v must be an even integer\[GreaterEqual]4. Still haven't riddled out odd cases yet.*)
n=v/2
HoldForm[(Sum[Abs[Cos[((n+2+2(k-1))Pi)/(2n)]],{k,1,n}])/(Sum[Abs[Cos[x+(((n+2+2(k-1))Pi)/(2n))]],{k,1,n}]),{x,0,2Pi}]

It did give the literal value as written, but didn't actually expand the Series before outputting the final function. I tried putting in an Expand[] function around the Series(es), but it just left the Expand[](s) in place and printed those too, rather than actually expanding the Series and then HoldForm[]ing.

Any more ideas? emoticon To get it to expand the series(es), and then hold/output the expanded function without simplifying it?

This worked slightly better, but only slightly:

v=14 (*v=number of vertices of the polygon.v must be an even integer\[GreaterEqual]4. Still haven't riddled out odd cases yet.*)
n=v/2
Expand[(Sum[Abs[Cos[((n+2+2(k-1))Pi)/(2n)]],{k,1,n}]),Trig->True]/Expand[(Sum[Abs[Cos[x+(((n+2+2(k-1))Pi)/(2n))]],{k,1,n}]),Trig->True]

Which seems to be equivalent to this:

v=14 (*v=number of vertices of the polygon.v must be an even integer\[GreaterEqual]4. Still haven't riddled out odd cases yet.*)
n=v/2
TrigExpand[(Sum[Abs[Cos[((n+2+2(k-1))Pi)/(2n)]],{k,1,n}])]/TrigExpand[(Sum[Abs[Cos[x+(((n+2+2(k-1))Pi)/(2n))]],{k,1,n}])]

I'd still like to be able to prevent it from trying to simplify and instead just give me the correct initial literal output of the series expansion... So, how do I getexpansion but preventsimplification? =o\ Seems like there should be some parameter or switch or function that turns off simplification...

Thx,
~MG
POSTED BY: Michael Gmirkin
Posted 11 years ago
@Ilian: Thanks for HoldForm & Defer. Will have to try those out & see if they git 'er done. ;)

That said, knowing what I know about the function(s), I know that it's based on sinusoidal repeating patterns, and in some regards it doesn't matter which values are used for the Series(es) so long as they are adjacent or equivalent to those that would be adjacent. So, in fact:

PolarPlot[(Abs[Cos[4Pi/4]] + Abs[Cos[6Pi/4]]) / ((Abs[Cos[x + 4Pi/4]] + Abs[Cos[x + 6Pi/4]])),{x,0,2Pi}]

Works equally as well as:

PolarPlot[(Abs[Cos[0]] + Abs[Cos[2Pi/4]]) / ((Abs[Cos[x]] + Abs[Cos[x + 2Pi/4]])),{x,0,2Pi}]

And the fact that the original Sigma graphs forwarded previously alternated between circumradius = 1 & apothem = 1 @ theta=0 was down to the fact of using even corfficients for the series(es) in both numerator and denominator. In order to have the graph ALWAYS start with circumradius = 1 @ theta = 0, we have to switch off even and odd coefficient series(es).

By rewriting the series(es) as a series of progressive starts of the coeficient series, we can accomplish this.

PolarPlot[{(Abs[Cos[4Pi/4]]+Abs[Cos[6Pi/4]])/((Abs[Cos[x+4Pi/4]]+Abs[Cos[x+6Pi/4]])),
(Abs[Cos[5Pi/6]]+Abs[Cos[7Pi/6]]+Abs[Cos[9Pi/6]])/(Abs[Cos[x+5Pi/6]]+Abs[Cos[x+7Pi/6]]+Abs[Cos[x+9Pi/6]]),
(Abs[Cos[6Pi/8]]+Abs[Cos[8Pi/8]]+Abs[Cos[10Pi/8]]+Abs[Cos[12Pi/8]])/(Abs[Cos[x+6Pi/8]]+Abs[Cos[x+8Pi/8]]+Abs[Cos[x+10Pi/8]]+Abs[Cos[x+12Pi/8]]),
(Abs[Cos[7Pi/10]]+Abs[Cos[9Pi/10]]+Abs[Cos[11Pi/10]]+Abs[Cos[13Pi/10]]+Abs[Cos[15Pi/10]])/(Abs[Cos[x+7Pi/10]]+Abs[Cos[x+9Pi/10]]+Abs[Cos[x+11Pi/10]]+Abs[Cos[x+13Pi/10]]+Abs[Cos[x+15Pi/10]])},{x,0,2Pi}]

In Sigma notation it looks more like this:

v=8 (* v = number of vertices of the polygon. v must be an even integer >= 4. Still haven't riddled out odd cases yet. *)
n=v/2
PolarPlot[(Sum[Abs[Cos[((n+2+2(k-1))Pi)/(2n)]],{k,1,n}])/(Sum[Abs[Cos[x+(((n+2+2(k-1))Pi)/(2n))]],{k,1,n}]),{x,0,2Pi}]

This seems to pretty effectively give the outputs I was after in terms of graphs... Just plug the number of sides into the "v = ..." line (as long as v is an even integer >= 4). Odds still don't work in this scenario, but it's yet one step closer to riddling it all out.
POSTED BY: Michael Gmirkin
It is possible to display expressions in unevaluated form, e.g. using HoldForm or Defer. This is a quick attempt that could use improvement:
f[n_?EvenQ] := Module[{r = Pi (Range[Mod[n/2, 2], n - Mod[n + 1, 2], 2])/HoldForm[n],
   sum = Plus @@ Abs[Cos[#]] &}, r = r /. {0 -> HoldForm[0]}; sum[r]/sum[x + r] /. {x + HoldForm[0] -> x}]

f[8]


The function func does contain Mod, nevertheless it is continuous and for even n it is equivalent to f but represented in a much more compact way. We can see their plots match exactly (a rigorous mathematical proof should not be very hard).
func[n_] := Cos[Pi/n]/Cos[Mod[x, 2 Pi/n] - Pi/n]

Plot[{func[8], ReleaseHold[f[8]]}, {x, 0, 2}]



By the way, I'd like to recommend the great blog series by Michael Trott about Making Formulas… for Everything — From Pi to the Pink Panther to Sir Isaac Newton which tackles various complicated shapes -- a step up from regular polygons!
POSTED BY: Ilian Gachevski
Posted 11 years ago
Doing a little bit of exploring on my own and stumbled across Sequences and Series...

PolarPlot[(Sum[Abs[Cos[((k-1)2Pi)/4]],{k,1,2}])/(Sum[Abs[Cos[x+(((k-1)2Pi)/4)]],{k,1,2}]),{x,0,2Pi}]

Well, that seems to do the job nicely for the function of 4. Might have to do a little more exploring on my own, see what the other sequences / series might look like. Unless someone cares to off up some additional interesting tidbits or avenues of exploration.

Entirely possible I'm treading down a garden path here, though I feel intuitively like there should be solutions, eventually... ^_^

Dang, learn one little thing and it simplifies your life, doesn't it?

n=10
PolarPlot[(Sum[Abs[Cos[((k-1)2Pi)/(2n)]],{k,1,n}])/(Sum[Abs[Cos[x+(((k-1)2Pi)/(2n))]],{k,1,n}]),{x,0,2Pi}]

This is even slightly better:

v=18(* v = vertices, v must currently be an even integer *)
n=v/2
PolarPlot[(Sum[Abs[Cos[((k-1)2Pi)/(2n)]],{k,1,n}])/(Sum[Abs[Cos[x+(((k-1)2Pi)/(2n))]],{k,1,n}]),{x,0,2Pi}]

It allows you to specify the even number of vertexes and get exactly that many ratherthan specifying an even number and getting twice as many vertexes as specified.

So, basically, this'll pretty much do it for any integer n >1. Only gives the even-sided polygons with vertexes >= 4 at this point, but it's a major step in the right direction. Amazing the things you can learn on Khan Academy, once you know what you're after.

Now, just wish I knew how to get it to spit out the literal un-simplified version of the formula(s), with all the bits and pieces expanded, intact and in the right positions. ^_^

P.S. Thanks Ilian, that looks interesting. Though I think I'd abandoned the Mod[] function some wile ago in attempting to manufacture a "continuous" function rather than a piecewise one... But, it seems to perform admirably for what it does. :o)

Any thoughts on the Sigma notation or Sum[] approach?

Seems like I've basically got that working, insofar as I've gotten with it... Save for the fact that that it alternates between the circumradius and the apothem of the polygon being aligned with and intersecting (1,0). As opposed to it being always the circumradius (or alternately always the apothem).

One step at a time, I suppose? ^_^

Anyway, any thoughts on how to get Mathematica to spit out the unsimplified formula that would be generated by the series expansion(s)? That is including all of the terms as they'd expand out without trying to cancel, factor, etc?

~MG
POSTED BY: Michael Gmirkin
Michael Gmirkin:
I'm hoping there's some methodology for finding a super-fuction that works properly for all polygons V>=3 (that is regular polygons with 3 or more sides/vertexes).

This should plot regular polygons for odd n too

func[n_] := Cos[Pi/n]/Cos[Mod[x, 2 Pi/n] - Pi/n]

Table[PolarPlot[func[n], {x, 0, 2 Pi}], {n, 3, 12}]
POSTED BY: Ilian Gachevski
Posted 11 years ago
@Christopher: Well, I got it "running" thus:
genf[n_]:=Sum[Abs[Cos[Pi i/n]],{i,Mod[n/2,2],n-Mod[n+1,2],2}]/Sum[Abs[Cos[x+Pi i/n]],{i,Mod[n/2,2],n-Mod[n+1,2],2}]
PolarPlot[genf[#],{x,0,2 Pi},PlotLabel->Row[{"n=",#}]]&/@Range[4,20]

Yes, it seems to superficially reproduce the even-sided figures well enough. But, if you actually run it, it clearly doesn't give the "correct" interstitial "odd-sided" figures, when graphed.

When graphed, the "odd-numbered" figures are merely distorted version of the even-sided figures, and not "proper" odd-sided polygons. So, it pretty clearly fails at my intent/interest.

That is:
4 --> Proper 4-sided polygon
5 --> Vertically distorted 6-sided polygon
6 --> Proper 6-sided polygon
7 --> Horizontally distorted 6-sided polygon
8 --> Proper 8-sided polygon
9 --> Vertically distorted 10-sided polygon
10 --> Proper 10-sided polygon
11 --> Horizontally distorted 10-sided polygon
12 --> Proper 12-sided Polygon
...
and so on.

I'm hoping there's some methodology for finding a super-fuction that works properly for all polygons V>=3 (that is regular polygons with 3 or more sides/vertexes).

There's a pretty clear pattern that emerges with the even sided ones, I guess I'm just hoping there's some way of using the known functions for f(4), f(6), f(8) and so on to compute or reverse-engineer similar functions for f(3), f(5), f(7), etc. And of course all the other even-sided functions.

----------

That said, is there a way to have Mathematica spit out the raw functions produced by this approach for the "even" version of the functions for a given range of inputs (say 4-->100)? As opposed to graphing them? Preferably without "simplifying" them in the process? It would just make it a tiny bit simpler than having to copy and paste and hand-correct each one for the desired result.

So, yeah, might it be possible to simply have Mathematica "assemble" the final functions (preferably in similar format to what I'd originally posted), without simplifying (which tends to make them rather impossible to read / suss out)?
POSTED BY: Michael Gmirkin
This is giving me the same formula and diagram as your f[4]
PolarPlot[genf[4], {x, 0, 2 Pi}]

Works for even and odd n >= 4
PolarPlot[genf[#], {x, 0, 2 Pi}, PlotLabel -> Row[{"n=", #}]] & /@ Range[4, 20]

The way I arrived at the formula generator was by building up the coefficient lists,
rawf[n_] := {Table[i/n, {i, Mod[n/2, 2], n - Mod[n + 1, 2], 2}], x + Table[i/n, {i, Mod[n/2, 2], n - Mod[n + 1, 2], 2}]}

Compare f[6] with rawf[6]
f[6] = (Abs[Cos[Pi/6]] + Abs[Cos[3 Pi/6]] + Abs[Cos[5 Pi/6]]) / (Abs[Cos[x + Pi/6]] + Abs[Cos[x + 3 Pi/6]] + Abs[Cos[x + 5 Pi/6]]);
In[ ]:= rawf[6]
Out[ ]= {{1/6, 1/2, 5/6}, {1/6 + x, 1/2 + x, 5/6 + x}}

n=6 uses {1/6, 1/2, 5/6} to make both parts of the quotent, comes from {1, 3, 5} / 6 or sequence / n
n=4 => {0, 2}
n=6 => {1, 3, 5}
n=8 => {0, 2, 4, 6}

It is not my impression that FindSequenceFunction is going to be able to handle a sequence of lists of increasing length.
@Michael: it won't do anything on its own - it's just a function definition. Rather like saying "if I'm holding something, then throw it in the air" doesn't actually cause the thing I'm holding to be thrown into the air - although if I follow the instructions, then it does.
f[total_,x_]:=Sum[Abs[Cos[n Pi/total]], {n, 0, total - 1, 2}]/Sum[
Abs[Cos[x+n Pi/total]], {n, 1, total, 2}]

PolarPlot[f[8,x],{x,0,2Pi}]
f[8,x]
That might give you better results.
POSTED BY: Patrick Stevens
Posted 11 years ago
@Christopher: I tried copying that into Mathematica but it didn't quite appear to do anything? Probably 'cause I don't see a fuction entitled genf[]?

@all: I wonder if something like FindSequenceFunction or FindGeneratingFunction would work? Hmm, tried it, but it doesn't seem to do anything either... Nothing comes up. Don't know if it's thinking, or if it just doesn't generate anything...

~MG
POSTED BY: Michael Gmirkin
The formation of the limits of the Sum may be a bit crude, but let me know if this does what you wanted.
genf[n_] :=
Sum[Abs[Cos[Pi i/n]], {i, Mod[n/2, 2], n - Mod[n + 1, 2], 2}]/
  Sum[Abs[Cos[x + Pi i/n]], {i, Mod[n/2, 2], n - Mod[n + 1, 2], 2}]
There is a function called FindLinearRecurrence, but I did not have any luck using this on your plot arguments (it took
a few minutes and then came back unevaluated).

http://reference.wolfram.com/mathematica/ref/FindLinearRecurrence.html
POSTED BY: Arnoud Buzing
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract