R小鹽準(zhǔn)備介紹R語言機器學(xué)習(xí)與預(yù)測模型的學(xué)習(xí)筆記

你想要的R語言學(xué)習(xí)資料都在這里， 快來收藏關(guān)注【科研私家菜】

01 ROC曲線比較

臨床預(yù)測模型可以采用多種算法，每種算法都有優(yōu)缺點递礼，因而當(dāng)我們針對具體問題去判斷選擇那種算法時，必須對不同的預(yù)測模型進(jìn)行重做評估槐雾。

為了簡化這個過程，我們使用caret包來生成并比較不同的模型與性能幅狮。
加載對應(yīng)的包與將訓(xùn)練控制算法設(shè)置為10折交叉驗證，重復(fù)次數(shù)為3

library(ROCR)
library(e1071)
library("pROC")
library(caret)
library("pROC")
control = trainControl(method = "repaetedcv",
   number = 10,
   repeats =3,
   classProbs = TRUE,
   summaryFunction = twoClassSummary)

# 使用glm在訓(xùn)練數(shù)據(jù)集上訓(xùn)練一個分類器
glm.model = train(churn ~ .,
   data= trainset,
   method = "glm",
   metric = "ROC",
   trControl = control)
# 使用svm在訓(xùn)練數(shù)據(jù)集上訓(xùn)練一個分類器
svm.model = train(churn ~ .,
   data= trainset,
   method = "svmRadial",
   metric = "ROC",
   trControl = control)

# 使用rpart函數(shù)查看rpart在訓(xùn)練數(shù)據(jù)集上的運行情況
rpart.model = train(churn ~ .,
   data = trainset,
   method = "svmRadial",
   metric = "ROC",
   trControl = control)

# 使用不同的已經(jīng)訓(xùn)練好的數(shù)據(jù)分類預(yù)測：
glm.probs = predict(glm.model,testset[,!names(testset) %in% c("churn")],type = "prob")
svm.probs = predict(svm.model,testset[,!names(testset) %in% c("churn")],type = "prob")
rpart.probs = predict(rpart.model,testset[,!names(testset) %in% c("churn")],type = "prob")

生成每個模型的ROC曲線

glm.ROC = roc(response = testset[,c("churn")],
  predictor = glm.probs$yes,
  levels = levels(testset[,c("churn")]))
plot(glm.ROC,type = "S",col = "red")
svm.ROC = roc(response = testset[,c("churn")],
  predictor = svm.probs$yes,
  levels = levels(testset[,c("churn")]))
plot(svm.ROC,add = TRUE,col = "green")
rpart.ROC = roc(response = testset[,c("churn")],
  predictor = rpart.probs$yes,
  levels = levels(testset[,c("churn")]))
plot(rpart.ROC,add = TRUE,col = "blue")

將不同的分類模型的ROC曲線繪制在同一個圖中進(jìn)行比較株灸，設(shè)置訓(xùn)練過程的控制參數(shù)為重復(fù)三次的10折交叉驗證崇摄，模型性能的評估參數(shù)為twoClassSummary,然后在使用glm,svm,rpart,三種不同的方法建立分類模型。

從圖中可以看出慌烧，svm對訓(xùn)練集的預(yù)測結(jié)果（未調(diào)優(yōu)）是三種分類算法里最好的逐抑。

效果如下：

02 多模型性能差異比較

可以通過重采樣的方法得對每一個匹配模型的統(tǒng)計信息，包括ROC曲線屹蚊，靈敏度與特異度厕氨，然后基于這些統(tǒng)計信息來比較不同模型的性能差異进每。
利用提前準(zhǔn)備好的glm分類模型，svm分類模型命斧，rpart分類模型：
使用resample函數(shù)生成各個模型的統(tǒng)計信息田晚，再調(diào)用summary函數(shù)輸出三個模型在ROC、靈敏度及特異性上的統(tǒng)計信息国葬。
使用dotplot方法處理重采樣結(jié)果來觀測不同模型ROC差異贤徒，最后，采用箱線圖在同一張圖上對ROC汇四、靈敏度及特異方面的差別進(jìn)行比較接奈。

cv.values = resamples(list(glm = glm.model,svm =svm.model,rpart = rpart.model))
> summary(cv.values)
Call:
summary.resamples(object = cv.values)
Models: glm, svm, rpart 
Number of resamples: 30 
ROC 
  Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
glm 0.7597790 0.7927740 0.8040455 0.8106454 0.8347961 0.8760824 0
svm 0.8191998 0.8786439 0.8945208 0.8947360 0.9196775 0.9562556 0
rpart 0.6064540 0.7150320 0.7608241 0.7556544 0.8086731 0.8554750 0
Sens 
  Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
glm 0.08823529 0.1764706 0.2058824 0.2124930 0.2516807 0.3235294 0
svm 0.44117647 0.5294118 0.5882353 0.5956863 0.6470588 0.7941176 0
rpart 0.20000000 0.4117647 0.4705882 0.4787955 0.5514706 0.7352941 0
Spec 
  Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
glm 0.9393939 0.9645119 0.9721581 0.9702721 0.9796954 0.9898477 0
svm 0.9494949 0.9695431 0.9771574 0.9755004 0.9847716 0.9898990 0
rpart 0.9492386 0.9746193 0.9796954 0.9780359 0.9848485 1.0000000 0

# 使用dotplot函數(shù)繪制重采樣在ROC曲線度量中的結(jié)果
dotplot(cv.values,metric = "ROC")
# 使用箱線圖繪制重采樣結(jié)果
bwplot(cv.values,layout=c(3,1))

效果如下：

03 時間依賴性ROC曲線繪制

## 變成data_frame
data <- as_data_frame(data)
## 繪圖
plot(survfit(Surv(futime, fustat) ~ 1,
          data = data)

## 擬合cox模型
coxph(formula = Surv(futime, fustat) ~ pspline(age, df = 4) + 
##獲得線性預(yù)測值
 predict(coxph1, type = "lp")

## 定義一個輔助函數(shù)，以在不同的時間進(jìn)行評估
ROC_hlp <- function(t) {
  survivalROC(Stime    
        status    
        marker    
        predict.time = t,
        method    = "NNE",
        span = 0.25 * nrow(ovarian)^(-0.20))
}
## 每180天評估一次
ROC_data <- data_frame(t = 180 * c(1,2,3,4,5,6)) %>%
  mutate(survivalROC = map(t, survivalROC_helper),
      ## 提取AUC
      auc = map_dbl(survivalROC, magrittr::extract2, "AUC"),
      ## 在data_frame中放相關(guān)的值
      df_survivalROC = map(survivalROC, function(obj) {
      
## 繪圖
 ggplot(mapping = aes(x = FP, y = TP)) +
  geom_point() +
  geom_line() +
   facet_wrap( ~ t) +

## 定義一個輔助函數(shù)通孽，以在不同的時間進(jìn)行評估
 
## 每180天評估一次
 
      ## 提取AUC
      auc = map_dbl(risksetROC, magrittr::extract2, "AUC"),
      ## 在data_frame中放相關(guān)的值
      df_risksetROC = map(risksetROC, function(obj) {
        ## 標(biāo)記欄
        marker <- c(-Inf, obj[["marker"]], Inf)
 
## 繪圖
 
  ggplot(mapping = aes(x = FP, y = TP)) +
  geom_point() +
  geom_line() +
  geom_label(data = risksetROC_data %>% dplyr::select(t,auc) %>% unique,
  facet_wrap( ~ t) +

關(guān)注R小鹽序宦，關(guān)注科研私家菜(VX_GZH: SciPrivate)，有問題請聯(lián)系R小鹽背苦。讓我們一起來學(xué)習(xí) R語言機器學(xué)習(xí)與臨床預(yù)測模型