lucainnocenti

(* this one gives maximally negative tripartite *)
superScrambling2qutritsUnitary := Table[
    Normal @ Flatten @ KroneckerProduct[
        SparseArray[{Mod[i + j, 3] + 1 -> 1}, 3],
        SparseArray[{Mod[i - j, 3] + 1 -> 1}, 3]
    ],
    {i, {0, 1, 2}}, {j, {0, 1, 2}}
] // ArrayReshape[#, {9, 9}] & // Transpose;

(* unitary changing local bases to Fourier bases *)

lucainnocenti

generatePair[pauliIndices_List, tuple_List] := {
   BitXor[
    ReplaceAll[
     pauliIndices, {3 -> 0, 2 -> 1}
     ],
    tuple
    ],
   (-1)^Total@tuple[[Flatten@Position[pauliIndices, 2 | 3]]] 
   };

lucainnocenti

ShannonEntropy[probs_] := -Total[# * Log @ #] & @ DeleteCases[probs, _?PossibleZeroQ];
par[t_, s_] = {1, 0, 0} + t / Sqrt@2 {-1, 1, 0} + s/Sqrt[3/2] {-1/2, -1/2, 1} // Simplify;
par[pars_List] := par @@ pars;
ContourPlot[
  ShannonEntropy@par[t, s], {t, 0, Sqrt@2}, {s, 0, Sqrt[3/2]}, 
  PlotRange -> All,
  ColorFunction -> "TemperatureMap", PlotRangePadding -> None,
  Contours -> 10,
  FrameStyle -> Directive[Large, Black, FontFamily -> "Latin Modern Math"],
  FrameLabel -> (MaTeX[#, Magnification -> 2] & /@ {"t", "s"}),

lucainnocenti

getDualBasis[vecs_List] := With[{
    sMatrix = Total[KroneckerProduct[#, Conjugate@#] & /@ vecs]
    },
   Dot[Inverse@sMatrix, #] & /@ vecs
   ];
getParsevalFrame[vecs_List] := With[{
    sMatrix = Total[KroneckerProduct[#, Conjugate@#] & /@ vecs]
    },
   Dot[MatrixFunction[Sqrt, Inverse@sMatrix], #] & /@ vecs
   ];

lucainnocenti

stereoTo3D[x_, y_] := 1/(1 + x^2 + y^2) {2 x, 2 y, 1 - x^2 - y^2};

DynamicModule[
  {pt = {0, 0}},
  Row @ {
    LocatorPane[Dynamic @ pt, 
      Graphics[{Gray, Disk[]}, Frame -> True, ImageSize -> 200]
    ],
    Graphics3D[
      {

lucainnocenti

euclideanAlgorithmList[a_Integer, b_Integer] := NestWhileList[
  With[{newSortedPair = {Max@# - Floor[Max@#/Min@#] Min@#, Min@#}},
    If[#[[1]] > #[[2]], newSortedPair, Reverse@newSortedPair]
  ] &,
  {a, b},
  Min @ # > 1 &
];

DynamicModule[{a = 17, b = 10},
  EventHandler[

lucainnocenti

DynamicModule[{pts={{1,1}}, activePoint=None},
	EventHandler[
		Dynamic @ Show[
			Graphics[{
					[email protected],Dynamic@Point@pts,
					Circle[],
					If[activePoint =!= None,
						{Blue, Point @ pts[[activePoint]]}, {}
					],
					InfiniteLine[# / Norm[#]^2, Cross @ #] & /@ pts // Dynamic

lucainnocenti

xMax = 1.4;
numPartitions = 10; dx = xMax/numPartitions;
pointsAndLines[pts_] := {Point@pts, Line@pts};
fun[x_] := x^2;
Plot[fun@x, {x, 0, xMax},
  PlotRange -> All, PlotStyle -> Directive[Thick], Frame -> True, 
  GridLines -> Automatic, 
  FrameStyle -> Directive[Black, Thick, Large], 
  PlotLegends -> "Expressions",
  ImageSize -> 500

lucainnocenti

<< MaTeX`

distribute[args_] := (args //. {
    HoldPattern[nc[l___, Plus[m__], r___]] :> Total[nc[l, #, r] & /@ {m}],
    nc[l___, c_*nc[m__], r___] :> c nc[l, m, r],
    nc[l___, nc[m__], r___] :> nc[l, m, r],
    nc[-a_, b_] :> -nc[a, b],
    nc[a_, -b_] :> -nc[a, b],
    nc[nc[l : __], r_] :> nc[l, r], nc[l_, nc[r : __]] :> nc[l, r],
    nc[a_] :> a

lucainnocenti

zeros[0] = 0;
zeros[dim_] := ConstantArray[0, {dim, dim}];

MF[expr_] := MatrixForm@expr;

(* take small matrix and embed it into a larger matrix, padding with zeros *)
injectIntoLargerMatrix[mat_, largerMatDim_, position_Integer: 1] := Module[{outMat},
  (* put zeros on bottom right *)
  If[largerMatDim - Length@mat - position + 1 > 0,
    outMat = ArrayFlatten[{