Unexpected behavior from CoordinateBoundingBoxArray with Into[1] and 0.41

Question

I want to get the four corners of a Cuboid. This usually works:

CoordinateBoundingBoxArray[{-{1., 1.}, {1., 1.}}, Into@1]

gives

{{{-1., -1.}, {-1., 1.}}, {{1., -1.}, {1., 1.}}}

as expected.

The expressions CoordinateBoundingBoxArray[{-{1., 0.40}, {1., 0.40}}, Into@1] and CoordinateBoundingBoxArray[{-{1., 0.42}, {1., 0.42}}, Into@1] evaluate to a 2x2 matrix of 2d coordinates as well, as I would expect. But for some reason

CoordinateBoundingBoxArray[{-{1., 0.41}, {1., 0.41}}, Into@1]

gives

{{{-1., -0.41}}, {{1., -0.41}}}

I am confident that this is not the way this should work.

Answer 1

The problem arises from rounding in machine precision. For instance the second-coordinate interval {-0.41, 0.41} leads to this edge case, a one ulp error:

SetAccuracy[1/0.82*0.82, Infinity]
(*  9007199254740991/9007199254740992  *)

It turns out this affects how the range is computed, because Floor is used on it and it returns 0 instead of 1.

One workaround is to avoid machine precision, using either exact numbers or arbitrary precision. Another workaround is to create a Floor that applies a machine-precision fudge factor, in the way that Equal has the fudge factor Internal`$EqualTolerance.

First way:

ClearAll[cbba];
cbba = SetPrecision[
    CoordinateBoundingBoxArray[
     # /. x_?Developer`MachineRealQ :> SetPrecision[x, $MachinePrecision], ##2],
     Precision[#]] &; 

Second way, mostly just as evidence that Floor is implicated:

ClearAll[cbba];
cbba[v_, rest__] /; Precision[v] === MachinePrecision :=
  Internal`InheritedBlock[{Floor},
   Unprotect@Floor;
   Floor[x_] /; ! TrueQ[$in] := Block[{$in = True},   (* Villegas-Gayley *)
     Floor[x + 10^Internal`$EqualTolerance $MachineEpsilon Abs[x]]];
   Protect@Floor;
   CoordinateBoundingBoxArray[v, rest]
   ];

Or even more simply:

ClearAll[cbba];
cbba[args___] /; FreeQ[{args}, Floor] :=
  Block[{Floor = Round},
   CoordinateBoundingBoxArray[args]
   ];

I can't find a way in which this substitution of Round for Floor causes a problem in CoordinateBoundingBoxArray, but I suppose it might.

Test:

cbba[{-{1., 0.41}, {1., 0.41}}, Into@1]
(*  {{{-1., -0.41}, {-1., 0.41}}, {{1., -0.41}, {1., 0.41}}}  *)