Solution of the homeworks

Try to generalize your solution. Write short, neat, dense codes: they are easier to read, extend and apply.

Everybody

Consider a 3×4 matrix and conctruct the one obtained from it by a 90 degree rotation.

András Vértesaljai

a={{1,2,3,4},{5,6,7,8},{9,10,11,12}};
a//MatrixForm
b=ConstantArray[0,{4,3}];
For[j=1,j<4,j++,
For[i=1,i<5,i++,
b[[5-i,j]]=a[[j,i]]]]
b//MatrixForm

a={{1,2,3,4},{5,6,7,8},{9,10,11,12}};
a//MatrixForm

Dimensions[{{1,2,3,4},{5,6,7,8},{9,10,11,12}}]

ClearAll[a,rot];rot[a_]:=Module[{},
{m,n}=Dimensions[a];
b=ConstantArray[0,{n,m}];
For[j=1,j<m+1,j++,
For[i=1,i<n+1,i++,
b[[n+1-i,j]]=a[[j,i]]]];
b//MatrixForm]

rot[{{1,2,3,4},{5,6,7,8},{9,10,11,12}}]

rot[{{1,2,3,4},{-5,0,7,8},{9,10,11,12},{s,d,f,g}}]

Asli Ileri

Logical formatting!

mat=Table[Random[],{3},{4}];
                    mat//MatrixForm

Transpose@(Reverse/@mat)//MatrixForm

rot2[m_]:=Transpose@(Reverse/@m)

rot2[{{1,2,3,4},{-5,0,7,8},{9,10,11,12},{s,d,f,g}}]

Bence Bogdola

mat:={{1,2,3},{4,5,6},{7,8,9},{10,11,12}}

MatrixForm[mat]

mattransp:=Transpose[matr]

MatrixForm[mattransp]

Bence Tipary

Consider a 3×4 matrix

M={{m11,m12,m13,m14},{m21,m22,m23,m24},{m31,m32,m33,m34}};
%//MatrixForm

After the 90° rotation in positive direction:

Mr=Table[M[[i,j]],{j,Length[M[[1]]],1,-1},{i,1,Length[M[[All,1]]]}];
%//MatrixForm

Carsten Olm

Unfortunately, the solution is NOT as easy as just converting the matrix into its transposed form:

ClearAll[matrix1,matrix2];
matrix1=(({{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}}));
matrix2 = (({{9, 5, 1}, {10, 6, 2}, {11, 7, 3}, {12, 8, 4}}));
Transpose[matrix1]//MatrixForm

Transpose[matrix1] == matrix2

Another nice Matrix operation function is called "Reverse" :

Reverse[matrix1]//MatrixForm

That's also not quite what we want. However, if we combine Reverse and Transpose :

Transpose[Reverse[matrix1]]//MatrixForm
Transpose[Reverse[matrix1]]==matrix2

Bingo!

---
Side note:

Although this is kind of correct as well, it's probably not what you were looking for ☺:

TableForm[Rotate[matrix1 // MatrixForm,-90°]]

Dávid Horváth

The 90 degree rotation of a 3x4 matrix A can be expressed as follows: (Subscript[A, i, j]^90)=(Subscript[A, 5-j, i]) or (Subscript[A, i, j]^(-90))=(Subscript[A, j, 4-i])  .

István Mester

(*rotation about x, y, z axis*)
Rx[ϕ_]:={{1,0,0},{0,Cos[ϕ],-Sin[ϕ]},{0,Sin[ϕ],Cos[ϕ]}};
Ry[ϕ_]:={{Cos[ϕ],0,Sin[ϕ]},{0,1,0},{-Sin[ϕ],0,Cos[ϕ]}};
Rz[ϕ_]:={{Cos[ϕ],-Sin[ϕ],0},{Sin[ϕ],Cos[ϕ],0},{0,0,1}};
(*consider 4 points in 3D*)
v1={0,0,0};
v2={0,0.5,0};
v3={0.5,0.5,0};
v4={0.5,0.2,0.75};
(*in 3x4 matrix*)
vm=Transpose[{v1,v2,v3,v4}];
(*general rotation matrix*)
Rg[α_,β_,γ_]:=Rx[α].Ry[β].Rz[γ];
Rg[α,β,γ]//MatrixForm

Rotation about x axis:

vmRotated=Rg[π/2,0,0].vm;

The original matrix:

The rotated one:

vmRotated//MatrixForm

Lam Van Thanh Binh

MatrixA={{1,2,3,4},{5,6,7,8},{9,10,11,12}};
Print[vmRotated//MatrixForm"The Original matrix ",MatrixForm[MatrixA]];
Print["Rotated 90 degree ",MatrixForm[Transpose[MatrixA]]];

MatrixA={{1,2,3,4},{5,6,7,8},{9,10,11,12}};
Print[vmRotated//MatrixForm"The Original matrix ",MatrixForm[MatrixA]];
{"Rotated 90 degree ",MatrixForm[Transpose[MatrixA]]}

Lucas da Silva

a= Table[RandomInteger[10],{i,0,2},{j,0,3}]

MatrixForm[a]

r=RotationMatrix[90Degree,{0,1,0}]

MatrixForm[Table[r.a[[All,n]],{n,1,4}]]

MatrixForm[r.a]

Xuan Tran Thi

mylist= RandomReal[{0,20},{3,4}]
mymatrix = MatrixForm[%]

Transpose[mylist]//MatrixForm

Using a positive definite matrix (how do you check this property) define a new scalar product.

András Vértesaljai

a={{2,0},{4,4}};
a//MatrixForm
b=Eigenvalues[a] 
z={{1,3}};
TrueQ[Min[b]>0]
skalar=z.a.Transpose[z]

Asli Ileri

In[3]:= m={{2,3},{4,8}};

In[4]:=PositiveDefiniteMatrixQ[m]

Bence Bogdola

Checking positive definite property

posdef:={{1,1},{2,4}}

PositiveDefiniteMatrixQ[posdef]

Defining a scalar product

Det[posdef]

Tr[posdef]

Bence Tipary

We can check if a matrix is positive definite by using the function PositiveDefiniteMatrixQ

Let us define a matrix

M={{2,-1,0},{-1,2,-1},{0,-1,2}};
%//MatrixForm

Check whether it is positive definite or not

PositiveDefiniteMatrixQ[M]

Definition of a new scalar product (it needs two vectors and a positive definite matrix)

newscalarproduct[{a1_,a2_,a3_},{b1_,b2_,b3_},{{m11_,m12_,m13_},{m21_,m22_,m23_},{m31_,m32_,m33_}}]:=
Module[{a,b,M},
a={a1,a2,a3};
b={b1,b2,b3};
M={{m11,m12,m13},{m21,m22,m23},{m31,m32,m33}};
If[PositiveSemidefiniteMatrixQ[M]==True,
Conjugate[b].M.a,"The matrix is not positive definite"]]

The new scalar product using the identity matrix

a={2,5,-2.5};
b={-6,4,12};

newscalarproduct[a,b,IdentityMatrix[3]]

The new scalar product using a not positive definite matrix

newscalarproduct[a,b,{{1,2,3},{4,5,6},{7,8,9}}]

The new scalar product using the positive definite matrix defined above

newscalarproduct[a,b,{{2,-1,0},{-1,2,-1},{0,-1,2}}]

The result is scalar, but is different due to the scaling

The original scalar product

a.b

newsc[a_,b_,M_]:=a.M.b

newsc[{2,5,-2.5},{-6,4,12},{{2,-1,0},{-1,2,-1},{0,-1,2}}]

Carsten Olm

I'm not a mathematician and always get confused by these terms :

Easier than I thought. In fact our previous matrices matrix1 and matrix2 can be used here.

ClearAll[a,b];
Animate[If[matrix1[[a,b]]>0,"","matrix not positive-definite"],{a,1,3,1},{b,1,4,1}]

Let' s test what happens if the matrix has a negative element, say {2,2}:

ClearAll[matrix3];
matrix3=matrix1;
matrix3[[2,2]]=-1;
Animate[If[matrix3[[a,b]]>0,"","matrix not positive-definite"],{a,1,3,1},{b,1,4,1}]

I don' t really see what the difficulty is concerning the second part of the task. Or shall the task be easy this time?

Dot[matrix1[[1]],matrix1[[2]]]

Dávid Horváth

<uv(Subscript[>, A]):=(∑_(i,j=1)^N)(Subscript[A, i,j])(Subscript[u, i])(Subscript[v, j]) 
With this definition the properties of the ordinary scalar product are retained. The matrix A is positive definite if all of its eigenvalues are larger than zero.

István Mester

A matrix m is positive definite if Conjugate[x].m.x > 0 for all nonzero vectors x (help).

ma={{2,4},{-3,1}};
mb={{1,3},{2,-1}};

PositiveDefiniteMatrixQ[ma]

IdentityMatrix[2]

PositiveDefiniteMatrixQ[IdentityMatrix[2]]

Lam Van Thanh Binh

ClearAll;
MatrixA={{2,-1,0},{-1,2,-1},{0,-1,2}};
PositiveDefiniteMatrixQ[MatrixA]

Lucas da Silva

In linear algebra,a symmetric n×n real matrix M is said to be positive definite if zTMz is positive for every 
non-zero column vector z of n real numbers.Here zT denotes the transpose of z.

m=RotationMatrix[45]

PositiveDefiniteMatrixQ[m]

{x,y}.m.{{x},{y}}//Simplify

innerProduct[x_,y_]:= {x,y}.RotationMatrix[45].{{x},{y}}

Beginners

Construct a Vandermonde matrix from a list of real numbers, and calculate its determinant.

András Vértesaljai

n=5;
vmatrix=ConstantArray[0,{n,n}];
r=RandomInteger[{1,20},n];
r//MatrixForm
For[i=1,i<n+1,i++,
vmatrix[[All,i]]=r^(i-1)]
vmatrix//MatrixForm
Det[vmatrix]

det=1;
For[j=0,j<n,j++

For[i=1,i<(n-(j-1)),i++,         det=det*(r[[(n-(j-1))]]-r[[(n-(j-1)-i)]]) ]
]
det
TrueQ[det==Det[vmatrix]]

Asli Ileri

m={{1,2,4},{1,3,9},{1,4,16}}

In[9]:= Det[m]

Bence Bogdola

Vmatrix:={{1,2,4},{1,4,16},{1,8,64}}

Det[Vmatrix]

Bence Tipary

Defining the number of rows and columns

n=5; (*rows*)
m=6; (*columns*)

reals=Table[RandomReal[100],{i,n}]

The Vandermonde matrix

Table[((reals[[i]])^j),{i,1,n},{j,0,m-1}];
%//MatrixForm

The determinant works only when the matrix is square

V=Table[((reals[[i]])^j),{i,1,n},{j,0,n-1}];
%//MatrixForm

The determinant

Det[V]

Carsten Olm

Seems like I will learn a lot about math in this Mathematica course :

Hyperlink["http://en.wikipedia.org/wiki/Vandermonde_matrix"]

Here is my solution (define the number of rows m yourself!):

m=10;
n=m-1;
alpha=Array[Plus,m];
vanmat=Array[f,{m,10}];
Do[vanmat[[i]]=NestList[alpha[[i]] #&,1,n],{i,1,m}];
vanmat//MatrixForm

Looks nice, doesn’t it? Now, let’s calculate the determinant of the Vandermonde matrix. This only works of this is a square matrix, i.e. n has to be equal to m -1. Therefore I only allowed m to be a variable in the above definition.

Det[vanmat]

Dávid Horváth

lista={2,4,6,7}

Length[lista]

VDM=Table[lista[[i]]^(j-1), {i, Length[lista]},{j, Length[lista]}];

MatrixForm[VDM]

Det[VDM]

István Mester

ClearAll[r]

r=Table[RandomReal[{1,2}],{10}]

Two solutions for the problem:

VandermondeM=Table[Table[r[[j]] ^i,{i,0,7}],{j,1,Length[r]}];
VandermondeM2=Table[NestList[r[[j]] #&,1.,7],{j,1,Length[r]}];
VandermondeM//MatrixForm
VandermondeM==VandermondeM2

The two expressions gives the same result.

r={aa,dd,ff,gg};Table[r[[j]] ^i,{i,0,Length[r]-1},{j,1,Length[r]}]//MatrixForm

Det[%]

Factor[%]

Lam Van Thanh Binh

ListVandermonde={2,3,4,5,6};
MatrixB=SparseArray[{5,5}->0,{5,5}];
For [i=1,i≤Length[ListVandermonde],i++,
For [j=1,j≤Length[ListVandermonde],j++,
MatrixB[[i,j]]=ListVandermonde[[i]]^(j-1);
]
]
Print["Vadermonde Matrix is: ",MatrixForm[MatrixB]];
Print["Determinant of Vandemonde Matrix is ",Det[MatrixB]];

Lucas da Silva

MatrixForm[numbers=Table[ RandomReal[10] ,{i,0,4}]]

MatrixForm[Table[numbers[[i]]^j,{i,1,4},{j,0,4}]]

Xuan Tran Thi

ClearAll[y];

y[x_,n_]:= n*x;
max= 6;
l={};
For[
n = 1, n≤max, n++,(*Print[y[n,3]]]*)
l= Append[l,NestList[y,1,5]]
]
myvander = MatrixForm[l]

(*NestList[y[2,#]&,1,5]*)

(({{1, 1, 1, 1, 1, 1}, {1, 2, 4, 8, 16, 32}, {1, 3, 9, 27, 81, 243}, {1, 4, 16, 64, 256, 1024}, {1, 5, 25, 125, 625, 3125}, {1, 6, 36, 216, 1296, 7776}}))
detval = Det[l]

Study FoldList and show an application.

András Vértesaljai

I can calculate the determinant of a vandermonde matrix.

n=5;
r=RandomInteger[{1,20},n];
r//MatrixForm
a=Subsets[r,{2}]
binom=Binomial[n ,2];
b=RandomInteger[{1,1},binom];
For[i=1,i<binom+1,i++, b[[i]]=a[[i,2]]-a[[i,1]] ]
b
c=FoldList[Times,1,b];
c[[-1]]

Asli Ileri

FoldList[Plus,0,{1,1,2,7}]

Accumulate[{1,1,2,7}]

RandomInteger[{-1,1},16]

ListPlot[Accumulate[RandomInteger[{-1,1},1160]]]

Bence Bogdola

Bence Tipary

Some information about the function FoldList

Information[FoldList]

Definition of a geometric series

gs=Table[(((-2))^(-i)),{i,1,5}]

Showing convegence by using FoldList (subtracting every time the half of the previous value and changing the sign)

fl=FoldList[-#1-#2&,1,gs]

Plot of the result

ListPlot[fl]

István Mester

ClearAll[r]

r=Table[RandomReal[{1,2}],{10}]

VandermondeM3=Table[FoldList[#*r[[j]]&,1,Array[r[[j]],7]],{j,1,Length[r]}];
VandermondeM3//MatrixForm

Carsten Olm

? FoldList

As the help function tells us, FoldList[Plus, 0, list] generates cumulative sums of the elements in list.

What does that mean?

ClearAll[a,b,c,d1,d2,d3];
a=2;
b=3;
c=4;
d1=FoldList[Plus,0,{a,b,c}]

In this example, 0 is the starting value, to which fold list subsequently adds the values in the list. Hence, FoldList is one element longer than the initial list. Let’s see what else works:

d2=FoldList[Plus,0,Range[0,20,3]]

I remember that in IQ tests you sometimes get strings of numbers which you have to continue. By using a similar expression as the above in a trial & error process, you can increase your own IQ score ;).

Dávid Horváth

?FoldList

Euler method using predefined, non equidistant points

list={0.01, 0.025, 0.045,0.06, 0.08, 0.01}

f[x_, y_]:=y

Iter[{x_,y_}, t_]:={t, y+f[x,y] (t-x)}

FoldList[Iter, {0,1},list]

Lam Van Thanh Binh

FoldList[Plus,2,{1,2,3,4}]

Luas da Silva

Build up a number from digits:

FoldList[ #1 10 + #2 &, 0,{1,2,3,4,5,6,7}]

FromDigits

IntegerDigits

Xuan Tran Thi

FoldList[Join@@List,{2},Range[10]]

Calculate the first ten powers of 2 using NestList.

András Vértesaljai

NestList[2 #&,1,10]
(2^#)&[Range[0,10]]

Asli Ileri

NestList[(#)^2&,2,10]

Bence Bogdola

Bence Tipary

The first ten powers of 2 by using NestList

NestList[#*2&,2,10]

Carsten Olm

Applying what we have learned about "# &" in the last lecture :

NestList[2 #&,1,10]

Later on I realized that the exact same solution is given in the help function of NestList. Was that intended?

Dávid Horváth

g[x_]:=2x

NestList[g,2,9]

István Mester

TableForm[NestList[2 #&,1,10],TableDirections->Row]

Lam Van Thanh Binh

NestList[#*2&,1,10]

Lucas da Silva

NestList[2 # &,1,10]

Xuan Tran Thi

ClearAll[f]
f[x_]:= 2*x;

NestList[f,1,10]

Advanced

Calculate GCD using functional programming tools based on the euclidean algorithm.

András Vértesaljai

{a,b}={210,45};
While[b≠0,{a,b}={b,Mod[a,b]}];
a

gcd[aa_,bb_]:=Module[{},While[bb≠0,{aa,bb}={bb,Mod[aa,bb]}];aa]

gcd[210,45]

Bence Bogdola

Bence Tipary

The new function for calculating the greatest common divisor

newGCD[n1_,n2_]:=Module[{f1,f2,d,max},f1=FactorInteger[n1];f2=FactorInteger[n2];max=IntegerPart[((Max[n1,n2])/2)];
d={};
Do[If[f1[[i,1]]==f2[[j,1]],d=AppendTo[d,((f1[[i,1]])^(Min[f1[[i,2]],f2[[j,2]]]))]],{i,1,Length[f1],1},{j,1,Length[f2],1}];
Product[d[[i]],{i,1,Length[d]}]]

newGCD[245,840]

Checking the result

GCD[245,840]

Plot of GCDs of numbers form 1 - 99 with 1000

DiscretePlot[newGCD[1000,n],{n,99},PlotRange->All]

Lam Van Thanh Binh

gcd[a_,b_]:=Block[{aa,bb},
aa=a;
bb=b;
t=0;
While[bb≠0,
t=bb;
bb=Mod[aa,bb];
aa=t;
];
Print["The GCD of ",a," and ",b," is ",aa];
Return[aa]
]
gcd[1071,462];

gcd[a_,b_]:=Block[{aa,bb},
aa=a;
bb=b;
t=0;
While[bb≠0,
t=bb;
bb=Mod[aa,bb];
aa=t;
];
"The GCD of "<>ToString[a]<>" and "<>ToString[b]<>" is "<>ToString[aa]
]
gcd[1071,462]

Write a program for the Runge-Kutta method. Try to get the same results what you have obtained in the case of a concrete problem using the options of NDSolve.

Lam Van Thanh Binh

Needs@"DifferentialEquations`InterpolatingFunctionAnatomy`";
f[t_,y_]:=y-t^2+1;
RungeKutta4[h_,t_,w_,loop_]:=Block[{tt,ww},
Print["Step 0: t= ",t,"; h= ",h,"; w= ",w];
ww=w;
tt=t;
For[i=1,i≤loop,i++,
k1=h*f[tt,ww];
k2=h*f[tt+h/2,ww+k1/2];
k3=h*f[tt+h/2,ww+k2/2];
k4=h*f[tt+h,ww+k3];
ww=ww+(k1+2*k2+2*k3+k4)/6;
tt=tt+h;
Print["Step ",i," has t= ",tt," and w= ",ww];
];
Print["The results for the ",loop," order Runge Kutta method are: t= ",tt," and w= ",ww];
Print["==================================================="];
Return[{tt,ww}];
]
RungeKutta4[.5,0,.5,4];
tt=NDSolve[{y'[t]==y[t]-t^2+1,y[0]==.5},y,{t,0,4}]
y/.tt

Bence Tipary

Runge-Kutta method for 2D

RK2[f1_,f2_,x00_,y00_,ds_,n_]:=Module[{x0,y0,k1,k2,k3,k4,f,x1,y1,RKdata},
f[x_,y_]:={f1[x,y],f2[x,y]};
x0=x00;
y0=y00;
RKdata={{x0,y0}};

Do[
k1=ds f[x0 ,y0];
k2=ds f[x0+((k1[[1]])/2),y0+((k1[[2]])/2)];
k3=ds f[x0+((k2[[1]])/2),y0+((k2[[2]])/2)];
k4=ds f[x0+k3[[1]],y0+k3[[2]]];
x1=x0+((k1[[1]]+2k2[[1]]+2k3[[1]]+k4[[1]])/6);
y1=y0+((k1[[2]]+2k2[[2]]+2k3[[2]]+k4[[2]])/6);
RKdata=Join[RKdata,{{x1,y1}}];
x0=x1;
y0=y1;
,{i,1,n}
];
ListLinePlot[RKdata]]

Consider the following functions from a predator-prey model

f1[x_,y_]:=x(1-y-0.5)
f2[x_,y_]:=y(x-1-0.5)

The result:

RK2[f1,f2,1,2,0.05,200]

Comparing with the built in solver

x0=1;
y0=2;
n=10;
sol=NDSolve[{x'[t]==x[t] (1-y[t]-0.5),y'[t]==(-1+x[t]-0.5) y[t],x[0]==x0,y[0]==y0},{y,x},{t,n},Method->"ExplicitRungeKutta"];
ParametricPlot[Evaluate[{x[t],y[t]}/.sol],{t,0,n},PlotRange->{{0,All},{0,All}}]

Runge-Kutta method for 3D

RK3[f1_,f2_,f3_,x00_,y00_,z00_,ds_,n_]:=Module[{x0,y0,z0,k1,k2,k3,k4,f,x1,y1,z1,RKdata},
f[x_,y_,z_]:={f1[x,y,z],f2[x,y,z],f3[x,y,z]};
x0=x00;
y0=y00;
z0=z00;
RKdata={{x0,y0,z0}};

Do[
k1=ds f[x0 ,y0,z0];
k2=ds f[x0+((k1[[1]])/2),y0+((k1[[2]])/2),z0+((k1[[3]])/2)];
k3=ds f[x0+((k2[[1]])/2),y0+((k2[[2]])/2),z0+((k2[[3]])/2)];
k4=ds f[x0+k3[[1]],y0+k3[[2]],z0+k3[[3]]];
x1=x0+((k1[[1]]+2k2[[1]]+2k3[[1]]+k4[[1]])/6);
y1=y0+((k1[[2]]+2k2[[2]]+2k3[[2]]+k4[[2]])/6);
z1=z0+((k1[[3]]+2k2[[3]]+2k3[[3]]+k4[[3]])/6);
RKdata=Join[RKdata,{{x1,y1,z1}}];
x0=x1;
y0=y1;
z0=z1;
,{i,1,n}
];
ListPointPlot3D[RKdata]]

Consider the following functions

f1[x_,y_,z_]:=-10 x+10 y
f2[x_,y_,z_]:=27 x-y-x z
f3[x_,y_,z_]:=x y-(8/3) z

The result:

RK3[f1,f2,f3,1,0,0,0.001,30000]

István Mester

k1[x_,y_]:=h f[x,y]
k2[x_,y_]:=h f[x+(1/2)h,y+(1/2)k1[x,y]]
k3[x_,y_]:=h f[x+(1/2)h,y+(1/2)k2[x,y]]
k4[x_,y_]:=h f[x+h,y+k3[x,y]]
step[{x_,y_}]:={x+h,y+(1/6)k1[x,y]+(1/3)k2[x,y]+(1/3)k3[x,y]+(1/6)k4[x,y]}

f[x_,y_]:=2y;h=0.1;
plot=NestList[step,{0,2},8]

sol=NDSolve[{y'[x]==2y[x],y[0]==2},y,{x,0,0.7},Method->"ExplicitRungeKutta"];

pl2=Plot[y[x]/.sol,{x,0,0.7},PlotStyle->Red];

The built-in solver gives the same result:

Show[pl2,ListPlot[plot]]

Write another FoldList which takes the composition in its second variable.

Bence Bogdola

FoldList[g[#2,#1]&,x,l={a,b,c,d}]

Bence Tipary

A FoldList function which takes the composition in its second variable

FoldList[g[#2,#1]&,x,{p,q,r,s,t}]

Homeworks

1. Draw a man/woman in the plane using graphics primitives such as Point, Line, Circle, Polygon, Disk etc. Use directives such as Red, Opacity

2. Draw a man/woman in the three-dimensional  space using graphics primitives such as Point, Line, Cyilinder, Cuboid, Tube. Use Texture as well.

3. I am going to turn to graphics, differential eqautions and programming. What else would you prefer?