$Version

Off[General::spell,General::spell1]

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
Solve and Reduce
Fractals

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

N[Pi,100]

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

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

*******************************************************
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 //Short[#,2]&

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]

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}]

Show[pic, ViewPoint->{-2,4,2}, BoxRatios->{1,1,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

Animate[Plot[BesselJ[n, x], {x, 0, 15}], {n, 1, 7, 0.1}]

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

Animate[
Plot[
   {Sin[2 Pi ( x - t) ],
    Sin[2 Pi ( x + t) ], 
    Sin[2 Pi ( x - t) ]+ 
    Sin[2 Pi ( x + t) ]},{x,0,1},     
PlotStyle->{Thickness[0.005],Thickness[0.005],Thickness[0.008]},
PlotRange->{-2,2} ] 
,{t,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->Automatic]

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

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 : b

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}];1

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]

** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ***
Solve and Reduce1

Solve[x^3==1,x]

Solve[x a==a,x]

Reduce[x a==a,x]

** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ***
FractalsP

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}]

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