2
$\begingroup$

I am new to Mathematica and am wondering how to plot a function over a lattice, and have it's lattice be shown beneath it (with edges).

Say we have some function $f(x,y)$ (doesn't matter what) for some values $x,y \in \mathbb{R}$. I want to plot this function over a triangular lattice, and then have the triangular lattice below it (along with the edges).

The best I've been able to do is: enter image description here

Show[ListPlot3D[data, PlotRange -> All, 
 PlotStyle -> {White, Opacity[0.75]}, Mesh -> None], 
 Graphics3D[{Black, Opacity[0.5], PointSize[0.01], Point[data]}], 
 Graphics3D[LatticePlotTwoDimensions[[1]] /. {x_Real, y_Real} :> {x, y, -0.2}]]

where data denotes the evaluations of $f$, and is obtained via

Evaluations = Map[f[#] &, Lattice];
data = Transpose[Append[Transpose[Lattice], Evaluations]]

and LatticePlotTwoDimensions denotes a ListPlot of Lattice, i.e.

ListPlot[Lattice, PlotStyle -> Blue]

Note: I am also wanting to colour certain nodes of the lattice (beneath the plot and above it) according to their position (i.e. all points between the two peaks to be red say, and I'm not sure how to do this either. In particular, I would like to put this below it: enter image description here

Any help would be appreciated.


In case it is useful, I construct the triangular lattice via:

FullLattice := 
  Flatten[
   Table[
    x*{1, 0} + y*{-1/2, Sqrt[3]/2}, {x, -10, 20}, {y, 0, 7}],
    1];
Lattice := Select[FullLattice, -5 < #[[1]] < 5 &];
$\endgroup$

2 Answers 2

3
$\begingroup$
f[x_, y_] := Sin[x y]

vcolor = If[0 < f[#1, #2] < 2, Red, Blue] & @@@ Lattice;
data = {#1, #2, f[#1, #2]} & @@@ Lattice;

g = IndexGraph[NearestNeighborGraph[Lattice]];

With ListPlot3D:

Show[{ListPlot3D[data, Mesh -> All, PlotRange -> All, 
   PlotStyle -> {White, Opacity[0.75]}], 
  Graphics3D[{GraphicsComplex[{#1, #2, -1.5} & @@@ 
      Lattice, {Line[List @@@ EdgeList[g]], PointSize[.015], 
      Point[Range[Length[Lattice]], VertexColors -> vcolor]}],
    GraphicsComplex[
     data, {PointSize[.015], 
      Point[Range[Length[Lattice]], VertexColors -> vcolor]}]}]}]

or custom polygons:

Graphics3D[{GraphicsComplex[
   data, {EdgeForm[{GrayLevel[0.2]}], 
    Directive[Lighting -> Automatic, GrayLevel[1], 
            Opacity[0.75]], 
    Polygon[FindCycle[g, 3, All][[All, All, 1]]]}], 
  GraphicsComplex[{#1, #2, -1.5} & @@@ 
    Lattice, {Line[List @@@ EdgeList[g]], PointSize[.015], 
    Point[Range[Length[Lattice]], VertexColors -> vcolor]}],
  GraphicsComplex[
   data, {PointSize[.015], 
    Point[Range[Length[Lattice]], VertexColors -> vcolor]}]}, 
 Axes -> True]
$\endgroup$
1
  • $\begingroup$ Thank you! This did precisely what I wanted $\endgroup$
    – spaceman
    May 9, 2022 at 17:31
2
$\begingroup$

I would create a Plot3D of your function surface, combine it with a Graphics3D of the Points you want displayed, and limit the display to the triangle you want using this answer: Plot3D constrained to a non-rectangular region

For example:

pts1 = Table[
   Point[{data[[i, 1]], data[[i, 2]], 
     Sin[data[[i, 3, 1, 1]]] + Sin[data[[i, 3, 1, 2]]]}], {i, 
    Length@data}];
floorpts1 = 
  Table[Point[{data[[i, 1]], data[[i, 2]], -2}], {i, Length@data}];
pl3d = Plot3D[
  Sin[x] + Sin[y], {x, Min[data[[;; , 1]]], Max[data[[;; , 1]]]}, {y, 
   Min[data[[;; , 2]]], Max[data[[;; , 2]]]},
  RegionFunction -> Function[{x, y, z}, x - y + 1]];
Show[{pl3d, Graphics3D[{pts1, floorpts1}]}, Boxed -> False, 
 Axes -> False]
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.