2
$\begingroup$

I'm fairly new to Mathematica, and programming in general, but I'm trying to define an $n$-dimensional piecewise function, $F({\bf x})$. Properties of the function are set by an underlying lattice, defined by a set of primitive vectors, ${\bf a}_i$, where each lattice position is defined by $${\bf R}_A = A_1{\bf a}_1+\dotsc +A_n{\bf a}_n,$$ where $A_i\in\mathbb{Z}.$

Now essentially, I want my function to be some value $V_0$ when it is within a radius $r$ of each lattice position, and $0$ elsewhere. In short, $$F({\bf x})= \begin{cases} V_0 & |{\bf x}-{\bf R}_A| < r \\ 0 & \textrm{Elsewhere} \end{cases}.$$

To simplify the discussion, I'll talk about the $n=1$ case, which is a pulse train, but I'd like to be able to generalize this to higher dimensions.

I've mainly tried to define this function by some variation of

F[x_] := Piecewise[{{V0, Abs[x - a * A] < r}}]

but I've yet to succeed. In my code, I assign some value to a and r, which are my lattice spacing (essentially, my 1D primitive vector) and radius, respectively.

The tricky part comes with dealing with A, as it's not being assigned a particular value, but is instead any element of a set. I've tried declaring Element[A, Integers] before defining F[x] above. I've also tried to use Refine as in

F[x_] := Refine[Piecewise[{{V0, Abs[x - a*A] < r}}], Element[A, Integers]]

but have met with similar results. Every time I try to plot F[x], I just end up with a blank plot. I imagine I'm not setting up my condition correctly, but I don't know how else to let Mathematica know A is any integer. It really seems like there would be an straightforward way to define this function, short of using a Fourier series, but I haven't found out how. Any help would be appreciated, and thank you in advance!

$\endgroup$
  • $\begingroup$ Like this: lat[x_, v0_, a_, r_] := Piecewise[{{v0, Norm[Function[t, t - Round[t]][LinearSolve[a, x]]] < r}}, 0]; Plot3D[lat[{x, y}, 1/4, IdentityMatrix[2], 1/3], {x, -2, 2}, {y, -2, 2}, Exclusions -> None, PlotPoints -> 95]? $\endgroup$ – J. M. will be back soon Nov 1 '17 at 9:17
  • $\begingroup$ Thank you for your response! That's an interesting solution, though it doesn't quite seem to work for a generalized lattice. For example, if you use the basis of a 2D hexagonal lattice: a={{1, 0}, {1/2, Sqrt[3]/2}} the result is not as intended. I'll try and adapt it and will let you know how it goes! $\endgroup$ – G. Esparza Nov 1 '17 at 19:32
3
$\begingroup$

The implementation I gave in the comments had a missing piece. The following should now work:

lattice[x_, v0_, a_, r_] := With[{tr = Transpose[a], per = (# - Round[#]) &}, 
        Piecewise[{{v0, Norm[tr.per[LinearSolve[tr, x]]] < r}}, 0]]

Some examples:

Plot[lattice[{x}, 1, {{1}}, 1/4], {x, -2, 2}, Axes -> None, Frame -> True]

pulse train

DensityPlot[lattice[{x, y}, 1/4, {{1, 0}, {1/2, Sqrt[3]/2}}, 1/5],
            {x, -2, 2}, {y, -2, 2}, Exclusions -> None, PlotPoints -> 75]

hexagonal lattice

{DensityPlot3D[lattice[{x, y, z}, 1, LatticeData["BodyCenteredCubic", "Basis"], 1/4],
               {x, 0, 2}, {y, 0, 2}, {z, 0, 2}, PlotPoints -> 75], 
 DensityPlot3D[lattice[{x, y, z}, 1, LatticeData["FaceCenteredCubic", "Basis"], 1/4],
               {x, 0, 2}, {y, 0, 2}, {z, 0, 2}, PlotPoints -> 75]} // GraphicsRow

centered cubic lattices

$\endgroup$
  • $\begingroup$ Excellent! Nice solution, if you're curious today I found an alternate approach as well, seen in the comment below. Thank you for your help! $\endgroup$ – G. Esparza Nov 3 '17 at 4:17
1
$\begingroup$

Another approach would be to apply a transformation to a point in your original lattice to another lattice with orthogonal primitive vectors of unit length. One can then more easily find the nearest lattice coordinate there, thereby also finding the coefficients of the nearest lattice coordinate in the original space:

NearLat[x_, a_] := Total[a*Round[x.Inverse[a]]]
PWLat[x_, a_, V0_, r_] := Piecewise[{{V0, Norm[x - NearLat[x, a]] < r}}, 0]
$\endgroup$
  • $\begingroup$ It works OK here, but in general, you will want to avoid using Inverse[], and use LinearSolve[] instead: NearLat[x_, a_] := Round[LinearSolve[Transpose[a], x]].a $\endgroup$ – J. M. will be back soon Nov 3 '17 at 4:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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