Group Abstract

Message Boards

WOLFRAM COMMUNITY

17.6K Views

10 Replies

3 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Recreation Wolfram|Alpha Wolfram Language

How do I create a multiple tree of the differences of a numerical sequence?

Kevin Teal

Posted 11 years ago

I'm new to Mathematica and on WolframAlpha when you input a short number sequence you'll usually get a nice differences tree, showing the differences of each level of differences. I was wondering how to get this same multi-level tree of the differences in longer numerical sequences on Mathematica? (instead of just one level at a time)

POSTED BY: Kevin Teal

10 Replies

Sort By:

Kevin Teal

Posted 11 years ago

You're right, it works fine on Mathematica... thanks, I really appreciate it, it's awesome! Is there a way though, to make it so that the actual sequence itself appears as the first line in the Output?

POSTED BY: Kevin Teal

Sander Huisman

Sander Huisman, University of Twente

Posted 11 years ago

Copy my second code.

POSTED BY: Sander Huisman

Kevin Teal

Posted 11 years ago

Sorry, didn't realize that. Thanks, Sander, I really appreciate your help. Have a great holiday!

POSTED BY: Kevin Teal

Kevin Teal

Posted 11 years ago

Still not working for me, although I'm trying it with Mathematica Online... don't know if that would make a difference, but when I get home tonight I'll try it then and see. Looks great when you did it!

POSTED BY: Kevin Teal

Sander Huisman

Sander Huisman, University of Twente

Posted 11 years ago

Try: ClearAll[xypos] xypos[xs_List,y_]:=MapThread[Text[#2,{#1,y}]&,{2Range[Length[xs]]-Length[xs],xs}] seq={1,2,3,4,10,19,36,69,134}; seqs=Differences[seq,#]&/@Range[1,Length[seq]-1]; heights=Range[Length[seqs],1,-1]; Graphics[MapThread[xypos,{seqs,heights}]] giving:

Try:

ClearAll[xypos]
xypos[xs_List,y_]:=MapThread[Text[#2,{#1,y}]&,{2Range[Length[xs]]-Length[xs],xs}]
seq={1,2,3,4,10,19,36,69,134};
seqs=Differences[seq,#]&/@Range[1,Length[seq]-1];
heights=Range[Length[seqs],1,-1];
Graphics[MapThread[xypos,{seqs,heights}]]

giving:

enter image description here

POSTED BY: Sander Huisman

Kevin Teal

Posted 11 years ago

That looks awesome, almost perfect, except that I want the original sequence to appear as the first line... how do I do that? (obviously completely new to Mathematica) Still though, when I copied it to try it, I got this result: SetDelayed::write: Tag Times in Null xypos[xsList,y] is Protected. It didn't come out.

POSTED BY: Kevin Teal

Sander Huisman

Sander Huisman, University of Twente

Posted 11 years ago

If i copy the above it works fine, clear your Memory (or restart mathematica) to be sure... here is it with the original sequence: ClearAll[xypos] xypos[xs_List, y_] := MapThread[Text[#2, {#1, y}] &, {2 Range[Length[xs]] - Length[xs], xs}] seq = {1, 2, 3, 4, 10, 19, 36, 69, 134}; seqs = Differences[seq, #] & /@ Range[0, Length[seq] - 1]; heights = Range[Length[seqs], 1, -1]; Graphics[MapThread[xypos, {seqs, heights}]]

If i copy the above it works fine, clear your Memory (or restart mathematica) to be sure...

here is it with the original sequence:

ClearAll[xypos]
xypos[xs_List, y_] := MapThread[Text[#2, {#1, y}] &, {2 Range[Length[xs]] - Length[xs], xs}]
seq = {1, 2, 3, 4, 10, 19, 36, 69, 134};
seqs = Differences[seq, #] & /@ Range[0, Length[seq] - 1];
heights = Range[Length[seqs], 1, -1];
Graphics[MapThread[xypos, {seqs, heights}]]

POSTED BY: Sander Huisman

Kevin Teal

Posted 11 years ago

Does anyone know how to produce a differences to multiple levels (like the above example from WolframAlpha) on Mathematica? I can sort of produce it, but not in the elegant way it looks above...

POSTED BY: Kevin Teal

Kevin Teal

Posted 11 years ago

Wow, thanks! Appreciate it. That is what I wanted essentially. Although now I'd like to figure out a way to make it look like this, if possible? This is how it appears in WolframAlpha:

POSTED BY: Kevin Teal

Daniel Lichtblau

Daniel Lichtblau, Wolfram Research

Posted 11 years ago

I was not able to figure out what you did in Wolfram\|Alpha (a specific example is always helpful). Possibly this will give a start along the lines of what you want. aa = {1, 81, 28, 13, 19, 57, 25, 87, 19, 44}; NestList[Differences, aa, 3] (* {{1, 81, 28, 13, 19, 57, 25, 87, 19, 44}, {80, -53, -15, 6, 38, -32, 62, -68, 25}, {-133, 38, 21, 32, -70, 94, -130, 93}, {171, -17, 11, -102, 164, -224, 223}} ) This variant will go all the way to the root, so to speak. Most[FixedPointList[Differences, aa]] ( Out[37]= {{1, 81, 28, 13, 19, 57, 25, 87, 19, 44}, {80, -53, -15, 6, 38, -32, 62, -68, 25}, {-133, 38, 21, 32, -70, 94, -130, 93}, {171, -17, 11, -102, 164, -224, 223}, {-188, 28, -113, 266, -388, 447}, {216, -141, 379, -654, 835}, {-357, 520, -1033, 1489}, {877, -1553, 2522}, {-2430, 4075}, {6505}, {}} *)

I was not able to figure out what you did in Wolfram|Alpha (a specific example is always helpful). Possibly this will give a start along the lines of what you want.

aa = {1, 81, 28, 13, 19, 57, 25, 87, 19, 44};
NestList[Differences, aa, 3]

(* {{1, 81, 28, 13, 19, 57, 25, 87, 19, 44}, {80, -53, -15, 6, 38, -32, 
  62, -68, 25}, {-133, 38, 21, 32, -70, 94, -130, 93}, {171, -17, 
  11, -102, 164, -224, 223}} *)

This variant will go all the way to the root, so to speak.

Most[FixedPointList[Differences, aa]]

 (*  Out[37]= {{1, 81, 28, 13, 19, 57, 25, 87, 19, 44}, {80, -53, -15, 6, 
    38, -32, 62, -68, 25}, {-133, 38, 21, 32, -70, 94, -130, 
    93}, {171, -17, 11, -102, 164, -224, 223}, {-188, 28, -113, 
    266, -388, 447}, {216, -141, 379, -654, 835}, {-357, 520, -1033, 
    1489}, {877, -1553, 2522}, {-2430, 4075}, {6505}, {}} *)

POSTED BY: Daniel Lichtblau

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback