The p-Dissection of a product of quintuple products

T. Daniels, T. Huber, J. McLaughin, D. Ye

This notebook is intended as a helpful tool in documenting and verifying some formulas and computations in the paper “The p-Dissection of a product of quintuple products”, as well as providing tools for computing explicit examples.

Definitions

Documentation/README

This notebook uses a fair amount of “special characters’’ and symbolic notation/definitions, so we want to briefly explain the usage/practices found herein

Greek letters are entered using the pattern EscletterEsc, for example
	EscgEsc -> γ,
	EscGEsc -> Γ.

Because “primed” inputs like h' do not work as variables, below we define the quote character ’ as a symbol, so that expressions like hʼ do function as “h prime”. This character is entered using
	EscaffEsc
(we previously used it to mean “affine”).

Many of our expressions use Ctrl6 to place exponents, e.g.,  (q^6) vs. q^6. These inputs are equivalent, and our code works equally well with both.

Similarly, for some expressions we use Ctrl_ to place subscripts. The inputs
	(Subscript[x, k])	and 	Subscript[x,k]
are equivalent.

(*Expand the sections below and run the cells to set definitions*)

Misc

(*Cancels instances of x(OverBar[x]) (to 1)*)
AR=ResourceFunction["AlgebraicReplace"];
cancelInv[expr_,x_]:=(AR[(expr*x*OverBar[x]//Expand),x OverBar[x],𝟙])/.{𝟙->1};

(* Declaring that \[EscapeKey]aff\[EscapeKey] produces the ʼ character. This allows one to use things like hʼ as variable names*)
SetOptions[EvaluationNotebook[],
InputAliases->DeleteDuplicates[Join[
<|"aff"->FromCharacterCode[700]|>,
InputAliases/. Options[EvaluationNotebook[],InputAliases]
]]
]

Pochhammer Symbol

We use `QP` as an abbreviation for the function `QPochhammer`. Defining this “new” `QP` allows us to accept lists as inputs. For example,
	QP[(z^({a,b})),q],	QP[{(z^a),(z^b)},q],	     and 	QP[(z^a),q]QP[(z^b),q]
are equivalent in our code.

QP[z_,q_]:=QPochhammer[z,q];
QP[Z_?ListQ,q_]:=Product[QPochhammer[z,q],{z,Z}];

(*(Subscript[(z;q), h])*)
(Subscript[QP, h_])[z_,q_]:=(∏_(k=0)^(h-1))(1-z*(q^k)); 
(*Extract a list of powers and moduli from a product of QPs*)
QPPowerList[Times[X__]]:=Module[{XL,powL},
XL=List@@X;(*Return list of things multiplied*)
XL=XL/.{Power[QPochhammer[x_,y_],e_]:>Splice[ConstantArray[QPochhammer[x,y],e]]}(*Split apart powers*);
powL=Cases[XL,QPochhammer[(q^(x_)),(q^(y_))]->{y,x}](*List of {mod,expon}*);
powL=GroupBy[powL,First->Last];
KeyValueMap[{Flatten[#2],{{#1}}}&,powL]
];

QPPowerList usage example

X=QP[{(q^2),(q^4),(q^9),(q^11),(q^13),(q^13)},(q^13)]*QP[{(q^5),(q^9),(q^17),(q^21)},(q^26)];
X//TraditionalForm
TableForm[QPPowerList[X],TableDepth->2]

Exponent quantities (Subscript[α, k]), (Subscript[β, k]), etc.

Clear[α,β,γ,σ,κ,χ];
(OverTilde[χ])=.; (*Unset definition*)

α[k_]:=3k m p+3b p-(((m+n)p)/2)+((3(p^2))/2);
β[k_]:=3k n p+(((m-n)p)/2)+((3(p^2))/2);
γ[k_]:=3b k m+((k(3k-1)p)/2);
σ[k_]:=k(k-1)((3(p^2))/2);
κ[r_]:=Mod[r*ModularInverse[3b m,p],p]; (*k such that 3bkm ≡ r (mod p)*)

χ[k_]:=γ[k] + p(1-n s)(k n+((p+m-n(1+p s))/6));

(*Used in place of (Subscript[χ, k]^( * )). Entered using \[EscapeKey]c\[EscapeKey] \[ControlKey]7 ~*)
(OverTilde[χ])[k_]:=γ[k]+p(1-m s)(b+k m+((p-m(1+p s)-n)/6));

Triple product (Subscript[⟨(q^a),(q^b)⟩, ∞])

The expression
	(Subscript[⟨(q^a);(q^b)⟩, ∞])
is encoded for us via the input
	⟨(q^a),(q^b)⟩ .
The brackets are entered using Esc<Esc and Esc>Esc. Make sure to use a comma in the input, not a semicolon.

Note: The expressions of the form l_:1, etc. indicate that l is an optional argument, and that `1` should be used if none is given. This lets us circumvent a “troublesome” case: if we defined only ⟨(q^(l_)),(q^(M_))⟩, the input ⟨q,(q^3)⟩ is undefined, because Mathematica reads `q` as just `q`, not as `(q^1)`.

(*These define ⟨(q^a),(q^b)⟩ in terms of q-Pochammer symbols.*)
(*Part of the definition first "reduces" these expressions as in Lemma 1*)
⟨1,_⟩:=0;
⟨(q^(l_:1)),(q^(M_:1))⟩/;(M>0&&(l==Mod[l,M]||M==1)):=QP[{(q^l),(q^(M-l)),(q^M)},(q^M)];
⟨(q^(l_:1)),(q^(M_:1))⟩/;(M>0&&l!=Mod[l,M]):=Module[{h=⌊l/M⌋,r=Mod[l,M]},
(((-1))^h)(q^(-h r - h(h-1)M/2))⟨(q^r),(q^M)⟩
];

⟨-1,(q^(M_:1))⟩:=QP[{-1,-(q^M),(q^M)},(q^M)];
⟨-(q^(l_:1)),(q^(M_:1))⟩/;(M>0&&(l==Mod[l,M]||M==1)):=QP[{-(q^l),-(q^(M-l)),(q^M)},(q^M)];
⟨-(q^(l_:1)),(q^(M_:1))⟩/;(M>0&&l!=Mod[l,M]):=Module[{h=⌊l/M⌋,r=Mod[l,M]},
(q^(-h r - h(h-1)M/2))⟨-(q^r),(q^M)⟩
];

Quintuple product Q((q^a),(q^b))

(* Q((q^l),(q^p)) := (Subscript[((q^l),(q^(p-l)),(q^p);(q^p)), ∞])(Subscript[((q^(p-2l)),(q^(p+2l));(q^(2p))), ∞]) *)
(*Part of the definition first reduces these expressions as in Lemma 1*)
Clear[QQ];
QQ[1,(q^(p_))]:=0;
QQ[(q^(l_:1)),(q^(p_))]/;(l==Mod[l,p]&&l<p/2):=QP[{(q^l),(q^(p-l)),(q^p)},(q^p)]QP[{(q^(p-2l)),(q^(p+2l))},(q^(2p))];
QQ[(q^(l_:1)),(q^(p_))]/;(l==Mod[l,p]&&l>p/2):=-(q^(p-2l))QQ[(q^(p-l)),(q^p)]
QQ[(q^(l_:1)),(q^(p_))]/;(l!=Mod[l,p]):=Module[{h=⌊l/p⌋,r=Mod[l,p]},
(q^(-3h r - h(3h-1)p/2))QQ[(q^r),(q^p)]
];

Winquist function W(a,b,q)

W[u_,v_,w_]:=((⟨u,w⟩⟨v,w⟩⟨u v,w⟩⟨u/v,w⟩)/((QP[w,w])^2));

(*Expression appearing in Winquist's identity*)
WAlt[a_,b_,q_]:=⟨(a^3),(q^3)⟩(⟨(b^3)q,(q^3)⟩-b⟨(b^3)(q^2),(q^3)⟩)-(a/b)⟨(b^3),(q^3)⟩(⟨(a^3)q,(q^3)⟩-a⟨(a^3)(q^2),(q^3)⟩);

Extracting r (mod p) components

(*Below, `X` should be a sum of terms (without an O((q^(#))) term)*)
(*`Normal@X` discards the O((q^(#))) term (if any is present)*)

Component[X_,0,M_]:=Module[{c1,Y=Normal@X},
c1=Coefficient[Y,q];(* because "q" doesn't register as "(q^1)"*)
(Y-c1 q)/.{(q^(x_))/;(Mod[x,M]!=0)->0}
];
Component[X_,1,M_]:=Module[{c0=1,Y=Normal@X},
(Y-c0)/.{(q^(x_))/;(Mod[x,M]!=1)->0}
];
Component[X_,r_,M_]/;(1<r<M):=Module[{c0=1,c1,Y=Normal@X},
c1=Coefficient[Y,q];(* because "q" doesn't register as "(q^1)"*)
(Y-c0-c1 q)/.{(q^(x_))/;(Mod[x,M]!=r)->0}
];

Usage example

prod=QPochhammer[(q^1),(q^13)] QPochhammer[(q^4),(q^13)] QPochhammer[(q^5),(q^26)]*
 QPochhammer[(q^9),(q^13)] QPochhammer[(q^9),(q^26)] QPochhammer[(q^12),(q^13)]*
 ((QPochhammer[(q^13),(q^13)])^2) QPochhammer[(q^17),(q^26)] QPochhammer[(q^21),(q^26)];
ser = Series[prod,{q,0,200}]

Table[{r,Component[ser,r,13]},{r,0,7}]//TableForm

Symbolic checks for proofs

Corollary 3, equation (2.10)

FullSimplify[γ[k+p]-γ[k]-(m α[k]+σ[m])-(n β[k]+σ[n])//Expand]

Corollary 3, shift k->k-p

{α[k-p]-α[k],β[k-p]-β[k]}//Expand

To check that 
	(q^(Subscript[γ, k-p]))(Subscript[⟨-(q^((Subscript[α, k])-m y)),-(q^((Subscript[β, k])-n y));(q^y)⟩, ∞])=(q^((Subscript[γ, k-p])+m((Subscript[α, k])-y)-(Subscript[σ, m])+n((Subscript[β, k])-y)-(Subscript[σ, n])))(Subscript[⟨-(q^(Subscript[α, k])),-(q^(Subscript[β, k]));(q^y)⟩, ∞])=(q^(Subscript[γ, k]))(Subscript[⟨-(q^(Subscript[α, k])),-(q^(Subscript[β, k]));(q^y)⟩, ∞])

Assuming[{p==(m^2)+(n^2)},FullSimplify[γ[k-p]-γ[k]+m(α[k]-y)-σ[m]+n(β[k]-y)-σ[n]/.{y->3(p^2)}//Expand]]

Lemma 8, equation (2.15)

Clear[p,m,n,b,μ,s,y]

(*Function to replace 3mμ->1+ps*)
μReduce[X_]:=AR[X//Expand,3m μ,𝟙]/.{𝟙->1+p s};

(*Definition of (Subscript[δ, 0])*)
(*Expand bn+(Subscript[γ, κ-nμ])-(Subscript[γ, κ]), then replace 3mμ->1+ps*)
(Subscript[δ, 0])=μReduce[b n + γ[κ-n μ]-γ[κ]]//Expand

For equation (2.14), we know that
	(q^(γ+(Subscript[δ, 0])))(Subscript[⟨-(q^(β+m s (p^2)-μ y));(q^y)⟩, ∞])= (q^(γ+(Subscript[δ, 0])+(μ(β+m s (p^2)-y)-(Subscript[σ, μ]))))(Subscript[⟨-(q^(β+m s (p^2)));(q^y)⟩, ∞]),
so we want to simplify
	(Subscript[δ, 0])+(μ(β+m s (p^2)-y)-(Subscript[σ, μ])).

(*Expand and replace y->3(p^2)*)
((Subscript[δ, 0])+μ(β[κ]+m s (p^2)-y)-σ[μ])/.{y->3(p^2)}//Expand

(*Simplify the latter pieces*)
Assuming[{p==(m^2)+(n^2)},
Simplify[((m p μ)/2)+m (p^2) s μ+(3/2) (n^2) p (μ^2)-((3 (p^2) (μ^2))/2)/.{μ->((1+p s)/(3m))}]
]

As (n^2)-p=-(m^2), we see that indeed
	(Subscript[δ, 0])+(μ(β+m s (p^2)-y)-(Subscript[σ, μ])) = -b n p s+(((1+p s)(p^2)s)/6)=δ,
which verifies equation (2.14).

Theorem 4, equation (3.6)

Equation (3.6) states that
	(A/3) == ξ+(Ν(β-y)-(Subscript[σ, Ν]))+((M+1)(α+(p^2)-y)-(Subscript[σ, M+1])),
where
	A=(Subscript[α, κ])-(p^2),	B=2(p^2)-(Subscript[β, κ]),
and
	N=((n s)/3),   M=((m s-2)/3),   and   y=3 (p^2).

Clear[p,m,n,b,μ,s,y]
Module[{A,B,δ,ξ,X,Ν=((n s)/3),M=((m s-2)/3),y=3(p^2)},
(*We use capital Greek nu Ν, entered with \[EscapeKey]N\[EscapeKey], to avoid conflict with the built-in function N.*)
A=α[κ]-(p^2);
B=2(p^2)-β[κ];
ξ=-b m p s-κ (p^2)s+(1/6)(1+p s)(p^2)s;
X=ξ+(Ν(β[κ]-y)-σ[Ν])+((M+1)(α[κ]+(p^2)-y)-σ[M+1]);

Assuming[{p==(m^2)+(n^2)},Simplify[X-(A/3)//Expand]]
]

Theorem 5(1), equation (4.9); the formula for χ

Clear[A,B,Ν,p,m,n,b,μ,s,y]
A=α[κ];
B=β[κ]-n s (p^2);
Ν=((n s-1)/3);
χ0=γ-Ν(B+(p^2))-σ[Ν]//Expand (*Initial definition*)

(*Removing the γ piece since it is kept as-is*)
Assuming[{p==(m^2)+(n^2)},FullSimplify[χ0-γ]]

Theorem 5(2), equation (4.13); the formula for (SuperStar[χ])

Clear[A,B,M,p,m,n,b,μ,s,y]
A=α[κ]-m s (p^2);
B=β[κ];
M=((m s-1)/3);
chiTilde0=γ-M(A+(p^2))-σ[M]/.{y->3(p^2)}//Expand (*Initial definition*)

Assuming[{p==(m^2)+(n^2)},FullSimplify[chiTilde0-γ]]

Then (4.13) follows by distributing -(1/6).

Some examples computing and checking dissections

Dissection components in Theorems 4 and 5

These functions depend on the “global” variables p, m, n, b, μ, and s, so you need to reset those values for different examples. However, you don’t need to “recompile” these functions every time you change p, m, etc..

For p≡1(mod 12)

QQComp[r_]/;(Mod[m,3]==1):=Module[{k=κ[r]},
(q^(γ[k]))QQ[(q^((α[k]-(p^2))/3)),(q^(p^2))]QQ[(q^((2(p^2)-β[k])/3)),(q^(p^2))]
];
QQComp[r_]/;(Mod[m,3]==2):=Module[{k=κ[r]},
(q^(γ[k]))QQ[(q^((2(p^2)-α[k])/3)),(q^(p^2))]QQ[(q^((β[k]-(p^2))/3)),(q^(p^2))]
];

For p≡5(mod 12)

(* Dissection summand for p≡5(12) AND m≡-n(3) *)
WComponent[r_]/;(Mod[m+n,3]==0):=Module[{k=κ[r]},
Expand[(q^(χ[k]))W[-(q^(α[k]/3)),-(q^((β[k]-n s (p^2))/3)),(q^(p^2))]]
];
WAltComponent[r_]/;(Mod[m+n,3]==0):=Module[{k=κ[r]},
Expand[(q^(χ[k]))WAlt[-(q^(α[k]/3)),-(q^((β[k]-n s (p^2))/3)),(q^(p^2))]]
];

(* Dissection summand for p≡5(12) AND m≡n(3) *)
WComponent[r_]/;(Mod[m-n,3]==0):=Module[{k=κ[r]},
Expand[(q^((OverTilde[χ])[k]))W[-(q^(β[k]/3)),-(q^((α[k]-m s (p^2))/3)),(q^(p^2))]]
];
WAltComponent[r_]/;(Mod[m-n,3]==0):=Module[{k=κ[r]},
Expand[(q^((OverTilde[χ])[k]))WAlt[-(q^(β[k]/3)),-(q^((α[k]-m s (p^2))/3)),(q^(p^2))]]
];

A “quirk” of series expansion

Mathematica sometimes has quirks when computing series expansions, in particular with what O((q^N)) to “compute up to”. This can happen if
	1) There are negative powers in the Pochhammer symbols;
	2) The Pochhammer symbols are multiplied by powers (q^M);
In the example below, technically I request O((q^500)), but we get 2(q^583)+O((q^584)), which is part of the r=9 (mod 41) component. Once we go higher than 583, things “settle”.

Clear[p,m,n,μ,s,quintProd,quintSer];

p=41;
m=5;n=4;b=2;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;(* 3 m μ = 1+ps *)

quintProd=QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)];

(*Ostensibly the difference is not identically zero*)
qMax=500;
quintSer=Normal@Series[quintProd,{q,0,qMax}];
Table[Component[quintSer,r,p]-Normal@Series[WComponent[r],{q,0,qMax}],{r,0,40}]

(*The issue dissappears when we increase the O((q^N)) power*)
qMax=900;
quintSer=Normal@Series[quintProd,{q,0,qMax}];
Table[Component[quintSer,r,p]-Normal@Series[WComponent[r],{q,0,qMax}],{r,0,40}]

p=13=(2^2)+(3^2), b=2;

Clear[p,m,n,b,μ,s,quintProd,DissSer];

p=13;
m=2;n=3;b=2;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;(* 3 m μ = 1+ps *)

quintProd=QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)]
DissSer=Sum[QQComp[r],{r,0,p-1}];

Series[QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)]-DissSer,{q,0,2000}]

p=41=(5^2)+(4^2),  b=2;   m≡-n (3)

Clear[p,m,n,b,μ,s,quintProd,DissSer];

p=41;
m=5;n=4;b=2;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;(* 3 m μ = 1+ps *)

quintProd=QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)]
DissSer=Sum[WComponent[r],{r,0,p-1}];

Series[QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)]-DissSer,{q,0,2000}]

p=53=(7^2)+(2^2),  b=3;  m≡-n (3)

Clear[p,m,n,b,μ,s,quintProd,DissSer];

p=53;
m=7;n=2;b=3;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;(* 3 m μ = 1+ps *)

quintProd=QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)];
DissSer=Sum[WComponent[r],{r,0,p-1}]; (* This is very long if printed *)

Series[quintProd-DissSer,{q,0,2000}]

p=89=(8^2)+(5^2), b=2;  m≡n (3)

Clear[p,m,n,b,μ,s,quintProd,DissSer];

p=89;
m=8;n=5;b=2;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;(* 3 m μ = 1+ps *)

quintProd=QQ[(q^(b m)),(q^p)]QQ[(q^(b n)),(q^p)]
DissSer=Sum[WComponent[r],{r,0,p-1}]; (* This is very long if printed *)

Series[quintProd-DissSer,{q,0,2000}]

Sign computations

Sign computer (`CompSign`)

The function `CompSign` computes the signs ±1 (or 0) as in Corollaries 5 and 8. 

Note: The function requires that “global” variables p, m, n, b, μ, and s be defined (as well as α, β, etc.). Thus, to compute the sign of a particular r-component of a quintuple product, one should run (e.g.):
	Clear[p,m,n,b,μ,s];
p=13;
m=2;n=3;b=5;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;
to (re)set those values, and then run
	CompSign[r]

Signs as in Corollary 5  ( p≡1(12) )

CompSign[r_]/;(Mod[p,12]==1&&Mod[m,3]==1):=Module[{kr,h,hʼ,l,lʼ,ϵ,ϵʼ},
kr=κ[r];

h=(α[kr]-(p^2))/(3p);
hʼ=(2(p^2)-β[kr])/(3p);

l=h-p*Floor[h/p];
lʼ=hʼ-p*Floor[hʼ/p];

ϵ=If[0<=l<p/2,0,p-2l];
ϵʼ=If[0<=lʼ<p/2,0,p-2lʼ];

(*Uncomment these if you want to print the exponents*)
(*Echo[{h,l,ϵ},"{h,l,ϵ} ="];
Echo[{hʼ,lʼ,ϵʼ},"{hʼ,lʼ,ϵʼ} ="];*)

If[l==0||lʼ==0,
Return[0],
Return[(((-1))^(ϵ+ϵʼ))]
]
];

CompSign[r_]/;(Mod[p,12]==1&&Mod[m,3]==2):=Module[{kr,h,hʼ,l,lʼ,ϵ,ϵʼ},
kr=κ[r];

h=(2(p^2)-α[kr])/(3p);
hʼ=(β[kr]-(p^2))/(3p);

l=h-p*Floor[h/p];
lʼ=hʼ-p*Floor[hʼ/p];

ϵ=If[0<=l<p/2,0,p-2l];
ϵʼ=If[0<=lʼ<p/2,0,p-2lʼ];

(*Uncomment these if you want to print the exponents*)
(*Echo[{h,l,ϵ},"{h,l,ϵ} ="];
Echo[{hʼ,lʼ,ϵʼ},"{hʼ,lʼ,ϵʼ} ="];*)

If[l==0||lʼ==0,
Return[0],
Return[(((-1))^(ϵ+ϵʼ))]
]
];

Signs as in Corollary 8 ( p≡5(12) )

CompSign[r_]/;(Mod[p,12]==5&&Mod[m+n,3]==0):=Module[{kr,h,hʼ,k,kʼ,l,lʼ},
kr=κ[kr];

h=(α[kr]+β[kr]-n s (p^2))/(3p);
hʼ=(α[kr]-β[kr]+n s (p^2))/(3p);

k=Floor[h/p];
kʼ=Floor[hʼ/p];

l=h-p k;
lʼ=hʼ-p kʼ;

(*Uncomment these if you want to print the exponents*)
(*Echo[{h,l,ϵ},"{h,l,ϵ} ="];
Echo[{hʼ,lʼ,ϵʼ},"{hʼ,lʼ,ϵʼ} ="];*)

If[l==0||lʼ==0,
Return[0],
Return[(((-1))^(k+kʼ))]
]
];

CompSign[r_]/;(Mod[p,12]==5&&Mod[m-n,3]==0):=Module[{kr,h,hʼ,k,kʼ,l,lʼ},
kr=κ[r];

h=(β[kr]+α[kr]-m s (p^2))/(3p);
hʼ=(β[kr]-α[kr]+m s (p^2))/(3p);

k=Floor[h/p];
kʼ=Floor[hʼ/p];

l=h-p k;
lʼ=hʼ-p kʼ;

(*Uncomment these if you want to print the exponents*)
(*Echo[{h,l,ϵ},"{h,l,ϵ} ="];
Echo[{hʼ,lʼ,ϵʼ},"{hʼ,lʼ,ϵʼ} ="];*)

If[l==0||lʼ==0,
Return[0],
Return[(((-1))^(k+kʼ))]
]
];

Sign table printer (`sgnTable`)

Here we define the function `signTable[]`, which we use as so:
	Input:
		sgnTable[]:=RowTable[(CompSign[#]/.{-1->"-",1->"+"})&,Range[0,p-1]];
sgnTable[]
	Output:
		({{"r", 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}, {"sgn", "-", "+", "+", "+", "-", "-", 0, "+", "+", 0, "+", "+", "-"}})

sgnTable[]:=RowTable[(CompSign[#]/.{-1->"-",1->"+"})&,Range[0,p-1]];

Note that this requires the `RowTable` function, which is defined by the following lines

RowTable

PreColumn[T_,c_]:=Transpose@Prepend[c][Transpose@T];
Vec[list_]:=Table[{x},{x,list}];(* Returns a "column vector" from list *)

RowTable[f_,R_]:=Module[{T0,T1,T2},
	T0=Vec@Table[f[x],{x,R}];
	T1=Transpose@PreColumn[T0,R];
	Grid[Join[{{"r"},{"sgn"}},T1,2],
	Dividers->{2->Black,{2->Black}},
	Alignment->Center
	]
]

Usage is:
	RowTable[(func to apply),(list of inputs)],
e.g.
	RowTable[(#^2)&,{1,2,3}]
outputs
	({{r, 1, 2, 3}, {sgn, 1, 4, 9}})
(of course, the row headers don’t make sense when used this way)

Note: The `sgnTable` function requires that “global” variables p, m, n, b, μ, and s be defined, since `sgnTable` calls `CompSign`.

Example: p=13, m=2, n=3, b=5

Clear[p,m,n,b,μ,s];

p=13;
m=2;n=3;b=5;
μ=ModularInverse[3m,p];
s = (3m μ-1)/p;

sgnTable[]