1.線性回歸入門
線性回歸(linear regression)輸出變量是通過輸入特征的一個線性加權組合來預測。線性回歸的假設
假設輸出變量是一組特征變量的加權線性函數
?假設1:誤差項具有同方差性
同方差(homoscedasticity):誤差部分的方差不會隨著輸入特征的值或水平而變化
異方差(heteroskedastic):誤差部分的方差隨著輸入特征的值的變化而變化
order()函數用于返回向量大小順序的秩,從小到大的數字的序號值。
x<-c(10,6,4,7,8)
order(x)
[1] 3 2 4 5 1
sapply(x,FUN),第一個參數x是需要處理的數據,FUN是處理數據x的Funtion。
library(ggplot2)
set.seed(15)
# 隨機產生200個數,均值100,標準差25
x1 <- order(rnorm(200, mean = 100, sd = 25))
y <- sapply(x1, function(x) {17+1.8*x + rnorm(1,mean=0, sd = x/4)})
#標準差隨x變大而變大,y的值也隨之變大,誤差項的方差與x有相關性。其實是構造了一個隨x變化的異方差的y的數據
df <- data.frame(x1 = x1, y = y)
fit<-coef(lm(y ~ x1, data = df))
# coef()函數提取線性回歸lm模型的系數
# qplot畫點圖,geom_abline畫線圖
# size:坐標軸標簽字體大小,lineheight: 標簽行間距的倍數,family:字體,face:字體外形(粗斜體等)
p <- qplot(x1,y,data=df) + geom_abline(intercept=fit[1],slope=fit[2]) + ggtitle("Linear Relationship with Heteroskedastic Errors")+
theme(plot.title = element_text(lineheight=.8, face="bold"))
p
可以看到,系數是17.0848,1.81745,非常接近我們構造的函數17+1.8*x + rnorm(1,mean=0, sd = x/4),因為有噪聲,所以截距和x的系數有細微變化。
同方差性與異方差性的區別:
a <- 1:200
#同方差
A <- data.frame(x=1:200, y=1+2*a+rnorm(n=200,mean=0,sd=10))
ggplot(data = A, aes(x,y)) +
geom_point()+ geom_smooth(method = 'lm')
#異方差
B <- data.frame(x=1:200, y=1+2*a+rnorm(n=200,mean=0,sd=0.4*a))
ggplot(data = B, aes(x,y)) +
geom_point()+ geom_smooth(method = 'lm')
?假設2:誤差項具有獨立性
人工擴大數據集的方式會破壞獨立性的假設。
例如:取出一部分數據,把特征值和輸出值都乘以2,看起來數據集合變大了,但是數據之間的誤差有了相關性。
不同工廠的測量數據,工廠應該作為一種特征。
?假設3:特征在統計學上是相互獨立的
2.簡單線性回歸
從均勻分布中隨機抽取點,讓數據理想地分開
?? = 1.67??1 ? 2.93 + ??(0,2^2)
估算回歸系數
?一元回歸模型:根據數據集合{????, ????}對兩個回歸系數??1, ??0進行估算注意:
如果 ??1^ = 0表示輸出變量與輸入特征相互獨立
即使兩個變量統計學上相互獨立,通常還是會有少量的協方差
協方差是0也不代表是相互獨立
如果訓練一個線性回歸模型,一般??1^ ≠ 0
set.seed(5427395)
nObs <- 100
x1minrange <- 5
x1maxrange <- 25
# 隨機產生100個最小值為5,最大值為25的均勻分布隨機數
x1 <- runif(nObs,x1minrange,x1maxrange)
# 隨機產生100個均值為0,標準差為2的正態分布隨機數
e <- rnorm(nObs,mean = 0, sd = 2.0)
y <- 1.67*x1 - 2.93 + e
# 構造一個數據框格式
df <- data.frame(y,x1)
# 線性擬合
myfit <- lm(y~x1,df)
summary(myfit)
因為e的噪聲干擾,發現截距在-2.93附近,x1自變量系數在1.67附近。e是同方差干擾。
# 畫圖
p <- qplot(x1,y,data=df)
p <- p + ggtitle("Simple Linear Regression") #畫標題
# 畫lm函數擬合直線
p <- p + geom_abline(intercept=coef(myfit)[1],slope=coef(myfit)[2], aes(linetype="Estimated Line"), size=1.2, show_guide=T)
# 畫y = 1.67*x1 - 2.93 + e固定系數下原始直線
p <- p + geom_abline(intercept = -2.93, slope = 1.67, aes(linetype="Population Regression Line"),size=1.2, show_guide=T)
p <- p + xlab("Feature x1") # x軸的名稱
p <- p + ylab("Output y") # y軸的名稱
# 控制線性,也可以寫scale_linetype_manual(values=c("twodash", "dotted"))
p <- p + scale_linetype_manual(name="",values=c("Population Regression Line"=1,"Estimated Line"=2))
p <- p + theme(plot.title = element_text(lineheight=.8, face="bold"),legend.position = "bottom")
p
以上是回歸線性系數估計擬合線與固定系數和截距劃線的比較,發現兩條線基本重合,擬合度較好。
3.多元線性回歸
具有k個輸入特征的多元線性回歸模型?? = ???????? + ?????1?????1 + ? + ??1??1 + ??0 + ??
通常假設??與(??1, ??2, … , ????)相互獨立。
1)預測CPU性能
把數據集做成訓練集和測試集,比例85%:15%
1.該數據沒有缺失值,而且樣本較少,僅有200行
library(caret)
set.seed(4352345)
machine$PRP
# 按照輸出變量PRP進行索引,提取85%作為訓練集
machine_sampling_vector <- createDataPartition(machine$PRP, p = 0.85, list = FALSE)
# 獲取訓練集數據
machine_train <- machine[machine_sampling_vector,]
machine_train_labels <- machine$PRP[machine_sampling_vector]
# 獲取測試集數據
machine_test <- machine[-machine_sampling_vector,]
machine_test_labels <- machine$PRP[-machine_sampling_vector]
2.數據設置好后,分析和檢查針對線性回歸的假設
machine_train_features <-machine[,1:6] #保留1-6列,去掉了第七列PRP
machine_correlations <- cor(machine_train_features) #每一列之間的相關性
# 篩選與其他相關性系數強的變量并且刪除
findCorrelation(machine_correlations)
findCorrelation(machine_correlations, cutoff = 0.75)
cor(machine_train$MMIN,machine_train$MMAX)
高度相關性的閾值默認的0.9沒有發現哪個特征該去掉。
但是,當閾值改成0.75的時候,caret包推薦去掉第三個特征MMAX。
檢查發現MMIN和MMAX相關性很大。最小主內存的型號也有較大的主內存,這里我們不修改。
2)預測二手汽車的價格
數據集caret,獲取二手車可靠價格的數據,包含804種通用汽車(GM)品牌的汽車。
第一步:數據預處理
library(caret)
data(cars)
# 查看一下各特征之間的相關系數矩陣,判斷相關關系
cars_cor <- cor(cars[,-1]) #去掉第一列price
findCorrelation(cars_cor) #默認cutoff=0.9
findCorrelation(cars_cor, cutoff=0.75)
cor(cars$Doors,cars$coupe)
# 用交叉列聯表來查看相關性
table(cars$coupe,cars$Doors)
# 查找完全線性組合的特征
findLinearCombos(cars)
# 根據建議,去掉具有完全線性組合的特征
cars <- cars[,c(-15,-18)]
第三列doors有超過75%相關性。查看相關矩陣,發現在Doors和coupe之間存在較高的相關性。
跑車大概率是2門車,跑車和車門相關性為-0.8254435。門越少,是跑車可能性越高。2門車中140個是跑車,50個不是跑車,4門車中0個是跑車。
函數結果表示:要把15(coupe)和18(wagon)remove掉,因為15和18是其他特征的組合。
第二步:把數據分為訓練集和測試集
set.seed(232455)
# 劃分訓練集和測試集,同時標注特征數據和標簽數據
cars_sampling_vector <- createDataPartition(cars$Price, p = 0.85, list = FALSE)
# 獲取訓練集數據
cars_train <- cars[cars_sampling_vector,]
cars_train_features <- cars[,-1] #去掉第一列price
cars_train_labels <- cars$Price[cars_sampling_vector]
# 獲取測試集數據
cars_test <- cars[-cars_sampling_vector,]
cars_test_labels <- cars$Price[-cars_sampling_vector]
4.評估線性回歸模型
利用lm函數,用線性回歸模型來擬合數據。
# 根據訓練集建立模型
machine_model1 <- lm(PRP~.,data=machine_train)
cars_model1 <- lm(Price~.,data=cars_train)
# 模型評估(包括:殘差分析、顯著性檢驗等。其中顯著性檢驗又包括線性關系檢驗和回歸系數檢驗)
summary(cars_model1)
summary(machine_model1)
summary()結果解讀
- 調用:Call,表明lm是如何被調用的
- 殘差統計量:Residuals,殘差第一四分位數(1Q)和第三分位數(Q3)有大約相同的幅度,意味著有較對稱的鐘形分布
- 系數:Coefficients
分別表示: 估值標準誤差 T值 P值
Intercept:表示截距
Mileage:影響因子/特征
Estimate:包含由普通最小二乘法計算出來的估計回歸系數。
Std. Error:估計的回歸系數的標準誤差。
t值:系數估計值與標準誤差的比值。
P值:估計系數不顯著的可能性,有較大P值的變量是可以從模型中移除的候選變量。可以直接通過P值與預設的0.05進行比較,來判定對應的解釋變量的顯著性,檢驗的原假設是:該系數顯著為0;若P<0.05,則拒絕原假設,即對應的變量顯著不為0。(p值很高并不一定代表特征值和輸出沒有線性關系;它只表明有其他特征存在的時候,這個特征對輸出變量不提供新的信息)
可以看到Mileage、Cylinder、Doors都可以認為是在P為0.05的水平下顯著不為0,通過顯著性檢驗;Cruise的P值為0.20025,不顯著。- Multiple R-squared和Adjusted R-squared
這兩個值,即R^{2},常稱之為“擬合優度”和“修正的擬合優度”,指回歸方程對樣本的擬合程度幾何,這里可以看到,修正的擬合優 度=0.9104,表示擬合程度良好,這個值當然是越高越好。- F-statistic
F統計量,也成為F檢驗,常常用于判斷方程整體的顯著性檢驗,其值越大越顯著;其P值為p-value: < 2.2e-16,顯然是<0.05的,可以認為方程在P=0.05的水平上還是通過顯著性檢驗的。
注意到:Coefficients: (1 not defined because of singularities)
由于潛在的依賴關系導致有1個特征對輸出的作用無法和其他特征分清楚,這種現象:混疊(aliasing)。
使用alias函數顯示從模型中去除的特征。
alias(cars_model1)
cars_model2 <- lm(Price~.-Saturn,data=cars_train) #去掉Saturn行
summary(cars_model2)
發現有問題的是Saturn(代表車輛是否是土星)。
1)殘差分析
殘差:模型對特定觀測數據產生的誤差,輸出的實際值和預測值之間的差異???? = ???? ? ????^。
通常會把殘差從小到大排序,較為理想的是0中位數和較小的四分位數值。
可以看到二手車的均價在21k,但是50%的數在±1.6k左右,這個結果較為合理。
殘差圖
R語言里的模型診斷圖(Residuals vs Fitted,Normal QQ , Scale-Location ,Residuals Leverage)
?分位圖(Quantile-Quantile plot, Q-Q plot):
通過比較分位數(quantile)的值來比較兩種分布。
在理想線性模型中有五大假設。其中之一便是殘差應該是一個正態分布,與估計值無關。如果殘差還和估計值有關,那就說明模型仍然有值得去改進的地方,當然,這樣的模型準確程度也就大打折扣。
QQ-plot用來檢測其殘差是否是正態分布的。對應于正態分布的QQ圖,就是由標準正態分布的分位數為橫坐標,樣本值為縱坐標的散點圖;橫坐標也可以是1,2,3,表示幾個標準差。
# 殘差
machine_residuals <- machine_model1$residuals
# lm線性方程擬合值
machine_fitted_values <- machine_model1$fitted.values
# 179個訓練集的序列號
machine_train_ids <- rownames(machine_train)
#離群殘差點:大于150的,放入序列號,否則為空;abs()取絕對值
machine_large_residuals <- ifelse(abs(machine_residuals) > 150,machine_train_ids,'')
p1 <- qplot(machine_fitted_values,machine_residuals) #橫坐標是擬合值,縱坐標是殘差
p1 <- p1 + ggtitle("Residual Plot for CPU Data Set") #標題
p1 <- p1 + theme(plot.title = element_text(lineheight=.8, face="bold")) #字體
p1 <- p1 + xlab("Fitted Values") #橫坐標名稱
p1 <- p1 + ylab("Residuals") #縱坐標名稱
p1 <- p1 + geom_text(size = 4, hjust=-0.15, vjust=0.1, aes(label=machine_large_residuals)) # 標記離群殘差點
p1
cars_residuals <- cars_model1$residuals
cars_fitted_values <- cars_model1$fitted.values
cars_train_ids <- rownames(cars_train)
cars_large_residuals <- ifelse(abs(cars_residuals) > 9500,cars_train_ids,'')
p2 <- qplot(cars_fitted_values,cars_residuals)
p2 <- p2 + ggtitle("Residual Plot for Cars Data Set")
p2 <- p2 + theme(plot.title = element_text(lineheight=.8, face="bold"))
p2 <- p2 + xlab("Fitted Values")
p2 <- p2 + ylab("Residuals")
p2 <- p2 + geom_text(size = 4, hjust=-0.15, vjust=0.1, aes(label=cars_large_residuals))
p2
#par(mfrow=c(2,1)) #畫布布局,兩行一列
par(mar=c(1,1,1,1)) #設置圖形的邊界,下,左,上,右
# qqnorm生成y中值的正常QQ圖
qqnorm(machine_residuals, main = "Normal Q-Q Plot for CPU data set")
# qqline函數用于繪制QQ圖的近似擬合直線,其解析式a是正態分布的標準差,截距b為均值
qqline(machine_residuals)
qqnorm(cars_residuals, main = "Normal Q-Q Plot for Cars data set")
qqline(cars_residuals)
2)線性回歸的性能衡量指標
?F統計量:來源于檢查兩個(正態)分布的方差之間是否存在統計顯著性的F檢驗。
檢驗只有截距的模型的殘差方差和現有訓練模型的殘差方差的顯著性差異。
anova()函數代表方差分析(analysis of variance)
# 概率分布的T分布,調用t分布P值函數pt()即可獲得該統計量的P值。
# 參數:q:t統計量的值,df:自由度,lower.tail:確定計算概率的方向。如果lower.tail=T,計算Pr(X ≤x),反之,計算Pr(X >x)。
(q <- 5.210e-02 / 1.885e-02)
pt(q, df = 172, lower.tail = F) * 2
# 只有截距的模型
machine_model_null = lm(PRP~1,data=machine_train)
anova(machine_model_null, machine_model1)
n_machine <- nrow(machine_train)
k_machine <- length(machine_model1$coefficients) -1 #6列變量
# 殘差標準差RSE
sqrt(sum(machine_model1$residuals ^ 2) / (n_machine - k_machine - 1))
n_cars <- nrow(cars_train)
k_cars <- length(cars_model1$coefficients) -1
sqrt(sum(cars_model1$residuals ^ 2) / (n_cars - k_cars - 1))
mean(machine_train$PRP)
mean(cars_train$Price)
# 計算R^2
compute_rsquared <- function(x,y) {
rss <- sum((x-y)^2)
tss <- sum((y-mean(y))^2)
return(1-(rss/tss))
}
compute_rsquared(machine_model1$fitted.values,machine_train$PRP)
compute_rsquared(cars_model2$fitted.values,cars_train$Price)
3)比較不同的回歸模型
?如何比較兩個輸入特征數量不相同的回歸模型?
一個回歸模型是??1個特征數量,另一個回歸模型是??2個特征數量
兩個模型該如何比較??^2?
調整后的adjusted ??^2
compute_adjusted_rsquared <- function(x,y,p) {
n <- length(y)
r2 <- compute_rsquared(x,y)
return(1 - ((1 - r2) * (n-1)/(n-p-1)))
}
compute_adjusted_rsquared(machine_model1$fitted.values,machine_train$PRP,k_machine)
compute_adjusted_rsquared(cars_model2$fitted.values,cars_train$Price,k_cars)
4)在測試集上的性能
?在訓練集和測試集都需要去觀察模型的性能
用訓練集和測試集去計算性能(均方差)
函數predict
#創建一個函數,來計算通過模型得到的結果和實際結果之間的均方差
compute_mse <- function(predictions, actual) {
mean((predictions-actual)^2) }
machine_model1_predictions <- predict(machine_model1, machine_test)
compute_mse(machine_model1$fitted.values, machine_train$PRP)
compute_mse(machine_model1_predictions, machine_test$PRP)
cars_model2_predictions <- predict(cars_model2, cars_test)
compute_mse(cars_model2$fitted.values, cars_train$Price)
compute_mse(cars_model2_predictions, cars_test$Price)
5.線性回歸的問題
1)多重共線性
是指線性回歸模型中解釋變量之間由于存在精確相關關系或高度相關關系而導致模型估計失真或難以估計。
多重共線性如何觀測到?
?可疑處一:
兩個高度共線性的特征具有較大的p值,但是如果去掉其中一個,另一個p值變小
?可疑處二:
某個系數出現不正常的符號,如:預測收入的模型,教育背景的系數是負數
處理辦法
?把兩個特征合并
?直接去除其中一個
多重共線性可以對線性模型中的每個輸入特征計算其方差膨脹因子(variance inflation factor, VIF)。
2.
VIF的計算步驟為:
1.用某特征作為輸出,其他作為輸入計算??2;
在R中可直接使用VIF函數:
#在R中可直接使用VIF函數
library(carData)
library("car")
vif(cars_model2)
#計算sedan的VIF,用擬合值和真實值作為輸入變量
sedan_model <- lm(sedan ~.-Price-Saturn, data=cars_train)
sedan_r2 <- compute_rsquared(sedan_model$fitted.values,cars_train$sedan)
1 - (1-sedan_r2)
如果vif的值超過4或者更大的特征就是可疑的;如果vif的值大于10就有多重共線性的極大可能性。
2)離群值
離群值可能由于測量誤差產生,沒有選對特征或創建了錯誤的種類導致。
?小心去除離群值
包含它們可能會產生顯著改變預測模型系數的效果
離群值一般通過殘差圖來看。殘差就是預測值和真實值之間的差異。殘差圖可以直接用plot畫出。
#離群值一般通過殘差圖來看。
plot(cars_model2)
#第200行的PRP的值很大,去掉這個離群點
machine_model2 <- lm(PRP~.,
data=machine_train[!(rownames(machine_train)) %in% c(200),])
summary(machine_model2)
machine_model2_predictions <- predict(machine_model2, machine_test)
compute_mse(machine_model2_predictions, machine_test$PRP)
說明:去掉離群點,model2計算出的MSE應該比model1的小。
3)特征選擇
實際環境中特征數量太多,在模型中選擇一個特征子集以構成一個帶有更少特征的新模型的過程。
前向選擇(forward selection)
逐步回歸(step regression),從一個沒有特征的空模型開始,接著進行??次(針對每個特征一次)簡單線性回歸并從中選最好的。
后向選擇(backward selection)
AIC指標:越小越好
AIC準則是由日本統計學家Akaike與1973年提出的,全稱是最小化信息量
準則(Akaike Information Criterion)。它是擬合精度和參數個數的加權函數:
AIC=2(模型參數的個數)-2ln(模型的極大似然函數)
#建立一個只有截距項的模型
machine_model_null = lm(PRP~1,data=machine_train)
machine_model1 <- lm(PRP~.,data=machine_train)
#采用向前選擇方式來進行特征選擇
machine_model3 <- step(machine_model_null,
scope = list(lower = machine_model_null,
upper=machine_model1),
direction = "forward")
cars_model_null <- lm(Price~1,data=cars_train)
cars_model2 <- lm(Price~.-Saturn,data=cars_train)
#采用向后選擇方式來進行特征選擇
cars_model3 <- step(cars_model2,
scope=list(lower=cars_model_null,
upper=cars_model2),
direction="backward")
#預測
machine_model3_predictions <- predict(machine_model3, machine_test)
#評價模型
compute_mse(machine_model3_predictions, machine_test$PRP)
cars_model3_predictions <- predict(cars_model3, cars_test)
compute_mse(cars_model3_predictions, cars_test$Price)
6.正則化與過擬合
過擬合
模型在理想情況下,應該是對訓練集和測試集都能擬合得比較好。如果模型只對訓練集擬合得很好,對測試集擬合得一般,那就說明存在過擬合得情況。模型的魯棒性較差,無法適應普片情況。
對過擬合和欠擬合進行直觀的理解:
如何避免過擬合呢?
(1)丟棄一些對最終預測結果影響不大的特征,具體哪些特征需要丟棄可以通過PCA算法來實現;
(2)使用正則化(regularization)技術,保留所有特征,但是減少特征前面的參數的大小, 具體就是修改線性回歸中的損失函數形式即可,嶺回歸以及Lasso回歸即如此。
對于一個一元線性回歸方程,系數的大小決定了信息含量的大小。那么正則化的思想就是降低這些系數的影響,以達到減少過擬合的情況。線性回歸的擬合好壞是根據MSE或者RSS(有時也叫SSE,MSE=RSS/n)大小來判斷的。越小的MSE或者RSS,代表擬合程度越好。在此判斷條件上在加上一個約束,即,要同時滿足RSS最小,同時參數值也最小。
嶺回歸(ridge regression):通過其約束條件引入偏誤但能有效第減少模型的方差。
如果??較大,就會把參數壓縮到0,欠擬合
如果??較小,就對過擬合沒有效果
如果?? = 0,就是普通的線性回歸
最小絕對值收縮和選擇算子(lasso):嶺回歸的一種替代正則化方法。
兩者區別:一個是取系數的平方求和,一個是取系數的絕對值求和。
所以,正則化的關鍵就是尋找合適的??。一般采用的是交叉驗證法來確定??。
在R中,可以使用glmnet包來實現嶺回歸和Lasso回歸。
glmnet是由斯坦福大學的統計學家們開發的一款R包,用于在傳統的廣義線性回歸模型的基礎上添加正則項,以有效解決過擬合的問題,支持線性回歸,邏輯回歸,泊松回歸,cox回歸等多種回歸模型。
glmet接受一個矩陣,每一行為一個觀測向量,每一列代表一個特征。y是響應變量。
alpha=0代表嶺回歸,alpha=1代表lasso回歸
alpah如果介于0和1之間,則代表既有嶺回歸又與lasso回歸的混合模型——彈性網絡,此時aplha代表混合比。
對于每種模型Glmnet都提供了glmnet用于擬合模型, cv.glmnet使用k折交叉驗證擬合模型, predict對數據進行預測(分類/回歸),coef用于提取指定lambda時特征的系數。
library(Matrix)
library(glmnet)
#使用model.matrix先來創建特征矩陣,同時確保各列都是數值型(邏輯型、數值型、因子等)
cars_train_mat <- model.matrix(Price~.-Saturn, cars_train)[,-1]
#給定lamda范圍,從10^8 到 10^-4,平均生成250個lamda
lambdas <- 10 ^ seq(8,-4,length=250)
#嶺回歸
cars_models_ridge= glmnet(cars_train_mat,cars_train$Price,
alpha=0,lambda=lambdas)
#lasso回歸
cars_models_lasso= glmnet(cars_train_mat,cars_train$Price,
alpha=1,lambda=lambdas)
cars_models_ridge
#選出第70個lambda
cars_models_ridge$lambda[70]
#選出第70個模型的系數
coef(cars_models_ridge)[,70]
#畫出250個模型的系數隨著lamda的變化而變化。橫坐標是lamda,縱坐標是各特征參數的取值
layout(matrix(c(1,2), 1, 2))
plot(cars_models_ridge, xvar = "lambda", main = "Coefficient Values vs. Log Lambda for Ridge Regression")
plot(cars_models_lasso, xvar = "lambda", main = "Coefficient Values vs. Log Lambda for Lasso")
可看到,隨著??的增大,各特征的系數被壓縮到了0。此時會導致欠擬合。那么??選多大合適呢?可以使用交叉檢驗法來選擇合適的??。
R中,可以直接使用cv.glmnet 來幫忙選擇最優的??。
ridge.cv <- cv.glmnet(cars_train_mat,cars_train$Price,
alpha=0,lambda=lambdas)
lambda_ridge <- ridge.cv$lambda.min
lambda_ridge
lasso.cv <- cv.glmnet(cars_train_mat,cars_train$Price,
alpha=1,lambda=lambdas)
lambda_lasso <- lasso.cv$lambda.min
lambda_lasso
#x軸代表經過log以后的lambda值,y軸代表模型的誤差,cv.glmnet會自動選擇使誤差最小的lambda(左側的虛線)
layout(matrix(c(1,2), 1, 2))
plot(ridge.cv, col = gray.colors(1))
title("Ridge Regression", line = +2)
plot(lasso.cv, col = gray.colors(1))
title("Lasso", line = +2)
同時也可以使用coef提取每一個特征在指定lambda下的系數:
#提取lambda = 9.201432時的特征系數,·代表經過L1正則化后這些特征已經被消掉了。
coef.apprx = coef(ridge.cv, s = 9.201432)
coef.apprx
有了??后,就可以來進行預測。
#輸出新數據的預測值,type參數允許選擇預測的類型并提供預測值,newx代表要預測的數據。
predict(cars_models_lasso, type="coefficients", s = lambda_lasso)
cars_test_mat <- model.matrix(Price~.-Saturn, cars_test)[,-1]
cars_ridge_predictions <- predict(cars_models_ridge, s = lambda_ridge, newx = cars_test_mat)
compute_mse(cars_ridge_predictions, cars_test$Price)
cars_lasso_predictions <- predict(cars_models_lasso, s = lambda_lasso, newx = cars_test_mat)
compute_mse(cars_lasso_predictions, cars_test$Price)
【完整步驟】從機器學習的角度來做線性回歸:
第一步:數據預處理:
#二手車交易數據
data(cars)
#進行數據預處理,查看一下各特征之間的相關系數矩陣,判斷相關關系
cars_cor <- cor(cars[-1]) #去掉第一列后,進行相關系數統計
findCorrelation(cars_cor)
findCorrelation(cars_cor, cutoff = 0.75)
#通過查看相關矩陣,發現在Doors和coupe之間存在較高的相關性:如果是coupe很有可能是2雙門,否則是4門
cor(cars$Doors,cars$coupe)
table(cars$coupe,cars$Doors) #用交叉列聯表來查看相關性
#查找完全線性組合,發現15列和18列存在完全線性組合
findLinearCombos(cars)
#根據建議,去掉具有完全線性組合的特征
cars <- cars[,c(-15,-18)]
第二步:劃分訓練集和測試集
#劃分訓練集和測試集,同時標注特征數據和標簽數據
cars_sampling_vector <- createDataPartition(cars$Price, p=0.85, list = FALSE)
cars_train <- cars[cars_sampling_vector,]
cars_train_features <- cars[,-1]
cars_train_labels <- cars$Price[cars_sampling_vector]
cars_test <- cars[-cars_sampling_vector,]
cars_test_labels <- cars$Price[-cars_sampling_vector]
第三步:訓練模型:
#根據訓練集建立模型
cars_model1 <- lm(Price~.,data=cars_train)
第四步:模型優化
模型評估(包括:殘差分析、顯著性檢驗等。其中顯著性檢驗又包括線性關系檢驗和回歸系數檢驗)
summary(cars_model1)
#混疊(aliasing),Coefficients(1 not defined because of singularities),Saturn行數據都為NA
#移除特征再進行回歸
cars_model2 <- lm(Price~.-Saturn,data=cars_train)
summary(cars_model2)
#殘差分析
cars_residuals <- cars_model2$residuals
qqnorm(cars_residuals, main = "Normal Q-Q Plot for Cars data set")
qqline(cars_residuals)
#顯著性檢驗
#方差分析
cars_model_null = lm(Price~1,data=cars_train)
anova(cars_model_null, cars_model2)
#計算R^2
compute_rsquared <- function(x,y) {
rss <- sum((x-y)^2)
tss <- sum((y-mean(y))^2)
return(1-(rss/tss))
}
compute_rsquared(cars_model2$fitted.values,cars_train$Price)
#調整后的adjusted ??^2
compute_adjusted_rsquared <- function(x,y,p) {
n <- length(y)
r2 <- compute_rsquared(x,y)
return(1 - ((1 - r2) * (n-1)/(n-p-1)))
}
k_cars <- length(cars_model2$coefficients) -1
compute_adjusted_rsquared(cars_model2$fitted.values,cars_train$Price,k_cars)
第五步:預測
cars_model2_predictions <- predict(cars_model2, cars_test)
第六步:模型評價
通過分別計算訓練集上的模型和測試集上的模型得到結果與實際結果的差值比較來判斷模型的好壞(MSE)。
越小的MSE或者RSS,代表擬合程度越好。
#創建一個函數,來計算通過模型得到的結果和實際結果直接的均方差
compute_mse <- function(predictions, actual) {
mean((predictions-actual)^2)
}
compute_mse(cars_model2$fitted.values, cars_train$Price)
compute_mse(cars_model2_predictions, cars_test$Price)