Problem Set 2 Group

Problem G2-1

All of the groups did extremely well on both of these problems, touché!  You're ability to march up the learning curve is impressive.  Keep it up!
The following is adapted from the solution handed in by the following group: Samantha Bennett, Ben Cooper, Kathryn Duffy, Matt Handler, Byron Hsu, Michelle Kaufman, Forrest Liau, and Tom Schilling.  Of particular interest in the Mathematica code is the manipulation of colors.  Notice how overlaying two differently-colored disks on top of one another would cause problems if not properly taken into account.  The following solution deals with the color issue expeditiously, while maintaining proper symmetry throughout.

PrimObj[origin_ , LatticeVecA_ ,  
        LatticeVecB_ ]  :=  {
Pink = 
          origin; 
Purple = 
          origin + LatticeVecA; 
Green = 
          origin + LatticeVecA + LatticeVecB; 
Orange = 
          origin + 
            LatticeVecB; 
Graphics[{RGBColor[1, 0,  .5], 
            Disk[origin, 0.3]}], 
Graphics[{RGBColor[ .5, 
              0, 1], Disk[origin  +  LatticeVecA, 
              0.3]}], 
Graphics[{RGBColor[1,  .5, 0], 
            Disk[origin  +  LatticeVecB, 
              0.3]}], 
Graphics[{RGBColor[ .5, 1, 0], 
            Disk[origin +  LatticeVecA +  LatticeVecB, 0.3]}]}

Default graphic.

Example = 
        Show[PrimObj[{-1/2, -1/2}, {0, 1}, {2, 1}], 
          Axes -> True, AspectRatio -> Automatic];

Definition of operations.

XReflection[Point_] := Point . {{1, 0}, {0, -1}}

YReflection[Point_] := Point . {{-1, 0}, {0, 1}}

Inversion[Point_] := Point . {{-1, 0}, {0, -1}}

Rotation[θ_, 
        Point_] := (Point . {{Cos[θ], -Sin[θ]}, {Sin[θ], Cos[θ]}})

Definition of functions which will use the above operations.

YR[Pink_, Purple_, Green_, 
        Orange_] := {
Graphics[{RGBColor[1, 0,  .5], 
            Disk[YReflection[Pink],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 0, 1], 
            Disk[YReflection[Purple],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[1,  .5, 0], 
            Disk[YReflection[Orange],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 1, 0], 
            Disk[YReflection[Green],  .3]}, Axes -> True, 
          AspectRatio -> Automatic]
}

XR[Pink_, Purple_, Green_, 
        Orange_] := {
Graphics[{RGBColor[1, 0,  .5], 
            Disk[XReflection[Pink],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 0, 1], 
            Disk[XReflection[Purple],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[1,  .5, 0], 
            Disk[XReflection[Orange],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 1, 0], 
            Disk[XReflection[Green],  .3]}, Axes -> True, 
          AspectRatio -> Automatic]
}

Inv[Pink_, Purple_, Green_, 
        Orange_] := {
Graphics[{RGBColor[1, 0,  .5], 
            Disk[Inversion[Pink],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 0, 1], 
            Disk[Inversion[Purple],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[1,  .5, 0], 
            Disk[Inversion[Orange],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 1, 0], 
            Disk[Inversion[Green],  .3]}, Axes -> True, 
          AspectRatio -> Automatic]
}

Rot[θ_, Pink_, Purple_, Green_, 
        Orange_] := {
Graphics[{RGBColor[1, 0,  .5], 
            Disk[Rotation[θ, Pink],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 0, 1], 
            Disk[Rotation[θ, Purple],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[1,  .5, 0], 
            Disk[Rotation[θ, Orange],  .3]}, Axes -> True, 
          AspectRatio -> 
            Automatic], 
Graphics[{RGBColor[ .5, 1, 0], 
            Disk[Rotation[θ, Green],  .3]}, Axes -> True, 
          AspectRatio -> Automatic]
}

Part (a)

Implementation of functions.

Question1 = 
        Show[Example, XR[Purple, Purple, Green, Orange]];

Part (b)

Question2a = 
        Show[Example, Inv[Pink, Purple, Green, Orange]];

Question2b = 
        XR and YR applied to Example because;
Print["XR.YR= ", {{1, 0}, {0, -1}} . {{-1, 0}, {0, 1}} // 
        MatrixForm,  "= Inversion Matrix"]

Part (c)

Question3 = 
        Show[Example,  XR[Pink, Green, Green, Orange],  
          YR[Pink, Green, Green, Orange], 
          Inv[Pink, Green, Green, Orange]];

Part (d)

Question4 = 
        Show[Example, Rot[-Pi/2, Pink, Purple, Green, Orange], 
          Rot[- Pi, Pink, Purple, Green, Orange], 
          Rot[- 3 Pi/2, Pink, Purple, Green, Orange], 
          XR[Pink, Pink, Green, Green]];

Part (e)

Question5 = 
        Show[Example, Rot[-Pi/4, Pink, Purple, Green, Orange], 
          Rot[Pi/4, Pink, Green, Green, Green], 
          Inv[Purple, Purple, Green, Green]];

Problem G2-2

Load the necessary Graphics packages:

<< Graphics`Graphics`

<< Graphics`Graphics3D`

<< Graphics`Shapes`

Defining a function that will take the radius and coordinates in three dimensions to draw a sphere:

DrawSphere[radius_, {x_, y_, z_}] := 
      TranslateShape[
        Graphics3D[Sphere[radius, 30, 30]], {x, y, z}]

Define a matrix that will rotate an object by an angle of θ in a plane

MatrixRotateinTwoDimensions[θ_] := {{Cos[θ], -Sin[θ], 0}, {Sin[θ], Cos[θ], 0}, {0, 0, 1}}

Define a matrix that will reflect an object over the z=0 plane

MatrixReflect = {{1, 0, 0}, {0, 1, 0}, {0, 0, -1}};

CesiumRadius = 1.69;

ChlorideRadius = 1.81;

SodiumRadius =  .97;

Here is the lattice constant, which is the edge length of the unit cell, of CsCl:

LatticeConstant = 4.04;

Define the coordinates of one sphere in a corner in the top row:

MatrixTopRow[1] = {LatticeConstant/2, LatticeConstant/2, 
        LatticeConstant/2}

Rotate this sphere three times

For[i = 1, i ≤ 3, i++, 
      Print[MatrixTopRow[i + 1] = 
          MatrixTopRow[i] . MatrixRotateinTwoDimensions[Pi/2]]]

Produce the coordinates of the bottom row by reflecting the coordinates of the top row

For[i = 1, i ≤ 4, i++, 
      Print[MatrixBottomRow[i] = MatrixTopRow[i] . MatrixReflect]]

Put all of the coordinates of all of the spheres into MatrixTopRow

For[i = 1, i ≤ 4, i++, 
        MatrixTopRow[i + 4] = 
          MatrixBottomRow[i]];
MatrixTopRow[9] = {0, 0, 0};

Make a table of the Graphics and give the spheres their appropriate radius value

TopandBottomRows  = 
        Table[Show[DrawSphere[CesiumRadius, MatrixTopRow[i]], 
            DisplayFunction -> Identity], {i, 1, 
            8}];
MiddleAtom = 
        Table[Show[DrawSphere[ChlorideRadius, MatrixTopRow[i]], 
            DisplayFunction -> Identity], {i, 9, 9}];

Join the Graphics together

AllAtoms=Append[TopandBottomRows, MiddleAtom[[1]]];

Show[AllAtoms, DisplayFunction -> $DisplayFunction, 
        ViewPoint  ->  {-2, 5, 1}, 
        Shading -> False];

G2-2 NaCl Structure

Begin with the lattice constant of NaCl and some initial coordinates for some anions and cations

LatticeConstantNaCl = 
        2*SodiumRadius +  2*ChlorideRadius;

ChlorideTopLevel[1] = {LatticeConstantNaCl/2, LatticeConstantNaCl/2, 
          LatticeConstantNaCl/2};

ChlorideTopMiddle[1] = {0, 0, LatticeConstantNaCl/2};

SodiumTopLevel[1] =  {LatticeConstantNaCl/2,  0,  
          LatticeConstantNaCl/2};

ChlorideMiddleLevel[1] = {LatticeConstantNaCl/2, 0, 0};

SodiumMiddleLevel[1] = {LatticeConstantNaCl/2, LatticeConstantNaCl/2, 
          0};

SodiumCenter[1] = {0, 0, 0}

The operations follow the operations done above for CsCl.  We've added a middle row for NaCl

For[i = 1, i ≤ 3, i++, 
      Print[ChlorideTopLevel[i + 1] = 
          ChlorideTopLevel[i] . 
            MatrixRotateinTwoDimensions[Pi/2]]]

For[i = 1, i ≤ 4, i++, 
      Print[ChlorideBottomLevel[i] = 
          ChlorideTopLevel[i] . MatrixReflect]]

For[i = 1, i ≤ 3, i++, 
      Print[ChlorideMiddleLevel[i + 1] = 
          ChlorideMiddleLevel[i] . 
            MatrixRotateinTwoDimensions[Pi/2]]]

ChlorideBottomMiddle[1] = 
      ChlorideTopMiddle[1] . MatrixReflect

Index the coordinates into NumericalPositionChloride[i]

For[i = 1, i ≤ 4, i++, 
        NumericalPositionChloride[i] = 
          ChlorideTopLevel[i]];
For[i = 5, i ≤ 8, i++, 
        NumericalPositionChloride[i] = 
          ChlorideBottomLevel[i - 4]];
For[i = 9, 
        i ≤ 
          12, i++,  NumericalPositionChloride[i] = 
            ChlorideMiddleLevel[i - 8];];
NumericalPositionChloride[13] = ChlorideBottomMiddle[1]; 
    NumericalPositionChloride[14] = ChlorideTopMiddle[1];

Create a table of Graphics objects for the Chloride ions.

ChlorideRows  = 
        Table[Show[DrawSphere[ChlorideRadius, NumericalPositionChloride[i]], 
            DisplayFunction -> Identity], {i, 1, 14}];

The same sort of operations, now for sodium:

For[i = 1, i ≤ 3, i++, 
      Print[SodiumTopLevel[i + 1] = 
          SodiumTopLevel[i] . MatrixRotateinTwoDimensions[Pi/2]]]

For[i = 1, i ≤ 4, i++, 
      Print[SodiumBottomLevel[i] = 
          SodiumTopLevel[i] . MatrixReflect]]

For[i = 1, i ≤ 3, i++, 
      Print[SodiumMiddleLevel[i + 1] = 
          SodiumMiddleLevel[i] . 
            MatrixRotateinTwoDimensions[Pi/2]]]

For[i = 1, i ≤ 4, i++, 
        NumericalPositionSodium[i] = 
          SodiumTopLevel[i]];
For[i = 5, i ≤ 8, i++, 
        NumericalPositionSodium[i] = 
          SodiumBottomLevel[i - 4]];
For[i = 9, i ≤ 12, i++,  
        NumericalPositionSodium[i] = 
          SodiumMiddleLevel[i - 8]];
NumericalPosition[13] = SodiumCenter[1];

SodiumRows  = 
        Table[Show[DrawSphere[SodiumRadius, NumericalPositionSodium[i]], 
            DisplayFunction -> Identity], {i, 1, 13}];

Join together all of the Graphics objects for the ions

TopAndBottomRows = ChlorideRows;
For[i = 1,i ≤ 12,i++,TopAndBottomRows=Append[TopAndBottomRows, SodiumRows[[i]]]]

Show[TopAndBottomRows, DisplayFunction -> $DisplayFunction, 
      ViewPoint  ->  {5, -2.5, 2.5}, 
      Shading -> False]

Note that the anions are not touching on the body diagonal, but that every cation is touching an anion and vice versa