Koska ABABAB-atomiryhmä on kuusikulmainen, kuinka voin luoda Mathematica : n luomiseen kuusikulmaisella ristikolla (ääretön) tällä ryhmällä, joten kukin atomi A on vain B-atomien ympäröimä ja päinvastoin.
Kommentit
- Hola Jose , tervetuloa Mathematica.SE-sivustoon. Tarkoitatko graafista hilaa, juovaa, joka on välttämättä äärellinen, tai analyyttistä kuvaa hilasta? Luultavasti voisit antaa lisätietoja siitä, mitä aiot tehdä sillä, joten sen auttaminen on helpompaa.
- äärellinen ristikko, jonka antaa kuusikulmainen kuvio, jossa on 2 atomia, kuten tämä google.es/… , mutta 2 atomin sijasta yksi (grafeeni)
- Liittyvä: 19165 , 14632 .
- Liittyy myös: Wolfram-esittely
- Jotkut tiedot kiinteän olomuodon fysiikasta helpottavat sitä.
Vastaa
2D-muodossa
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}}] } Tämä luo yksikkösolun
Graphics[unitCell[0, 0], ImageSize -> 100] 
Sijoitamme sen ristikkoon
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 ] 
3D-muodossa
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}} ] 
Kommentit
- ok kiitos …: D
- Hyvä vastaus, tykkäsi sekä 2d: stä että 3D: stä!
Vastaa
2D-muodossa
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} ] Vastaus
Toinen tapa on käyttää GeometricTransformation, joka saattaa näkyä nopeammin, mutta sitä rajoittaa $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} ] ] }] ] 
Tämä ei toimi ilman $IterationLimit -arvon lisäämistä, kun {16, 16} korvataan {128, 128}.
vastaus
On olemassa vähän resurssifunktioita, jotka voivat auttaa kuusikulmaisten ruudukkojen luomisessa . Alla oleva koodi on esimerkkejä 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
(Huomaa, että tämän toiminnon toimittaa 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}] 