#increasing convex regression spline code: hinge algorithm in R #must have x=predictor,y=response,k=#interior knots then use the #following.... the x values must be sorted and distinct # quadratic version only # Make the sigma vectors and first q-vectors mcspl=function(x,y,k){ n=length(x) sm=0.00000001 q1=(1:n*0+1)/sqrt(n) qm=q1 l=1 h=c(1) r=1 knots=round((0:(k+1))*n/(k+1)) knots[1]=1 t=x[knots] m=k+3 sigma=matrix(1:(m*n)*0,nrow=m,ncol=n) sigma[1,]=1:n*0+1 sigma[2,]=x for(j in 1:(m-3)){ for(i in 1:knots[j]){ sigma[j+2,i] = 0 } for(i in (knots[j]+1):knots[j+1]){ sigma[j+2,i] = (x[i]-t[j])^2 / 2 } for(i in (knots[j+1]+1):n){ sigma[j+2,i]=(t[j+1]-t[j])^2/2 +(x[i]-t[j+1])*(t[j+1]-t[j]) } } for(i in 1:knots[k+1]){ sigma[m,i] = 0 } for(i in (knots[k+1]+1):n){ sigma[m,i] = (x[i]-t[m-2])^2 / 2 } id=diag(1:n*0+1,nrow=n) proj=id-qm%*%t(qm) sigma=proj%*%t(sigma) sigma=t(sigma) sigma[1,]=t(q1) # add one edge to start check=0 rhat=y-qm%*%t(qm)%*%y b2=sigma%*%rhat if(b2[rank(b2)==m]>sm){ obs=1:m i=obs[rank(b2)==m] l=l+1 qnew=sigma[i,]-qm%*%t(qm)%*%sigma[i,] qnew=qnew/sqrt(sum(qnew^2)) qm=cbind(qm,qnew) h=c(h,i) r=t(qm)%*%t(sigma[h,]) } if(b2[rank(b2)==m](-sm)) { c1=1 # # now see if we need to add another hinge # theta=qm%*%t(qm)%*%y rhat=y-theta b2=sigma%*%rhat # check to see if b2 negative obs=1:m #i=obs[rank(b2)==m] i=min(obs[b2==max(b2)]) if(b2[i]>sm){ l=l+1 qnew=sigma[i,]-qm%*%t(qm)%*%sigma[i,] qnew=qnew/sqrt(sum(qnew^2)) qm=cbind(qm,qnew) h=c(h,i) r=t(qm)%*%t(sigma[h,]) c2=0 } if(b2[i]