INDEX:
How small a fraction can you use to approximate Pi?
Express the Golden Ratio as a continued fraction:
Expand a Polynomial:
Solve a cubic equation:
Solve a quartic equation:
Solve a fifth order equation:
Do some integrations: 
Do some plots: 
Do some 3D Plots: 
Do some Contour Plots: 
Do some Series
Do some Matrices
Do some 3D Plots
Do some Bessel Functions
How to View Animations in Mathematica
Standing Wave Animation
Play with Loops and Conditionals:
3D Plots of Complex Functions
Prime Numbers
The Factorial Function: Old Fashioned Way
The Factorial Function: New Way
Different Bases
Least Squares Fitting:
Musical Beats
Homemade Integration
Solve and Reduce
Fractals

*******************************************************
How small a fraction can you use to approximate Pi?

N[Pi,150]

Timing[N[Pi,1000]][[1]]

Do[out=Rationalize[N[Pi],10^(-m)];
   Print[m," = ",out,"   ",N[out,10]];Print["  "],{m,1,9,4}]

*******************************************************
Express the Golden Ratio as a continued fraction:

Nest[Function[x,1/(1+x)],x,3]

goldenratio=1+Nest[Function[x,1/(1+x)],x,10]

N[goldenratio//.{x->1},20]

N[GoldenRatio,20]

*******************************************************
Expand a Polynomial:

temp=Expand[(a+b)^20]

Factor[temp]

*******************************************************
Solve a cubic equation:

temp=2x^3+3x^2+5x+2

sol=Solve[temp==0,x]

N[sol]

*******************************************************
Solve a quartic equation:

temp=7x^4+2x^3+3x^2+5x+2

sol=Solve[temp==0,x];

sol[[1]]

N[sol]

NRoots[temp==0,x]

*******************************************************
Solve a fifth order equation:

temp=17x^4+7x^4+2x^3+3x^2+5x+2

NRoots[temp==0,x]

*******************************************************
Do some integrations:

ztemp = 1/((x+I y) -1)^2 //.{x->u+v, y->u-v}

{x->u+v, y->u-v}

Integrate[ztemp,u] //Simplify

Integrate[temp,x]

*******************************************************
Do some plots:

Plot[2x^3-12x^2+5x+2,{x,-10,10}];

Plot[Sin[1/x],{x,0,0.1}];

Plot[Gamma[x],{x,-5,5}];

*******************************************************
Do some 3D Plots:

Plot3D[Re[Exp[10 I(x^2+y^2)]],{x,0,1},{y,0,1}];

*******************************************************
Do some Contour Plots:

ContourPlot[Re[Exp[10 I(x^2+y^2)]],{x,0,1},{y,0,1}];

*******************************************************
Do some Series

Series[Exp[x],{x,0,6}]

Series[Exp[x],{x,a,4}]

*******************************************************
Do some Matrices

matrix={{a,c},{c,b}};
MatrixForm[matrix]

Det[matrix]

Eigenvalues[matrix] //Simplify

*******************************************************
Do some 3D Plots

res= 1/( (x+I y) -(1+I))

pic=Plot3D[Re[res],{x,0,2},{y,0,2},
                 BoxRatios->{1,1,1},
                 ViewPoint->{-2,6,1}];

Plot[Re[res] /.{y->1} //Evaluate ,{x,0,2}];

*******************************************************
Do some Bessel Functions

list={BesselJ[1,z],BesselJ[2,z]}

pic2=Plot[{BesselJ[1,z],BesselJ[2,z],BesselJ[3,z],
           BesselJ[4,z],BesselJ[5,z],BesselJ[6,z],
           BesselJ[7,z],BesselJ[8,z],BesselJ[9,z]
            }  ,{z,0,10}];

*****************************************************
 How to View Animations in Mathematica

In Mathematica, an animation is a group of graphics cells.  Each cell is one frame of the animation.  To run the animation, open the group (by double-clicking its enclosing bracket), and scroll until the first graphics cell of the group is centered in the window.  Then select the Animate Selected Graphics command under the Special Effects submenu of the Cells menu (Y is the keyboard equivalent for this command).  You can use the Special Effects Settings... command (and various keyboard equivalents) to control the speed of the animation, and the order in which the  frames are presented (forward, backward, or cyclic).  Complete details may be found in the User Manual that came with Mathematica.

Needs["Graphics`Animation`"]

?MoviePlot

MoviePlot[BesselJ[n, x], {x, 0, 15}, {n, 1, 7, 3},
		PlotRange->{-0.5, 1.0}]

*****************************************************
Standing Wave Animation

Do[
Plot[
   {Sin[2 Pi ( x - t) ],
    Sin[2 Pi ( x + t) ], 
    Sin[2 Pi ( x - t) ]+ 
    Sin[2 Pi ( x + t) ]},{x,0,1},     
PlotRange->{-2,2},
PlotStyle->{Thickness[0.005],Thickness[0.005],
      Thickness[0.008]} ]
,{t,0,1,0.1}]

*****************************************************
Play with Loops and Conditionals:

For[i=1, i<4,  Print[i++]]

For[i=1, i<4,  Print[++i]]

For[i=2, i<8,  Print[i+=2]]

For[i=2, i<64,  Print[i*=2]]

Clear[x,t];
t=x;
Do[t=1/(1+t), {3}];t

Clear[x,t];
t=x;
table=Table[t=1/(1+t), {4}]

table //.{x->1} //N

FixedPoint[1/(1+#)&,1.0,20]   //N[#,20]&

FixedPoint[1/(1+#)&,1.0]    //N[#,20]&

Nest[ 1/(1+#)&,x,4]

t1=Nest[ 1/(1+#)&,1,100] //N[#,20]&

t2=1/Nest[ 1/(1+#)&,1,100] //N[#,20]&

t1-t2 //N[#,20]&

*****************************************************
3D Plots of Complex Functions

Plot3D[Im[Sqrt[x + I y]],{x,-4,4},{y,-4,4}, Lighting->True];

ContourPlot[Im[Sqrt[x + I y]],{x,-4,4},{y,-4,4}];

Needs["Graphics`ParametricPlot3D`"]

ParametricPlot3D[
    {r Cos[theta]
    ,r Sin[theta]
    ,Im[Sqrt[r Cos[theta] + I r Sin[theta]]]}
,{r,0,4}
,{theta,-Pi+0.0001, Pi-0.0001}
,Boxed->False
,BoxRatios->{1,1,0.4}];

ParametricPlot3D[
    {r Cos[theta]
    ,r Sin[theta]
    ,Re[Sqrt[r Cos[theta] + I r Sin[theta]]]}
,{r,0,4}
,{theta,-Pi+0.0001, Pi-0.0001}
,Boxed->False
,BoxRatios->{1,1,0.4}];

*****************************************************
Prime Numbers

Clear[i];
Do[Print[i,"  ",Prime[i]],{i,1000,2000,100}]

Plot[Prime[Floor[i]],{i,1,20}];

Plot[Prime[Floor[i]],{i,1,100}];

*******************************************************
The Factorial Function: Old Fashioned Way

Clear[fac2]
fac2[n_Integer?(Function[n,n>0]) ]:=
 Module[{total=1},
    Do[ total=total * i,{i,1,n}];
    Return[total];
 ]
 
fac2[0]=1

{fac2[4],fac2[0],fac2[4.0],fac2[4.5],fac2[-4]}

*******************************************************
The Factorial Function: New Way

Clear[fac]
fac[n_Integer]:= n fac[n-1] /; n>=1
fac[0]=1;

?fac

{fac[4],fac[0],fac[4.0],fac[4.5],fac[-4]}

Log[10,1000.!]

*******************************************************
Different Bases

BaseForm[#,2]& /@ {$MaxMachineNumber,$MaxPrecision}

BaseForm[Pi//N ,2]

BaseForm[Pi//N ,16]

*******************************************************
Least Squares Fitting:

list={1,2.5,3.0,4.5,5.0};
fit[x_]=Fit[list,{1,x},x]

p1=ListPlot[list,PlotStyle->{PointSize[0.03]}];

p2=Plot[fit[x],{x,1,5}];

Show[p1,p2];

*******************************************************
Musical Beats

Plot[Sin[2 Pi 440 t] + Sin[2 Pi 444 t]
  ,{t,0,1}
  ,PlotPoints->100];

f=440;
Play[Sin[2 Pi 440 t] + Sin[2 Pi 444 t]
     ,{t,0,1}
     ,SampleRate->4000]

*******************************************************
Homemade Integration

Clear[fred,fredi];
Integrate[fred[x_],x_] ^:= fredi[x];
fredi'[x_] := fred[x];

test1=x^2 + fred[x];
int=Integrate[ test1,x]

D[int,x]==test1

*******************************************************
Solve and Reduce

Solve[x^3==1,x]

Solve[x a ==a,x]

Reduce[x a ==a,x]

*******************************************************
Fractals

Clear[reduce,transx,transy];
reduce[point_]:=point/3;
transx[point_]:= point + (2/3 {1,0});
transy[point_]:= point + (2/3 {0,1});

p0={Random[],Random[]}
list={};
print=False;

Do[
p1=reduce[p0];
p1=If[Random[]>0.5,transx[p1],p1];
p1=If[Random[]>0.5,transy[p1],p1];
list=Append[list,p1];
If[print,Print[p1]];
p0=p1;

,{i,1,3000}]  (* This can take a while *)

ListPlot[list
    ,PlotStyle->{PointSize[0.005]}
    ,PlotRange->{{0,1},{0,1}}
    ,Axes->False
    ,AspectRatio->1
    ];