Plot MATLAB icon

Here's my attempt. To get the matrix representing the Laplacian I use LaplacianFilter on an array of symbols and CoefficientArrays to extract the coefficients.

n = 200;

shape = ArrayPad[ConstantArray[0, {n/2, n/2}], {{0, n/2}, {0, n/2}}, 1];    
shapeVector = Flatten @ Position[Flatten @ shape, 1];

symbolArray = Array[x, {n, n}];    
symbolLaplacian = LaplacianFilter[1.0 symbolArray , 1, Padding -> 0];    
lapMatrix = Last@CoefficientArrays[
    Flatten[symbolLaplacian][[shapeVector]],
    Flatten[symbolArray][[shapeVector]]];

{ev} = Eigenvectors[lapMatrix, {-1}];

result = Flatten[shape];
result[[shapeVector]] = ev;
result = Partition[result, n];

ListContourPlot[result]
ListPlot3D[result, BoxRatios -> {1, 1, 0.8}, Mesh -> False, 
  PlotStyle -> Specularity[White, 30]]

enter image description here

enter image description here


While the other answers are nice, the icon deserves a closer look:

MathWorks logo

Note, in particular, that four of the six edges are not constrained by the ostensible Dirichlet boundary conditions, nor is it clear that they solve a Neumann problem. And indeed, as I noted in the comments this is supported by the OP's first link.

In short, to produce the logo, they took 'pac-man' eigenfunctions around the convex corner, which is the trickiest bit to describe, and used a least-squares approach to impose the boundary conditions. Finally, they discarded all but two terms in the expansion:

After being so careful to satisfy the boundary conditions, the logo uses only the first two terms in the sum. This artistic license gives the edge of the logo a more interesting, curved shape.

In my view, this essentially says it is pointless to try and impose the boundary conditions at all. Since they took a certain artistic license, in replicating it one can simply try and do it by hand. We know that the plot is a function of the form $$ v(r,\theta)=\sum_{j=1,2} a_j J_\frac{2}{3}(k_j r)\sin(\tfrac{2}{3}\theta), $$ which has only four free parameters. These are enough that they can, to a good precision, simply be set by hand. I therefore used the Manipulate construct

Manipulate[
 Plot3D[(
    a BesselJ[2/3, λ Sqrt[x^2 + y^2]] Sin[
       2/3 (Arg[y - I x] + π)] + 
     b BesselJ[2/3, μ Sqrt[x^2 + y^2]] Sin[
       2/3 (Arg[y - I x] + π)]
    ) Boole[x >= 0 || y >= 0], {x, -1, 1}, {y, -1, 1},
  BoxRatios -> Automatic, Mesh -> None, Exclusions -> None, PlotPoints -> 50, Axes -> False
  ]
 , {{a, 1.275}, 0, 3}, {{b, 0.805}, 0, 3}, {{λ, 3.18}, 0, 10}, {{μ, 1.96}, 0, 10}]

to find good guesses for the parameters, which are the defaults above. The result is, I think, pretty close to the original:

enter image description here

One could also, if so inclined, attempt to implement their least-squares procedure. This sounds like a hazier problem to me: it is no longer "find an accurate enough solution of this specific problem", but rather "find an accurate solution that will also look like ours when you make this arbitrary restriction". It may be that many of the possible other options for the choices they make ($m$ points on the boundary, $n$ fundamental solutions) will yield similar-looking plots. But that's much too much work, I think.


I had this laying around from a course in numerical linear algebra I taught a few years ago.

Here's a matrix whose nonzero elements describe the basic shape.

size = 50;
nw = Partition[Table[i, {i, 1, size^2}], size];
sw = Partition[Table[i, {i, size^2 + 1, 2*size^2}], size];
se = Partition[Table[i, {i, 2*size^2 + 1, 3*size^2}], size];
L = ArrayFlatten[{{nw, 0}, {sw, se}}];
{m, n} = Dimensions[L];
L = Join[{Table[0, {n + 2}]},
  Map[Join[{0}, #, {0}] &, L],
  {Table[0, {n + 2}]}];

If size=4, for example, we get something like so

(* size = 4 *)
L // MatrixForm

enter image description here

Now, we convert this to the Laplacian.

entries[0, {_, _}] = {};
entries[k_, {i_, j_}] := Module[{goodVals},
   goodVals = Select[{
      {i + 1, j}, {i, j + 1}, {i - 1, j}, {i, j - 1}},
     L[[Sequence @@ #]] =!= 0 &];
   {k, #} -> 1 & /@ (L[[Sequence @@ #]] & /@ goodVals)];
saRules = Flatten[{Band[{1, 1}] -> -4,
    MapIndexed[entries, L, {2}]}];
lap = SparseArray[saRules];

lap is a matrix whose dimension is equal to the number of non-zero entries of L. You're essentially looking for an eigenvector of lap.

evs = Reverse[Eigenvectors[N[lap], 8,
  Method -> {"Arnoldi", "Shift" -> 0}]];

Here's a simple visualization

ev = evs[[1]];
vib = Map[If[# > 0, ev[[#]], 0] &, L, {2}];
ListPlot3D[vib, ViewPoint -> {2.3, 2.26, 1}]

enter image description here

OK, let's spruce it up a bit

{m, n} = Dimensions[vib];
delete[0, {i_, j_}] := If[
   (i + 1 > m || vib[[i + 1, j]] == 0 ) && 
    (j + 1 > n || vib[[i, j + 1]] == 0) &&
    (i - 1 < 1 || vib[[i - 1, j]] == 0) && 
    (j - 1 < 1 || vib[[i, j - 1]] == 0) &&
    ((i + 1 > m || j + 1 > n) || vib[[i + 1, j + 1]] == 0) &&
    ((i - 1 < 1 || j + 1 > n) || vib[[i - 1, j + 1]] == 0) &&
    ((i + 1 > m || j - 1 < 1) || vib[[i + 1, j - 1]] == 0) &&
    ((i - 1 < 1 || j - 1 < 1) || vib[[i - 1, j - 1]] == 0),
   Null, 0];
delete[x_, {_, _}] := x;
vib2 = MapIndexed[delete, vib, {2}];
ListPlot3D[vib2,
 Mesh -> None, PlotStyle -> {RGBColor[0.8, 0.2, 0.2],
   Specularity[White, 20]}, Lighting -> {
   {"Directional", RGBColor[0, 0.4, 0.4],
    {{-40, -100, 2}, {0, 0, 0}}},
   {"Directional", RGBColor[0.4, 0.4, 0],
    {{80, -50, 20}, {0, 0, 0}}}}, Background -> Black,
 Boxed -> False, ViewPoint -> {2.3, 2.26, 1}]

enter image description here