0
$\begingroup$

I have the hyperplane $\sum_{i=1}^{d} x_i c_i = z$ for $x \in \mathbb{R}^d$, defined by the vector of postivive numerical coefficients $c_i \in \mathbb{R}, c_i > 0$, and the value $z > 0$. I need a function in Mathematica that can return all positive integer points $n_i \in \mathbb{Z}, n_i \ge 0$ that are at most a distance $\epsilon$ from the plane.

I tried treating the question as an integer programming problem;

LatticePlaneIntersectionInstance[
  coefficients_?(VectorQ[#, NumericQ] &), rhs_?NumericQ, 
  precision_?(NumericQ[#] && # > 0 &)] := Module[{sol = LinearProgramming[coefficients, {coefficients}, {rhs}, 0, 
     Integers];
   If[(Abs[coefficients.sol - rhs]/Sqrt[coefficients.coefficients])  < precision, sol, {}]
   ]

Which does work in some situations; it will return at most one point and only if the point is exactly incident with the plane:

LatticePlaneIntersectionInstance[{5.2, 6.8}, 5.2 + 2.0*6.8, 0.1] 

returns {1,2}

but

LatticePlaneIntersectionInstance[{5.2, 6.8}, 5.2 + 2.001*6.8, 0.1] 

returns {}.

This didn't seem to work so well which is why I've reformulated the problem as the intersection of a plane with a lattice.

Can anyone provide a different solution which will find all of the points and also take into account the precision parameter properly?

------------------EDIT------------------ Solved by kglr. Here is his code written as a function:

LatticePlaneIntersection[
  coefficients_?(VectorQ[#, NumericQ] && And @@ Thread[# > 0] &), 
  rhs_?(NumericQ[#] && # > 0 &), 
  precision_?(NumericQ[#] && # > 0 &)] := 
 Block[{nnn}, 
  With[{coords = nnn /@ Range[Length[coefficients]]}, 
   If[Length[#] > 0, coords /. #, {}] &@Solve[
     Evaluate@Append[
       Thread[coords >= 0], 
       Rationalize[Abs[coords.coefficients - rhs] <= precision]
       ],
     coords, Integers]
   ]]
$\endgroup$
0
1
$\begingroup$
coeffs = Rationalize[{5.2, 6.8}];
rhs = Rationalize[(5.2 + 2.0*6.8)];
tol = 3;

pnts = {a, b} /. Solve[Norm[{a, b}.coeffs - rhs] <= tol && 0 <= a && 0 <= b, {a, b}, 
   Integers]

{{0, 3}, {1, 2}, {2, 1}, {4, 0}}

Graphics[{Hyperplane[coeffs, rhs], PointSize[Large], Red, Point@pnts}, 
 PlotRange -> {{-1, 5}, {-1, 5}}, Axes -> True]

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ Very nice, thanks. I have written it into a function and put it in my question. $\endgroup$ – Joe Feb 7 '20 at 15:03

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.