Find the 3D region containing the origin bounded by given planesUsing Mathematica to help to determine the consistency of and numerically solve systems of non-linear equationsHow to represent the lines that are formed by the intersection of two planes?Solving equations bounded by a regionRegion bounded by the curveFinding possible lattice planes of a crystal structureDrawing convex cone with given vectorsChanging the basis vectors of a 2D density plotFinding Intersections Between Arbitrary Surface and A LineGenerate convex-hull of a 15 dimensional spaceFind all integer tuples in a bounded region

Do adult Russians normally hand-write Cyrillic as cursive or as block letters?

The term for the person/group a political party aligns themselves with to appear concerned about the general public

Word for a small burst of laughter that can't be held back

Show sparse matrices like chessboards

Is it a problem that pull requests are approved without any comments

Credit card offering 0.5 miles for every cent rounded up. Too good to be true?

How to make thick Asian sauces?

pitch and volume compensations for different instruments

Does any lore text explain why the planes of Acheron, Gehenna, and Carceri are the alignment they are?

What if you don't bring your credit card or debit for incidentals?

Initialize an array of doubles at compile time

Movie where a boy is transported into the future by an alien spaceship

What people are called boars ("кабан") and why?

Concise way to draw this pyramid

Hygienic footwear for prehensile feet?

Opposite of "Squeaky wheel gets the grease"

Pros and cons of writing a book review?

Chopin: marche funèbre bar 15 impossible place

Is the decompression of compressed and encrypted data without decryption also theoretically impossible?

Is it possible for people to live in the eye of a permanent hypercane?

Metal bar on DMM PCB

Why is Colorado so different politically from nearby states?

Saying “or something” at the end of a sentence?

Humans meet a distant alien species. How do they standardize? - Units of Measure



Find the 3D region containing the origin bounded by given planes


Using Mathematica to help to determine the consistency of and numerically solve systems of non-linear equationsHow to represent the lines that are formed by the intersection of two planes?Solving equations bounded by a regionRegion bounded by the curveFinding possible lattice planes of a crystal structureDrawing convex cone with given vectorsChanging the basis vectors of a 2D density plotFinding Intersections Between Arbitrary Surface and A LineGenerate convex-hull of a 15 dimensional spaceFind all integer tuples in a bounded region













2












$begingroup$


I'm writing a code to generate the Wigner-Seitz cell of the reciprocal lattice for a given set of lattice translation vectors. For example, consider the Body Centered Cubic (BCC) lattice whose basis translation vectors are given by



a1 = -1, 1, 1/2;
a2 = 1, -1, 1/2;
a3 = 1, 1, -1/2;


The reciprocal basis vectors are then defined according to



d = 2 Pi;
v = a1.(a2[Cross]a3);
b1 = d/v (a2[Cross]a3);
b2 = d/v (a3[Cross]a1);
b3 = d/v (a1[Cross]a2);


The reciprocal lattice is then defined by the set of reciprocal lattice vectors, the set of all linear combinations of integer multiples of reciprocal basis vectors, i.e.



$$vecG = n_1 vecb_1 + n_2 vecb_2 + n_3 vecb_3, qquad n_i in mathbbZ$$



The Wigner-Seitz cell (in this case the First Brillouin Zone) is defined as the region containing the origin which is bounded by the perpendicular bisecting planes of the reciprocal lattice vectors. We generally can accomplish this by only considering the first, second, and maybe third closest reciprocal lattice points to the origin. In the case of BCC, for example, the following vectors will suffice:



recipvecs = 
Select[Flatten[
Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2],
Norm[#] <= 2 d &];


Question: Given these vectors, how can I construct the Wigner-Seitz cell?



For example, one possibility is to construct the equations for all the planes



planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice


(note there is a redundancy for the origin, which just gives True, this can be removed). Now the issue is going to be to rewrite each of these equations as an inequality such that the half-space defined by the inequality contains the origin. I don't think that would be too difficult, but not every one of the equations can be solved for any one of the coordinates, e.g. we cannot solve every equation for $z$, like



Solve[#, z] & /@ planes


Some of the equations will have to be solved for $x$ or $y$ before being turned into inequalities. I think I could find a brute force solution but I'm hoping there's something more elegant.



Ultimately I'd like to obtain the inequalities that define the region so that I can visualize it with RegionPlot3D and use it to Select points from a mesh.










share|improve this question











$endgroup$
















    2












    $begingroup$


    I'm writing a code to generate the Wigner-Seitz cell of the reciprocal lattice for a given set of lattice translation vectors. For example, consider the Body Centered Cubic (BCC) lattice whose basis translation vectors are given by



    a1 = -1, 1, 1/2;
    a2 = 1, -1, 1/2;
    a3 = 1, 1, -1/2;


    The reciprocal basis vectors are then defined according to



    d = 2 Pi;
    v = a1.(a2[Cross]a3);
    b1 = d/v (a2[Cross]a3);
    b2 = d/v (a3[Cross]a1);
    b3 = d/v (a1[Cross]a2);


    The reciprocal lattice is then defined by the set of reciprocal lattice vectors, the set of all linear combinations of integer multiples of reciprocal basis vectors, i.e.



    $$vecG = n_1 vecb_1 + n_2 vecb_2 + n_3 vecb_3, qquad n_i in mathbbZ$$



    The Wigner-Seitz cell (in this case the First Brillouin Zone) is defined as the region containing the origin which is bounded by the perpendicular bisecting planes of the reciprocal lattice vectors. We generally can accomplish this by only considering the first, second, and maybe third closest reciprocal lattice points to the origin. In the case of BCC, for example, the following vectors will suffice:



    recipvecs = 
    Select[Flatten[
    Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2],
    Norm[#] <= 2 d &];


    Question: Given these vectors, how can I construct the Wigner-Seitz cell?



    For example, one possibility is to construct the equations for all the planes



    planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice


    (note there is a redundancy for the origin, which just gives True, this can be removed). Now the issue is going to be to rewrite each of these equations as an inequality such that the half-space defined by the inequality contains the origin. I don't think that would be too difficult, but not every one of the equations can be solved for any one of the coordinates, e.g. we cannot solve every equation for $z$, like



    Solve[#, z] & /@ planes


    Some of the equations will have to be solved for $x$ or $y$ before being turned into inequalities. I think I could find a brute force solution but I'm hoping there's something more elegant.



    Ultimately I'd like to obtain the inequalities that define the region so that I can visualize it with RegionPlot3D and use it to Select points from a mesh.










    share|improve this question











    $endgroup$














      2












      2








      2


      1



      $begingroup$


      I'm writing a code to generate the Wigner-Seitz cell of the reciprocal lattice for a given set of lattice translation vectors. For example, consider the Body Centered Cubic (BCC) lattice whose basis translation vectors are given by



      a1 = -1, 1, 1/2;
      a2 = 1, -1, 1/2;
      a3 = 1, 1, -1/2;


      The reciprocal basis vectors are then defined according to



      d = 2 Pi;
      v = a1.(a2[Cross]a3);
      b1 = d/v (a2[Cross]a3);
      b2 = d/v (a3[Cross]a1);
      b3 = d/v (a1[Cross]a2);


      The reciprocal lattice is then defined by the set of reciprocal lattice vectors, the set of all linear combinations of integer multiples of reciprocal basis vectors, i.e.



      $$vecG = n_1 vecb_1 + n_2 vecb_2 + n_3 vecb_3, qquad n_i in mathbbZ$$



      The Wigner-Seitz cell (in this case the First Brillouin Zone) is defined as the region containing the origin which is bounded by the perpendicular bisecting planes of the reciprocal lattice vectors. We generally can accomplish this by only considering the first, second, and maybe third closest reciprocal lattice points to the origin. In the case of BCC, for example, the following vectors will suffice:



      recipvecs = 
      Select[Flatten[
      Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2],
      Norm[#] <= 2 d &];


      Question: Given these vectors, how can I construct the Wigner-Seitz cell?



      For example, one possibility is to construct the equations for all the planes



      planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice


      (note there is a redundancy for the origin, which just gives True, this can be removed). Now the issue is going to be to rewrite each of these equations as an inequality such that the half-space defined by the inequality contains the origin. I don't think that would be too difficult, but not every one of the equations can be solved for any one of the coordinates, e.g. we cannot solve every equation for $z$, like



      Solve[#, z] & /@ planes


      Some of the equations will have to be solved for $x$ or $y$ before being turned into inequalities. I think I could find a brute force solution but I'm hoping there's something more elegant.



      Ultimately I'd like to obtain the inequalities that define the region so that I can visualize it with RegionPlot3D and use it to Select points from a mesh.










      share|improve this question











      $endgroup$




      I'm writing a code to generate the Wigner-Seitz cell of the reciprocal lattice for a given set of lattice translation vectors. For example, consider the Body Centered Cubic (BCC) lattice whose basis translation vectors are given by



      a1 = -1, 1, 1/2;
      a2 = 1, -1, 1/2;
      a3 = 1, 1, -1/2;


      The reciprocal basis vectors are then defined according to



      d = 2 Pi;
      v = a1.(a2[Cross]a3);
      b1 = d/v (a2[Cross]a3);
      b2 = d/v (a3[Cross]a1);
      b3 = d/v (a1[Cross]a2);


      The reciprocal lattice is then defined by the set of reciprocal lattice vectors, the set of all linear combinations of integer multiples of reciprocal basis vectors, i.e.



      $$vecG = n_1 vecb_1 + n_2 vecb_2 + n_3 vecb_3, qquad n_i in mathbbZ$$



      The Wigner-Seitz cell (in this case the First Brillouin Zone) is defined as the region containing the origin which is bounded by the perpendicular bisecting planes of the reciprocal lattice vectors. We generally can accomplish this by only considering the first, second, and maybe third closest reciprocal lattice points to the origin. In the case of BCC, for example, the following vectors will suffice:



      recipvecs = 
      Select[Flatten[
      Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2],
      Norm[#] <= 2 d &];


      Question: Given these vectors, how can I construct the Wigner-Seitz cell?



      For example, one possibility is to construct the equations for all the planes



      planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice


      (note there is a redundancy for the origin, which just gives True, this can be removed). Now the issue is going to be to rewrite each of these equations as an inequality such that the half-space defined by the inequality contains the origin. I don't think that would be too difficult, but not every one of the equations can be solved for any one of the coordinates, e.g. we cannot solve every equation for $z$, like



      Solve[#, z] & /@ planes


      Some of the equations will have to be solved for $x$ or $y$ before being turned into inequalities. I think I could find a brute force solution but I'm hoping there's something more elegant.



      Ultimately I'd like to obtain the inequalities that define the region so that I can visualize it with RegionPlot3D and use it to Select points from a mesh.







      list-manipulation equation-solving graphics programming






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited May 17 at 22:19







      Kai

















      asked May 17 at 19:26









      KaiKai

      57219




      57219




















          3 Answers
          3






          active

          oldest

          votes


















          4












          $begingroup$

          Unfortunately, VoronoiMesh does not work in 3D. So we do it manually.



          the crystal lattice vectors:



          a1 = -1, 1, 1/2;
          a2 = 1, -1, 1/2;
          a3 = 1, 1, -1/2;


          the reciprocal lattice vectors: (Inverse is easier than using cross products, but ultimately the same thing)



          B = b1, b2, b3 = 2π*Inverse[Transpose[a1, a2, a3]];


          an inequality defining the perpendicular bisecting plane of a reciprocal lattice point v:



          pbp[0, 0, 0, r_] = True;
          pbp[v_, r_] := v.r/v.v <= 1/2


          make a list of such inequalities, And them, and simplify: (here you may have to go to larger s to get all the constraints, as you said)



          With[s = 1,
          WS[x_, y_, z_] = FullSimplify[
          And @@ Flatten[Table[pbp[n1,n2,n3.B, x,y,z], n1,-s,s, n2,-s,s, n3,-s,s]]]]



          -2 π <= y + z <= 2 π && z <= 2 π + x && x <= 2 π + z && y <= 2 π + x && x <= 2 π + y && -2 π <= x + z <= 2 π && z <= 2 π + y && y <= 2 π + z && -2 π <= x + y <= 2 π




          make a 3D plot of the Wigner-Seitz cell: (use more PlotPoints to make it prettier)



          With[t = 2π,
          RegionPlot3D[WS[x, y, z], x, -t, t, y, -t, t, z, -t, t]]


          enter image description here



          You can also check if a point is in the Wigner-Seitz cell or not:



          WS[0.1, 0.2, 0.3]
          (* True *)
          WS[3.1, 3.2, 0.3]
          (* False *)





          share|improve this answer











          $endgroup$




















            3












            $begingroup$

            It is really unfortunate that we don't have a 3D implementation of VoronoiMesh.



            Borrowing quite a lot from Roman, the following tries to compute the extremal points of the Wigner-Seitz cells and applies ConvexHullMesh to the result in order to obtain the precise polyhedron.



            a1 = -1, 1, 1/2;
            a2 = 1, -1, 1/2;
            a3 = 1, 1, -1/2;
            B = b1, b2, b3 = 2 π*Inverse[Transpose[a1, a2, a3]];
            pts = Flatten[Table[b1, b2, b3.n1, n2, n3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2];
            G = NearestNeighborGraph[pts, VertexCoordinates -> pts];
            neighbors = Rest[VertexOutComponent[G, 0, 0, 0, 1]];
            rhs = MapThread[Dot, neighbors, neighbors]/2;
            subsets = Subsets[Range[Length[neighbors]], 3];

            q = Module[A, x,
            Table[
            A = neighbors[[s]];
            If[Det[A] != 0,
            x = LinearSolve[A, rhs[[s]]];
            If[And @@ Thread[neighbors.x <= rhs], x, Nothing],
            Nothing
            ],
            s, subsets]
            ];
            R = ConvexHullMesh[q]


            enter image description here






            share|improve this answer









            $endgroup$




















              2












              $begingroup$

              The other answers are great and very enlightening, I had already found a brute force solution but I took elements of both @Henrik Schumacher and @Roman's answers to produce this nice minimal one for what I wanted. I think both of their answers are better in that they provide more functionality.



              d = 2 Pi;
              a1 = -1, 1, 1/2;
              a2 = 1, -1, 1/2;
              a3 = 1, 1, -1/2;

              b1, b2, b3 = d*Inverse[Transpose[a1, a2, a3]];

              reciplattice =
              Select[Flatten[
              Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1],
              2], 0 < Norm[#] <= 2 d &];

              region = And@@FullSimplify[(x, y, z - (#/2)).# <= 0 & /@ reciplattice]


              And plotting it with



              e = d + 0.1;
              fbz = RegionPlot3D[region, x, -e, e, y, -e, e, z, -e, e,
              PlotPoints -> 60]


              enter image description here



              Update:



              I realized that my solution doesn't actually answer the original, broader question of how to get the region which contains the origin given a set of planes and is more specific to my case, so I figured I would add a solution which can be used more generally. Instead of directly setting up the inequalities, let's say I have the equations which define the planes



              planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice;


              Solve each of the equations for either $x$, $y$, or $z$, which results in a set of rules such as z -> 1, etc:



              sols = Flatten[
              If[sz = Solve[#, z]; sz != , sz,
              If[sx = Solve[#, x]; sx != , sx, Solve[#, y]]] & /@ planes];


              Now construct the inequalities for each side of the plane



              ineq = Flatten[#[[1]] <= #[[2]], #[[1]] > #[[2]] & /@ sols];


              And select the ones which contain the origin



              region = Select[ineq, (# /. x -> 0, y -> 0, z -> 0) == True &];


              which results in effectively the same result but can be used for any set of planes given their respective equations. We can find the region containing any point of interest by simply modifying the last line.






              share|improve this answer











              $endgroup$













                Your Answer








                StackExchange.ready(function()
                var channelOptions =
                tags: "".split(" "),
                id: "387"
                ;
                initTagRenderer("".split(" "), "".split(" "), channelOptions);

                StackExchange.using("externalEditor", function()
                // Have to fire editor after snippets, if snippets enabled
                if (StackExchange.settings.snippets.snippetsEnabled)
                StackExchange.using("snippets", function()
                createEditor();
                );

                else
                createEditor();

                );

                function createEditor()
                StackExchange.prepareEditor(
                heartbeatType: 'answer',
                autoActivateHeartbeat: false,
                convertImagesToLinks: false,
                noModals: true,
                showLowRepImageUploadWarning: true,
                reputationToPostImages: null,
                bindNavPrevention: true,
                postfix: "",
                imageUploader:
                brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
                contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
                allowUrls: true
                ,
                onDemand: true,
                discardSelector: ".discard-answer"
                ,immediatelyShowMarkdownHelp:true
                );



                );













                draft saved

                draft discarded


















                StackExchange.ready(
                function ()
                StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f198588%2ffind-the-3d-region-containing-the-origin-bounded-by-given-planes%23new-answer', 'question_page');

                );

                Post as a guest















                Required, but never shown

























                3 Answers
                3






                active

                oldest

                votes








                3 Answers
                3






                active

                oldest

                votes









                active

                oldest

                votes






                active

                oldest

                votes









                4












                $begingroup$

                Unfortunately, VoronoiMesh does not work in 3D. So we do it manually.



                the crystal lattice vectors:



                a1 = -1, 1, 1/2;
                a2 = 1, -1, 1/2;
                a3 = 1, 1, -1/2;


                the reciprocal lattice vectors: (Inverse is easier than using cross products, but ultimately the same thing)



                B = b1, b2, b3 = 2π*Inverse[Transpose[a1, a2, a3]];


                an inequality defining the perpendicular bisecting plane of a reciprocal lattice point v:



                pbp[0, 0, 0, r_] = True;
                pbp[v_, r_] := v.r/v.v <= 1/2


                make a list of such inequalities, And them, and simplify: (here you may have to go to larger s to get all the constraints, as you said)



                With[s = 1,
                WS[x_, y_, z_] = FullSimplify[
                And @@ Flatten[Table[pbp[n1,n2,n3.B, x,y,z], n1,-s,s, n2,-s,s, n3,-s,s]]]]



                -2 π <= y + z <= 2 π && z <= 2 π + x && x <= 2 π + z && y <= 2 π + x && x <= 2 π + y && -2 π <= x + z <= 2 π && z <= 2 π + y && y <= 2 π + z && -2 π <= x + y <= 2 π




                make a 3D plot of the Wigner-Seitz cell: (use more PlotPoints to make it prettier)



                With[t = 2π,
                RegionPlot3D[WS[x, y, z], x, -t, t, y, -t, t, z, -t, t]]


                enter image description here



                You can also check if a point is in the Wigner-Seitz cell or not:



                WS[0.1, 0.2, 0.3]
                (* True *)
                WS[3.1, 3.2, 0.3]
                (* False *)





                share|improve this answer











                $endgroup$

















                  4












                  $begingroup$

                  Unfortunately, VoronoiMesh does not work in 3D. So we do it manually.



                  the crystal lattice vectors:



                  a1 = -1, 1, 1/2;
                  a2 = 1, -1, 1/2;
                  a3 = 1, 1, -1/2;


                  the reciprocal lattice vectors: (Inverse is easier than using cross products, but ultimately the same thing)



                  B = b1, b2, b3 = 2π*Inverse[Transpose[a1, a2, a3]];


                  an inequality defining the perpendicular bisecting plane of a reciprocal lattice point v:



                  pbp[0, 0, 0, r_] = True;
                  pbp[v_, r_] := v.r/v.v <= 1/2


                  make a list of such inequalities, And them, and simplify: (here you may have to go to larger s to get all the constraints, as you said)



                  With[s = 1,
                  WS[x_, y_, z_] = FullSimplify[
                  And @@ Flatten[Table[pbp[n1,n2,n3.B, x,y,z], n1,-s,s, n2,-s,s, n3,-s,s]]]]



                  -2 π <= y + z <= 2 π && z <= 2 π + x && x <= 2 π + z && y <= 2 π + x && x <= 2 π + y && -2 π <= x + z <= 2 π && z <= 2 π + y && y <= 2 π + z && -2 π <= x + y <= 2 π




                  make a 3D plot of the Wigner-Seitz cell: (use more PlotPoints to make it prettier)



                  With[t = 2π,
                  RegionPlot3D[WS[x, y, z], x, -t, t, y, -t, t, z, -t, t]]


                  enter image description here



                  You can also check if a point is in the Wigner-Seitz cell or not:



                  WS[0.1, 0.2, 0.3]
                  (* True *)
                  WS[3.1, 3.2, 0.3]
                  (* False *)





                  share|improve this answer











                  $endgroup$















                    4












                    4








                    4





                    $begingroup$

                    Unfortunately, VoronoiMesh does not work in 3D. So we do it manually.



                    the crystal lattice vectors:



                    a1 = -1, 1, 1/2;
                    a2 = 1, -1, 1/2;
                    a3 = 1, 1, -1/2;


                    the reciprocal lattice vectors: (Inverse is easier than using cross products, but ultimately the same thing)



                    B = b1, b2, b3 = 2π*Inverse[Transpose[a1, a2, a3]];


                    an inequality defining the perpendicular bisecting plane of a reciprocal lattice point v:



                    pbp[0, 0, 0, r_] = True;
                    pbp[v_, r_] := v.r/v.v <= 1/2


                    make a list of such inequalities, And them, and simplify: (here you may have to go to larger s to get all the constraints, as you said)



                    With[s = 1,
                    WS[x_, y_, z_] = FullSimplify[
                    And @@ Flatten[Table[pbp[n1,n2,n3.B, x,y,z], n1,-s,s, n2,-s,s, n3,-s,s]]]]



                    -2 π <= y + z <= 2 π && z <= 2 π + x && x <= 2 π + z && y <= 2 π + x && x <= 2 π + y && -2 π <= x + z <= 2 π && z <= 2 π + y && y <= 2 π + z && -2 π <= x + y <= 2 π




                    make a 3D plot of the Wigner-Seitz cell: (use more PlotPoints to make it prettier)



                    With[t = 2π,
                    RegionPlot3D[WS[x, y, z], x, -t, t, y, -t, t, z, -t, t]]


                    enter image description here



                    You can also check if a point is in the Wigner-Seitz cell or not:



                    WS[0.1, 0.2, 0.3]
                    (* True *)
                    WS[3.1, 3.2, 0.3]
                    (* False *)





                    share|improve this answer











                    $endgroup$



                    Unfortunately, VoronoiMesh does not work in 3D. So we do it manually.



                    the crystal lattice vectors:



                    a1 = -1, 1, 1/2;
                    a2 = 1, -1, 1/2;
                    a3 = 1, 1, -1/2;


                    the reciprocal lattice vectors: (Inverse is easier than using cross products, but ultimately the same thing)



                    B = b1, b2, b3 = 2π*Inverse[Transpose[a1, a2, a3]];


                    an inequality defining the perpendicular bisecting plane of a reciprocal lattice point v:



                    pbp[0, 0, 0, r_] = True;
                    pbp[v_, r_] := v.r/v.v <= 1/2


                    make a list of such inequalities, And them, and simplify: (here you may have to go to larger s to get all the constraints, as you said)



                    With[s = 1,
                    WS[x_, y_, z_] = FullSimplify[
                    And @@ Flatten[Table[pbp[n1,n2,n3.B, x,y,z], n1,-s,s, n2,-s,s, n3,-s,s]]]]



                    -2 π <= y + z <= 2 π && z <= 2 π + x && x <= 2 π + z && y <= 2 π + x && x <= 2 π + y && -2 π <= x + z <= 2 π && z <= 2 π + y && y <= 2 π + z && -2 π <= x + y <= 2 π




                    make a 3D plot of the Wigner-Seitz cell: (use more PlotPoints to make it prettier)



                    With[t = 2π,
                    RegionPlot3D[WS[x, y, z], x, -t, t, y, -t, t, z, -t, t]]


                    enter image description here



                    You can also check if a point is in the Wigner-Seitz cell or not:



                    WS[0.1, 0.2, 0.3]
                    (* True *)
                    WS[3.1, 3.2, 0.3]
                    (* False *)






                    share|improve this answer














                    share|improve this answer



                    share|improve this answer








                    edited May 17 at 20:51

























                    answered May 17 at 20:23









                    RomanRoman

                    9,75511640




                    9,75511640





















                        3












                        $begingroup$

                        It is really unfortunate that we don't have a 3D implementation of VoronoiMesh.



                        Borrowing quite a lot from Roman, the following tries to compute the extremal points of the Wigner-Seitz cells and applies ConvexHullMesh to the result in order to obtain the precise polyhedron.



                        a1 = -1, 1, 1/2;
                        a2 = 1, -1, 1/2;
                        a3 = 1, 1, -1/2;
                        B = b1, b2, b3 = 2 π*Inverse[Transpose[a1, a2, a3]];
                        pts = Flatten[Table[b1, b2, b3.n1, n2, n3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2];
                        G = NearestNeighborGraph[pts, VertexCoordinates -> pts];
                        neighbors = Rest[VertexOutComponent[G, 0, 0, 0, 1]];
                        rhs = MapThread[Dot, neighbors, neighbors]/2;
                        subsets = Subsets[Range[Length[neighbors]], 3];

                        q = Module[A, x,
                        Table[
                        A = neighbors[[s]];
                        If[Det[A] != 0,
                        x = LinearSolve[A, rhs[[s]]];
                        If[And @@ Thread[neighbors.x <= rhs], x, Nothing],
                        Nothing
                        ],
                        s, subsets]
                        ];
                        R = ConvexHullMesh[q]


                        enter image description here






                        share|improve this answer









                        $endgroup$

















                          3












                          $begingroup$

                          It is really unfortunate that we don't have a 3D implementation of VoronoiMesh.



                          Borrowing quite a lot from Roman, the following tries to compute the extremal points of the Wigner-Seitz cells and applies ConvexHullMesh to the result in order to obtain the precise polyhedron.



                          a1 = -1, 1, 1/2;
                          a2 = 1, -1, 1/2;
                          a3 = 1, 1, -1/2;
                          B = b1, b2, b3 = 2 π*Inverse[Transpose[a1, a2, a3]];
                          pts = Flatten[Table[b1, b2, b3.n1, n2, n3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2];
                          G = NearestNeighborGraph[pts, VertexCoordinates -> pts];
                          neighbors = Rest[VertexOutComponent[G, 0, 0, 0, 1]];
                          rhs = MapThread[Dot, neighbors, neighbors]/2;
                          subsets = Subsets[Range[Length[neighbors]], 3];

                          q = Module[A, x,
                          Table[
                          A = neighbors[[s]];
                          If[Det[A] != 0,
                          x = LinearSolve[A, rhs[[s]]];
                          If[And @@ Thread[neighbors.x <= rhs], x, Nothing],
                          Nothing
                          ],
                          s, subsets]
                          ];
                          R = ConvexHullMesh[q]


                          enter image description here






                          share|improve this answer









                          $endgroup$















                            3












                            3








                            3





                            $begingroup$

                            It is really unfortunate that we don't have a 3D implementation of VoronoiMesh.



                            Borrowing quite a lot from Roman, the following tries to compute the extremal points of the Wigner-Seitz cells and applies ConvexHullMesh to the result in order to obtain the precise polyhedron.



                            a1 = -1, 1, 1/2;
                            a2 = 1, -1, 1/2;
                            a3 = 1, 1, -1/2;
                            B = b1, b2, b3 = 2 π*Inverse[Transpose[a1, a2, a3]];
                            pts = Flatten[Table[b1, b2, b3.n1, n2, n3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2];
                            G = NearestNeighborGraph[pts, VertexCoordinates -> pts];
                            neighbors = Rest[VertexOutComponent[G, 0, 0, 0, 1]];
                            rhs = MapThread[Dot, neighbors, neighbors]/2;
                            subsets = Subsets[Range[Length[neighbors]], 3];

                            q = Module[A, x,
                            Table[
                            A = neighbors[[s]];
                            If[Det[A] != 0,
                            x = LinearSolve[A, rhs[[s]]];
                            If[And @@ Thread[neighbors.x <= rhs], x, Nothing],
                            Nothing
                            ],
                            s, subsets]
                            ];
                            R = ConvexHullMesh[q]


                            enter image description here






                            share|improve this answer









                            $endgroup$



                            It is really unfortunate that we don't have a 3D implementation of VoronoiMesh.



                            Borrowing quite a lot from Roman, the following tries to compute the extremal points of the Wigner-Seitz cells and applies ConvexHullMesh to the result in order to obtain the precise polyhedron.



                            a1 = -1, 1, 1/2;
                            a2 = 1, -1, 1/2;
                            a3 = 1, 1, -1/2;
                            B = b1, b2, b3 = 2 π*Inverse[Transpose[a1, a2, a3]];
                            pts = Flatten[Table[b1, b2, b3.n1, n2, n3, n1, -1, 1, n2, -1, 1, n3, -1, 1], 2];
                            G = NearestNeighborGraph[pts, VertexCoordinates -> pts];
                            neighbors = Rest[VertexOutComponent[G, 0, 0, 0, 1]];
                            rhs = MapThread[Dot, neighbors, neighbors]/2;
                            subsets = Subsets[Range[Length[neighbors]], 3];

                            q = Module[A, x,
                            Table[
                            A = neighbors[[s]];
                            If[Det[A] != 0,
                            x = LinearSolve[A, rhs[[s]]];
                            If[And @@ Thread[neighbors.x <= rhs], x, Nothing],
                            Nothing
                            ],
                            s, subsets]
                            ];
                            R = ConvexHullMesh[q]


                            enter image description here







                            share|improve this answer












                            share|improve this answer



                            share|improve this answer










                            answered May 17 at 21:17









                            Henrik SchumacherHenrik Schumacher

                            63.3k589177




                            63.3k589177





















                                2












                                $begingroup$

                                The other answers are great and very enlightening, I had already found a brute force solution but I took elements of both @Henrik Schumacher and @Roman's answers to produce this nice minimal one for what I wanted. I think both of their answers are better in that they provide more functionality.



                                d = 2 Pi;
                                a1 = -1, 1, 1/2;
                                a2 = 1, -1, 1/2;
                                a3 = 1, 1, -1/2;

                                b1, b2, b3 = d*Inverse[Transpose[a1, a2, a3]];

                                reciplattice =
                                Select[Flatten[
                                Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1],
                                2], 0 < Norm[#] <= 2 d &];

                                region = And@@FullSimplify[(x, y, z - (#/2)).# <= 0 & /@ reciplattice]


                                And plotting it with



                                e = d + 0.1;
                                fbz = RegionPlot3D[region, x, -e, e, y, -e, e, z, -e, e,
                                PlotPoints -> 60]


                                enter image description here



                                Update:



                                I realized that my solution doesn't actually answer the original, broader question of how to get the region which contains the origin given a set of planes and is more specific to my case, so I figured I would add a solution which can be used more generally. Instead of directly setting up the inequalities, let's say I have the equations which define the planes



                                planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice;


                                Solve each of the equations for either $x$, $y$, or $z$, which results in a set of rules such as z -> 1, etc:



                                sols = Flatten[
                                If[sz = Solve[#, z]; sz != , sz,
                                If[sx = Solve[#, x]; sx != , sx, Solve[#, y]]] & /@ planes];


                                Now construct the inequalities for each side of the plane



                                ineq = Flatten[#[[1]] <= #[[2]], #[[1]] > #[[2]] & /@ sols];


                                And select the ones which contain the origin



                                region = Select[ineq, (# /. x -> 0, y -> 0, z -> 0) == True &];


                                which results in effectively the same result but can be used for any set of planes given their respective equations. We can find the region containing any point of interest by simply modifying the last line.






                                share|improve this answer











                                $endgroup$

















                                  2












                                  $begingroup$

                                  The other answers are great and very enlightening, I had already found a brute force solution but I took elements of both @Henrik Schumacher and @Roman's answers to produce this nice minimal one for what I wanted. I think both of their answers are better in that they provide more functionality.



                                  d = 2 Pi;
                                  a1 = -1, 1, 1/2;
                                  a2 = 1, -1, 1/2;
                                  a3 = 1, 1, -1/2;

                                  b1, b2, b3 = d*Inverse[Transpose[a1, a2, a3]];

                                  reciplattice =
                                  Select[Flatten[
                                  Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1],
                                  2], 0 < Norm[#] <= 2 d &];

                                  region = And@@FullSimplify[(x, y, z - (#/2)).# <= 0 & /@ reciplattice]


                                  And plotting it with



                                  e = d + 0.1;
                                  fbz = RegionPlot3D[region, x, -e, e, y, -e, e, z, -e, e,
                                  PlotPoints -> 60]


                                  enter image description here



                                  Update:



                                  I realized that my solution doesn't actually answer the original, broader question of how to get the region which contains the origin given a set of planes and is more specific to my case, so I figured I would add a solution which can be used more generally. Instead of directly setting up the inequalities, let's say I have the equations which define the planes



                                  planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice;


                                  Solve each of the equations for either $x$, $y$, or $z$, which results in a set of rules such as z -> 1, etc:



                                  sols = Flatten[
                                  If[sz = Solve[#, z]; sz != , sz,
                                  If[sx = Solve[#, x]; sx != , sx, Solve[#, y]]] & /@ planes];


                                  Now construct the inequalities for each side of the plane



                                  ineq = Flatten[#[[1]] <= #[[2]], #[[1]] > #[[2]] & /@ sols];


                                  And select the ones which contain the origin



                                  region = Select[ineq, (# /. x -> 0, y -> 0, z -> 0) == True &];


                                  which results in effectively the same result but can be used for any set of planes given their respective equations. We can find the region containing any point of interest by simply modifying the last line.






                                  share|improve this answer











                                  $endgroup$















                                    2












                                    2








                                    2





                                    $begingroup$

                                    The other answers are great and very enlightening, I had already found a brute force solution but I took elements of both @Henrik Schumacher and @Roman's answers to produce this nice minimal one for what I wanted. I think both of their answers are better in that they provide more functionality.



                                    d = 2 Pi;
                                    a1 = -1, 1, 1/2;
                                    a2 = 1, -1, 1/2;
                                    a3 = 1, 1, -1/2;

                                    b1, b2, b3 = d*Inverse[Transpose[a1, a2, a3]];

                                    reciplattice =
                                    Select[Flatten[
                                    Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1],
                                    2], 0 < Norm[#] <= 2 d &];

                                    region = And@@FullSimplify[(x, y, z - (#/2)).# <= 0 & /@ reciplattice]


                                    And plotting it with



                                    e = d + 0.1;
                                    fbz = RegionPlot3D[region, x, -e, e, y, -e, e, z, -e, e,
                                    PlotPoints -> 60]


                                    enter image description here



                                    Update:



                                    I realized that my solution doesn't actually answer the original, broader question of how to get the region which contains the origin given a set of planes and is more specific to my case, so I figured I would add a solution which can be used more generally. Instead of directly setting up the inequalities, let's say I have the equations which define the planes



                                    planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice;


                                    Solve each of the equations for either $x$, $y$, or $z$, which results in a set of rules such as z -> 1, etc:



                                    sols = Flatten[
                                    If[sz = Solve[#, z]; sz != , sz,
                                    If[sx = Solve[#, x]; sx != , sx, Solve[#, y]]] & /@ planes];


                                    Now construct the inequalities for each side of the plane



                                    ineq = Flatten[#[[1]] <= #[[2]], #[[1]] > #[[2]] & /@ sols];


                                    And select the ones which contain the origin



                                    region = Select[ineq, (# /. x -> 0, y -> 0, z -> 0) == True &];


                                    which results in effectively the same result but can be used for any set of planes given their respective equations. We can find the region containing any point of interest by simply modifying the last line.






                                    share|improve this answer











                                    $endgroup$



                                    The other answers are great and very enlightening, I had already found a brute force solution but I took elements of both @Henrik Schumacher and @Roman's answers to produce this nice minimal one for what I wanted. I think both of their answers are better in that they provide more functionality.



                                    d = 2 Pi;
                                    a1 = -1, 1, 1/2;
                                    a2 = 1, -1, 1/2;
                                    a3 = 1, 1, -1/2;

                                    b1, b2, b3 = d*Inverse[Transpose[a1, a2, a3]];

                                    reciplattice =
                                    Select[Flatten[
                                    Table[n1 b1 + n2 b2 + n3 b3, n1, -1, 1, n2, -1, 1, n3, -1, 1],
                                    2], 0 < Norm[#] <= 2 d &];

                                    region = And@@FullSimplify[(x, y, z - (#/2)).# <= 0 & /@ reciplattice]


                                    And plotting it with



                                    e = d + 0.1;
                                    fbz = RegionPlot3D[region, x, -e, e, y, -e, e, z, -e, e,
                                    PlotPoints -> 60]


                                    enter image description here



                                    Update:



                                    I realized that my solution doesn't actually answer the original, broader question of how to get the region which contains the origin given a set of planes and is more specific to my case, so I figured I would add a solution which can be used more generally. Instead of directly setting up the inequalities, let's say I have the equations which define the planes



                                    planes = (x, y, z - (#/2)).# == 0 & /@ reciplattice;


                                    Solve each of the equations for either $x$, $y$, or $z$, which results in a set of rules such as z -> 1, etc:



                                    sols = Flatten[
                                    If[sz = Solve[#, z]; sz != , sz,
                                    If[sx = Solve[#, x]; sx != , sx, Solve[#, y]]] & /@ planes];


                                    Now construct the inequalities for each side of the plane



                                    ineq = Flatten[#[[1]] <= #[[2]], #[[1]] > #[[2]] & /@ sols];


                                    And select the ones which contain the origin



                                    region = Select[ineq, (# /. x -> 0, y -> 0, z -> 0) == True &];


                                    which results in effectively the same result but can be used for any set of planes given their respective equations. We can find the region containing any point of interest by simply modifying the last line.







                                    share|improve this answer














                                    share|improve this answer



                                    share|improve this answer








                                    edited May 18 at 14:59

























                                    answered May 17 at 22:00









                                    KaiKai

                                    57219




                                    57219



























                                        draft saved

                                        draft discarded
















































                                        Thanks for contributing an answer to Mathematica Stack Exchange!


                                        • Please be sure to answer the question. Provide details and share your research!

                                        But avoid


                                        • Asking for help, clarification, or responding to other answers.

                                        • Making statements based on opinion; back them up with references or personal experience.

                                        Use MathJax to format equations. MathJax reference.


                                        To learn more, see our tips on writing great answers.




                                        draft saved


                                        draft discarded














                                        StackExchange.ready(
                                        function ()
                                        StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f198588%2ffind-the-3d-region-containing-the-origin-bounded-by-given-planes%23new-answer', 'question_page');

                                        );

                                        Post as a guest















                                        Required, but never shown





















































                                        Required, but never shown














                                        Required, but never shown












                                        Required, but never shown







                                        Required, but never shown

































                                        Required, but never shown














                                        Required, but never shown












                                        Required, but never shown







                                        Required, but never shown







                                        Popular posts from this blog

                                        Club Baloncesto Breogán Índice Historia | Pavillón | Nome | O Breogán na cultura popular | Xogadores | Adestradores | Presidentes | Palmarés | Historial | Líderes | Notas | Véxase tamén | Menú de navegacióncbbreogan.galCadroGuía oficial da ACB 2009-10, páxina 201Guía oficial ACB 1992, páxina 183. Editorial DB.É de 6.500 espectadores sentados axeitándose á última normativa"Estudiantes Junior, entre as mellores canteiras"o orixinalHemeroteca El Mundo Deportivo, 16 setembro de 1970, páxina 12Historia do BreogánAlfredo Pérez, o último canoneiroHistoria C.B. BreogánHemeroteca de El Mundo DeportivoJimmy Wright, norteamericano do Breogán deixará Lugo por ameazas de morteResultados de Breogán en 1986-87Resultados de Breogán en 1990-91Ficha de Velimir Perasović en acb.comResultados de Breogán en 1994-95Breogán arrasa al Barça. "El Mundo Deportivo", 27 de setembro de 1999, páxina 58CB Breogán - FC BarcelonaA FEB invita a participar nunha nova Liga EuropeaCharlie Bell na prensa estatalMáximos anotadores 2005Tempada 2005-06 : Tódolos Xogadores da Xornada""Non quero pensar nunha man negra, mais pregúntome que está a pasar""o orixinalRaúl López, orgulloso dos xogadores, presume da boa saúde económica do BreogánJulio González confirma que cesa como presidente del BreogánHomenaxe a Lisardo GómezA tempada do rexurdimento celesteEntrevista a Lisardo GómezEl COB dinamita el Pazo para forzar el quinto (69-73)Cafés Candelas, patrocinador del CB Breogán"Suso Lázare, novo presidente do Breogán"o orixinalCafés Candelas Breogán firma el mayor triunfo de la historiaEl Breogán realizará 17 homenajes por su cincuenta aniversario"O Breogán honra ao seu fundador e primeiro presidente"o orixinalMiguel Giao recibiu a homenaxe do PazoHomenaxe aos primeiros gladiadores celestesO home que nos amosa como ver o Breo co corazónTita Franco será homenaxeada polos #50anosdeBreoJulio Vila recibirá unha homenaxe in memoriam polos #50anosdeBreo"O Breogán homenaxeará aos seus aboados máis veteráns"Pechada ovación a «Capi» Sanmartín e Ricardo «Corazón de González»Homenaxe por décadas de informaciónPaco García volve ao Pazo con motivo do 50 aniversario"Resultados y clasificaciones""O Cafés Candelas Breogán, campión da Copa Princesa""O Cafés Candelas Breogán, equipo ACB"C.B. Breogán"Proxecto social"o orixinal"Centros asociados"o orixinalFicha en imdb.comMario Camus trata la recuperación del amor en 'La vieja música', su última película"Páxina web oficial""Club Baloncesto Breogán""C. B. Breogán S.A.D."eehttp://www.fegaba.com

                                        Vilaño, A Laracha Índice Patrimonio | Lugares e parroquias | Véxase tamén | Menú de navegación43°14′52″N 8°36′03″O / 43.24775, -8.60070

                                        Cegueira Índice Epidemioloxía | Deficiencia visual | Tipos de cegueira | Principais causas de cegueira | Tratamento | Técnicas de adaptación e axudas | Vida dos cegos | Primeiros auxilios | Crenzas respecto das persoas cegas | Crenzas das persoas cegas | O neno deficiente visual | Aspectos psicolóxicos da cegueira | Notas | Véxase tamén | Menú de navegación54.054.154.436928256blindnessDicionario da Real Academia GalegaPortal das Palabras"International Standards: Visual Standards — Aspects and Ranges of Vision Loss with Emphasis on Population Surveys.""Visual impairment and blindness""Presentan un plan para previr a cegueira"o orixinalACCDV Associació Catalana de Cecs i Disminuïts Visuals - PMFTrachoma"Effect of gene therapy on visual function in Leber's congenital amaurosis"1844137110.1056/NEJMoa0802268Cans guía - os mellores amigos dos cegosArquivadoEscola de cans guía para cegos en Mortágua, PortugalArquivado"Tecnología para ciegos y deficientes visuales. Recopilación de recursos gratuitos en la Red""Colorino""‘COL.diesis’, escuchar los sonidos del color""COL.diesis: Transforming Colour into Melody and Implementing the Result in a Colour Sensor Device"o orixinal"Sistema de desarrollo de sinestesia color-sonido para invidentes utilizando un protocolo de audio""Enseñanza táctil - geometría y color. Juegos didácticos para niños ciegos y videntes""Sistema Constanz"L'ocupació laboral dels cecs a l'Estat espanyol està pràcticament equiparada a la de les persones amb visió, entrevista amb Pedro ZuritaONCE (Organización Nacional de Cegos de España)Prevención da cegueiraDescrición de deficiencias visuais (Disc@pnet)Braillín, un boneco atractivo para calquera neno, con ou sen discapacidade, que permite familiarizarse co sistema de escritura e lectura brailleAxudas Técnicas36838ID00897494007150-90057129528256DOID:1432HP:0000618D001766C10.597.751.941.162C97109C0155020