Skip to content

Commit

Permalink
version 5.99.1
Browse files Browse the repository at this point in the history
  • Loading branch information
@rkoenker @cran-robot
rkoenker authored and cran-robot committed Nov 22, 2024
1 parent 18dc7af commit 413d32c
Show file tree
Hide file tree
Showing 12 changed files with 227 additions and 202 deletions.
10 changes: 7 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ Description: Estimation and inference methods for models for conditional quantil
risk are also now included. See Koenker, R. (2005) Quantile Regression, Cambridge U. Press,
<doi:10.1017/CBO9780511754098> and Koenker, R. et al. (2017) Handbook of Quantile Regression,
CRC Press, <doi:10.1201/9781315120256>.
Version: 5.99
Version: 5.99.1
Authors@R: c(
person("Roger", "Koenker", role = c("cre","aut"), email = "rkoenker@illinois.edu"),
person("Stephen", "Portnoy", role = c("ctb"),
Expand All @@ -29,6 +29,8 @@ Authors@R: c(
comment = "contributions to extreme value inference code"),
person("Ivan", "Fernandez-Val", role = c("ctb"),
comment = "contributions to extreme value inference code"),
person("Martin", "Maechler", role = "ctb", comment = c("tweaks (src/chlfct.f, 'tiny','Large')",
ORCID = "0000-0002-8685-9910")),
person(c("Brian", "D"), "Ripley", role = c("trl","ctb"),
comment = "Initial (2001) R port from S (to my everlasting shame --
how could I have been so slow to adopt R!) and for numerous other
Expand All @@ -42,7 +44,7 @@ License: GPL (>= 2)
URL: https://www.r-project.org
NeedsCompilation: yes
VignetteBuilder: R.rsp
Packaged: 2024-10-22 10:53:40 UTC; roger
Packaged: 2024-11-22 12:00:57 UTC; ripley
Author: Roger Koenker [cre, aut],
Stephen Portnoy [ctb] (Contributions to Censored QR code),
Pin Tian Ng [ctb] (Contributions to Sparse QR code),
Expand All @@ -56,7 +58,9 @@ Author: Roger Koenker [cre, aut],
code),
Ivan Fernandez-Val [ctb] (contributions to extreme value inference
code),
Martin Maechler [ctb] (tweaks (src/chlfct.f, 'tiny','Large'),
<https://orcid.org/0000-0002-8685-9910>),
Brian D Ripley [trl, ctb] (Initial (2001) R port from S (to my
everlasting shame -- how could I have been so slow to adopt R!) and
for numerous other suggestions and useful advice)
Date/Publication: 2024-10-22 12:50:02 UTC
Date/Publication: 2024-11-22 13:27:13 UTC
22 changes: 11 additions & 11 deletions MD5
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
37c2d088aebec596cbbee91d3f86654f *DESCRIPTION
d4cbfa5a48d1bc69a50a2c38f78e4972 *DESCRIPTION
59ae171f84eb2be52ee904fe100b1291 *NAMESPACE
6c1789eaa459e5175106e2eba12bdbb4 *R/ParetoTest.R
12fc3ee9b6eecda826cff7ed17f25e55 *R/anova.R
Expand All @@ -13,11 +13,11 @@ d2f509eb6977017d1b77faae7de97a7c *R/lprq.R
23abbfdfe6ab274c1ebe89aaa4d825ef *R/qrisk.R
63c8000c1eb0c126d62a215009245e74 *R/quantreg.R
a77c6ad37ae6093e30c9d639e27351f0 *R/rqss.R
f7723bc3ed3a21afb5b60417ddc7baa0 *R/sfn.R
2dfec3ad6cc67d6024558b3f9a314d55 *R/sfn.R
8177bc8bd37dd659c3e403f2fa504928 *R/table.R
11102c1b9076b53ebaac51cc79b90bfb *R/tools.R
00f6440dcfd495483f57d543f4918de0 *README
9a494536e7865311fc0c2d15e7e7a410 *build/vignette.rds
fb1aa25e922a29f7f6e3da91681027e8 *build/vignette.rds
56ef7db1af717ba44a86062560b034df *data/Bosco.rda
403622377f41685bab4f044f2dac7785 *data/CobarOre.rda
3d69ca4dff26067565dddb340c8d12a3 *data/Mammals.rda
Expand Down Expand Up @@ -50,12 +50,12 @@ ea9c96de3d670a1fa922585cf85789e3 *demo/predemo.R
32f68b8e497d02b2cae7cf5f9b83ff52 *demo/rqsslasso.R
5235d61a73c80e7eb83777d7d923d144 *demo/stack.R
a582af0bad3d273cb076a346c906cba5 *demo/subset.R
efd23c63e38a6579b6818e3d99d15768 *inst/ChangeLog
de7a2746ec618801c4790b614c91acf0 *inst/ChangeLog
c323f5a63f1fa8a44efe2d32cfab3e20 *inst/FAQ
f2732c4ab5eb2f4ca3421239a030f0ee *inst/TODO
3fb70411ec441d151dcae73d63a5e018 *inst/doc/crq.pdf
48b99baf4f65ac9b9a820769d55a75f0 *inst/doc/crq.pdf.asis
8d7109abf013b827de1f1cb7a2854a34 *inst/doc/rq.pdf
0de68334ee7d011f06785bc4926bcdc1 *inst/doc/rq.pdf
8faba626ac2f6a7ca45473bca52e2e67 *inst/doc/rq.pdf.asis
64449a66c0d80474c7aefef8907b8f05 *man/Bosco.Rd
768cf6c848f78a1862b44371c1f3e2a4 *man/CobarOre.Rd
Expand All @@ -68,7 +68,7 @@ e0161d8945e1258ff78943b06d7298de *man/MelTemp.Rd
5e19c6a25ab4ac17d770ee7c24c981e6 *man/ParetoTest.Rd
1c55b05cfde94862b2503523ccca1998 *man/Peirce.Rd
114a06055c68efb323cb9dd8a7278050 *man/QTECox.Rd
9d5c7b53fc04bbbbe5820d2d616e31b5 *man/akj.Rd
93035639b6851f7246a2cbb98b3abdfc *man/akj.Rd
a303a4ced70b992220472a10f79fa65c *man/anova.rq.Rd
742ec68efdfbcf12a2a47e1adcfde3fe *man/bandwidth.rq.Rd
36991ef697fde62deb19e355974477dd *man/barro.Rd
Expand Down Expand Up @@ -129,7 +129,7 @@ c42b5515ccf48527ae43449357b3dfb0 *man/rq.process.object.Rd
47b5d67bdd5108808d62c0905ab8e58a *man/rqs.fit.Rd
60adfb48bc8cf2d2728035eb0d19f547 *man/rqss.Rd
1d5e4c75789a5fac11763df6b7edef03 *man/rqss.object.Rd
7a198b2a81968dc5da8b7f59ff282714 *man/sfn.control.Rd
5bee50c05259df5e4da9d55ab9b2fa5b *man/sfn.control.Rd
2dfb6597245f45ee542f157105db4bc4 *man/srisk.Rd
cf9fd105c0bd87edbcce9ec4a71780e5 *man/summary.crq.Rd
3ec599a6f561cd6908bfa5032e59be75 *man/summary.rq.Rd
Expand All @@ -142,7 +142,7 @@ bda0ebc1c480b97ce4c9cb3b2ddaf9a9 *src/Makevars
bb6fb4e8354bba1c16aeaf0cf5f9768e *src/bound.f
f3a2629172dbce899d97b55d42490e5f *src/boundc.f
1bcb651bc603316f27c0c6a38f85d70b *src/brute.f
e897c735aa425937601d47591dbdee1f *src/chlfct.f
90e2c1e51b9fe243b7d1d03d53694700 *src/chlfct.f
1662015996d45d980ae598a9e243e760 *src/cholesky.f
344362611adeaf7c79c8c5a5c344aa21 *src/combos.f
a812e708aab3cd5e073b4cb0832a07eb *src/crqf.f
Expand All @@ -164,7 +164,7 @@ bd02eb1fbf344dd91d0e24a60a1c5269 *src/powell.f
abef5781d8b3c202a444af9fb291072b *src/pwxy.f
b8b6da4241edbbf057b398691772e4b0 *src/qfnb.f
00b5c50c8caa28b22e1434a7436d0bb9 *src/qselect.f
8e36db97b4d1a23328d5ceba8c882bf7 *src/quantreg_init.c
11136c6acb68f84acc7813dd5f146ee7 *src/quantreg_init.c
d2eb1038dddc50e80368118675819272 *src/ratfor/README
df3e98bf71bf48242ffe8a2939ea98b4 *src/ratfor/boot.r
abc8e4125098a8ec492c6d56a2e990ed *src/ratfor/brute.r
Expand Down Expand Up @@ -195,8 +195,8 @@ cbe8e3c270c3863ecbd3d01ba512b2c4 *src/rqfnc.f
2e4d138de042e0dc24f5432dea05a7f6 *src/rqs.f
8420f9a87d703ab5237d1707f25eb3a9 *src/sakj.f
aef01c414f773d044dc72cb95c8741f4 *src/sparskit2.f
ec5e92b756a88e077a3de86c8fb7bf86 *src/srqfn.f
5e11cb4cad5ff02717b26234beae168f *src/srqfnc.f
50c93379d3a1af3c8d0b5e6ec305e244 *src/srqfn.f
1ed46340b6a16e19697572e051d160a1 *src/srqfnc.f
f651f868d227919f2c670255f04fb137 *src/srtpai.f
a838141113a2049f3ca6b6c5914989bc *tests/panel.R
62bf15687c35cd5a9fa8d05d94fe28a5 *tests/rq.R
Expand Down
123 changes: 64 additions & 59 deletions R/sfn.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,11 @@
#


sfn.control <- function( nsubmax = NULL, tmpmax = NULL, nnzlmax = NULL,
cachsz = 64, small = 1e-6, maxiter=100, warn.mesg=TRUE)
sfn.control <- function( nsubmax = NULL, tmpmax = NULL, nnzlmax = NULL,
cachsz = 64, small = 1e-6, maxiter=100, tiny = 1e-30, Large = 1e128, warn.mesg=TRUE)
list(nsubmax = nsubmax, tmpmax = tmpmax, nnzlmax = nnzlmax, cachsz = cachsz,
small = small, maxiter = maxiter, warn.mesg = warn.mesg)
small = small, maxiter = as.integer(maxiter),
tiny = tiny, Large = Large, warn.mesg = warn.mesg)

#################################################################
# Interface for a sparse implementation of LMS interior point method
Expand All @@ -29,85 +30,86 @@ rq.fit.sfn <- function(a,y,tau=.5, rhs = (1-tau)*c(t(a) %*% rep(1,length(y))), c
{
y <- -y
n <- length(y)
m <- a@dimension[2]
m <- as.integer(a@dimension[2])
if(n != a@dimension[1])
stop("Dimensions of design matrix and the response vector not compatible")
u <- rep(1,length=n)
u <- rep(1, length=n)
x <- rep((1-tau),length=n)
nnzdmax <- nnza <- a@ia[n+1]-1
nnzdmax <- nnza <- a@ia[n+1L] -1L
iwmax <- 7*m+3
ao <- t(a)
e <- ao %*% a
nnzemax <- e@ia[m+1]-1
nnzemax <- as.integer(e@ia[m+1L]) - 1L
ctrl <- sfn.control()
if (!missing(control)) {
control <- as.list(control)
ctrl[names(control)] <- control
}
if (is.null(ctrl$nsubmax)) ctrl$nsubmax <- nnzemax
if (is.null(ctrl$tmpmax )) ctrl$tmpmax <- 6L * m
if (is.null(ctrl$nnzlmax)) ctrl$nnzlmax <- 4L * nnzdmax
nsubmax <- ctrl$nsubmax
tmpmax <- ctrl$tmpmax
tmpmax <- ctrl$tmpmax
nnzlmax <- ctrl$nnzlmax
if (is.null(ctrl$nsubmax)) ctrl$nsubmax <- nsubmax <- nnzemax
if (is.null(ctrl$tmpmax)) ctrl$tmpmax <- tmpmax <- 6 * m
if (is.null(ctrl$nnzlmax)) ctrl$nnzlmax <- nnzlmax <- 4 * nnzdmax
wwm <- vector("numeric",3*m)
s <- u - x
b1 <- solve(e, ao %*% y, tmpmax=tmpmax,nnzlmax=nnzlmax,nsubmax=nsubmax)
b1 <- solve(e, ao %*% y, tmpmax=tmpmax, nnzlmax=nnzlmax, nsubmax=nsubmax)
r <- y - a %*% b1
z <- ifelse(abs(r)<ctrl$small,(r*(r>0)+ctrl$small),r*(r>0))
z <- ifelse(abs(r) < ctrl$small,
r*(r>0) + ctrl$small,
r*(r>0))
w <- z - r
wwn <- matrix(0,n,14)
wwn <- matrix(0, n, 14L)
wwn[,1] <- r
wwn[,2] <- z
wwn[,3] <- w
fit <- .Fortran("srqfn",
n = as.integer(n),
m = as.integer(m),
nnza = as.integer(nnza),
a = as.double(a@ra),
a = as.double (a@ra),
ja = as.integer(a@ja),
ia = as.integer(a@ia),
ao = as.double(ao@ra),
ao = as.double (ao@ra),
jao = as.integer(ao@ja),
iao = as.integer(ao@ia),
nnzdmax = as.integer(nnzdmax),
d = double(nnzdmax),
jd = integer(nnzdmax),
id = integer(m+1),
dsub = double(nnzemax+1),
jdsub = integer(nnzemax+1),
id = integer(m+1L),
dsub = double(nnzemax+1L),
jdsub = integer(nnzemax+1L),
nnzemax = as.integer(nnzemax),
e = as.double(e@ra),
e = as.double (e@ra),
je = as.integer(e@ja),
ie = as.integer(e@ia),
nsubmax = as.integer(nsubmax),
lindx = integer(nsubmax),
xlindx = integer(m+1),
xlindx = integer(m+1L),
nnzlmax = as.integer(nnzlmax),
lnz = double(nnzlmax),
xlnz = integer(m+1),
xlnz = integer(m+1L),
iw = integer(m*5),
iwmax = as.integer(iwmax),
iwork = integer(iwmax),
xsuper = integer(m+1),
xsuper = integer(m+1L),
tmpmax = as.integer(tmpmax),
tmpvec = double(tmpmax),
wwm = as.double(wwm),
wwm = double(3*m),
wwn = as.double(wwn),
cachsz = as.integer(ctrl$cachsz),
level = as.integer( 8 ),
level = 8L,
x = as.double(x),
s = as.double(s),
u = as.double(u),
c = as.double(y),
sol = as.double(b1),
rhs = as.double(rhs),
small = as.double(ctrl$small),
rhs = as.double(rhs), # 'y'
sol = as.double(b1), # 'b'
sm_tn_Lrg = as.double(ctrl[c("small", "tiny", "Large")]),
ierr = integer(1),
maxiter = as.integer(ctrl$maxiter),
time = double(7))[c("sol","ierr","maxiter","time")]
time = double(7) )[c("sol","ierr","maxiter","time")]
ierr <- fit$ierr
if(!(ierr==0) && ctrl$warn.mesg)
if(ierr != 0 && ctrl$warn.mesg)
warning(sfnMessage(ierr))
coefficients <- -fit$sol
residuals <- -y - a %*% coefficients
Expand All @@ -116,7 +118,6 @@ rq.fit.sfn <- function(a,y,tau=.5, rhs = (1-tau)*c(t(a) %*% rep(1,length(y))), c
control = ctrl,
ierr = ierr,
it = fit$maxiter)

}
#------------------------------------------------------------------------------
#################################################################
Expand All @@ -137,8 +138,9 @@ rq.fit.sfnc <- function(x, y, R, r, tau = 0.5,
y <- -y
r <- -r
n1 <- length(y)
m <- x@dimension[2]
if(n1 != x@dimension[1])
xd <- as.integer(x@dimension)
m <- xd[2]
if(n1 != xd[1])
stop("The design matrix A1' and response vector y are not compatible")
n2 <- length(r)
if(n2 != R@dimension[1])
Expand All @@ -149,34 +151,36 @@ rq.fit.sfnc <- function(x, y, R, r, tau = 0.5,
x2 <- rep(1,length=n2)
wwm <- vector("numeric",6*m)
wwm[1:m] <- rhs
nnzx <- x@ia[x@dimension[1]+1]-1
nnzR <- R@ia[R@dimension[1]+1]-1
nnzx <- x@ia[xd[1] +1L] -1L
nnzR <- R@ia[R@dimension[1]+1L] -1L
nnzdmax <- max(nnzx,nnzR)
iwmax <- 7*m+3
ao1 <- t(x)
ao2 <- t(R)
e <- ao1 %*% x
g <- ao2 %*% R
h <- e + g
nnzemax <- e@ia[e@dimension[1]+1]-1
nnzgmax <- g@ia[g@dimension[1]+1]-1
nnzhmax <- h@ia[h@dimension[1]+1]-1
nnzemax <- e@ia[e@dimension[1]+1L] -1L
nnzgmax <- g@ia[g@dimension[1]+1L] -1L
nnzhmax <- h@ia[h@dimension[1]+1L] -1L
ctrl <- sfn.control()
if (!missing(control)) {
control <- as.list(control)
ctrl[names(control)] <- control
}
if (is.null(ctrl$nsubmax)) ctrl$nsubmax <- nnzhmax
if (is.null(ctrl$tmpmax )) ctrl$tmpmax <- 6L * m
if (is.null(ctrl$nnzlmax)) ctrl$nnzlmax <- 4L * nnzdmax
nsubmax <- ctrl$nsubmax
tmpmax <- ctrl$tmpmax
tmpmax <- ctrl$tmpmax
nnzlmax <- ctrl$nnzlmax
if (is.null(ctrl$nsubmax)) nsubmax <- nnzhmax
if (is.null(ctrl$tmpmax)) tmpmax <- 6 * m
if (is.null(ctrl$nnzlmax)) nnzlmax <- 4 * nnzdmax
s <- u - x1
chol.o <- chol(e, tmpmax=tmpmax, nsubmax=nsubmax, nnzlmax=nnzlmax)
b <- backsolve(chol.o, ao1 %*% y)
r1 <- y - x %*% b
z1 <- ifelse(abs(r1) < ctrl$small, (r1*(r1>0)+ctrl$small), r1*(r1>0))
z1 <- ifelse(abs(r1) < ctrl$small,
r1*(r1>0) + ctrl$small,
r1*(r1>0))
w <- z1 - r1
z2 <- rep(1,n2)
wwn1 <- matrix(0,n1,10)
Expand Down Expand Up @@ -205,31 +209,31 @@ rq.fit.sfnc <- function(x, y, R, r, tau = 0.5,
nnzdmax = as.integer(nnzdmax),
d = double(nnzdmax),
jd = integer(nnzdmax),
id = integer(m+1),
dsub = double(nnzhmax+1),
jdsub = integer(nnzhmax+1),
id = integer(m+1L),
dsub = double(nnzhmax+1L),
jdsub = integer(nnzhmax+1L),
nnzemax = as.integer(nnzemax),
e = as.double(e@ra),
je = as.integer(e@ja),
ie = as.integer(e@ia),
nnzgmax = as.integer(nnzgmax),
g = double(nnzgmax),
jg = integer(nnzgmax),
ig = integer(m+1),
ig = integer(m+1L),
nnzhmax = as.integer(nnzhmax),
h = double(nnzhmax),
jh = integer(nnzhmax),
ih = integer(m+1),
ih = integer(m+1L),
nsubmax = as.integer(nsubmax),
lindx = integer(nsubmax),
xlindx = integer(m+1),
xlindx = integer(m+1L),
nnzlmax = as.integer(nnzlmax),
lnz = double(nnzlmax),
xlnz = integer(m+1),
iw = integer(m*5),
xlnz = integer(m+1L),
iw = integer(m*5L),
iwmax = as.integer(iwmax),
iwork = integer(iwmax),
xsuper = integer(m+1),
xsuper = integer(m+1L),
tmpmax = as.integer(tmpmax),
tmpvec = double(tmpmax),
maxn1n2 = as.integer(maxn1n2),
Expand All @@ -238,22 +242,23 @@ rq.fit.sfnc <- function(x, y, R, r, tau = 0.5,
wwn1 = as.double(wwn1),
wwn2 = as.double(wwn2),
cachsz = as.integer(ctrl$cachsz),
level = as.integer( 8 ),
level = 8L,
x1 = as.double(x1),
x2 = as.double(x2),
s = as.double(s),
u = as.double(u),
s = as.double(s),
u = as.double(u),
c1 = as.double(y),
c2 = as.double(r),
sm_tn_Lrg = as.double(ctrl[c("small", "tiny", "Large")]),
## output:
sol = as.double(b),
small = as.double(ctrl$small),
ierr = integer(1),
maxiter = as.integer(ctrl$maxiter),
time = double(7))[c("sol","ierr","maxiter","time")]
time = double(7) )[c("sol","ierr","maxiter","time")]
ierr <- fit$ierr
if(ierr == 13)# stop()
stop("Increase nnzh.factor")
if(!(ierr==0) && ctrl$warn.mesg)
if(ierr != 0 && ctrl$warn.mesg)
warning(sfnMessage(ierr))
coefficients <- -fit$sol
residuals <- -y - x %*% coefficients
Expand Down
Binary file modified build/vignette.rds
View file
Binary file not shown.
8 changes: 8 additions & 0 deletions inst/ChangeLog
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1829,3 +1829,11 @@ version

3. changed several calls to model.matrix to use contrasts.arg = rather than
contrasts =


5.100

1. The new `cholesky.f` (from 5.99) needed amendments to correctly pass
'tiny, Large' to it e.g., such that package `cobs` tests pass.

2. Most naturally, extend the auxiliary R function `sfn.control()` accordingly.
Binary file modified inst/doc/rq.pdf
View file
Binary file not shown.
Loading

0 comments on commit 413d32c

Please sign in to comment.