Author: Sonja Žunar. Department of Mathematics, Faculty of Science, University of Zagreb, 10000 Zagreb, Croatia.

Email-adress: szunar@math.hr.

This R notebook is a supplement to the paper “On the Non-Vanishing of Poincaré Series on the Metaplectic Group”, which is submitted by the author to Manuscripta Mathematica. It contains calculations in R for the proof of Lemma 6-13.

R version details:

version
               _                           
platform       x86_64-w64-mingw32          
arch           x86_64                      
os             mingw32                     
system         x86_64, mingw32             
status                                     
major          3                           
minor          3.2                         
year           2016                        
month          10                          
day            31                          
svn rev        71607                       
language       R                           
version.string R version 3.3.2 (2016-10-31)
nickname       Sincere Pumpkin Patch       

First, we recall the formula for \(N_{k,m}\): \[N_{k,m}:=\frac{4\,\mathrm{M}\left(\frac k2+1,\frac m2-1\right)^{\frac12}}{1-\mathrm{M}\left(\frac k2+1,\frac m2-1\right)},\qquad k\in\mathbb Z_{\geq0},\ m\in\frac52+\frac12\mathbb Z_{\geq0},\] where \(\mathrm{M}(a,b)\) is the median of the beta distribution with parameters \(a,b\in\mathbb R_{>0}\), given in R by \(\texttt{qbeta(0.5,a,b)}\).

Let us calculate \(\lfloor N_{k,m}\rfloor+1\) for \(k\in\{0,1,2,\ldots,1000\}\) and \(m\in\frac12\mathbb Z\cap\left[\frac92,16970\right]\). (This calculation takes several minutes.)

k <- seq(0, 1000, by=1)
m <- seq(9/2, 16970, by=1/2)
f <- function(a, b) floor(4*sqrt(qbeta(0.5,a/2+1,b/2-1))/(1-qbeta(0.5,a/2+1,b/2-1)))+1
fp1_N_km <- outer(k, m, f)

Lemma 6-13.

Let \(k\in\mathbb Z_{\geq0}\) and \(m\in\frac92+\frac12\mathbb Z_{\geq0}\). We define \(C:=1.3738\), \[N_{k,m}^{close}:=4\sqrt{\frac{k+C}{m-4+C}\left(1+\frac{k+C}{m-4+C}\right)}.\]

\((1)\) If \(k\leq1000\), then \(\left\lceil N_{k,m}^{close}+6.204\right\rceil\in\left\{\left\lfloor N_{k,m}\right\rfloor+1,...,\left\lfloor N_{k,m}\right\rfloor+8\right\}\).

\((2)\) If \(k\leq158\), then \(\left\lceil N_{k,m}^{close}+0.8018\right\rceil\in\left\{\left\lfloor N_{k,m}\right\rfloor+1,\left\lfloor N_{k,m}\right\rfloor+2\right\}\).

\((3)\) If \(k\leq1000\) and \(m\geq 26.4+16.9431\,k\), then \(\left\lfloor N_{k,m}\right\rfloor+1=1\). If \(k\leq1000\) and \(m\leq25.34+16.9431\,k\), then \(\left\lfloor N_{k,m}\right\rfloor+1>1\).

Proof.

A calculation in R shows that \((1)\) is true if \(m<16970\).

g <- function(a, b) 4*sqrt((a+1.3738) / (b-2.6262) * (1 + (a+1.3738) / (b-2.6262)))
N_km_close <- outer(k, m, g)
min(ceiling(N_km_close+6.204) - fp1_N_km)
[1] 0
max(ceiling(N_km_close+6.204) - fp1_N_km)
[1] 7

Since both \(N_{k,m}\) and \(N_{k,m}^{close}\) are increasing in \(k\) and decreasing in \(m\), we have, for \(m\geq16970\) and \(k\leq1000\), \[1\leq\left\lfloor N_{k,m}\right\rfloor+1\leq\color{blue}{\left\lfloor N_{1000,16970}\right\rfloor+1\overset{\text{R}}=1}\quad\Rightarrow\quad\left\lfloor N_{k,m}\right\rfloor+1=1,\]

fp1_N_km[which(k==1000), which(m==16970)]
[1] 1

\[7\leq\left\lceil N_{k,m}^{close}+6.204\right\rceil\leq \color{blue}{\left\lceil N^{close}_{1000,16970}+6.204\right\rceil\overset{\text{R}}=8}\quad\Rightarrow\quad\left\lceil N_{k,m}^{close}+6.204\right\rceil\in\left\{7,8\right\},\]

ceiling(N_km_close[which(k==1000), which(m==16970)]+6.204)
[1] 8

which finishes the proof of \((1)\).

\((2)\) is proved analogously: one uses R to verify that it holds for \(m\leq2702\)

min(ceiling(N_km_close[1:which(k==158),1:which(m==2702)]+0.8018) - fp1_N_km[1:which(k==158),1:which(m==2702)])
[1] 0
max(ceiling(N_km_close[1:which(k==158),1:which(m==2702)]+0.8018) - fp1_N_km[1:which(k==158),1:which(m==2702)])
[1] 1

and to calculate \(\color{blue}{\left\lfloor N_{158,2702.5}\right\rfloor+1=1}\)

fp1_N_km[which(k==158),which(m==2702.5)]
[1] 1

and \(\color{blue}{\left\lceil N^{close}_{158,2702.5}+0.8018\right\rceil=2}\).

ceiling(N_km_close[which(k==158),which(m==2702.5)]+0.8018)
[1] 2

Since \(N_{k,m}\) is decreasing in \(m\), the proof of \((3)\) comes down to checking in R that, for every \(k\in\{0,1,2,\ldots,1000\}\), we have \[\color{blue}{\left\lfloor N_{k,\,m(k)}\right\rfloor+1=1},\quad\text{where}\quad m(k):=\min\left(\left(\frac92+\frac12\mathbb Z_{\geq0}\right)\cap\mathbb R_{\geq26.4+16.9431k}\right)=\frac{\lceil2(26.4+16.9431k)\rceil}2,\]

for(a in 0:1000){
  if(fp1_N_km[which(k==a),which(m==ceiling(2*(26.4+16.9431*a))/2)]>1){print("F")}
}
print("DONE")
[1] "DONE"

\[\color{blue}{\left\lfloor N_{k,\,m'(k)}\right\rfloor+1>1},\quad\text{where}\quad m'(k):=\max\left(\left(\frac92+\frac12\mathbb Z_{\geq0}\right)\cap\mathbb R_{\leq25.34+16.9431k}\right)=\frac{\lfloor2(25.34+16.9431k)\rfloor}2.\]

for(a in 0:1000){
  if(fp1_N_km[which(k==a),which(m==floor(2*(25.34+16.9431*a))/2)]==1){print("F")}
}
print("DONE")
[1] "DONE"
LS0tDQp0aXRsZTogIk9uIHRoZSBOb24tVmFuaXNoaW5nIG9mIFBvaW5jYXLpIFNlcmllcyBvbiB0aGUgTWV0YXBsZWN0aWMgR3JvdXAgLSBjYWxjdWxhdGlvbnMgaW4gUiBmb3IgdGhlIHByb29mIG9mIExlbW1hIDYtMTMiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpBdXRob3I6IFNvbmphII51bmFyLiBEZXBhcnRtZW50IG9mIE1hdGhlbWF0aWNzLCBGYWN1bHR5IG9mIFNjaWVuY2UsIFVuaXZlcnNpdHkgb2YgWmFncmViLCAxMDAwMCBaYWdyZWIsIENyb2F0aWEuIA0KDQpFbWFpbC1hZHJlc3M6IHN6dW5hclxAbWF0aC5oci4gDQoNClRoaXMgUiBub3RlYm9vayBpcyBhIHN1cHBsZW1lbnQgdG8gdGhlIHBhcGVyICJPbiB0aGUgTm9uLVZhbmlzaGluZyBvZiBQb2luY2Fy6SBTZXJpZXMgb24gdGhlIE1ldGFwbGVjdGljIEdyb3VwIiwgd2hpY2ggaXMgc3VibWl0dGVkIGJ5IHRoZSBhdXRob3IgdG8gTWFudXNjcmlwdGEgTWF0aGVtYXRpY2EuIEl0IGNvbnRhaW5zIGNhbGN1bGF0aW9ucyBpbiBSIGZvciB0aGUgcHJvb2Ygb2YgTGVtbWEgNi0xMy4NCg0KUiB2ZXJzaW9uIGRldGFpbHM6DQoNCmBgYHtyfQ0KdmVyc2lvbg0KYGBgDQoNCg0KRmlyc3QsIHdlIHJlY2FsbCB0aGUgZm9ybXVsYSBmb3IgJE5fe2ssbX0kOg0KJCROX3trLG19Oj1cZnJhY3s0XCxcbWF0aHJte019XGxlZnQoXGZyYWMgazIrMSxcZnJhYyBtMi0xXHJpZ2h0KV57XGZyYWMxMn19ezEtXG1hdGhybXtNfVxsZWZ0KFxmcmFjIGsyKzEsXGZyYWMgbTItMVxyaWdodCl9LFxxcXVhZCBrXGluXG1hdGhiYiBaX3tcZ2VxMH0sXCBtXGluXGZyYWM1MitcZnJhYzEyXG1hdGhiYiBaX3tcZ2VxMH0sJCQNCndoZXJlICRcbWF0aHJte019KGEsYikkIGlzIHRoZSBtZWRpYW4gb2YgdGhlIGJldGEgZGlzdHJpYnV0aW9uIHdpdGggcGFyYW1ldGVycyAkYSxiXGluXG1hdGhiYiBSX3s+MH0kLCBnaXZlbiBpbiBSIGJ5ICRcdGV4dHR0e3FiZXRhKDAuNSxhLGIpfSQuDQoNCkxldCB1cyBjYWxjdWxhdGUgJFxsZmxvb3IgTl97ayxtfVxyZmxvb3IrMSQgZm9yICRrXGluXHswLDEsMixcbGRvdHMsMTAwMFx9JCBhbmQgJG1caW5cZnJhYzEyXG1hdGhiYiBaXGNhcFxsZWZ0W1xmcmFjOTIsMTY5NzBccmlnaHRdJC4gKFRoaXMgY2FsY3VsYXRpb24gdGFrZXMgc2V2ZXJhbCBtaW51dGVzLikNCg0KYGBge3J9DQprIDwtIHNlcSgwLCAxMDAwLCBieT0xKQ0KbSA8LSBzZXEoOS8yLCAxNjk3MCwgYnk9MS8yKQ0KZiA8LSBmdW5jdGlvbihhLCBiKSBmbG9vcig0KnNxcnQocWJldGEoMC41LGEvMisxLGIvMi0xKSkvKDEtcWJldGEoMC41LGEvMisxLGIvMi0xKSkpKzENCmZwMV9OX2ttIDwtIG91dGVyKGssIG0sIGYpDQpgYGANCg0KDQoNCiMjTGVtbWEgNi0xMy4gDQoNCkxldCAka1xpblxtYXRoYmIgWl97XGdlcTB9JCBhbmQgJG1caW5cZnJhYzkyK1xmcmFjMTJcbWF0aGJiIFpfe1xnZXEwfSQuIFdlIGRlZmluZSAkQzo9MS4zNzM4JCwgDQokJE5fe2ssbX1ee2Nsb3NlfTo9NFxzcXJ0e1xmcmFje2srQ317bS00K0N9XGxlZnQoMStcZnJhY3trK0N9e20tNCtDfVxyaWdodCl9LiQkDQoJDQokKDEpJCBJZiAka1xsZXExMDAwJCwgdGhlbiAkXGxlZnRcbGNlaWwgTl97ayxtfV57Y2xvc2V9KzYuMjA0XHJpZ2h0XHJjZWlsXGluXGxlZnRce1xsZWZ0XGxmbG9vciBOX3trLG19XHJpZ2h0XHJmbG9vcisxLC4uLixcbGVmdFxsZmxvb3IgTl97ayxtfVxyaWdodFxyZmxvb3IrOFxyaWdodFx9JC4NCiAgDQokKDIpJCBJZiAka1xsZXExNTgkLCB0aGVuICRcbGVmdFxsY2VpbCBOX3trLG19XntjbG9zZX0rMC44MDE4XHJpZ2h0XHJjZWlsXGluXGxlZnRce1xsZWZ0XGxmbG9vciBOX3trLG19XHJpZ2h0XHJmbG9vcisxLFxsZWZ0XGxmbG9vciBOX3trLG19XHJpZ2h0XHJmbG9vcisyXHJpZ2h0XH0kLg0KCQ0KJCgzKSQgSWYgJGtcbGVxMTAwMCQgYW5kICRtXGdlcSAyNi40KzE2Ljk0MzFcLGskLCB0aGVuICRcbGVmdFxsZmxvb3IgTl97ayxtfVxyaWdodFxyZmxvb3IrMT0xJC4gSWYgJGtcbGVxMTAwMCQgYW5kICRtXGxlcTI1LjM0KzE2Ljk0MzFcLGskLCB0aGVuICRcbGVmdFxsZmxvb3IgTl97ayxtfVxyaWdodFxyZmxvb3IrMT4xJC4NCg0KIyNQcm9vZi4NCg0KQSBjYWxjdWxhdGlvbiBpbiBSIHNob3dzIHRoYXQgPHNwYW4gc3R5bGU9ImNvbG9yOmJsdWUiPiQoMSkkIGlzIHRydWUgaWYgJG08MTY5NzAkPC9zcGFuPi4gDQoNCmBgYHtyfQ0KZyA8LSBmdW5jdGlvbihhLCBiKSA0KnNxcnQoKGErMS4zNzM4KSAvIChiLTIuNjI2MikgKiAoMSArIChhKzEuMzczOCkgLyAoYi0yLjYyNjIpKSkNCk5fa21fY2xvc2UgPC0gb3V0ZXIoaywgbSwgZykNCm1pbihjZWlsaW5nKE5fa21fY2xvc2UrNi4yMDQpIC0gZnAxX05fa20pDQptYXgoY2VpbGluZyhOX2ttX2Nsb3NlKzYuMjA0KSAtIGZwMV9OX2ttKQ0KYGBgDQpTaW5jZSBib3RoICROX3trLG19JCBhbmQgJE5fe2ssbX1ee2Nsb3NlfSQgYXJlIGluY3JlYXNpbmcgaW4gJGskIGFuZCBkZWNyZWFzaW5nIGluICRtJCwgd2UgaGF2ZSwgZm9yICRtXGdlcTE2OTcwJCBhbmQgJGtcbGVxMTAwMCQsDQokJDFcbGVxXGxlZnRcbGZsb29yIE5fe2ssbX1ccmlnaHRccmZsb29yKzFcbGVxXGNvbG9ye2JsdWV9e1xsZWZ0XGxmbG9vciBOX3sxMDAwLDE2OTcwfVxyaWdodFxyZmxvb3IrMVxvdmVyc2V0e1x0ZXh0e1J9fT0xfVxxdWFkXFJpZ2h0YXJyb3dccXVhZFxsZWZ0XGxmbG9vciBOX3trLG19XHJpZ2h0XHJmbG9vcisxPTEsJCQNCmBgYHtyfQ0KZnAxX05fa21bd2hpY2goaz09MTAwMCksIHdoaWNoKG09PTE2OTcwKV0NCmBgYA0KJCQ3XGxlcVxsZWZ0XGxjZWlsIE5fe2ssbX1ee2Nsb3NlfSs2LjIwNFxyaWdodFxyY2VpbFxsZXEgXGNvbG9ye2JsdWV9e1xsZWZ0XGxjZWlsIE5ee2Nsb3NlfV97MTAwMCwxNjk3MH0rNi4yMDRccmlnaHRccmNlaWxcb3ZlcnNldHtcdGV4dHtSfX09OH1ccXVhZFxSaWdodGFycm93XHF1YWRcbGVmdFxsY2VpbCBOX3trLG19XntjbG9zZX0rNi4yMDRccmlnaHRccmNlaWxcaW5cbGVmdFx7Nyw4XHJpZ2h0XH0sJCQNCmBgYHtyfQ0KY2VpbGluZyhOX2ttX2Nsb3NlW3doaWNoKGs9PTEwMDApLCB3aGljaChtPT0xNjk3MCldKzYuMjA0KQ0KYGBgDQp3aGljaCBmaW5pc2hlcyB0aGUgcHJvb2Ygb2YgJCgxKSQuIA0KCQ0KJCgyKSQgaXMgcHJvdmVkIGFuYWxvZ291c2x5OiBvbmUgdXNlcyBSIHRvIHZlcmlmeSB0aGF0IDxzcGFuIHN0eWxlPSJjb2xvcjpibHVlIj5pdCBob2xkcyBmb3IgJG1cbGVxMjcwMiQ8L3NwYW4+IA0KYGBge3J9DQptaW4oY2VpbGluZyhOX2ttX2Nsb3NlWzE6d2hpY2goaz09MTU4KSwxOndoaWNoKG09PTI3MDIpXSswLjgwMTgpIC0gZnAxX05fa21bMTp3aGljaChrPT0xNTgpLDE6d2hpY2gobT09MjcwMildKQ0KbWF4KGNlaWxpbmcoTl9rbV9jbG9zZVsxOndoaWNoKGs9PTE1OCksMTp3aGljaChtPT0yNzAyKV0rMC44MDE4KSAtIGZwMV9OX2ttWzE6d2hpY2goaz09MTU4KSwxOndoaWNoKG09PTI3MDIpXSkNCmBgYA0KYW5kIHRvIGNhbGN1bGF0ZSAkXGNvbG9ye2JsdWV9e1xsZWZ0XGxmbG9vciBOX3sxNTgsMjcwMi41fVxyaWdodFxyZmxvb3IrMT0xfSQgDQpgYGB7cn0NCmZwMV9OX2ttW3doaWNoKGs9PTE1OCksd2hpY2gobT09MjcwMi41KV0NCmBgYA0KYW5kICRcY29sb3J7Ymx1ZX17XGxlZnRcbGNlaWwgTl57Y2xvc2V9X3sxNTgsMjcwMi41fSswLjgwMThccmlnaHRccmNlaWw9Mn0kLg0KYGBge3J9DQpjZWlsaW5nKE5fa21fY2xvc2Vbd2hpY2goaz09MTU4KSx3aGljaChtPT0yNzAyLjUpXSswLjgwMTgpDQpgYGANClNpbmNlICROX3trLG19JCBpcyBkZWNyZWFzaW5nIGluICRtJCwgdGhlIHByb29mIG9mICQoMykkIGNvbWVzIGRvd24gdG8gY2hlY2tpbmcgaW4gUiB0aGF0LCBmb3IgZXZlcnkgJGtcaW5cezAsMSwyLFxsZG90cywxMDAwXH0kLCB3ZSBoYXZlIA0KJCRcY29sb3J7Ymx1ZX17XGxlZnRcbGZsb29yIE5fe2ssXCxtKGspfVxyaWdodFxyZmxvb3IrMT0xfSxccXVhZFx0ZXh0e3doZXJlfVxxdWFkIG0oayk6PVxtaW5cbGVmdChcbGVmdChcZnJhYzkyK1xmcmFjMTJcbWF0aGJiIFpfe1xnZXEwfVxyaWdodClcY2FwXG1hdGhiYiBSX3tcZ2VxMjYuNCsxNi45NDMxa31ccmlnaHQpPVxmcmFje1xsY2VpbDIoMjYuNCsxNi45NDMxaylccmNlaWx9MiwkJA0KYGBge3J9DQpmb3IoYSBpbiAwOjEwMDApew0KICBpZihmcDFfTl9rbVt3aGljaChrPT1hKSx3aGljaChtPT1jZWlsaW5nKDIqKDI2LjQrMTYuOTQzMSphKSkvMildPjEpe3ByaW50KCJGIil9DQp9DQpwcmludCgiRE9ORSIpDQpgYGANCiQkXGNvbG9ye2JsdWV9e1xsZWZ0XGxmbG9vciBOX3trLFwsbScoayl9XHJpZ2h0XHJmbG9vcisxPjF9LFxxdWFkXHRleHR7d2hlcmV9XHF1YWQgbScoayk6PVxtYXhcbGVmdChcbGVmdChcZnJhYzkyK1xmcmFjMTJcbWF0aGJiIFpfe1xnZXEwfVxyaWdodClcY2FwXG1hdGhiYiBSX3tcbGVxMjUuMzQrMTYuOTQzMWt9XHJpZ2h0KT1cZnJhY3tcbGZsb29yMigyNS4zNCsxNi45NDMxaylccmZsb29yfTIuJCQNCmBgYHtyfQ0KZm9yKGEgaW4gMDoxMDAwKXsNCiAgaWYoZnAxX05fa21bd2hpY2goaz09YSksd2hpY2gobT09Zmxvb3IoMiooMjUuMzQrMTYuOTQzMSphKSkvMildPT0xKXtwcmludCgiRiIpfQ0KfQ0KcHJpbnQoIkRPTkUiKQ0KYGBg