Commit 7c64033f authored by Andreas Tille's avatar Andreas Tille

Update upstream source from tag 'upstream/2.1.11'

Update to upstream version '2.1.11'
with Debian dir 9b232d025227dd01fd40d8da21bef5b9d877131e
parents 28faf422 36745746
Package: logspline
Version: 2.1.10
Date: 2018-06-01
Version: 2.1.11
Date: 2018-06-14
Title: Routines for Logspline Density Estimation
Author: Charles Kooperberg <clk@fredhutch.org>
Maintainer: Charles Kooperberg <clk@fredhutch.org>
......@@ -12,6 +12,6 @@ Description: Contains routines for logspline density estimation.
Imports: stats, graphics
License: Apache License 2.0
NeedsCompilation: yes
Packaged: 2018-06-01 23:09:26 UTC; clk
Packaged: 2018-06-14 19:11:08 UTC; clk
Repository: CRAN
Date/Publication: 2018-06-02 04:58:19 UTC
Date/Publication: 2018-06-14 19:44:30 UTC
e005c87432b1a0afdd14162adcb4e956 *DESCRIPTION
f95c841aa7f92a244b373c69aca3a2dd *DESCRIPTION
73d98ba76a12b8b7aed3bb0ac4d6183c *NAMESPACE
09b85350d31e7ea491ce12e0af07b944 *R/logspline.R
cfc92ccd57493b57ad1714288d9daeb1 *R/logspline.R
e5937390332be13e210110b2f5030d8d *man/dlogspline.Rd
1905f0e1bc2347092ee3a4d6fc806b08 *man/doldlogspline.Rd
e8f70418b42dc00732c0bba662e65537 *man/logspline-internal.Rd
0523706ecb792f50782788cb50fea636 *man/logspline-internal.Rd
0e63737114e136fef7ed9e2b893d8372 *man/logspline.Rd
85aef4792b0f000ec0cf45e3e64e700d *man/oldlogspline.Rd
08c579c346e1f7b79c687bf6dc674269 *man/oldlogspline.to.logspline.Rd
......@@ -14,7 +14,7 @@ eabaae5f996c1402466f5a54717a3121 *man/summary.logspline.Rd
d9d2d511c4cec309ecc1c2f05d87b121 *man/unstrip.Rd
8290d2e9740414e315237f0d5d4024bb *src/Makevars
157084291a6fa50c11e5d7ae2325507f *src/allpack.f
51b9bf35a21a9698214eb75ee5033258 *src/lsdall.c
6df20d87970ec1b9a5eef7f70933c11e *src/nlsd.c
3975f51f6ed3550a08dc0aee0196cdec *src/lsdall.c
cd4f299bb18985e5154ec39e27d29cc2 *src/nlsd.c
c625d1f0667c03581e95c09fdf044aae *src/registerDynamicSymbol.c
782c6ba6b56e9842d5854775ce3653e3 *src/x2c.h
......@@ -585,7 +585,7 @@ plogspline <- function(q, fit)
zz <- z$pp[sq]
if(fit$bound[1] > 0) zz[q<fit$bound[2]] <- 0
if(fit$bound[3] > 0) zz[q>fit$bound[4]] <- 1
zz
zz
}
qlogspline <- function(p, fit)
{
......
\name{logspline-internal}
\title{Internal glmnet functions}
\title{Internal logspline functions}
\alias{logcensor}
\alias{nlogcensor}
\alias{nlogcensorx}
\alias{pqlsd}
\alias{rpqlsd}
\description{Internal logspline functions}
\author{Charles Koopeeberg}
\author{Charles Kooperberg}
\details{These are not intended for use by users.}
\keyword{internal}
......@@ -35,7 +35,7 @@ static void coeff() ,start1() ,start2() ,suffstat1() ,suffstat2() ,knotplace();
static double dens3(),numint(),expin(),dens33(),onesearch();
static double fun2(),tails(),fun48(),numints(),expin2();
static void intnum2(),intnum3(),intnum4();
static void qtop(),ptoq();
static void qtop(),qtop1(),ptoq();
static double pqexp(),pqnum(),lpqexpi(),pqdens();
/******************************************************************************/
/* this is the main program */
......@@ -141,7 +141,7 @@ int i,j,nkstart,iremove=0,iknots[NC],xiknots[NC];
/* Compute coefficient matrix. */
itrouble = 0;
do{
coeff(coef2);
coeff(coef2);
/* Compute sufficient statistics. */
suffstat2(suffcombine,coef2,sufficient);
......@@ -1542,7 +1542,7 @@ double coef2[][NC];
coef2[nknots-2][nknots] = (knots[nknots-3] - knots[nknots-1]) /
(knots[nknots-1] - knots[nknots-2]);
coef2[nknots-2][nknots+1] = (knots[nknots-2] - knots[nknots-3]) /
(knots[nknots-1] - knots[nknots-2]);
(knots[nknots-1] - knots[nknots-2]);
/* we first create basis functions that are 0 before knot[i] and constant
after knot [i+3] */
......@@ -1582,9 +1582,9 @@ double coef2[][NC];
/* The rest is a bit tricking with the correct indices */
for(i=0; i<nknots-1; i++){
for(j=i; j<i+4; j++){
if(j > 0 && j < nknots+1 && (i != 0 || j != 3)){
for(k=i+1; k<j+2; k++){
for(j=i; j<i+4; j++){
for(k=i+1; k<j+2; k++){
if(j > 0 && j < nknots+1 && (i != 0 || j != 3)){
if(k != 1){
coef[i][0][j] = coef[i][0][j] -
coef2[i][k] * pow(knots[k-2], 3.);
......@@ -1594,9 +1594,9 @@ double coef2[][NC];
coef[i][3][j] = coef[i][3][j] + coef2[i][k];
}
}
}
}
}
}
}
}
}
/******************************************************************************/
......@@ -2882,19 +2882,15 @@ void pqlsd(coef,knots,bound,ipq,pp,qq,lk,lp)
double coef[],knots[],pp[],bound[],qq[];
int *ipq,*lk,*lp;
{
double v1[2],v2[2];
double v1[2],v20;
int ij;
v2[0]=0;
v2[1]=0;
if((*ipq)==1)
qtop(coef,knots,bound,pp,qq,*lp,*lk);
else{
v2[0]=knots[2];
ij=1;
qtop(coef,knots,bound,v1,v2,ij,*lk);
v2[0]=v2[0];
for(ij=0;ij<*lp;ij++)pp[ij]=pp[ij]*v2[0];
ptoq(coef,knots,bound,pp,qq,*lp,*lk,v2[0]);
v20=knots[2];
qtop1(coef,knots,bound,v1,v20,*lk);
for(ij=0;ij<*lp;ij++)pp[ij]=pp[ij]*v20;
ptoq(coef,knots,bound,pp,qq,*lp,*lk,v20);
}
}
/******************************************************************************/
......@@ -2962,6 +2958,32 @@ int lp,lk;
}
}
/******************************************************************************/
static void qtop1(coef,knots,bound,pp,v2,lk)
double coef[],knots[],bound[],pp[],v2;
int lk;
{
double l0,l1,r0,r1,s2;
int i,j,k,vr,vl;
l0 = coef[0];
l1 = coef[1];
r0 = l0;
r1 = l1;
for(i=0;i<lk;i++){
r0 = r0 - coef[i+2]*knots[i]*knots[i]*knots[i];
r1 = r1 + 3.* coef[i+2]*knots[i]*knots[i];
}
vr = 4;
if(bound[2]<0.5)vr=3;
vl = 2;
if(bound[0]<0.5)vl=1;
s2 = pqexp(vl,knots[0],bound[1],l1,l0);
for(j=1;j<lk;j++)
s2 = s2 + pqnum(knots[j-1],knots[j],j,knots,coef);
s2 = s2+fabs(pqexp(vr,knots[lk-1],bound[3],r1,r0));
v2=s2;
pp[0]=pp[0]/s2;
}
/******************************************************************************/
static void qtop(coef,knots,bound,pp,qq,lp,lk)
double coef[],knots[],bound[],pp[],qq[];
int lp,lk;
......@@ -3000,7 +3022,7 @@ int lp,lk;
pp[i] = s2;
}
}
if(k==lk && ko != lk){
if(k==lk && ko != lk &&i>0){
s2 = s2 + pqnum(qq[i-1],knots[ko],ko,knots,coef);
if(k>ko+1)
for(j=ko+1;j<k;j++)
......
......@@ -2180,8 +2180,9 @@ int *ipq,*lk,*lp;
else ppl[nk]=z1int(kpl[nk-1],cpl[nk-1],-1)+ppl[nk-1];
}
/* correction factor */
cor=ppl[nk];
cor=1.;
/* correct the density */
for(i=0;i<=nk;i++)cpl[i][0]=cpl[i][0]+log(1./ppl[nk]);
for(i=0;i<=nk;i++)ppl[i]=ppl[i]/ppl[nk];
j=0;
/* initialize */
......@@ -2216,7 +2217,7 @@ int *ipq,*lk,*lp;
else getp1(pq,pqx,fst,lst,cpl[i],kpl[i],kpl[i+1],ppl[i],ppl[i+1]);
}
}
/* beyond the larst knot */
/* beyond the last knot */
fst=j;
lst=j-1;
jx=j;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment