int
RpcPdu::makeReplyBuffer (char*& buf, size_t& buflen)
{
int hdrLength = hdrLen ();
int payloadLength = payloadLen ();
buflen = hdrLength + payloadLength;
buf = new char[buflen];
if (buf)
{
// Set the fragment-length field, and the DREP...
fragLenSet ();
drepSet ();
// Format the packet into the correct NDR mode...
commonHdrReformat (drep ());
extHdrReformat (drep ());
char* header = reinterpret_cast<char*> (&m_header);
::memcpy (buf, header, hdrLength);
if (payloadLength > 0)
::memcpy (buf + hdrLength, stubData (), payloadLength);
}
return buf ? 0 : -1;
}
size_t
RpcPdu::appendExtendedHdr (const char* buf, size_t len)
{
COM_ASSERT (m_pduState & HAVE_HDR);
size_t n = min(len, m_requiredOctets); // octets to copy
::memcpy (m_headerOffset, buf, n);
m_headerOffset += n;
m_requiredOctets -= n;
if (m_requiredOctets == 0)
{
// Un-NDR the remainder of the header...
extHdrReformat (drep ());
// mark the next state's requirements
m_pduState = HAVE_XHDR;
m_requiredOctets = fragLen () - hdrLen ();
if (m_requiredOctets > 0)
m_stubData.reserve (m_requiredOctets);
if (m_requiredOctets > 0 && (len - n) > 0)
n += appendStubData (buf + n, len - n);
else if (m_requiredOctets == 0)
m_pduState = HAVE_STUB;
}
return n;
}
size_t
RpcPdu::appendCommonHdr (const char* buf, size_t len)
{
COM_ASSERT (m_pduState & HAVE_NONE);
size_t n = min(len, m_requiredOctets); // octets to copy
::memcpy (m_headerOffset, buf, n);
m_headerOffset += n;
m_requiredOctets -= n;
if (m_requiredOctets == 0)
{
// Un-NDR the packet header...
commonHdrReformat (drep ());
// mark the next state's requirements
m_pduState = HAVE_HDR;
m_requiredOctets = hdrLen () - sizeof (rpc_cn_common_hdr_t);
if (len - n > 0)
n += appendExtendedHdr (buf + n, len - n);
}
return n;
}
void gamlr(int *famid, // 1 gaus, 2 bin, 3 pois
int *n_in, // nobs
int *p_in, // nvar
int *N_in, // length of nonzero x entries
int *xi_in, // length-l row ids for nonzero x
int *xp_in, // length-p+1 pointers to each column start
double *xv_in, // nonzero x entry values
double *y_in, // length-n y
int *doxx_in, // indicator for pre-calc xx
double *xxv_in, // dense columns of upper tri for xx
double *eta, // length-n fixed shifts (assumed zero for gaussian)
double *varweight, // length-p weights
double *obsweight, // length-n weights
int *standardize, // whether to scale penalty by sd(x_j)
int *nlam, // length of the path
double *delta, // path stepsize
double *penscale, // gamma in the GL paper
double *thresh, // cd convergence
int *maxit, // cd max iterations
double *lambda, // output lambda
double *deviance, // output deviance
double *df, // output df
double *alpha, // output intercepts
double *beta, // output coefficients
int *exits, // exit status. 0 is normal
int *verb) // talk?
{
dirty = 1; // flag to say the function has been called
// time stamp for periodic R interaction
time_t itime = time(NULL);
/** Build global variables **/
fam = *famid;
n = *n_in;
p = *p_in;
nd = (double) n;
pd = (double) p;
N = *N_in;
E = eta;
Y = y_in;
ysum = sum_dvec(Y,n);
ybar = ysum/nd;
xi = xi_in;
xp = xp_in;
xv = xv_in;
xbar = new_dzero(p);
for(int j=0; j<p; j++){
for(int i=xp[j]; i<xp[j+1]; i++)
xbar[j] += xv[i];
xbar[j] *= 1.0/nd; }
doxx = *doxx_in;
xxv = xxv_in;
H = new_dvec(p);
W = varweight;
V = obsweight;
Z = new_dup_dvec(Y,n);
vxbar = new_dvec(p);
vxz = new_dvec(p);
vsum = sum_dvec(V,n);
docurve();
xsd = drep(1.0,p);
if(*standardize){
for(int j=0; j<p; j++){
if(H[j]==0.0) W[j] = INFINITY;
else xsd[j] = sqrt(H[j]/vsum);
}
}
A=0.0;
B = new_dzero(p);
G = new_dzero(p);
ag0 = new_dzero(p);
gam = *penscale;
npass = itertotal = 0;
// some local variables
double Lold, NLLHD, Lsat;
int s;
// family dependent settings
switch( fam )
{
case 2:
nllhd = &bin_nllhd;
reweight = &bin_reweight;
A = log(ybar/(1-ybar));
Lsat = 0.0;
break;
case 3:
nllhd = &po_nllhd;
reweight = &po_reweight;
A = log(ybar);
// nonzero saturated deviance
Lsat = ysum;
for(int i=0; i<n; i++)
if(Y[i]!=0) Lsat += -Y[i]*log(Y[i]);
break;
default:
fam = 1; // if it wasn't already
nllhd = &sse;
Lsat=0.0;
A = intercept(n, E, V, Z, vsum);
for(int j=0; j<p; j++) dograd(j);
}
l1pen = INFINITY;
Lold = INFINITY;
NLLHD = nllhd(n, A, E, Y, V);
if(*verb)
speak("*** n=%d observations and p=%d covariates ***\n", n,p);
// move along the path
for(s=0; s<*nlam; s++){
// deflate the penalty
if(s>0)
lambda[s] = lambda[s-1]*(*delta);
l1pen = lambda[s]*nd;
// run descent
exits[s] = cdsolve(*thresh,*maxit);
// update parameters and objective
itertotal += npass;
Lold = NLLHD;
NLLHD = nllhd(n, A, E, Y, V);
deviance[s] = 2.0*(NLLHD - Lsat);
df[s] = dof(s, lambda, NLLHD);
alpha[s] = A;
copy_dvec(&beta[s*p],B,p);
if(s==0) *thresh *= deviance[0]; // relativism
// gamma lasso updating
for(int j=0; j<p; j++)
if(isfinite(gam)){
if( (W[j]>0.0) & isfinite(W[j]) )
W[j] = 1.0/(1.0+gam*fabs(B[j]));
} else if(B[j]!=0.0){
W[j] = 0.0;
}
// verbalize
if(*verb)
speak("segment %d: lambda = %.4g, dev = %.4g, npass = %d\n",
s+1, lambda[s], deviance[s], npass);
// exit checks
if(deviance[s]<0.0){
exits[s] = 1;
shout("Warning: negative deviance. ");
}
if(df[s] >= nd){
exits[s] = 1;
shout("Warning: saturated model. ");
}
if(exits[s]){
shout("Finishing path early.\n");
*nlam = s; break; }
itime = interact(itime);
}
*maxit = itertotal;
gamlr_cleanup();
}
