Biorąc pod uwagę tablicę atomów ABABAB w układzie heksagonalnym, jak mogę użyć Mathematica do utworzenia z sześciokątną siatką (nieskończoną) z taką tablicą, więc każdy atom A jest otoczony tylko przez atomy B i odwrotnie.
Komentarze
- Hola Jose , witamy w Mathematica.SE. Czy masz na myśli siatkę graficzną, działkę z konieczności skończoną, czy też analityczny opis sieci? Prawdopodobnie mógłbyś podać więcej szczegółów na temat tego, co zamierzasz z tym zrobić, więc łatwiej jest ci pomóc.
- skończona krata dana sześciokątnym wzorem z 2 atomami, na przykład w ten sposób google.es/… ale z dwoma atomami zamiast jednego (grafen)
- Powiązane: 19165 , 14632 .
- Podobne: Wolfram Demo
- Ułatwia to pewna znajomość fizyki ciała stałego.
Odpowiedź
W 2D
unitCell[x_, y_] := { Red , Disk[{x, y}, 0.1] , Blue , Disk[{x, y + 2/3 Sin[120 Degree]}, 0.1] , Gray, , Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}] , Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}] , Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}] } Spowoduje to utworzenie komórki elementarnej
Graphics[unitCell[0, 0], ImageSize -> 100] 
Umieszczamy go w kratownicy
Graphics[ Block[ { unitVectA = {Cos[120 Degree], Sin[120 Degree]} ,unitVectB = {1, 0} }, Table[ unitCell @@ (unitVectA j + unitVectB k) , {j, 1, 12} , {k, Ceiling[j/2], 20 + Ceiling[j/2]} ] ], ImageSize -> 500 ] 
W 3D
unitCell3D[x_, y_, z_] := { Red , Sphere[{x, y, z}, 0.1] , Blue , Sphere[{x, y + 2/3 Sin[120 Degree], z}, 0.1] , Gray , Cylinder[{{x, y, z}, {x, y +2/3 Sin[120 Degree], z}}, 0.05] , Cylinder[{{x, y, z}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2, z}}, 0.05] , Cylinder[{{x, y, z}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2, z}}, 0.05] } Graphics3D[ Block[ {unitVectA = {Cos[120 Degree], Sin[120 Degree], 0}, unitVectB = {1, 0, 0} }, Table[unitCell3D @@ (unitVectA j + unitVectB k), {j, 20}, {k, 20}]] , PlotRange -> {{0, 10}, {0, 10}, {-1, 1}} ] 
Komentarze
- ok, dzięki …: D
- Świetna odpowiedź, polubiłem, biorąc pod uwagę zarówno 2D, jak i 3D!
Odpowiedź
W 2D
Manipulate[( basis = {{s, 0}, {s/2, s Sqrt[3]/2}}; points = Tuples[Range[0, max], 2].basis; Graphics[Point[points], Frame -> True, AspectRatio -> Automatic]) , {s, 0.1, 1} , {max, 2, 10} ] Odpowiedź
Innym sposobem jest użycie GeometricTransformation, który może renderować się szybciej, ale jest ograniczony przez $IterationLimit.
With[{base = Line[{ {{-(1/2), -(1/(2 Sqrt[3]))}, {0, 0}}, {{0, 0}, {0, 1/Sqrt[3]}}, {{0, 0}, {1/2, -(1/(2 Sqrt[3]))}} }] }, Graphics[{ GeometricTransformation[ base, Flatten@Array[ TranslationTransform[ {1/2, -(1/(2 Sqrt[3]))} + {#1 + If[OddQ[#2], 1/2, 0], #2 Sqrt[3]/2} ] &, {16, 16} ] ] }] ] 
To nie działa bez zwiększenia $IterationLimit po zastąpieniu {16, 16} przez {128, 128}.
Odpowiedź
Jest kilka funkcji zasobów, które mogą pomóc w tworzeniu sześciokątnych siatek . Poniższy kod pochodzi z przykładów HextileBins .
HextileBins
hexes2 = Keys[ ResourceFunction["HextileBins"][ Flatten[Table[{x, y}, {x, 0, 16}, {y, 0, 12}], 1], 2]]; Graphics[{EdgeForm[Blue], FaceForm[Opacity[0.1]], hexes2}] 
lsBCoords = Union[Flatten[First /@ hexes2, 1]]; Graphics[{EdgeForm[Blue], hexes2 /. Polygon[p_] :> Line[Append[p, First[p]]], Red, PointSize[0.02], Point[lsBCoords]}] 
HexagonalGridGraph
(Zwróć uwagę, że ta funkcja jest dostarczana przez Wolfram Research.)
grHex = ResourceFunction["HexagonalGridGraph"][{16, 12}] 
lsVCoords = GraphEmbedding[grHex]; lsVCoords[[1 ;; 12]] (* {{0, 0}, {0, 2}, {Sqrt[3], -1}, {Sqrt[3], 3}, {2 Sqrt[3], 0}, {Sqrt[ 3], 5}, {2 Sqrt[3], 2}, {2 Sqrt[3], 6}, {3 Sqrt[3], -1}, {3 Sqrt[3], 3}, {2 Sqrt[3], 8}, {3 Sqrt[3], 5}} *) grHexPolygons = Map[Polygon@(List @@@ #)[[All, 1]] &, FindCycle[grHex, {6, 6}, All]] /. v_Integer :> lsVCoords[[v]]; Graphics[{EdgeForm[Blue], FaceForm[Opacity[0.2]], grHexPolygons}] 