Givet en række atomer ABABAB i et sekskantet mønster, hvordan kan jeg bruge Mathematica til at oprette med et sekskantet gitter (uendeligt) med dette array, så hvert atom A kun er omgivet af B-atomer og omvendt.
Kommentarer
- Hola Jose , velkommen til Mathematica.SE. Mener du grafisk gitter, et plot nødvendigvis endeligt eller en analytisk beskrivelse af et gitter? Sandsynligvis kunne du give flere detaljer om, hvad du har til hensigt at gøre med det, så det er lettere at hjælpe dig.
- et endeligt gitter givet af et sekskantet mønster med 2 atomer for eksempel som dette google.es/… men med 2 atomer i stedet for en (grafen)
- Relateret: 19165 , 14632 .
- Også relateret: Wolfram Demo
- En vis viden om solid state fysik letter det.
Svar
I 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}}] } Dette opretter enhedscellen
Graphics[unitCell[0, 0], ImageSize -> 100] 
Vi placerer det i et gitter
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 ] 
I 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}} ] 
Kommentarer
- ok tak …: D
- Fantastisk svar, kunne lide at overveje både 2d og 3d!
Svar
I 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} ] Svar
En anden måde er at bruge GeometricTransformation, som muligvis gengives hurtigere, men er begrænset af $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} ] ] }] ] 
Dette fungerer ikke uden at øge $IterationLimit når du erstatter {16, 16} med {128, 128}.
Svar
Der er få ressourcefunktioner, der kan hjælpe med at oprette sekskantede gitre . Koden nedenfor er fra eksemplerne på 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
(Bemærk at denne funktion er indsendt af 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}] 