Import["https://quest.qtechtheory.org/QuEST.m"]
CreateDownloadedQuESTEnv[];

Create circuits, where circA |in⟩ will be recompiled to circB(ϕ) |in⟩

numQb = 4;
m=(1/(Sqrt[2]))(({{1, I, 0, 0}, {0, 0, I, 1}, {0, 0, I, -1}, {1, -I, 0, 0}}));
circA = Circuit[
  (Subscript[Ry, 0])[.1] (Subscript[Y, 1])(Subscript[S, 2])(Subscript[T, 3])(Subscript[C, 0])[(Subscript[Ry, 2])[.1]] (Subscript[C, 3])[(Subscript[SWAP, 1,2])]
(Subscript[Ry, 1])[.2](Subscript[Rx, 2])[.3](Subscript[Rz, 3])[.4](Subscript[Rz, 0])[.1] (Subscript[C, 0])[(Subscript[SWAP, 2,3])]
(Subscript[C, 3])[(Subscript[Rz, 2])[.1]] (Subscript[C, 0])[(Subscript[Rz, 1])[.2]]R[.1,(Subscript[X, 1])(Subscript[Y, 2])] 
(Subscript[C, 3])[(Subscript[U, 0,2])[m]] (Subscript[C, 0])[(Subscript[X, 2])] (Subscript[H, 3])];

DrawCircuit[circA]

numϕ = 18 ;
circB = Circuit[
  (Subscript[Ry, 0])[(Subscript[ϕ, 1])](Subscript[Rx, 3])[(Subscript[ϕ, 2])](Subscript[Ry, 1])[(Subscript[ϕ, 3])](Subscript[Ry, 2])[(Subscript[ϕ, 4])](Subscript[C, 1])[(Subscript[X, 0])](Subscript[C, 3])[(Subscript[X, 2])]
(Subscript[Rx, 0])[(Subscript[ϕ, 5])](Subscript[Rx, 1])[(Subscript[ϕ, 6])](Subscript[Rx, 2])[(Subscript[ϕ, 7])](Subscript[Rx, 3])[(Subscript[ϕ, 8])](Subscript[SWAP, 1,2])(Subscript[C, 0])[(Subscript[Ry, 1])[(Subscript[ϕ, 9])]](Subscript[C, 3])[(Subscript[Ry, 2])[(Subscript[ϕ, 10])]]
(Subscript[Rx, 0])[(Subscript[ϕ, 11])](Subscript[Rx, 1])[(Subscript[ϕ, 12])](Subscript[Rx, 2])[(Subscript[ϕ, 13])](Subscript[Rx, 3])[(Subscript[ϕ, 14])]
(Subscript[Rz, 0])[(Subscript[ϕ, 15])](Subscript[Rz, 1])[(Subscript[ϕ, 16])](Subscript[Rz, 2])[(Subscript[ϕ, 17])](Subscript[Rz, 3])[(Subscript[ϕ, 18])]];
invB = Reverse[circB];

DrawCircuit[circB, numQb]

Prepare quantum registers and create fictitious Hamiltonian with ground-state |in⟩ = |+⟩

{aψ,bψ,hψ, iψ} = CreateQuregs[numQb,4];
dψ = CreateQuregs[numQb,numϕ];

h = -1. (Subscript[X, 0]) - 1. (Subscript[X, 1])- 1. (Subscript[X, 2]) - 1. (Subscript[X, 3]);
InitPlusState[iψ];
gs = CalcExpecPauliSum[iψ, h, hψ]

Simulate variational recompilation of circA |in⟩ into circB(ϕ) |in⟩

evolve[ϕi_, Δt_, steps_] := Module[
	{ϕvec,ϕrule, matrA,vecC, ϕEvo={},energyEvo={},fidEvo={}},
	
	InitPureState[aψ, iψ];
	ApplyCircuit[circA, aψ];
	ϕvec=ϕi;
	Do[
		ϕrule=Table[(Subscript[ϕ, t])->ϕvec[[t]],{t,numϕ}];
		CalcQuregDerivs[invB,aψ,ϕrule,dψ];
		matrA=Re @ CalcInnerProducts[dψ];

		ApplyCircuit[invB /. ϕrule, InitPureState[bψ, aψ]];
		ApplyPauliSum[bψ,h,hψ];
		vecC=-Re @ CalcInnerProducts[hψ, dψ];

		ϕvec = ϕvec + Δt LinearSolve[matrA,vecC, Method->"Krylov"];
		
		AppendTo[ϕEvo,ϕvec];
		AppendTo[energyEvo, CalcExpecPauliSum[bψ,h,hψ]];
		AppendTo[fidEvo, CalcFidelity[bψ,iψ]];
		Null,steps
	];
	
	{ϕEvo,energyEvo,fidEvo}
]

style = {
	Frame->True,FrameStyle->Black,FrameTicks->{{Automatic,None},{Automatic,None}},
	LabelStyle->{FontFamily->"CMU Serif",FontSize->12},
	PlotRange-> {{0,All},Automatic}, ImageSize->Small};

... and plot

{ϕEvo, eEvo, fEvo} = evolve[RandomReal[{-π,π},numϕ],.05,100];

Column[{
ListLinePlot[eEvo,PlotRange->{0,gs}, FrameLabel->"Energy", style],
ListLinePlot[fEvo,PlotRange->{0,1},FrameLabel->"Fidelity", style],
ListLinePlot[Transpose[ϕEvo], FrameLabel->"Parameters", style]
}]

These discovered parameters produce  B(ϕ)|0⟩  ≈ A|0⟩

InitPureState[aψ, iψ];
ApplyCircuit[circA, aψ];

InitPureState[bψ, iψ];
Table[(Subscript[ϕ, t])->-ϕEvo[[-1,t]], {t,numϕ}]
ApplyCircuit[circB /. %, bψ];

CalcFidelity[aψ, bψ]