P-1: Group Problem 1 Solution

Authors:  David Gray, Juliana Olmstead, Hannah Yun, Stephanie Silberstein

Edited by: Brendan Wells, TA


Editor's Note: The above group of authors prepared and presented a rigorous, yet elegant algorithm for solving P1-G1, which follows.  Errors have been corrected where necessary.  Note that this algorithm will work with minimal input from the user.  The algorithm breaks down at NumberOfMagnets = 2, where the user must change all occurrences of ((μ^2)/2) to ((μ^2)/4)to account for the way in which the program calculates a loop of two magnets.  The only other user input is in the normalization section.  Finally, arbitrary values for H and μ (with H = μ as described in the initial problem) were chosen and can be varied as well.

Define the number of magnets

NumberOfMagnets = 10

Define the limit that will used in the For loop that follows.

EndLimit = -((2 NumberOfMagnets) - 1)

Create matrices that include all of the possible permutations for the magnets.  "Up" is represented by "1" and "down" is represented by "-1"

For[i = 1, i ≥ EndLimit, i = i - 2, 
        Print[Table[
            MyMatrix[i] = 
              MatrixForm[
                Transpose[
                  Permutations[
                    Sign[Range[i, i + (-(EndLimit + 1)), 
                        2]]]]]]]];

Transpose the matrices

For[i = 1, i ≥ EndLimit, i = i - 2, 
      TransposedMatrix[i] = Transpose[MyMatrix[i][[1]]]]

Concatenate the matrices to form one that contains all of the possible permutations

TotallyTransposedMatrix = 
        TransposedMatrix[1];
For[i = -1, i ≥ EndLimit, i = i - 2, 
      TotallyTransposedMatrix = 
        Join[TransposedMatrix[i], TotallyTransposedMatrix]]

Transpose the matrix

MatrixOfPermutations = 
        Transpose[TotallyTransposedMatrix] // MatrixForm;

We need a list of the possible permutations to perform some of the operations found farther below:

ListOfPermutations = MatrixOfPermutations[[1]];

Find number of permutations

Dimensions[%]

Define number of  rows for future procedures

NumberOfRows = NumberOfMagnets

Define number of permutations for future procedures

NumberOfPermutations = (2^NumberOfMagnets)

Find the pair-to-pair energy ineractions for each permutation:

SumOfColumnPAIRTOPAIR = 0;
SumOfAllColumnsPAIRTOPAIR = 
        Table[ For[i = 1, i ≤ NumberOfRows, i++, 
            If[i == NumberOfRows, 
              SumOfColumnPAIRTOPAIR = 
                ListOfPermutations[[NumberOfRows, j]] 
                    ListOfPermutations[[1, j]] + SumOfColumnPAIRTOPAIR; 
              IndexedSumOfColumnPAIRTOPAIR[j] = SumOfColumnPAIRTOPAIR; 
              SumOfColumnPAIRTOPAIR = 0, 
              SumOfColumnPAIRTOPAIR = 
                ListOfPermutations[[i, j]] 
                    ListOfPermutations[[i + 1, j]] + 
                  SumOfColumnPAIRTOPAIR]], {j, 1, 
            NumberOfPermutations}];
If[NumberOfMagnets == 1, IndexedSumOfColumnPAIRTOPAIR[1] = 0; 
        IndexedSumOfColumnPAIRTOPAIR[2] = 0];

Create a matrix containing the data of the pair-to-pair energy ineractions for each permutation:

PairToPairInteractions = (Table[
                IndexedSumOfColumnPAIRTOPAIR[j], {j, 1, 
                  NumberOfPermutations}]) ((μ^2)/2) // 
          MatrixForm;

We need a list of the possible pair-to-pair energy values for all permutations to perform some of the operations found farther below:

(Table[
            IndexedSumOfColumnPAIRTOPAIR[j], {j, 1, 
              NumberOfPermutations}]) // MatrixForm;

Find the magnetic field interactions for each permutation:

For[j = 1, j ≤ NumberOfPermutations, j++, 
      IndexedSumOfColumnMAGNETIC[j] = 
        Sum[ListOfPermutations[[i, j]], {i, NumberOfRows}]]

Create a matrix containing the data of the pair-to-pair energy interactions for each permutation:

MagneticInteractions = (Table[
                IndexedSumOfColumnMAGNETIC[j], {j, 1, 
                  NumberOfPermutations}]) μ H // 
          MatrixForm;

We need a list of the possible magnetic energy values for all permutations to perform some of the operations found farther below:

(Table[
            IndexedSumOfColumnMAGNETIC[j], {j, 1, NumberOfPermutations}]) // 
        MatrixForm;

Create a matrix containing the data of the pair-to-pair energy ineractions added to the magnetic interactions for each permutation:

TotalInteractions = (MagneticInteractions + 
              PairToPairInteractions) // MatrixForm;

Define some values that will serve as limits for procedures found below

LargestValuePAIRTOPAIR = NumberOfMagnets; 
    SmallestValuePAIRTOPAIR = -NumberOfMagnets;
LargestValueMAGNETIC = NumberOfMagnets; 
    SmallestValueMAGNETIC = -NumberOfMagnets;

Initialize NumberOfEntries[i,j]=0 for all values i and j within our range

For[i = SmallestValuePAIRTOPAIR, 
        i ≤ LargestValuePAIRTOPAIR, i++, 
        For[j = SmallestValueMAGNETIC, 
          j ≤ LargestValueMAGNETIC, j++, 
          NumberOfEntries[i, j] = 0]];

Calculate the number of permutations that have a pair-to-pair energy ineraction total of i and a magnetic field energy interaction of j as NumberOfEntries[i,j] for all values i and j within our range

For[i = SmallestValuePAIRTOPAIR, 
      i ≤ LargestValuePAIRTOPAIR, i++, 
      For[j = SmallestValueMAGNETIC, 
        j ≤ LargestValueMAGNETIC, j++, 
        For[k = 1, k ≤ NumberOfPermutations, k++, 
          If[IndexedSumOfColumnPAIRTOPAIR[k] == i && 
              IndexedSumOfColumnMAGNETIC[k] == j, 
            NumberOfEntries[i, j] = NumberOfEntries[i, j] + 1; 
            Continue[]]]]]

Calculate the number of distinct possible energy values

NumberOfDistinctPossibleEnergies = 0;
For[i = SmallestValuePAIRTOPAIR, 
        i ≤ LargestValuePAIRTOPAIR, i++, 
        For[j = SmallestValueMAGNETIC, 
          j ≤ LargestValueMAGNETIC, j++, 
          If[NumberOfEntries[i, j] > 0, 
            NumberOfDistinctPossibleEnergies = 
              NumberOfDistinctPossibleEnergies + 
                1]]];
NumberOfDistinctPossibleEnergies

Output the number of permutations that have an energy  jHμ + i  ((μ^2)/2) where i and j range from the smallest magnetic and pair-to-pair energy values to the largest.  Also output the total number of distinct possible energy values

μ = 2; H = 2;
For[i = SmallestValuePAIRTOPAIR, 
        i ≤ LargestValuePAIRTOPAIR, i++, 
        For[j = SmallestValueMAGNETIC, 
          j ≤ LargestValueMAGNETIC, j++, 
          If[NumberOfEntries[i, j] > 0, 
            Print["There is/are ", 
              NumberOfEntries[i, 
                j],  " entries for ",  (j) H μ + 
                i  ((μ^2)/2)]]]];
Print["There are a total of ",  
      NumberOfPermutations, " permutations." ,  "There are ",  
      NumberOfDistinctPossibleEnergies,  " distinct possible energy \
values."]

The next three For loops index the values listed above so that they can be entered into a matix

For[k = 1, k ≤ NumberOfDistinctPossibleEnergies, k++, 
        IndexedDensityRow1[k] = 0];
k = 1;
For[i = SmallestValuePAIRTOPAIR, 
      i ≤ LargestValuePAIRTOPAIR, i++, 
      For[j = SmallestValueMAGNETIC, 
        j ≤ LargestValueMAGNETIC, j++, 
        If[NumberOfEntries[i, j] > 0, 
          IndexedDensityRow1[k] = NumberOfEntries[i, j]; 
          k = k + 1]]]

For[k = 1, k ≤ NumberOfDistinctPossibleEnergies, k++, 
        IndexedDensityRow2[k] = 0];
k = 1;
For[i = SmallestValuePAIRTOPAIR, 
      i ≤ LargestValuePAIRTOPAIR, i++, 
      For[j = SmallestValueMAGNETIC, 
        j ≤ LargestValueMAGNETIC, j++, 
        If[NumberOfEntries[i, j] > 0, IndexedDensityRow2[k] = i  ((μ^2)/2); 
          k = k + 1]]]

For[k = 1, k ≤ NumberOfDistinctPossibleEnergies, k++, 
        IndexedDensityRow3[k] = 0];
k = 1;
For[i = SmallestValuePAIRTOPAIR, 
      i ≤ LargestValuePAIRTOPAIR, i++, 
      For[j = SmallestValueMAGNETIC, 
        j ≤ LargestValueMAGNETIC, j++, 
        If[NumberOfEntries[i, j] > 0, 
          IndexedDensityRow3[k] = j (H μ); k = k + 1]]]

Create a table of the number of repeats for a particular energy

ListOFDensity = 
      Table[IndexedDensityRow1[j], {j, 1, 
          NumberOfDistinctPossibleEnergies}]

Create a table of the number of repeats for a particular energy and a that energy where μ and H have specified values

TotalListOFDensity = 
      Table[{IndexedDensityRow2[j] + IndexedDensityRow3[j], 
          IndexedDensityRow1[j]}, {j, 1, 
          NumberOfDistinctPossibleEnergies}]

***User Input: Normalize the data.  Note that this is the only part that is not automatic.  The smallest x-value in the above output is placed in the numerator in the input below (with sign switched).  The smallest x-value above is subtracted from the largest and placed in the denomonator below.

TotalListOFDensityNormalized = 
      Table[{(IndexedDensityRow2[j] + IndexedDensityRow3[j] + 20)/80. , 
          IndexedDensityRow1[j]/NumberOfPermutations}, {j, 1, 
          NumberOfDistinctPossibleEnergies}]

Sort the energies

TotalListOFDensityNormalizedSorted2 = 
      Sort[TotalListOFDensityNormalized]

Plot the density graph

ListPlot[TotalListOFDensityNormalizedSorted2, 
      PlotStyle -> {Hue[0.6], PointSize[0.015]}]