`Class/Declare`("HP_table",
"An instance of this class encapsulates data about a family of cromulent isomorphisms $HX(a_H) \\to PX(a_P)$ for various values of $a_H$ and $a_P$",
["Field","H_to_P_maps"::table,"A table of objects of class @H_to_P_map@, indexed by values of @a_H@"],
["Field","P_to_H_maps"::table,"A table of objects of class @P_to_H_map@, indexed by values of @a_P@"],
["Field","H_to_P_num_samples"::posint = 200],
["Field","H_to_P_poly_deg"::posint = 20],
["Field","H_to_P_num_steps"::posint = 20],
["Field","P_to_H_poly_deg"::posint = 20],
["Field","P_to_H_num_charts"::posint = 10],
["Field","P_to_H_tolerance"::RR1 = 10.^(-20)],
["Field","P_to_H_gap"::RR1 = 0.02],
["Field","a_H_to_a_P_spline" = NULL],
["Constructor","",
proc(this)
this["H_to_P_maps"] := table();
this["P_to_H_maps"] := table();
end
],
["Method","a_H_indices","",
proc(this)
local T,L;
T := eval(this["H_to_P_maps"]);
L := sort(map(op,[indices(T)]));
L := remove(a -> (T[a] = NULL),L);
return L;
end
],
["Method","a_P_indices","",
proc(this)
local T,L;
T := eval(this["P_to_H_maps"]);
L := sort(map(op,[indices(T)]));
L := remove(a -> (T[a] = NULL),L);
return L;
end
],
["Method","a_H_a_P_pairs","",
proc(this)
local A_H;
A_H := this["a_H_indices"];
map(a -> [a,this["H_to_P_maps"][a]["a_P"]],A_H);
end
],
["Method","a_P_a_H_pairs","",
proc(this)
local A_P;
A_P := this["a_P_indices"];
map(a -> [a,this["P_to_H_maps"][a]["a_H"]],A_P);
end
],
["Method","set_spline","",
proc(this)
this["a_H_to_a_P_spline"] :=
unapply(CurveFitting[Spline]([[0,1],op(HP_table["a_H_a_P_pairs"]),[1,0]],a_H),a_H):
end
],
["Method","a_H_to_a_P","",
proc(this,a)
if this["a_H_to_a_P_spline"] = NULL then
this["set_spline"];
fi;
this["a_H_to_a_P_spline"](evalf(a));
end
],
["Method","a_P_to_a_H","",
proc(this,a)
local f,b;
if this["a_H_to_a_P_spline"] = NULL then
this["set_spline"];
fi;
f := eval(this["a_H_to_a_P_spline"]);
return fsolve(f(b) = a,b);
end
],
["Method","add_a_H","",
proc(this,a0)
local A_H,A_HL,A_HR,a_HL,a_HR,aL,aR,HP;
userinfo(7,genus2,sprintf("Adding entry with a_H=%A",a0));
A_H := this["a_H_indices"];
A_HL := select(a -> (a < a0),A_H);
A_HR := select(a -> (a > a0),A_H);
if member(a0,A_H) then
HP := eval(this["H_to_P_maps"][a0]);
HP["make_samples",this["H_to_P_num_samples"]];
HP["set_poly_deg",this["H_to_P_poly_deg"]];
else
HP := `new/H_to_P_map`():
HP["set_a_H",a0];
this["H_to_P_maps"][a0] := eval(HP);
HP["make_samples",this["H_to_P_num_samples"]];
HP["set_poly_deg",this["H_to_P_poly_deg"]];
if A_HL <> [] then
a_HL := max(A_HL);
if A_HR <> [] then
a_HR := min(A_HR);
userinfo(7,genus2,sprintf("Interpolating between a_H=%A and a_H=%A",a_HL,a_HR));
HP["a"] := this["H_to_P_maps"][a_HR]["a"];
HP["fix_a"];
aR := HP["a"];
HP["a"] := this["H_to_P_maps"][a_HL]["a"];
HP["fix_a"];
aL := HP["a"];
HP["a"] := ((a0 - a_HL) *~ aR +~
(a_HR - a0) *~ aL) /~ (a_HR - a_HL);
else
userinfo(7,genus2,sprintf("Extrapolating from a_H=%A",a_HL));
HP["a"] := this["H_to_P_maps"][a_HL]["a"];
HP["fix_a"];
fi;
else
if A_HR <> [] then
a_HR := min(A_HR);
userinfo(7,genus2,sprintf("Extrapolating from a_H=%A",a_HR));
HP["a"] := this["H_to_P_maps"][a_HR]["a"];
HP["fix_a"];
fi;
fi;
fi;
HP["find_p1",this["H_to_P_num_steps"]];
HP["set_p1_inv"];
NULL;
end
],
["Method","remove_a_H","",
proc(this,a0)
this["H_to_P_maps"][a0] := NULL;
end
],
["Method","add_a_P","",
proc(this,a0)
local A_P,PH;
userinfo(7,genus2,sprintf("Adding entry with a_P=%A",a0));
A_P := this["a_P_indices"];
if member(a0,A_P) then
PH := eval(this["P_to_H_maps"][a0]);
PH["degree"] := this["P_to_H_poly_deg"];
else
PH := `new/P_to_H_map`():
PH["set_a_P",a0];
fi;
this["P_to_H_maps"][a0] := eval(PH);
PH["add_charts",this["P_to_H_num_charts"]];
PH["find_p1_inv",this["P_to_H_tolerance"],this["P_to_H_gap"]];
end
],
["Method","remove_a_P","",
proc(this,a0)
this["P_to_H_maps"][a0] := NULL;
end
],
["Method","a_H_a_P_plot","",
proc(this)
local P;
P := this["a_H_a_P_pairs"];
if P = [] then
return NULL;
else
return
display(
map(u -> point([u[1],u[2]],colour=blue),P),
view = [0..1,0..1]
);
fi;
end
],
["Method","a_P_a_H_plot","",
proc(this)
local P;
P := this["a_P_a_H_pairs"];
if P = [] then
return NULL;
else
return
display(
map(u -> point([u[2],u[1]],colour=red),P),
view = [0..1,0..1]
);
fi;
end
],
["Method","spline_plot","",
proc(this)
display(
plot(this["a_H_to_a_P_spline"](a),a=0..1,colour=grey),
view = [0..1,0..1]
);
end
],
["Method","full_plot","",
proc(this)
display(
this["spline_plot"],
this["a_H_a_P_plot"],
this["a_P_a_H_plot"],
view = [0..1,0..1]
);
end
],
["Method","spline_plot_tikz","",
proc(this)
local s1,t1,p,pts,T;
T := eval(this["H_to_P_maps"]);
pts := [[0,1],
seq([a,T[a]["a_P"]],
a in sort(map(op,[indices(T)]))),
[1,0]
];
s1 := sprintf(" \\draw[%s] plot[smooth] coordinates{ ","red");
for p in pts do
s1 := cat(s1,sprintf("(%.3f,%.3f) ",op(1,p),op(2,p)));
od;
s1 := cat(s1,"};\n");
t1 := cat(
"\\begin{center}\n",
" \\begin{tikzpicture}[scale=4]\n",
" \\draw[black,->] (-0.05,0) -- (1.05,0);\n",
" \\draw[black,->] (0,-0.05) -- (0,1.05);\n",
" \\draw[black] (1,-0.05) -- (1,0);\n",
" \\draw[black] (-0.05,1) -- (0,1);\n",
" \\draw ( 0.00,-0.05) node[anchor=north] {$0$};\n",
" \\draw ( 1.00,-0.05) node[anchor=north] {$1$};\n",
" \\draw (-0.05, 0.00) node[anchor=east ] {$0$};\n",
" \\draw (-0.05, 1.00) node[anchor=east ] {$1$};\n",
" \\draw ( 1.05, 0.00) node[anchor=west ] {$b$};\n",
" \\draw ( 0.00, 1.05) node[anchor=south] {$a$};\n",
s1,
sprintf(" \\fill[black] (%.3f,%.3f) circle(0.015);\n",a_H0,a_P0),
" \\end{tikzpicture}\n",
"\\end{center}\n"
):
return t1;
end
]
):