Linear Algebra Examples

This tutorial shows a number of examples of the use of Mathematica for computations that involve linear algebra.

Matrix Ordering

Certain sparse matrix techniques try to reorder the matrix so that elements are grouped into blocks. The computation then works on each block using dense matrix techniques. One simple way to order a matrix into blocks involves sorting according to the sum of elements on each row. This will be demonstrated in this example.

First, generate a symmetric random sparse matrix:

n=30;
nz=30;
sp=SparseArray[
	RandomInteger[{1,n},{nz,2}]->Table[1,{nz}],{n,n}];
sp=sp+Transpose[sp];

Here is a plot of the matrix:

MatrixPlot[sp]

Now compute a permutation of the matrix and then apply it to the matrix. This topic is discussed in "Matrix Permutations":

perm=Reverse[Ordering[sp.Table[1,{n}]]];
spOrdered=sp[[perm,perm]];

Here is a plot of the reordered matrix; the effect of the reordering can be seen:

MatrixPlot[spOrdered]

Here is a much larger matrix with no structure and many random elements:

n=10000;
nz=2000;
sp=SparseArray[
	RandomInteger[{1,n},{nz,2}]->Table[1,{nz}],{n,n}];
sp=sp+Transpose[sp];
perm=Reverse[Ordering[sp.Table[1,{n}]]];
spOrdered=sp[[perm,perm]];

This is a plot of the original matrix:

MatrixPlot[ sp]

This plot of the reordered matrix shows that there are many rows and columns with no elements:

MatrixPlot[spOrdered]

Full Rank Least Squares Solutions

Solving a matrix equation A.X==B is one of the key problems of matrix computation; techniques for solving it are discussed under "Solving Linear Systems". If A is an m×n matrix, this is a set of m linear equations in n unknowns. If m>n, there are more equations than unknowns and the system is overdetermined. A general technique for finding least squares solutions is given under "Least Squares Solutions". This example will show some different techniques for finding approximate solutions to overdetermined systems for full rank matrices.

Note that all the example solutions in this section would work just as well if they were given sparse matrices as input.

Least Squares Cholesky

This technique uses a Cholesky decomposition to find a least squares solution. If a matrix A has full rank, the solution can be found in the following way.

Solve A.x==B
	C==(A^T).A
	d==(A^T).B
	find G such that C==(G^T).G (Cholesky decomposition)
	find y such that (G^T).y==d
	then G.x==y.

These steps can be placed into a Mathematica function as follows:

L2CholeskySolve[a_,b_]:=
Module[ {aT,c,d,g,gT,y},
aT = Transpose[a];
c= aT.a;
d=aT.b;
g=CholeskyDecomposition[c];
gT=Transpose[g];
y=LinearSolve[gT,d];
LinearSolve[g,y]
]

The function can be applied as follows:

mat={{1.,2.},{5.,6.},{4.5,6.}};
vec={5.,6.,8.};
sol1=L2CholeskySolve[mat,vec]

The solution is close to satisfying the equation:

mat.sol1

This compares the solution to that from (RefLink[PseudoInverse, paclet:ref/PseudoInverse]):

PseudoInverse[mat].vec

This technique is fast, but is less accurate because it computes (A^T).A.

This computes 1-, 2-, and ∞-norms for the solution that was found:

Map[Norm[mat.sol1-vec,#]&,{1,2,Infinity}]

Least Squares QR

When A is full rank, a more accurate way to solve the problem is to use the QR decomposition as follows.

Solve A.x==B
	find Q,R such that A==(Q^T).R (QR decomposition)
	then solve R.x==Q.B.

A Mathematica program to find the solution is as follows:

L2QRSolve[a_,b_]:=
Module[ {Q,R,m,n},
{m,n}=Dimensions[a];
{Q,R}=QRDecomposition[a];
LinearSolve[R,Q.b]
]

The solution for this problem is very similar to the Cholesky solution:

mat={{1.,2.},{5.,6.},{4.5,6.}};
vec={5.,6.,8.};
sol2=L2QRSolve[mat,vec]

The QR decomposition solution can be more expensive than the Cholesky approach, but it is more accurate. An example that demonstrates the difference in accuracy is shown:

mat={{-4.1799231,-5.010860245276564,-5.841797048032377},{4.985838406555408,5.8047054724005,6.623572538245592},{3.6958074724742653,3.687168314818264,3.678529157162263},{-5.488825789918355,-7.024200075119946,-8.559574360321538}};
vec={1.,4.,2.,1.};
sol1=L2CholeskySolve[mat,vec];
sol2=L2QRSolve[mat,vec];

This shows how close the Cholesky solution is when using the 2-norm:

Norm[mat.sol1-vec]

This shows how close the QR solution is when using the 2-norm. It can be seen that the QR solution is a better approximation:

Norm[mat.sol2-vec]

Minimization of 1 and Infinity Norms

Many techniques for finding approximate solutions for the matrix equation A.X==B when it is overdetermined (i.e., when m>n) work by minimizing the 2-norm. This is because of certain advantages that make it computationally tractable. One reason is that the function

ϕ(x)==(1/2)∥A x-b(Subscript[∥, 2]^2)

is differentiable and differentiation is a linear operation. Thus, a linear system can be formed that finds the minimizing solutions. Another reason is that the 2-norm is preserved under orthogonal transformations. This means that a range of equivalent problems can be formed, which may be easier to solve.

However, there are other solutions that can be found by minimizing other norms, such as the 1-norm or the ∞-norm. These may be more desirable in the particular context because they may find solutions that maintain important properties relevant to the individual problem. In this example techniques are shown to find approximate solutions that minimize these norms; both will use a method to find minimum values of constrained linear problems; typically this is known as linear programming.

In Mathematica, linear programming is provided by the function (RefLink[LinearProgramming, paclet:ref/LinearProgramming]). This can solve the linear programming problem for the different types of numbers that Mathematica supports: integers and rational numbers, as well as machine-precision approximate real and arbitrary-precision approximate real numbers. In addition, it provides techniques that are suitable for minimizing extremely large systems by means of an interior point method.

The solutions given in this section are suitable for dense matrix input. It would be straightforward to modify them for sparse matrix input; this would be necessary to take full advantage of the interior point linear programming technique.

Note that the techniques in this section could be extended to add other constraints on the solution.

One-Norm Minimization

Minimizing the 1-norm involves finding the value of x that minimizes the following.

Min ∥Ax-b(Subscript[∥, 1])==Min(∑_i)(Subscript[(Ax-b), i])

This is done by forming new variables z and finding the minimum.

Min  (e^T)z
subject to z>Ax-b, z>-(Ax-b)

This is implemented with the following program:

L1Solve[A_,b_]:= 
Module[
{m,n,Aall,ball,c,x,bds,id},
{m,n}=Dimensions[A];
id=IdentityMatrix[m];
Aall=Join[Transpose[Join[Transpose[id],Transpose[-A]]],Transpose[Join[Transpose[id],Transpose[A]]]];
ball=Join[-b,b];
c=Join[Table[1,{m}],Table[0,{n}]];
bds = Table[{-Infinity,Infinity},{m+n}];
x=LinearProgramming[c,Aall,ball,bds];
Take[x,-n]
]

This finds the solution:

mat={{1.,2.},{5.,6.},{4.5,6.}};
vec ={5.,6.,8.};
sol3=L1Solve[mat,vec]

Here 1-, 2-, and ∞-norms are computed for the solution that was found:

Map[Norm[mat.sol3-vec,#]&,{1,2,Infinity}]

Infinity-Norm Minimization

Minimizing the ∞-norm is similar to minimizing the 1-norm. It involves finding the value of x that minimizes the following.

Min  ∥Ax-b(Subscript[∥, ∞])

This is done by forming new variables z and finding the minimum.

Min  z
subject to ze>Ax-b, ze≥-(Ax-b)

This is implemented with the following program:

LInfinitySolve[A_,b_]:= 
Module[
{m,n,Aall,ball,c,x,bds,onesT},
{m,n}=Dimensions[A];
onesT={Table[1,{m}]};
Aall=Join[Transpose[Join[onesT,Transpose[-A]]],Transpose[Join[onesT,Transpose[A]]]];
ball=Join[-b,b];
c=Join[{1},Table[0,{n}]];
bds = Table[{-Infinity,Infinity},{n+1}];
x=LinearProgramming[c,Aall,ball,bds];
Take[x,-n]
]

This finds the solution:

mat={{1.,2.},{5.,6.},{4.5,6.}};
vec ={5.,6.,8.};
sol4=LInfinitySolve[mat,vec]

Here 1-, 2-, and ∞-norms are computed for the solution that was found:

Map[Norm[mat.sol4-vec,#]&,{1,2,Infinity}]

Finite Difference Solutions

One way to solve partial differential equations is to form a spatial discretization and solve them with finite differences. This example considers a basic finite difference solution for the Poisson equation on a unit square.

ΔU==(e^(-((x^2)+(y^2))))
U[0,y]==U[x,0]==U[1,y]==U[x,1]==0
0≤x≤1,0≤y≤1

This sets up the problem for an 80×80 grid with (Subscript[x, i])==i h. An abbreviated form of the variable matrix is printed out:

num=80;hStep=N[1/(num+1)];
vars=Table[u[i,j],{i,num},{j,num}];
Short[vars,6]

This is the finite difference formula for the differential operator:

kern={{0,1,0},{1,-4,1},{0,1,0}}/hStep^2;

In this step the application of the finite difference formula to the variable matrix is made. The boundary conditions are incorporated by allowing an overhang of one variable with a coefficient of zero around the boundary:

lap=ListCorrelate[kern,vars,{2,2},0];

Here equations for the solutions on the grid are formed:

Short[eqns=Thread[Map[Flatten,lap==Table[Exp[-((((hStep i))^2)+(((hStep j))^2))],{i,num},{j,num}]]],20]

The approximate solution to the Poisson equation will be found by solving these equations. One way to solve the equations is to use (RefLink[Solve, paclet:ref/Solve]), which will recognize the equations as linear and sparse and accordingly use a sparse matrix solver. Another method that also gives you the possibility of solving additional Poisson problems is to construct a matrix from the equations. The matrix represents the linear operator when the grid is flattened into a vector:

{vec,mat}=CoefficientArrays[eqns, Flatten[vars]]

Now the solution is quickly found using (RefLink[LinearSolve, paclet:ref/LinearSolve]):

sol=LinearSolve[mat,-vec];//Timing

This repartitions the solution to restore the original structure:

sol=Partition[sol,num];

This makes a contour plot of the solution:

ListContourPlot[sol,ColorFunction->Hue]

If you wanted to solve several Poisson equations with the same geometries but different right-hand functions, you could compute a factorization of the matrix and use it repeatedly. The way that Mathematica allows you to repeat the factorization is described under "Saving the Factorization":

factors = LinearSolve[mat]

Now you just need to give it a vector representing the function (RefLink[Cos, paclet:ref/Cos])[6(x^2)+3(y^2)] on the grid:

cvec = Flatten[Table[Cos[6(((hStep i))^2)+3(((hStep j))^2)],{i,num},{j,num}]];
sol=Partition[factors[cvec],num];

This passes the vector to the factorization, thereby finding the solution:

ListContourPlot[sol,ColorFunction->Hue]

It should be noted that this solution is only available at discrete points in the interior of the region. It does not include the value on the boundary or at other points in the interior. If the solution was to be used for other computational purposes this might be a limitation. (RefLinkPlain[PadLeft, paclet:tutorial/LinearAlgebraMatrixAndTensorOperations#782554218]) and (RefLinkPlain[PadRight, paclet:tutorial/LinearAlgebraMatrixAndTensorOperations#782554218]) could be used to add the boundary value and (RefLink[Interpolation, paclet:ref/Interpolation]) used to generate an interpolating function for the region:

sol=PadRight[PadLeft[sol,{num+1,num+1}],{num+2,num+2}];
data = Flatten[Table[{i hStep, j hStep, sol[[i+1,j+1]]}, {j, 0, num+1}, {i,0,num+1}], 1];
iFun=Interpolation[data]

This uses (RefLink[Plot3D, paclet:ref/Plot3D]) to plot the solution:

Plot3D[iFun[x,y],{x,0,1},{y,0,1}]

Now the solution can be computed at any position in the region:

Table[iFun[x,0.5],{x,0,1,0.05}]

Mesh Partitioning

This example demonstrates a practical use for extreme eigenvalues. The aim is to partition the vertices of a mesh/graph into two subdomains, with each part having roughly equal numbers of vertices and with the partition cutting through as few edges as possible. (An edge is cut if its two vertices lie in each of the two subdomains.) One way to partition a graph is to form the Laplacian and use its Fiedler vector (the eigenvector that corresponds to the second smallest eigenvalue) to order the vertices. There are more efficient algorithms for graph partitioning that do not require the calculation of the eigenvector, but the approach using Fiedler remains an important one.

Data

This is the data for the coordinates of the vertices:

coordinates = {{-60.,60.},{-60.,-60.},{60.,60.},{60.,-60.},{12.809475,12.5},{-12.809475,-12.5},{-7.,-4.},{-7.,2.},{-60.,0.},{0.,60.},{60.,0.},{0.,-60.},{-1.,7.415715},{1.,-7.415715},{-7.,-1.},{9.,8.716814},{-1.,-13.474961},{4.769961,25.682898},{1.,13.474961},{-4.769961,-25.682898},{2.736733,-23.013988},{-8.206816,-29.954422},{5.,1.037611},{5.,13.301991},{8.822488,14.823734},{-7.494958,-19.97955},{-2.746936,-18.232192},{13.830102,22.165298},{7.494958,19.97955},{2.746936,18.232192},{-13.830102,-22.165298},{-17.681008,-21.469559},{-7.905112,-27.965817},{-22.988602,-13.396162},{8.897511,-15.808074},{6.245633,15.852277},{-11.891051,-17.475286},{11.891052,17.475286},{-17.238035,-9.740396},{-1.,-3.029623},{-1.,17.861054},{1.,3.029623},{-1.,2.193046},{1.,-2.193046},{1.,-17.861054},{1.,-12.638385},{-1.,-8.252292},{1.,8.252292},{-0.561635,-22.748417},{-9.895431,-25.457646},{-1.937437,-26.879819},{5.,-11.226769},{4.923133,-17.356056},{3.197251,-26.32948},{0.647938,-25.24711},{-2.153142,-29.248212},{-18.935854,-24.655299},{5.,7.169801},{-14.955767,-17.159894},{-18.991451,-15.547121},{-13.641527,-25.994504},{-15.95189,-23.991475},{-10.89993,-27.348592},{-4.851524,-27.806102},{-18.098166,-2.47478},{-60.,-30.},{-39.049083,28.76261},{-39.467927,-12.32765},{-39.049083,-1.23739},{-30.,-60.},{-30.5,38.930527},{-9.467927,-42.32765},{-9.549083,7.693137},{-4.103408,-44.977211},{-4.,9.930527},{1.598625,-43.16474},{-0.5,38.930527},{6.915051,41.082649},{10.853493,-1.654037},{31.598625,-43.16474},{34.448756,-37.904037},{30.,60.},{34.448756,-7.904037},{36.915051,11.082649},{60.,30.},{-20.024542,23.311832},{21.915051,41.082649},{36.915051,41.082649},{-60.,-15.},{-60.,30.},{-39.467927,-42.32765},{-49.524542,14.381305},{-49.524542,44.381305},{-41.494301,-6.698081},{-39.467927,-27.32765},{-28.573625,13.143915},{-30.,60.},{-29.536812,26.037221},{-29.20189,-18.491474},{-28.573625,-1.856085},{-24.467927,-42.32765},{-15.75,28.39579},{-19.061354,10.418526},{-15.,-60.},{-14.20189,-33.491474},{-15.25,49.465263},{-10.512271,20.586443},{-6.155112,-37.465817},{-3.128275,-37.112712},{-4.733963,-51.163825},{-1.076571,-44.624106},{2.397938,-34.74711},{-0.75,28.39579},{2.384981,42.841449},{10.372577,31.623973},{9.,-3.547565},{10.957526,50.541324},{15.799313,-51.58237},{17.397938,-34.74711},{17.872577,31.623973},{21.673134,-26.856056},{15.,60.},{21.673134,-11.856056},{23.629115,2.297981},{25.372577,16.623973},{18.823003,-32.116759},{25.372577,31.623973},{25.957526,50.541324},{30.,-60.},{36.404738,6.25},{36.915051,26.082649},{47.224378,-48.952019},{45.,60.},{47.224378,-18.952019},{60.,-30.},{60.,45.},{60.,15.},{-60.,15.},{-60.,45.},{-60.,-45.},{-49.733963,-21.163825},{-49.733963,-6.163825},{-49.524542,29.381305},{-49.524542,-0.618695},{-45.25,49.465263},{-49.733963,-36.163825},{-45.,-60.},{-39.049083,13.76261},{-40.012271,41.655916},{-32.241451,-10.047122},{-31.018842,-7.316776},{-29.20189,-33.491474},{-33.811354,20.953263},{-33.811354,5.953263},{-34.733963,-51.163825},{-31.228264,-12.861906},{-29.20189,-25.991474},{-25.262271,31.121179},{-30.25,49.465263},{-23.335896,5.334568},{-19.733963,-51.163825},{-21.70189,-33.491474},{-14.786812,15.502485},{-15.5,38.930527},{-15.,60.},{-12.233963,-51.163825},{-8.375,23.128422},{-8.125,33.663159},{-0.25,49.465263},{-2.051704,-52.488606},{-1.614857,-36.936159},{0.799313,-51.58237},{3.577471,34.262174},{3.457526,50.541324},{7.899656,-55.791185},{9.498282,-38.955925},{5.842506,33.382774},{10.297594,-30.538295},{12.435192,-26.592768},{11.010127,-29.223119},{15.,-60.},{18.457526,50.541324},{16.598625,-43.16474},{15.285322,-21.332065},{22.651124,-4.779037},{25.210814,-37.640749},{24.607106,9.375},{28.060945,-32.380046},{24.862263,11.791324},{25.372577,24.123973},{23.698969,-47.373555},{28.060945,-17.380046},{34.448756,-22.904037},{33.457526,50.541324},{40.957526,50.541324},{40.836567,-43.428028},{45.799313,-51.58237},{47.224378,-3.952019},{48.457526,5.541324},{48.457526,20.541324},{48.457526,35.541324},{47.224378,-33.952019},{48.457526,50.541324},{60.,-15.},{60.,-45.},{-54.762271,37.190653},{-54.762271,52.190653},{-54.762271,7.190653},{-54.762271,22.190653},{-49.733963,-51.163825},{-50.74715,-3.349041},{-49.733963,-43.663825},{-49.733963,-28.663825},{-49.733963,-13.663825},{-44.286812,6.571958},{-44.286812,36.571958},{-44.286812,21.571958},{-45.,60.},{-42.233963,-51.163825},{-37.875,44.197895},{-39.049083,6.26261},{-37.625,54.732632},{-31.967927,-42.32765},{-27.233963,-51.163825},{-22.875,44.197895},{-22.625,54.732632},{-23.125,33.663159},{-7.875,44.197895},{-7.625,54.732632},{-0.538286,-52.312053},{1.19249,51.420725},{8.698969,-47.373555},{22.899656,-55.791185},{24.498282,-38.955925},{26.635879,-35.010398},{30.799313,-51.58237},{37.899656,-55.791185},{40.836567,-28.428028},{40.836567,-13.428028},{39.411502,-46.058379},{45.,-60.},{48.202369,3.125},{48.457526,43.041324},{48.457526,13.041324},{48.457526,28.041324},{53.612189,-54.476009},{53.612189,-9.476009},{53.612189,-39.476009},{53.612189,-24.476009},{-52.625,54.732632},{38.698969,-47.373555},{52.899656,-55.791185},{-39.467927,-34.82765},{-39.467927,-19.82765},{-33.811354,-1.546737},{-34.334909,-30.409562},{-28.573625,5.643915},{-27.108433,-13.129034},{-25.781113,-7.626123},{-24.068872,-21.573387},{-24.068872,-29.073387},{-26.834909,-37.909562},{-23.335896,-2.165432},{-18.57976,3.971873},{-19.334909,-37.909562},{-16.568872,-29.073387},{-18.716608,-18.592506},{-15.900463,-14.023561},{-16.967927,-42.32765},{-15.755555,-21.817429},{-13.823625,2.609179},{-14.805062,-19.755279},{-13.735814,-24.079901},{-14.085381,-28.34564},{-12.133847,-24.135439},{-12.868763,-5.533022},{-8.837372,-36.141036},{-8.25,28.39579},{-8.,38.930527},{-7.351243,-25.992286},{-5.274542,12.777095},{-6.904738,-10.376146},{-6.904738,-12.987481},{-4.,0.596523},{-4.,-2.014812},{-5.667546,-33.533567},{-0.875,23.128422},{-0.625,33.663159},{-4.,-6.126146},{-2.424183,-24.562157},{-1.249536,-24.814118},{-0.277258,-36.206476},{1.087549,-22.881202},{1.868367,-20.437521},{2.797594,-30.538295},{2.134981,32.306713},{2.981226,38.551811},{2.961567,-14.99722},{4.193324,-20.325447},{3.873468,15.767091},{5.548454,-41.060333},{6.347766,-32.642703},{4.927766,19.630794},{7.571269,28.653436},{8.158723,17.401642},{7.068019,-21.621736},{7.816221,-26.461124},{9.875502,-8.731056},{12.101339,26.894636},{9.897938,-34.74711},{9.,11.782909},{11.831484,5.422981},{12.900312,15.089181},{12.393814,36.353311},{10.666352,-21.200421},{14.415051,41.082649},{16.263313,-6.755046},{15.851339,26.894636},{15.285322,-13.832065},{18.219295,7.398991},{19.091026,14.561987},{19.601339,26.894636},{17.241304,0.321972},{21.673134,-19.356056},{18.708291,10.9375},{19.601339,19.394636},{19.893814,36.353311},{29.415051,41.082649},{30.016926,4.273991},{31.143814,13.853311},{31.143814,28.853311},{31.143814,21.353311},{29.038936,-2.803028},{36.915051,18.582649},{36.915051,33.582649},{-27.615026,-11.721642},{9.098625,-43.16474},{-27.003722,-10.356469},{-34.334909,-22.909562},{-34.334909,-15.409562},{-29.20189,-22.241474},{-23.528737,-17.484774},{-25.95476,1.739241},{-24.068872,-25.323387},{-24.299083,18.227874},{-21.93964,-5.050452},{-21.602822,-7.46107},{-22.054429,-19.418871},{-20.717031,1.429894},{-20.318872,-29.073387},{-17.95189,-33.491474},{-18.48769,-12.531142},{-16.318387,-19.314727},{-15.960896,0.067199},{-15.023755,-11.120198},{-12.839119,-9.016511},{-14.305219,9.055832},{-11.834909,-37.909562},{-15.625,33.663159},{-12.983163,0.839197},{-11.204353,-31.722948},{-11.768479,-25.726075},{-9.904737,-8.25},{-10.152217,-16.239775},{-8.900272,-26.711731},{-9.857106,-11.438073},{-10.030677,14.13979},{-7.778206,-15.366096},{-5.5,5.965263},{-6.952369,-7.188073},{-4.5625,25.762106},{-4.4375,31.029475},{-3.952369,-11.925554},{-4.,-3.514812},{-3.952369,-9.314219},{-3.353699,-26.281359},{-4.825837,-15.609836},{-4.6875,20.494738},{-4.3125,36.296843},{-4.,4.707857},{-0.375,44.197895},{-1.,-5.640958},{0.620987,-20.433219},{0.561635,22.748417},{1.947481,24.40566},{3.452471,28.994805},{2.596662,-19.093251},{1.359079,16.044508},{2.961567,-17.608555},{3.980783,-13.111995},{3.,13.388476},{4.173716,29.972536},{4.496285,17.042234},{5.,-14.292864},{5.171805,14.810988},{5.358865,-24.161617},{5.306234,29.532836},{6.870296,17.915913},{6.747423,-28.433888},{8.936288,45.811987},{8.643814,36.353311},{7.741415,15.8575},{6.706887,31.018105},{8.43565,26.288767},{9.751605,-24.107252},{9.969867,19.213434},{10.35677,16.14951},{11.236958,29.259304},{10.815981,13.661867},{9.895432,25.457646},{10.904737,10.608407},{9.926747,3.531389},{10.8614,14.956458},{12.32048,8.961491},{12.580412,-11.28156},{13.111958,29.259304},{12.091417,-18.57007},{14.122577,31.623973},{14.536394,2.872477},{14.840721,24.529967},{15.514385,9.949495},{16.143814,36.353311},{14.955767,17.159894},{16.436288,45.811987},{16.715721,24.529967},{17.054163,-26.724412},{16.752309,-3.216537},{16.460564,18.363642},{18.968223,-9.305551},{16.861958,29.259304},{18.835869,12.145662},{19.601339,23.144636},{20.924205,4.848486},{21.413201,8.386995},{21.622577,31.623973},{22.231801,15.59298},{25.372577,27.873973},{25.372577,20.373973},{27.393814,36.353311},{23.936288,45.811987},{27.312016,6.824495},{28.060945,-24.880046},{30.505922,7.8125},{31.143814,36.353311},{31.143814,17.603311},{31.143814,25.103311},{30.761079,10.228824},{41.814558,1.148991},{-5.756135,19.223748},{3.,10.777142},{7.103689,-27.7763},{9.,2.584625}};

This is a list of triangles that forms the mesh:

triangles={{209,90,138},{206,139,90},{207,1,139},{208,138,9},{142,9,89},{141,89,66},{210,140,2},{146,66,140},{250,1,207},{206,93,139},{207,139,93},{208,92,138},{209,138,92},{208,9,144},{206,90,143},{209,143,90},{211,9,142},{211,144,9},{212,146,140},{213,141,66},{213,66,146},{214,142,89},{214,89,141},{212,140,210},{250,218,1},{210,2,147},{250,207,145},{211,142,144},{207,93,145},{215,92,208},{144,215,208},{216,93,206},{143,216,206},{209,92,217},{143,209,217},{250,145,218},{210,219,212},{142,214,94},{142,94,144},{146,253,213},{141,254,214},{212,91,146},{213,95,141},{219,210,147},{149,145,93},{216,149,93},{215,144,69},{216,143,67},{217,67,143},{215,148,92},{217,92,148},{219,91,212},{214,68,94},{144,94,69},{253,95,213},{254,68,214},{254,141,95},{253,146,91},{222,218,145},{216,67,149},{220,145,149},{221,215,69},{221,148,215},{219,147,155},{145,220,222},{153,67,217},{148,153,217},{219,155,91},{255,69,94},{256,95,253},{339,254,95},{340,68,254},{150,94,68},{222,97,218},{221,154,148},{221,69,154},{253,91,223},{155,147,70},{149,67,71},{220,149,71},{254,339,340},{339,95,256},{255,154,69},{151,255,94},{223,91,155},{150,68,340},{220,159,222},{150,151,94},{256,253,152},{153,98,67},{154,96,148},{153,148,96},{152,253,223},{98,71,67},{220,71,159},{222,159,97},{339,99,340},{157,339,256},{156,150,340},{154,255,257},{340,99,156},{155,224,223},{255,151,100},{256,152,157},{341,339,157},{341,99,339},{224,155,70},{336,150,156},{257,96,154},{255,100,257},{338,151,150},{262,152,223},{345,98,153},{258,156,99},{336,338,150},{96,345,153},{258,336,156},{259,100,151},{158,71,98},{338,259,151},{224,101,223},{225,159,71},{262,223,101},{343,257,100},{226,97,159},{157,344,341},{261,157,152},{341,260,99},{338,336,258},{257,160,96},{258,99,342},{227,71,158},{343,100,263},{343,160,257},{262,162,152},{263,100,259},{344,260,341},{344,157,261},{34,338,258},{224,70,161},{342,99,260},{225,71,227},{338,34,259},{159,225,226},{261,152,162},{158,98,86},{345,86,98},{34,258,342},{345,96,103},{224,161,101},{346,263,259},{160,103,96},{262,101,265},{347,259,34},{343,263,349},{160,343,349},{342,260,348},{346,259,347},{342,348,34},{261,350,344},{162,262,265},{226,165,97},{344,57,260},{350,261,162},{348,260,57},{161,70,104},{227,158,102},{346,65,263},{350,57,344},{349,264,160},{349,263,65},{346,347,65},{164,225,227},{269,101,161},{158,86,102},{264,103,160},{265,101,269},{225,106,226},{162,351,350},{86,345,163},{351,162,265},{345,103,163},{350,266,57},{264,349,354},{351,266,350},{349,65,354},{359,227,102},{359,164,227},{225,164,106},{352,60,268},{226,106,165},{353,267,32},{267,59,60},{357,103,264},{351,265,105},{355,39,352},{353,59,267},{268,60,59},{353,32,270},{266,274,57},{268,355,352},{270,32,62},{161,166,269},{351,105,266},{354,271,264},{357,163,103},{269,358,265},{354,65,360},{166,161,104},{272,353,270},{271,357,264},{107,102,86},{353,272,59},{270,62,31},{358,105,265},{163,107,86},{355,356,39},{266,105,274},{270,31,272},{355,268,6},{268,59,6},{273,31,62},{273,62,61},{356,276,39},{354,360,271},{355,6,356},{273,275,31},{359,102,278},{273,61,275},{361,274,105},{359,168,164},{163,357,367},{166,72,269},{228,106,164},{358,269,72},{229,165,106},{357,271,73},{362,275,61},{362,61,63},{356,363,276},{6,366,356},{367,107,163},{358,277,105},{364,6,37},{167,102,107},{361,105,277},{357,73,367},{360,8,271},{362,50,275},{361,22,274},{6,364,366},{366,363,356},{362,63,50},{278,102,167},{168,359,278},{166,104,110},{279,164,168},{279,228,164},{229,106,228},{271,8,73},{358,72,277},{363,7,276},{365,50,63},{364,37,26},{364,368,366},{365,63,33},{366,282,363},{449,107,367},{365,280,50},{72,166,74},{277,286,361},{364,26,368},{286,22,361},{367,73,281},{449,167,107},{283,366,368},{277,72,108},{365,33,280},{370,7,363},{370,363,282},{366,283,282},{229,10,165},{369,73,8},{371,278,167},{166,110,74},{281,449,367},{372,168,278},{277,108,286},{379,279,168},{280,33,64},{377,368,26},{110,104,12},{108,72,74},{377,283,368},{369,75,73},{281,73,75},{378,167,449},{285,15,7},{284,8,15},{370,289,7},{282,375,370},{373,282,283},{167,378,371},{372,278,371},{20,280,64},{168,372,379},{380,369,8},{279,77,228},{286,56,22},{169,229,228},{283,377,373},{27,377,26},{8,284,380},{285,284,15},{374,7,289},{374,285,7},{286,108,109},{375,289,370},{375,282,373},{108,74,109},{376,20,64},{379,77,279},{449,281,41},{378,449,41},{376,290,20},{369,13,75},{380,13,369},{286,109,171},{281,75,41},{376,64,51},{378,287,371},{111,74,110},{377,17,373},{113,372,371},{372,288,379},{289,382,374},{284,43,380},{285,40,284},{374,40,285},{375,47,289},{375,373,47},{381,228,77},{377,27,17},{381,169,228},{109,74,111},{292,56,286},{170,111,110},{376,51,290},{171,292,286},{170,110,12},{169,231,229},{378,41,287},{231,10,229},{371,287,113},{382,40,374},{284,40,43},{380,43,13},{382,289,47},{75,13,41},{373,17,47},{171,109,111},{372,113,288},{291,290,51},{379,288,77},{291,49,290},{230,111,170},{230,170,12},{291,51,55},{384,287,41},{291,55,49},{171,111,76},{230,172,111},{292,171,76},{292,112,56},{230,12,172},{385,113,287},{288,113,296},{383,49,293},{293,49,55},{172,76,111},{381,77,114},{385,287,384},{297,77,288},{174,169,381},{295,56,112},{294,383,293},{295,54,56},{387,45,383},{174,231,169},{293,55,21},{113,385,386},{231,174,10},{386,296,113},{297,114,77},{298,46,45},{450,19,48},{294,387,383},{296,173,288},{388,19,391},{114,174,381},{293,21,294},{173,297,288},{389,45,387},{292,76,301},{389,298,45},{44,23,42},{44,14,23},{46,52,14},{42,58,48},{391,19,450},{385,384,18},{112,292,301},{390,46,298},{388,300,30},{300,388,391},{387,294,299},{172,12,175},{294,21,299},{450,48,58},{386,392,296},{390,52,46},{385,18,386},{389,387,53},{389,53,298},{52,23,14},{42,23,58},{391,450,24},{232,76,172},{393,30,300},{295,112,302},{173,296,177},{387,299,53},{390,298,394},{300,391,395},{296,392,177},{393,303,30},{297,78,114},{399,54,295},{394,298,53},{397,392,386},{450,58,24},{391,24,395},{18,397,386},{300,395,393},{390,394,52},{174,117,10},{174,114,400},{401,297,173},{396,54,451},{76,232,301},{302,399,295},{395,36,393},{392,397,403},{303,393,398},{177,392,403},{399,451,54},{175,232,172},{301,176,112},{393,36,398},{397,18,304},{177,401,173},{114,78,400},{112,176,302},{401,78,297},{398,29,303},{403,397,304},{307,396,451},{404,304,18},{398,36,402},{306,396,405},{398,305,29},{305,398,402},{175,12,181},{403,115,177},{396,307,405},{404,18,410},{232,337,301},{400,117,174},{399,302,178},{301,337,176},{399,178,451},{403,304,115},{401,177,115},{406,29,305},{176,310,302},{451,180,307},{117,122,10},{305,402,407},{302,310,178},{315,35,306},{402,25,407},{304,404,408},{405,315,306},{308,116,35},{412,16,452},{401,314,78},{451,178,180},{305,407,406},{409,25,311},{452,116,79},{411,311,16},{408,115,304},{408,404,410},{412,452,79},{405,307,179},{407,25,413},{400,78,316},{413,25,409},{311,411,409},{412,312,16},{307,180,179},{415,308,35},{401,115,314},{417,35,315},{407,38,406},{411,16,414},{232,175,118},{405,179,315},{407,413,38},{414,16,312},{309,408,410},{314,316,78},{337,232,183},{411,5,409},{413,409,313},{408,416,115},{308,317,116},{337,183,176},{412,79,419},{413,313,38},{411,414,5},{317,79,116},{417,319,35},{312,412,419},{117,400,424},{408,309,416},{409,5,313},{415,35,319},{310,176,119},{309,410,420},{418,314,115},{310,119,178},{416,418,115},{417,315,184},{315,179,184},{410,28,420},{175,181,118},{178,119,180},{415,317,308},{414,312,421},{400,316,424},{426,179,180},{414,421,5},{416,309,318},{232,118,183},{419,79,323},{422,314,418},{417,184,319},{420,318,309},{422,316,314},{176,183,119},{427,79,317},{430,418,416},{182,122,117},{419,320,312},{426,184,179},{427,323,79},{428,28,423},{420,28,425},{421,312,320},{318,430,416},{424,182,117},{415,319,429},{423,5,321},{126,426,180},{28,428,425},{431,5,421},{180,119,126},{420,425,318},{317,415,429},{120,422,418},{430,120,418},{422,327,316},{428,423,321},{431,321,5},{425,322,318},{319,184,324},{430,318,322},{421,320,325},{419,323,433},{424,316,87},{428,432,425},{325,431,421},{320,419,433},{233,118,181},{422,120,327},{324,184,426},{430,322,120},{428,321,326},{326,432,428},{427,317,185},{425,432,322},{429,319,123},{191,183,118},{327,87,316},{427,185,323},{426,126,121},{429,185,317},{434,325,320},{234,119,183},{123,319,324},{182,424,440},{431,325,434},{435,120,322},{435,327,120},{182,128,122},{436,321,431},{121,324,426},{434,320,433},{436,326,321},{186,126,119},{433,323,124},{424,87,440},{233,191,118},{429,123,185},{323,185,124},{432,326,438},{432,190,322},{183,191,234},{189,431,434},{189,436,431},{435,322,437},{435,127,327},{434,433,187},{234,186,119},{438,326,436},{233,181,129},{440,128,182},{188,121,126},{439,87,327},{190,432,438},{437,322,190},{235,126,186},{187,189,434},{128,82,122},{121,442,324},{324,192,123},{124,441,433},{127,435,437},{436,189,125},{127,439,327},{441,187,433},{125,438,436},{185,123,333},{235,188,126},{440,87,328},{333,124,185},{236,191,233},{442,192,324},{442,121,188},{439,328,87},{440,328,128},{191,80,234},{447,189,187},{441,124,329},{234,80,186},{330,125,189},{190,446,437},{125,445,438},{438,332,190},{437,331,127},{187,441,447},{329,124,333},{129,236,233},{439,127,444},{192,83,123},{123,83,333},{236,80,191},{235,186,81},{189,447,330},{446,331,437},{127,331,444},{445,332,438},{445,125,330},{446,190,332},{441,329,443},{439,444,328},{441,443,447},{128,328,194},{235,81,188},{194,82,128},{442,188,193},{442,193,192},{186,80,81},{329,333,130},{443,329,130},{444,88,328},{443,130,447},{236,129,237},{447,84,330},{331,335,444},{445,334,332},{446,131,331},{445,330,334},{446,332,131},{328,88,194},{251,80,236},{239,83,192},{193,239,192},{188,81,238},{193,188,238},{447,130,84},{194,195,82},{331,131,335},{332,334,131},{330,84,334},{444,335,88},{333,83,448},{196,81,80},{130,333,448},{237,251,236},{251,240,80},{194,88,195},{240,196,80},{237,129,241},{195,133,82},{199,84,130},{334,84,244},{131,245,335},{335,201,88},{334,200,131},{251,237,197},{239,193,134},{238,81,202},{196,202,81},{238,134,193},{239,198,83},{448,83,198},{251,197,240},{195,88,243},{130,448,199},{240,132,196},{237,241,197},{240,197,132},{200,334,244},{245,201,335},{243,88,201},{244,84,199},{245,131,200},{195,203,133},{448,198,242},{203,195,243},{448,242,199},{238,202,249},{134,238,249},{247,198,239},{134,247,239},{248,202,196},{132,248,196},{252,197,241},{246,132,197},{252,246,197},{203,3,133},{242,198,11},{242,11,199},{243,201,136},{243,136,203},{244,199,137},{244,137,200},{245,85,201},{245,200,85},{252,241,4},{247,11,198},{248,135,202},{246,205,132},{249,204,134},{249,202,135},{248,132,205},{247,134,204},{252,4,246},{201,85,136},{203,136,3},{199,11,137},{200,137,85},{248,205,135},{246,4,205},{247,204,11},{249,135,204}};

Plotting the Mesh

To plot the mesh, simply plot each of the triangles:

edges={};
FaceToEdges[{j_,k_,l_}] :={ {j,k},{k,j},{j,l},{l,j},{k,l},{l,k}};
edges = Partition[Flatten[Map[(FaceToEdges[#])&,triangles]],{2}];
graphicsEdge[{i_,j_}]:= Line[{coordinates[[i]],coordinates[[j]]}];
Lines = Map[graphicsEdge,edges];
Show[Graphics[Lines],AspectRatio->1]

The Laplacian

A Laplacian of a graph, L, is an n×n sparse matrix, with n the number of vertices in the graph. The entries of L are mostly zero, except that the diagonals are positive integers that correspond to the degree of the vertex, where the degree is the number of vertices linked to the vertex. In addition, if two vertices, i and j, are joined by an edge, the entry (Subscript[L, i j]) is -1.

(Subscript[L, i j])==({{degree(i), if i==j}, {-1, if i and j form an edge}, {0, otherwise}})

For the mesh here, the off-diagonals are given by the sparse array M:

num = Max[edges];
mat=SparseArray[Map[Rule[#,-1]&,edges],{num,num}]

Each diagonal in a row is the negated sum of the off-diagonals. Thus the diagonal part of matrix is as follows:

diag = SparseArray[{{i_,i_}->1.},{num,num}]  SparseArray[ -mat.Table[1.,{num}]]

Therefore, the Laplacian is given as shown here:

lap=mat+diag

This visualizes the matrix:

MatrixPlot[lap]

The Fiedler Vector

The sum of each row is zero, therefore the Laplacian matrix is positive semi-definite with a zero eigenvalue. The eigenvector corresponding to the second smallest eigenvalue is called the Fiedler vector.

This calculates the two smallest eigenvalues and eigenvectors:

{{lam2,lam1},{vec2,vec1}}=Eigensystem[lap,-2];

One of these eigenvalues is zero:

Chop[{lam1,lam2}]

Partitioning the Nodes

Now use the Fiedler eigenvector to generate an ordering of vertices and form two groups of vertices: domain1 and domain2:

order = Ordering[vec2];
domain1 = Drop[order,Floor[num/2]];
domain2= Drop[order,-(num-Floor[num/2])];

This sets the colors of vertices in domain1 as (RefLink[Hue, paclet:ref/Hue])[0.] (red) and vertices in domain2 as (RefLink[Hue, paclet:ref/Hue])[0.75] (blue):

Map[(NodeColor[#] = Hue[0.])&,domain1];
Map[(NodeColor[#] = Hue[0.75])&,domain2];

This plots the partition. As can be seen, the partitions avoided the very dense part of the mesh, and each subdomain is nicely connected:

graphicsEdge[{i_,j_}]:= {NodeColor[i],Line[{coordinates[[i]],(coordinates[[j]]+coordinates[[i]])/2.}],
NodeColor[j],Line[{coordinates[[j]],(coordinates[[j]]+coordinates[[i]])/2.}]
};
Lines = Flatten[Map[graphicsEdge,edges]];
Show[Graphics[Lines],AspectRatio->1]

The number of edges cut by the partition can be calculated as follows:

vec=Table[1,{num}]; 
vec[[domain1]] = 0; 
Total[Abs[lap.vec]]/2

Matrix Functions with NDSolve

One of the important features of many of Mathematica's numerical solvers is that they work for vector and matrix input. Typically this is used to solve coupled systems of equations, but it can be used to solve matrix specific problems. One example will be given here that uses the numerical differential equation solver, (RefLink[NDSolve, paclet:ref/NDSolve]), to find parametrized solutions to matrix functions.

Here is a 3×3 matrix:

matA=N[-{{1,2,3},{4,5,6},{7,8,9}}];
matA//MatrixForm

The exponential function is the solution of the differential equation.

x'(t)==ax(t),x(0)==1

This can be demonstrated by solving the equation symbolically:

DSolve[{x'[t]==a x[t],x[0]==1},x,t]

The matrix exponential (RefLink[Exp, paclet:ref/Exp])[A t] can be found by forming a matrix equation and solving with (RefLink[NDSolve, paclet:ref/NDSolve]). The solution here is valid for 0≤t≤5:

solExp=NDSolve[X'[t]==matA.X[t]&&X[0]==IdentityMatrix[3],X,{t,0,5}];
matrixExpA=X/.First[solExp]

The solution is a function that will return the matrix function (RefLink[Exp, paclet:ref/Exp])[A t] for a range of t. If t is 0.0, the identity matrix is returned:

matrixExpA[0.]//MatrixForm

This demonstrates that (RefLink[Exp, paclet:ref/Exp])[A]:(RefLink[Exp, paclet:ref/Exp])[A ]=(RefLink[Exp, paclet:ref/Exp])[2A]:

expA=matrixExpA[1.];
expA.expA-matrixExpA[2.]//MatrixForm

Mathematica already has a function for computing the exponential of a function, (RefLink[MatrixExp, paclet:ref/MatrixExp]). This can be compared with the solution that was computed:

dat=Table[{t,Norm[MatrixExp[N[matA],"Parameter"->t]-matrixExpA[t],"Frobenius"]},{t,0.0001,5,0.2}];
ListLogPlot[dat]

Here is a differential equation for the (RefLink[Sin, paclet:ref/Sin]) function:

DSolve[{  x''[t]+ (a^2) x[t]==0,x[0]==0,x'[0]==a},x,t]

This computes the (RefLink[Sin, paclet:ref/Sin]) of the matrix A:

solSin=NDSolve[X''[t]+matA.matA.X[t]==0&&X[0]==DiagonalMatrix[{0,0,0}]&&X'[0]==matA,X,{t,0,4Pi}];
matrixSinA=X/.First[solSin]

The (RefLink[Sin, paclet:ref/Sin]) of the matrix has the correct behavior at the origin:

matrixSinA[0.]//MatrixForm

This computes the (RefLink[Cos, paclet:ref/Cos]) of the matrix A:

solCos=NDSolve[X''[t]+matA.matA.X[t]==0&&X[0]==IdentityMatrix[3]&&X'[0]==DiagonalMatrix[{0,0,0}],X,{t,0,4Pi}];
matrixCosA=X/.First[solCos]

The (RefLink[Cos, paclet:ref/Cos]) of the matrix has the correct behavior at the origin:

matrixCosA[0.]//MatrixForm

This demonstrates the identity ((sin(x))^2)+((cos(x))^2)==1, for t==3:

(mat1=matrixCosA[3.];mat1.mat1)+(mat2=matrixSinA[3.];mat2.mat2)//MatrixForm