Я пытаюсь сделать рисунок 5.3 в Элементах статистического обучения с использованием данных о сердечно-сосудистых заболеваниях в Южной Африке. Я дошел до того, что мне удалось получить точечные отклонения и построить их в зависимости от «sbp» переменных-предикторов модели. Частично, поскольку мой вектор поточечной дисперсии имеет размерность 462 на 1, единственное, что может построить точечную дисперсию, - это одна из переменных-предикторов, в моем случае «sbp», которая содержит такое же количество точек данных 462. После этого я получаю график, который выглядит следующим образом:
Глаза на этом графике видны, я вижу узлы на 33% (123) и 66% (162) для модели кубического сплайна с df = 6-1 (примечание: -1, потому что существует перехват) в соответствии с рисунком 5.3 с узлами в 0,33 и 0,66, как объяснено в описании на рисунке 5.3. Я думаю, что приближаюсь, но моя проблема сейчас в том, что это не строится в зависимости от X от 0 до 1 с 50 точками, как показано на рисунке. Вот что в принципе должна отображать фигура:
Код для моей фигуры выполнен в r и в настоящий момент является только попыткой модели кубического сплайна. Если бы я хотел сделать естественный кубический сплайн, я бы просто заменил функцию bs (), используемую для кубического сплайна, на функцию ns (), чтобы построить требуемую H-матрицу базисных функций. Пожалуйста, посмотрите код, показывающий, как я строю модель кубического сплайна:
library(sqldf)
library(splines)
library(gam)
library(mgcv)
SAheart <- read.table("SAheart.data",
sep = ",", head=T,row.names = 1)
SAheart.var<-sqldf("select sbp,tobacco,ldl,famhist,obesity,alcohol,age,chd from SAheart")
attach(SAheart.var)
sbp<-SAheart.var[,1]
tobacco<-SAheart.var[,2]
ldl.bsf<-SAheart.var[,3]
famhist<-SAheart.var[,4]
obesity<-SAheart.var[,5]
alcohol<-SAheart.var[,6]
age<-SAheart.var[,7]
chd<-SAheart.var[,8]
#Ignore these two models since they are simply dummy models for the natural cubic spline and global linear
SAheartGlobalLinear<-gam(chd~ sbp,data=SAheart)
SAheartNaturalCubicSpline<-gam(chd~ns(sbp,df=5),method="REML",data=SAheart)
#SAheartCubicSpline
sbp.bs <- bs(sbp,df=5)
tobacco.bs<-bs(tobacco,df=5)
ldl.bsf.bs<-bs(ldl.bsf,df=5)
famhist<-as.numeric(famhist)-1
obesity.bs<-bs(obesity,df=5)
alcohol.bs<-bs(alcohol,df=5)
age.bs<-bs(age,df=5)
chd.bs<-bs(chd,df=5)
#build required H matrix of basis functions using df=6-1 degrees of freedom
H <-cbind(sbp.bs,tobacco.bs,ldl.bsf.bs,famhist,obesity.bs,age.bs)
#centering the columns of H, intercept column is not centered
#producing another basis of the column space
H<-cbind(rep(1,dim(SAheart)[1]),scale(H,scale=FALSE))
#obtain coefficients with glm.fit
SAheartCubicSpline<-glm.fit(H,chd, family = binomial())
coeff<-SAheartCubicSpline<span class="math-container">$coefficients
#make W eight matrix 462 by 462
W= diag(SAheartCubicSpline$</span>weights)
#construct covariance matrix Note: I made it two different ways, not sure if it matters
Sigma = solve(t(H)%*%W%*%H)
sigma = (t(H)%*%W%*%H)^-1
#Calculate pointwise variance for one single predictor "sbp"
pw.var<-diag(H[,2:6]%*%Sigma[2:6,2:6]%*%t(H[,2:6]))
#make plot
plot(sbp,pw.var)
Я думаю, что я приближаюсь, но моя проблема сейчас в том, что это не строится в зависимости от X от 0 до 1 с 50 точками, потому чтомой вектор точечной дисперсии имеет 462 точки. Интересно, как точечная дисперсия против X как интервала U [0,1] с 50 случайными точками могла бы дать вам график кубического сплайна, как показано на рисунке 5.3. Кроме того, если это возможно, я также хотел бы знать, как я мог бы подогнать глобальный кубический полином и глобальный линейный. В противном случае, я полностью понимаю, но я хотел бы знать, где я иду не так с точки зрения оси X на рисунке 5.3. Заранее спасибо!