model_check.nb

(* Content-type: application/vnd.wolfram.mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 11.3' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       158,          7]
NotebookDataLength[     16484,        461]
NotebookOptionsPosition[     15015,        428]
NotebookOutlinePosition[     15351,        443]
CellTagsIndexPosition[     15308,        440]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell[TextData[StyleBox["Initialization of Notebook",
 FontSize->24,
 FontColor->RGBColor[1, 0, 0]]], "Text",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 CellChangeTimes->{{3.766723094112186*^9, 3.766723099950859*^9}, {
  3.7667238875572443`*^9, 3.766723907604228*^9}, {3.766725685772472*^9, 
  3.766725703564253*^9}},ExpressionUUID->"9a3114fa-3e4d-4447-b8ad-\
22b2ca85de11"],

Cell[BoxData[
 RowBox[{
  RowBox[{"ClearAll", "[", "\"\<Global`*\>\"", "]"}], ";", 
  RowBox[{"ClearSystemCache", "[", "]"}], ";"}]], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.},
 CellChangeTimes->{{3.766723120780086*^9, 3.766723125170362*^9}, {
   3.766723194669623*^9, 3.7667233044379663`*^9}, {3.766723381263883*^9, 
   3.766723381738866*^9}, {3.766723467460758*^9, 3.766723476027326*^9}, {
   3.766723507736075*^9, 3.7667235437685957`*^9}, {3.766723575269517*^9, 
   3.7667236019458427`*^9}, 3.766723907604669*^9, {3.766731019742477*^9, 
   3.7667310347670393`*^9}, {3.766731080623582*^9, 3.7667311257124166`*^9}, 
   3.767167597558558*^9, {3.767167651856669*^9, 3.7671676782517843`*^9}},
 CellLabel->"In[26]:=",ExpressionUUID->"e5861dae-d4f1-4f4f-95b3-5a2af677f4c5"]
}, Closed]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Functions For Interactions&PartialTrace",
 FontSize->24,
 FontColor->RGBColor[1, 0, 0]]], "Text",
 CellGroupingRules->{"GroupTogetherGrouping", 10001.},
 CellChangeTimes->{{3.76672304583326*^9, 3.766723067410877*^9}, 
   3.766723912579701*^9, {3.772420463930485*^9, 
   3.772420490249264*^9}},ExpressionUUID->"6dbbde99-c755-49d3-8ae4-\
c2ad8f7c0c7f"],

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"term", "[", 
     RowBox[{"op_List", ",", "po_List"}], "]"}], ":=", 
    RowBox[{"Module", "[", 
     RowBox[{
      RowBox[{"{", 
       RowBox[{"proxy", ",", "swap", ",", "result"}], "}"}], ",", 
      "\[IndentingNewLine]", 
      RowBox[{
       RowBox[{"proxy", "=", "list"}], ";", "\[IndentingNewLine]", 
       RowBox[{"Do", "[", 
        RowBox[{
         RowBox[{
          RowBox[{"proxy", "[", 
           RowBox[{"[", 
            RowBox[{"po", "[", 
             RowBox[{"[", "i", "]"}], "]"}], "]"}], "]"}], "=", 
          RowBox[{"op", "[", 
           RowBox[{"[", "i", "]"}], "]"}]}], ",", 
         RowBox[{"{", 
          RowBox[{"i", ",", "1", ",", 
           RowBox[{"Length", "@", "po"}]}], "}"}]}], "]"}], ";", 
       "\[IndentingNewLine]", 
       RowBox[{"swap", "=", 
        RowBox[{"proxy", "[", 
         RowBox[{"[", 
          RowBox[{"-", "1"}], "]"}], "]"}]}], ";", "\[IndentingNewLine]", 
       RowBox[{"Do", "[", 
        RowBox[{
         RowBox[{"swap", "=", 
          RowBox[{"KroneckerProduct", "[", 
           RowBox[{
            RowBox[{"proxy", "[", 
             RowBox[{"[", "i", "]"}], "]"}], ",", "swap"}], "]"}]}], ",", 
         RowBox[{"{", 
          RowBox[{"i", ",", 
           RowBox[{"-", "2"}], ",", 
           RowBox[{"-", "length"}], ",", 
           RowBox[{"-", "1"}]}], "}"}]}], "]"}], ";", "\[IndentingNewLine]", 
       RowBox[{"result", "=", 
        RowBox[{"SparseArray", "@", "swap"}]}], ";", "\[IndentingNewLine]", 
       RowBox[{"Return", "[", "result", "]"}], ";"}]}], "\[IndentingNewLine]",
      "]"}]}], ";"}], "\[IndentingNewLine]", "\[IndentingNewLine]", 
  RowBox[{"(*", " ", 
   RowBox[{"partial", " ", "trace", " ", "functions"}], " ", 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"traceM", "[", "\[Rho]_", "]"}], ":=", 
   RowBox[{
    RowBox[{"Total", "[", 
     RowBox[{
      RowBox[{"Transpose", "[", 
       RowBox[{"MapIndexed", "[", 
        RowBox[{
         RowBox[{
          RowBox[{"RotateLeft", "[", 
           RowBox[{"#1", ",", 
            RowBox[{"#2", "-", "1"}]}], "]"}], "&"}], ",", "\[Rho]"}], "]"}], 
       "]"}], "[", 
      RowBox[{"[", "1", "]"}], "]"}], "]"}], "//", "Return"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"eTrace", "[", 
    RowBox[{"\[Rho]_", ",", "dim2_"}], "]"}], ":=", 
   RowBox[{
    RowBox[{"Map", "[", 
     RowBox[{"Tr", ",", 
      RowBox[{"Partition", "[", 
       RowBox[{"\[Rho]", ",", 
        RowBox[{"{", 
         RowBox[{"dim2", ",", "dim2"}], "}"}]}], "]"}], ",", 
      RowBox[{"{", "2", "}"}]}], "]"}], "//", "Return"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"sTrace", "[", 
    RowBox[{"\[Rho]_", ",", "dim2_"}], "]"}], ":=", 
   RowBox[{
    RowBox[{"traceM", "[", 
     RowBox[{"Partition", "[", 
      RowBox[{"\[Rho]", ",", 
       RowBox[{"{", 
        RowBox[{"dim2", ",", "dim2"}], "}"}]}], "]"}], "]"}], "//", 
    "Return"}]}], ";"}]}], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10001.},
 CellChangeTimes->{{3.7667229672552023`*^9, 3.766722993645277*^9}, {
   3.7667236330407887`*^9, 3.766723638913307*^9}, {3.76672378635233*^9, 
   3.7667238168238897`*^9}, {3.766723857584557*^9, 3.7667238626916533`*^9}, 
   3.7667239125803747`*^9, {3.766723990155472*^9, 3.7667240293493567`*^9}, {
   3.766724201214891*^9, 3.7667242149292507`*^9}, {3.766724272246097*^9, 
   3.7667243363081207`*^9}, {3.7667244282300243`*^9, 
   3.7667244314524803`*^9}, {3.766724631761731*^9, 3.766724853337304*^9}, {
   3.766724886340651*^9, 3.766724916586319*^9}, {3.766725507910386*^9, 
   3.76672550947515*^9}, {3.766725713298052*^9, 3.766725718329932*^9}, {
   3.772420493558587*^9, 3.7724205667059793`*^9}, {3.7724907370518827`*^9, 
   3.772490741543721*^9}, {3.772490776994143*^9, 3.772490779883984*^9}},
 CellLabel->"In[52]:=",ExpressionUUID->"7ab0b4f5-a156-4326-b926-8b6c55db732e"]
}, Closed]],

Cell[CellGroupData[{

Cell[TextData[StyleBox["Main",
 FontSize->24,
 FontColor->RGBColor[1, 0, 0]]], "Text",
 CellGroupingRules->{"GroupTogetherGrouping", 10002.},
 CellChangeTimes->{{3.766723872245905*^9, 3.766723872987267*^9}, 
   3.766723922910964*^9},ExpressionUUID->"e63e42cd-14dd-487d-940b-\
7006762d2c13"],

Cell[BoxData[{
 RowBox[{
  RowBox[{"spin", "=", "1"}], ";", 
  RowBox[{"length", "=", "5"}], ";", 
  RowBox[{"J", "=", "1."}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"dim", "=", 
   RowBox[{
    RowBox[{"2", " ", "spin"}], "+", "1"}]}], ";", 
  RowBox[{"sample", "=", 
   RowBox[{"Table", "[", 
    RowBox[{"0", ",", "dim", ",", "dim"}], "]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"sz", "=", 
   RowBox[{"SparseArray", "@", 
    RowBox[{"DiagonalMatrix", "@", 
     RowBox[{"Table", "[", 
      RowBox[{
       RowBox[{"spin", "-", "i"}], ",", 
       RowBox[{"{", 
        RowBox[{"i", ",", "0", ",", 
         RowBox[{"dim", "-", "1"}]}], "}"}]}], "]"}]}]}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"sp", "=", 
   RowBox[{"Block", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"table", "=", "sample"}], "}"}], ",", 
     RowBox[{
      RowBox[{"Do", "[", 
       RowBox[{
        RowBox[{
         RowBox[{"table", "[", 
          RowBox[{"[", 
           RowBox[{"i", ",", 
            RowBox[{"i", "+", "1"}]}], "]"}], "]"}], "=", 
         RowBox[{"Sqrt", "[", 
          RowBox[{
           RowBox[{"spin", " ", 
            RowBox[{"(", 
             RowBox[{"spin", "+", "1"}], ")"}]}], "-", 
           RowBox[{
            RowBox[{"(", 
             RowBox[{"spin", "-", 
              RowBox[{"(", 
               RowBox[{"i", "-", "1"}], ")"}]}], ")"}], " ", 
            RowBox[{"(", 
             RowBox[{"spin", "-", "i"}], ")"}]}]}], "]"}]}], ",", 
        RowBox[{"{", 
         RowBox[{"i", ",", "1", ",", 
          RowBox[{"dim", "-", "1"}]}], "}"}]}], "]"}], ";", 
      RowBox[{"SparseArray", "@", "table"}]}]}], "]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"sm", "=", 
   RowBox[{
    RowBox[{"SparseArray", "@", "sp"}], "\[HermitianConjugate]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"sx", "=", 
   RowBox[{
    RowBox[{"SparseArray", "@", 
     RowBox[{"(", 
      RowBox[{"sp", "+", "sm"}], ")"}]}], "/", "2"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"sy", "=", 
   RowBox[{
    RowBox[{
     RowBox[{"SparseArray", "@", 
      RowBox[{"(", 
       RowBox[{"sp", "-", "sm"}], ")"}]}], "/", "2"}], "/", "I"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"ide", "=", 
   RowBox[{"SparseArray", "@", 
    RowBox[{"IdentityMatrix", "@", "dim"}]}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"list", "=", 
   RowBox[{"Table", "[", 
    RowBox[{"ide", ",", "length"}], "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"H", "=", 
   RowBox[{"Table", "[", 
    RowBox[{"0.", ",", 
     SuperscriptBox["dim", "length"], ",", 
     SuperscriptBox["dim", "length"]}], "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Do", "[", 
   RowBox[{
    RowBox[{"H", "+=", 
     RowBox[{"term", "[", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"J", " ", "sx"}], ",", "sx"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"i", ",", 
         RowBox[{"i", "+", "1"}]}], "}"}]}], "]"}]}], ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", 
      RowBox[{"length", "-", "1"}]}], "}"}]}], "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Do", "[", 
   RowBox[{
    RowBox[{"H", "+=", 
     RowBox[{"term", "[", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"J", " ", "sy"}], ",", "sy"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"i", ",", 
         RowBox[{"i", "+", "1"}]}], "}"}]}], "]"}]}], ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", 
      RowBox[{"length", "-", "1"}]}], "}"}]}], "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Do", "[", 
   RowBox[{
    RowBox[{"H", "+=", 
     RowBox[{"term", "[", 
      RowBox[{
       RowBox[{"{", 
        RowBox[{
         RowBox[{"J", " ", "sz"}], ",", "sz"}], "}"}], ",", 
       RowBox[{"{", 
        RowBox[{"i", ",", 
         RowBox[{"i", "+", "1"}]}], "}"}]}], "]"}]}], ",", 
    RowBox[{"{", 
     RowBox[{"i", ",", "1", ",", 
      RowBox[{"length", "-", "1"}]}], "}"}]}], "]"}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"{", 
     RowBox[{"ege", ",", "egs"}], "}"}], "=", 
    RowBox[{"Eigensystem", "@", "H"}]}], ";", 
   RowBox[{
    RowBox[{"{", 
     RowBox[{"ege", ",", "egs"}], "}"}], "=", 
    RowBox[{
     RowBox[{
      RowBox[{"{", 
       RowBox[{
        RowBox[{"ege", "[", 
         RowBox[{"[", "#", "]"}], "]"}], ",", 
        RowBox[{"egs", "[", 
         RowBox[{"[", "#", "]"}], "]"}]}], "}"}], "&"}], "@", 
     RowBox[{
      RowBox[{"Ordering", "[", "ege", "]"}], "[", 
      RowBox[{"[", "1", "]"}], "]"}]}]}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"(", 
   RowBox[{"rho2", "=", 
    RowBox[{"sTrace", "[", 
     RowBox[{
      RowBox[{"eTrace", "[", 
       RowBox[{
        RowBox[{"eTrace", "[", 
         RowBox[{
          RowBox[{"eTrace", "[", 
           RowBox[{
            RowBox[{"Outer", "[", 
             RowBox[{"Times", ",", "egs", ",", 
              RowBox[{"Conjugate", "@", "egs"}]}], "]"}], ",", "3"}], "]"}], 
          ",", "3"}], "]"}], ",", "3"}], "]"}], ",", "3"}], "]"}]}], ")"}], "//",
   "MatrixForm"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"rho2", "//", "Tr"}], "//", "Re"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"ege", "/", "length"}], "//", "Re"}], "//", 
  "InputForm"}]}], "Input",
 CellGroupingRules->{"GroupTogetherGrouping", 10002.},
 CellChangeTimes->CompressedData["
1:eJwdzE8ogwEABfD5so2Taexg0nbYWqM1K0NGtsMKm7a1RqREi2wx2Wp/1DTb
kNREDpLkoKilGbUcGNnBaY3D1GoOyA5baWoUM3vf4fWr1+txJ+Z0RoJCoTSW
Ayu3zMdWRlZ+LRw7gbuKYBS+xkW38Gk4JbChN5dIx19WJNAd9fRCTaKggg2m
zhGYdwxNQod4dBoaOxbm4XDyxwmbHd9LsKZd5oGmPeo6JJo5AaiPfPHtZVnv
IQFc5g2MqGuzcuURMQMrJJZZ6C86LZAW23ZB6Q7NDTkhrw9Gw6t+cpdRbkJ9
zkvKStGDUKt6u4BWTdsluYuI4rCFzXuE1Oe7JKQn6tLQkiYykBk7y0OzdK0A
D4WGX/JHmSI9OCeqBsvu159Ww8U/GwPa7wNMyHddNUAFbYoNA91hLpSymoTQ
/7Ahhh9RXyssiY0yHTsr78999sGeLrUWioo3BvgP6eHDhA==
  "],
 CellLabel->"In[89]:=",ExpressionUUID->"47639277-7ddd-426a-88ac-17f2cd74cbcf"]
}, Open  ]],

Cell[BoxData[
 TagBox[
  RowBox[{"(", "\[NoBreak]", GridBox[{
     {
      RowBox[{"0.571074966073339`", "\[VeryThinSpace]", "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{
       RowBox[{"-", "0.00007056954185137744`"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{
       RowBox[{"-", "3.817439201802096`*^-8"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}]},
     {
      RowBox[{
       RowBox[{"-", "0.00007056954185137744`"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{"0.309496559901589`", "\[VeryThinSpace]", "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{
       RowBox[{"-", "0.00005127721608080852`"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}]},
     {
      RowBox[{
       RowBox[{"-", "3.817439201802096`*^-8"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{
       RowBox[{"-", "0.00005127721608080852`"}], "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}], 
      RowBox[{"0.11942847402507156`", "\[VeryThinSpace]", "+", 
       RowBox[{"0.`", " ", "\[ImaginaryI]"}]}]}
    },
    GridBoxAlignment->{
     "Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, 
      "RowsIndexed" -> {}},
    GridBoxSpacings->{"Columns" -> {
        Offset[0.27999999999999997`], {
         Offset[0.7]}, 
        Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {
        Offset[0.2], {
         Offset[0.4]}, 
        Offset[0.2]}, "RowsIndexed" -> {}}], "\[NoBreak]", ")"}],
  Function[BoxForm`e$, 
   MatrixForm[BoxForm`e$]]]], "Output",
 CellChangeTimes->{3.77242086758396*^9, 3.7724900313378143`*^9, 
  3.772490748674423*^9, 3.7724907844853697`*^9, 3.772491348506908*^9},
 CellLabel->
  "Out[103]//MatrixForm=",ExpressionUUID->"2a6c23b3-ab27-4cd8-93c2-\
60b888717696"],

Cell[BoxData["0.9999999999999996`"], "Output",
 CellChangeTimes->{3.77242086758396*^9, 3.7724900313378143`*^9, 
  3.772490748674423*^9, 3.7724907844853697`*^9, 3.772491348509945*^9},
 CellLabel->
  "Out[104]=",ExpressionUUID->"08e9b606-da3b-46af-ab01-cbdb488d7542"],

Cell["-1.1660425045541658", "Output",
 CellChangeTimes->{3.77242086758396*^9, 3.7724900313378143`*^9, 
  3.772490748674423*^9, 3.7724907844853697`*^9, 3.772491348512218*^9},
 CellLabel->
  "Out[105]//InputForm=",ExpressionUUID->"d2b37145-81ab-4c7d-99c1-\
9c5ad33c92ee"]
},
WindowSize->{1130, 909},
WindowMargins->{{380, Automatic}, {70, Automatic}},
FrontEndVersion->"11.3 for Linux x86 (64-bit) (March 6, 2018)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[580, 22, 386, 7, 47, "Text",ExpressionUUID->"9a3114fa-3e4d-4447-b8ad-22b2ca85de11",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.}],
Cell[969, 31, 790, 12, 31, "Input",ExpressionUUID->"e5861dae-d4f1-4f4f-95b3-5a2af677f4c5",
 CellGroupingRules->{"GroupTogetherGrouping", 10000.}]
}, Closed]],
Cell[CellGroupData[{
Cell[1796, 48, 374, 7, 43, "Text",ExpressionUUID->"6dbbde99-c755-49d3-8ae4-c2ad8f7c0c7f",
 CellGroupingRules->{"GroupTogetherGrouping", 10001.}],
Cell[2173, 57, 3978, 101, 308, "Input",ExpressionUUID->"7ab0b4f5-a156-4326-b926-8b6c55db732e",
 CellGroupingRules->{"GroupTogetherGrouping", 10001.}]
}, Closed]],
Cell[CellGroupData[{
Cell[6188, 163, 290, 6, 43, "Text",ExpressionUUID->"e63e42cd-14dd-487d-940b-7006762d2c13",
 CellGroupingRules->{"GroupTogetherGrouping", 10002.}],
Cell[6481, 171, 6123, 192, 454, "Input",ExpressionUUID->"47639277-7ddd-426a-88ac-17f2cd74cbcf",
 CellGroupingRules->{"GroupTogetherGrouping", 10002.}]
}, Open  ]],
Cell[12619, 366, 1852, 47, 91, "Output",ExpressionUUID->"2a6c23b3-ab27-4cd8-93c2-60b888717696"],
Cell[14474, 415, 265, 4, 35, "Output",ExpressionUUID->"08e9b606-da3b-46af-ab01-cbdb488d7542"],
Cell[14742, 421, 269, 5, 50, "Output",ExpressionUUID->"d2b37145-81ab-4c7d-99c1-9c5ad33c92ee"]
}
]
*)