QuESTlink whitepaper

Import["https://qtechtheory.org/QuESTlink.m"];
CreateDownloadedQuESTEnv["MacOS"];

Demonstrations

Decoherence

opts = {
	LabelStyle->{FontFamily->"CMU Serif", FontSize->15}, 
	PlotLegends->Placed[{"(Bra[ψ]) ρ (Ket[ψ])","(Bra[ψ]) h (Ket[ψ]) - Tr (h ρ)"}, {{.65,.75}}],
	Frame->{True,True,False,False}, FrameStyle->Black, Axes->None, 
	FrameTicks->None, FrameLabel->{"depolarising"}
};

{ψ,ϕ} = CreateQuregs[5,2];
{ρ,σ} = CreateDensityQuregs[5,2];
SetQuregMatrix[ψ, Normalize @ Table[RandomComplex[],(2^5)]];
InitPureState[ρ,ψ];

h = .3 + .1 (Subscript[X, 0])(Subscript[Y, 1])(Subscript[Z, 2]) - .2(Subscript[Z, 0]);
data = Table[
MixTwoQubitDepolarising[ρ,0,1,.1];
{CalcFidelity[ρ,ψ], 
CalcExpecPauliSum[ψ,h,ϕ]-
CalcExpecPauliSum[ρ,h,σ]},
	100];

ListLinePlot[Transpose[data],opts]

DestroyAllQuregs[];

Variational imaginary time

nQb = 6;
h = GetPauliSumFromCoeffs["https://qtechtheory.org/hamil_6qbLiH.txt"];
h[[-2;;]]

entangle[qbs_] := 
       Table[R[θ,(Subscript[σ, q])(Subscript[σ, q+1])],{σ,{X,Y,Z}}, {q,qbs}]
gates= Flatten @ Join[
Table[(Subscript[op, q-1])[θ],{op,{Rz,Ry,Rx,Rz}},{q,nQb}],
entangle[{0,2,4}], 
entangle[{1,3}]];
ansatz = MapIndexed[#1 /. θ->(Subscript[θ, #2[[1]]])&,gates];
nθ = Length[ansatz];

DrawCircuit[ansatz, nQb]

{ψ,hψ,ϕ} = CreateQuregs[nQb,3];
dψ = CreateQuregs[nQb,nθ];

curθ = Table[(Subscript[θ, t])->RandomReal[],{t,nθ}];
ApplyCircuit[ansatz /. curθ, ψ];
CalcExpecPauliSum[ψ,h,ϕ]

Δt = .01;
nt = 100;
Do[
	InitZeroState[ψ];

	CalcQuregDerivs[ansatz, ψ, curθ, dψ];
	matrA = CalcInnerProducts[dψ] //Re;

	ApplyCircuit[ansatz /. curθ, ψ];
	ApplyPauliSum[ψ,h,hψ];
	vecC = -CalcInnerProducts[hψ,dψ] //Re;

	Δθ = Δt LinearSolve[matrA, vecC];
	curθ[[All,2]]+= Δθ,
	nt
];

CalcExpecPauliSum[ψ,h,ϕ]

Min @ Eigenvalues @ CalcPauliSumMatrix @ h

energy[θvals__?NumericQ] := Module[{curθ},
curθ = Table[(Subscript[θ, t])->{θvals}[[t]],{t,nθ}];
InitZeroState[ψ];
ApplyCircuit[ansatz /.curθ, ψ];
CalcExpecPauliSum[ψ,h,ϕ]]

θvars = Table[(Subscript[θ, t]),{t,nθ}];
NMinimize[energy@@θvars,θvars][[1]]

DestroyAllQuregs[];

Noisy Trotterisation

opts = {
	Joined->True,PlotStyle->Dashed,PlotMarkers->Graphics`PlotMarkers[][[1]],
	PlotLegends->Placed[
		LineLegend[{"1","2","4","6","8"},LegendMarkerSize->30,Spacings -> {1,-.5}],
		{{.85,.4}}],
	PlotRange->{{100,(10^5)},{0,1}},
	LabelStyle->{FontFamily->"CMU Serif",FontSize->15},
	Frame->True,FrameStyle->{{Black,White},{Black,White}},
	FrameTicks->{{{0,.5,1},None},{Table[{(10^n),(10^(ToString@n))},{n,2,5}],None}},
	FrameLabel->{"\[NumberSign]gates","Fidelity"},
	Epilog -> Text[Style["order:", FontFamily->"CMU Serif",FontSize->15], Scaled[{.85,.8}]]
};

nQb = 5;
h =Flatten @ Join[
Table[1. (Subscript[σ, q-1])(Subscript[σ, Mod[q,nQb]]) ,{σ,{X,Y,Z}},{q,nQb}],
Table[RandomReal[{-1,1}] (Subscript[Z, q-1]),{q,nQb}]];

symmetrize[h_, λ_, 1] := λ h
symmetrize[h_, λ_, 2] := With[
	{s1 = symmetrize[h, λ/2, 1]}, 
	Join[s1,Reverse[s1]]]
symmetrize[h_, λ_, n_?EvenQ] := Block[
	{γ, p=1/(4-(4^(1/(n-1))))}, With[
       {s=symmetrize[h,γ,n-2]}, With[
     {r=s /. γ -> λ p},
	     Join[r, r, s /. γ -> (1-4p)λ, r, r]]]]
gateify[Verbatim[Times][θ_, σ__]] := 
	R[2 θ, Times[σ]]
trotterize[h_, n_, r_, t_] :=With[
	{s=symmetrize[h, t/r, n]},
	 gateify /@ Flatten @ ConstantArray[s, r]]

childsify[h_, n_, r_, t_] := Flatten @ Table[
symmetrize[RandomSample @ h, t/r, n], r]

campbellize[h_, r_, t_] := With[
{c=h[[All,1]], σ=h[[All,2;;]],N=Length[h]*r},
	With[{λ=Total[c], p=Abs @ Normalize[c,Total]},
	t*λ/N RandomChoice[p -> σ, N]]]

DrawCircuit @ trotterize[h,1,1,nQb]

matrify[σ_] :=
       PauliMatrix[σ/.{X->1,Y->2,Z->3}]
matrify[Verbatim[Times][θ_, σ__]] := 
	θ KroneckerProduct @@ Fold[
	ReplacePart[#1, (nQb-#2[[2]])->
	matrify @ #2[[1]]]&,
	Table[IdentityMatrix[2],nQb], {σ}]

schrod[h_, Ψ0_, t_] := With[
	{H = matrify /@ h //Total},
	NDSolveValue[
	{I Ψ'[τ] == H . Ψ[τ], Ψ[0] ==Ψ0}, Ψ,
	{τ,0,nQb}]][t]

ψ0v = Normalize @ Table[RandomComplex[],(2^nQb)];
ψ0 = CreateQureg[nQb];
SetQuregMatrix[ψ0, ψ0v];

ψt = CreateQureg[nQb];
SetQuregMatrix[ψt,schrod[h,ψ0v,nQb]];

ψ = CreateQureg[nQb];
CloneQureg[ψ,ψ0];

fids = Table[
	circ = trotterize[h,order,reps,nQb];
	ApplyCircuit[circ,ψ0,ψ];
	{Length[circ], CalcFidelity[ψ,ψt]},
	{order,{1,2,4,6,8}},
	{reps, 1,50}
];

ListLogLinearPlot[fids,opts]

noisify[p_][u_] := u /. {
g:R[_, (Subscript[_, qb_])]:>Sequence[g,(Subscript[Depol, qb])[p]], 
g:R[_, Verbatim[Times][(Subscript[_, qb1_]),(Subscript[_, qb2_])]]:>
	Sequence[g,(Subscript[Depol, qb1,qb2])[p]]}

DrawCircuit @  noisify[(10^(-4))] @ 
	trotterize[h,1,1,nQb][[;;5]]

{ρ,ρ0} = CreateDensityQuregs[nQb, 2];
InitPureState[ρ0,ψ0];

nfids = Table[
	circ = noisify[(10^(-4))] @
		trotterize[h,order,reps,nQb];
	ApplyCircuit[circ,ρ0,ρ];
	{Length[circ], CalcFidelity[ρ,ψt]},
	{order,{1,2,4,6,8}},
	{reps, 1,50}
];

ListLogLinearPlot[nfids, opts]

DestroyAllQuregs[];