Defining a function [Mathematica]

• Sep 28th 2008, 11:12 AM
bkarpuz
[SOLVED] Defining a function [Mathematica]
I want to define the following function:
$\varphi:\mathbb{N}\to\mathbb{N}\times\mathbb{N},$
..... $\ell$.. $\to$.. $\varphi(\ell):=\begin{cases}(m,n),&(-1)^{m+n}=1\\ (n,m),&(-1)^{m+n}=-1,\end{cases}$
where
$u:=\bigg\lceil\frac{\sqrt{8\ell+1}-1}{2}\bigg\rceil$
$\nu:=\frac{u(u+1)}{2}-\ell$
$m:=\nu+1$
$n:=u-v.$
This is a 1-1 and onto mapping.
Then it would be nice to call this function and plot the way
$\varphi(\ell)$ for $\ell=1\to100$.
Is that possible to define such a function?

I just figured out some simple definitions as $f[x\_]=x^{2}$, but I dont know how to define such a function which will exceed a line in its formulation and ranges to $\mathbb{N}^{2}$. (Blush)
• Sep 28th 2008, 11:55 AM
shawsend
Looks like the following. The additional code was just for fun: Rearrange the table so that the values {1,x} are in the first row, {2,x} are in the second row, etc. Then print out the table in matrix form to illustrate how the entries are being filled up in a diagonal manner. Looks like to me anyway.

Code:

u[x_] := Ceiling[(1/2)*(Sqrt[8*x + 1] -       1)]; v[x_] := (1/2)*u[x]*(u[x] + 1) - x; f[y_] := {v[y] + 1, u[y] - v[y]}; tlist = Table[f[n], {n, 1, 100}]; newtable = Table[Select[tlist,     First[#1] == n & ], {n, 1, 10}] MatrixForm[newtable]
Edit: I see you changes some things. The above was for the initial post.
• Sep 28th 2008, 12:09 PM
shawsend
Here's what I came up with for the new code including a check that the switch is taking place in the new list:

Code:

In[187]:= u[x_] := Ceiling[(1/2)*(Sqrt[8*x + 1] -       1)]; v[x_] := (1/2)*u[x]*(u[x] + 1) - x; fold[y_] := {v[y] + 1, u[y] - v[y]}; oldlist = Table[fold[n], {n, 1, 20}] fnew[y_] := Module[{m, n}, m = v[y] + 1;     n = u[y] - v[y]; If[(-1)^(m + n) == 1,     {m, n}, {n, m}]] newlist = Table[fnew[n], {n, 1, 20}] Out[190]= {{1, 1}, {2, 1}, {1, 2}, {3, 1}, {2, 2},   {1, 3}, {4, 1}, {3, 2}, {2, 3}, {1, 4},   {5, 1}, {4, 2}, {3, 3}, {2, 4}, {1, 5},   {6, 1}, {5, 2}, {4, 3}, {3, 4}, {2, 5}} Out[192]= {{1, 1}, {1, 2}, {2, 1}, {3, 1}, {2, 2},   {1, 3}, {1, 4}, {2, 3}, {3, 2}, {4, 1},   {5, 1}, {4, 2}, {3, 3}, {2, 4}, {1, 5},   {1, 6}, {2, 5}, {3, 4}, {4, 3}, {5, 2}}
• Sep 28th 2008, 12:23 PM
bkarpuz
yes this is exactly the definition I wanted to have.

but it draws the table too fast, is it possible to animate it one by one, or make the program sleep for 0.05 secs before plotting them?

Also I am thinking about plotting the table with ArrayPlot to indicate the current point for each step...

Thanks again.
• Sep 28th 2008, 12:45 PM
shawsend
The code below uses Manipulate (an animator) in version 6 to sequentially show each value (x,y) as a point in the plane as the slider bar is moved through the first 50 entries. If desired, we could set up a "tooltip" such that when you place the cursor over one of the points, it prints out the value of the point at the cursor location. I may try and get that to work. I don't understand how you wish to use ArrayPlot with this data.

Code:

u[x_] := Ceiling[(1/2)*(Sqrt[8*x + 1] -       1)]; v[x_] := (1/2)*u[x]*(u[x] + 1) - x; fnew[y_] := Module[{m, n}, m = v[y] + 1;     n = u[y] - v[y]; If[(-1)^(m + n) == 1,       {m, n}, {n, m}]]; newlist = Table[fnew[n], {n, 1, 20}]; Manipulate[Show[Graphics[Point @@     {Table[fnew[n], {n, 1, nmax}]}],   PlotRange -> {{0, 20}, {0, 20}},   Axes -> True], {nmax, 1, 50}]
• Sep 28th 2008, 01:02 PM
bkarpuz
Quote:

Originally Posted by shawsend
The code below uses Manipulate (an animator) in version 6 to sequentially show each value (x,y) as a point in the plane as the slider bar is moved through the first 50 entries. If desired, we could set up a "tooltip" such that when you place the cursor over one of the points, it prints out the value of the point at the cursor location. I may try and get that to work. I don't understand how you wish to use ArrayPlot with this data.

Code:

u[x_] := Ceiling[(1/2)*(Sqrt[8*x + 1] -       1)]; v[x_] := (1/2)*u[x]*(u[x] + 1) - x; fnew[y_] := Module[{m, n}, m = v[y] + 1;     n = u[y] - v[y]; If[(-1)^(m + n) == 1,       {m, n}, {n, m}]]; newlist = Table[fnew[n], {n, 1, 20}]; Manipulate[Show[Graphics[Point @@     {Table[fnew[n], {n, 1, nmax}]}],   PlotRange -> {{0, 20}, {0, 20}},   Axes -> True], {nmax, 1, 50}]

thanks a million, this is what i was really dreaming of!
ty, ty, ty...
• Sep 28th 2008, 01:13 PM
bkarpuz
I have edited the code and get the following:\$

Code:

u[x_] := Ceiling[(1/2)*(Sqrt[8*x + 1] - 1)]; v[x_] := (1/2)*u[x]*(u[x] + 1) - x; fnew[y_] := Module[{m, n}, m = v[y] + 1;   n = u[y] - v[y]; If[(-1)^(m + n) == 1, {m, n}, {n, m}]]; maxval = 300; maxtrig = u[maxval]; newlist = Table[fnew[n], {n, 1, maxval}]; Manipulate[  Show[Graphics[Point @@ {Table[fnew[n], {n, 1, nmax}]}],   PlotRange -> {{0, maxtrig}, {0, maxtrig}}, Axes -> True], {nmax, 1,   maxval}]
Fasten twice and set backwards&forwards (Happy)