Revision 616fe292ea4c66f8db35d04c9fa045fea56eea02 authored by Roger Koenker on 04 September 2016, 13:02:15 UTC, committed by cran-robot on 04 September 2016, 13:02:15 UTC
1 parent db6345a
Raw File
crqfnb.r
# Peng-Huang Censored Quantile Regression
subroutine crqfnb(n,p,a1,c1,n1,X,y,c,B,g,m,r,s,d,u,wn,wp,info)

# Input
#	a1 = p by n1 design matrix (X[c,] transposed)
#	c1 = n1 response vector -y[c] 
#	X  = n by p design matrix
#	y  = n response vector
#	c  = n censoring indicator
#	g  = m grid vector of taus
#	d  = residual n-vector, initialized == 1 
#	s  = initialized cumhaz vector (rep(0,n))
#	u  = upper bound n-vector, initalized == 1
# Workspace
#	r  = rhs p-vector
#	wn = work array n1 by 9
#	wp = work array p by p+3
# Output
#	B  = p by m matrix of estimated coefficients
#	m  = final column dimension of of B
# Note
#	d  is used both for residuals and as a work vector for rqfnb.
#	u  needs to be reinitialized to ones at each iteration
	
integer n,p,n1,m,info,nit(3)
double precision a1(p,n1),c1(n),X(n,p),y(n),c(n),B(p,m),g(m)
double precision wn(n1,9),wp(p,p+3),r(p),s(n),d(n),u(n)
double precision zero,half,one,beta,eps,dH

parameter( zero  =  0.0d0)
parameter( half  =  0.5d0)
parameter( one   =  1.0d0)
parameter( beta  =  0.99995d0)
parameter( eps   =  1.0d-8)

do k = 2,m {
	dH = -log(one - g(k)) + log(one - g(k-1))
	do i = 1,n {
		u(i) = one
		wn(i,1) = half # initialize dual vector
		if(d(i) >= zero) s(i) = s(i) + dH
		d(i) = c(i) - s(i)
		}
	call dgemv('T',n,p,one,X,n,d,1,zero,r,1)
	call rqfnb(n1,p,a1,c1,r,d,u,beta,eps,wn,wp,nit,info)
	if(info != 0) break
	call dcopy(p,wp,1,B(1,k-1),1)
	call dcopy(n,y,1,d,1)
	call dgemv('N',n,p,one,X,n,B(1,k-1),1,one,d,1)
	}
m = k-1
return
end
back to top