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
$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.
list-manipulation equation-solving graphics programming
$endgroup$
add a comment |
$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.
list-manipulation equation-solving graphics programming
$endgroup$
add a comment |
$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.
list-manipulation equation-solving graphics programming
$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
list-manipulation equation-solving graphics programming
edited May 17 at 22:19
Kai
asked May 17 at 19:26
KaiKai
57219
57219
add a comment |
add a comment |
3 Answers
3
active
oldest
votes
$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]]
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 *)
$endgroup$
add a comment |
$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]
$endgroup$
add a comment |
$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]
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.
$endgroup$
add a comment |
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
);
);
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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
$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]]
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 *)
$endgroup$
add a comment |
$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]]
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 *)
$endgroup$
add a comment |
$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]]
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 *)
$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]]
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 *)
edited May 17 at 20:51
answered May 17 at 20:23
RomanRoman
9,75511640
9,75511640
add a comment |
add a comment |
$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]
$endgroup$
add a comment |
$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]
$endgroup$
add a comment |
$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]
$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]
answered May 17 at 21:17
Henrik SchumacherHenrik Schumacher
63.3k589177
63.3k589177
add a comment |
add a comment |
$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]
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.
$endgroup$
add a comment |
$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]
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.
$endgroup$
add a comment |
$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]
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.
$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]
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.
edited May 18 at 14:59
answered May 17 at 22:00
KaiKai
57219
57219
add a comment |
add a comment |
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.
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
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