Med tanke på en rad atomer ABABAB i ett sexkantigt mönster, hur kan jag använda Mathematica för att skapa med ett sexkantigt gitter (oändligt) med denna grupp så att varje atom A endast omges av B-atomer och vice versa.

Kommentarer

  • Hola Jose , välkommen till Mathematica.SE. Menar du grafiskt galler, ett plot nödvändigtvis ändligt, eller en analytisk beskrivning av ett galler? Förmodligen kan du ge mer information om vad du tänker göra med det, så det är lättare att hjälpa dig.
  • ett ändligt gitter som ges av ett sexkantigt mönster med två atomer till exempel så här google.es/… men med 2 atomer istället en (grafen)
  • Relaterad: 19165 , 14632 .
  • Även relaterat: Wolfram Demo
  • Viss kunskap om fasta tillståndsfysik underlättar 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}}] } 

Detta skapar enhetscellen

Graphics[unitCell[0, 0], ImageSize -> 100] 

Enhetscell

Vi placerar det i ett galler

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 ] 

2D Hexgitter


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}} ] 

3D Hex Gitter

Kommentarer

  • ok tack …: D
  • Bra svar, gillade med tanke på både 2d och 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

Ett annat sätt är att använda GeometricTransformation, vilket kan göra snabbare men begränsas av $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} ] ] }] ] 

Utmatning av sexkantigt galler

Detta fungerar inte utan att öka $IterationLimit när du ersätter {16, 16} med {128, 128}.

Svar

Det finns få resursfunktioner som kan hjälpa till att skapa sexkantiga rutnät . Koden nedan är från exemplen 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}] 

ange bildbeskrivning här

lsBCoords = Union[Flatten[First /@ hexes2, 1]]; 
Graphics[{EdgeForm[Blue], hexes2 /. Polygon[p_] :> Line[Append[p, First[p]]], Red, PointSize[0.02], Point[lsBCoords]}] 

ange bildbeskrivning här

HexagonalGridGraph

(Observera att den här funktionen skickas in av Wolfram Research.)

grHex = ResourceFunction["HexagonalGridGraph"][{16, 12}] 

ange bildbeskrivning här

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}] 

ange bildbeskrivning här

Lämna ett svar

Din e-postadress kommer inte publiceras. Obligatoriska fält är märkta *