由于在之前有专门的文章介绍线性回归,因此这里不在赘述。
在这里稍微提一句:R语言是一种向量语言,为了获得更好的性能,建议使用向量运算。因此一般情况下,for循环可以被一些映射函数所替代。常见的映射函数包括基础包里的apply()、lapply()、sapply()、vapply()等,或者使用purrr包中的map系列函数。 关于这几种函数的具体用法,参考如下几篇文章:
R语言apply系列介绍
R语言中的purrr:map()函数
下面我们从机器学习的角度来做一下线性回归:
第一步:数据预处理:
#二手车交易数据
data(cars)
#进行数据预处理,查看一下各特征之间的相关系数矩阵,判断相关关系
#我们通过查看相关矩阵,发现在Doors和coupe之间存在较高的相关性:如果是coupe很有可能是2双门,否则是4门
cars_cor <- cor(cars[-1]) #去掉第一列后,进行相关系数统计
findCorrelation(cars_cor)
findCorrelation(cars_cor, cutoff = 0.75)
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)
Call:
lm(formula = Price ~ ., data = cars_train)
Residuals:
Min 1Q Median 3Q Max
-9566.3 -1561.1 164.3 1487.1 13269.4
Coefficients: (1 not defined because of singularities)
Estimate Std. Error t value Pr(>|t|)
(Intercept) -8.611e+02 1.120e+03 -0.769 0.44232
Mileage -1.845e-01 1.379e-02 -13.377 < 2e-16 ***
Cylinder 3.576e+03 1.256e+02 28.471 < 2e-16 ***
Doors 1.565e+03 2.824e+02 5.541 4.33e-08 ***
Cruise 2.826e+02 3.229e+02 0.875 0.38174
Sound 5.358e+02 2.546e+02 2.104 0.03572 *
Leather 7.194e+02 2.721e+02 2.644 0.00839 **
Buick 1.097e+03 6.063e+02 1.810 0.07082 .
Cadillac 1.385e+04 6.801e+02 20.360 < 2e-16 ***
Chevy -5.074e+02 4.822e+02 -1.052 0.29306
Pontiac -1.164e+03 5.393e+02 -2.159 0.03122 *
Saab 1.240e+04 6.023e+02 20.595 < 2e-16 ***
Saturn NA NA NA NA
convertible 1.133e+04 5.938e+02 19.078 < 2e-16 ***
hatchback -6.202e+03 6.701e+02 -9.255 < 2e-16 ***
sedan -4.430e+03 4.820e+02 -9.192 < 2e-16 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2897 on 669 degrees of freedom
Multiple R-squared: 0.9177, Adjusted R-squared: 0.916
F-statistic: 533.1 on 14 and 669 DF, p-value: < 2.2e-16
在R中,关于线性回归函数的结果解读,可以参考这篇文章,这里不细诉。:
R语言-summary()函数的用法解读
我们发现在Coefficients后有这么一段话: 1 not defined because of singularities
同时,Saturn这一行的数据都为NA。这表示由于潜在的依赖关系导致有1个特征对输出的作用无法和其他特征分清楚
这种现象叫混叠 (aliasing)。导致此原因的情况有很多。我们需要具体分析。一般来说,最好先将此特征移除后再进行回归
cars_model2 <- lm(Price~.-Saturn,data=cars_train)
summary(cars_model2)
模型评估中的残差分析、显著性分析等之前有讲过,这里不再赘述。我们来进行模型预测。
第五步:预测
cars_model2_predictions <- predict(cars_model2, cars_test)
第六步:模型评价
我们可以通过分别计算训练集上的模型和测试集上的模型得到结果与实际结果的差值比较来判断模型的好坏(MSE)
#创建一个函数,来计算通过模型得到的结果和实际结果直接的均方差
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)
另外我们来探讨一下线性回归中的常见几个问题:
1)多重共线性问题
如何发现多重共线性?
判断方式一:两个高度共线性的特征具有较大的p值;但是如果去掉其中一个,另一个p值变小;
判断方式二:某个系数出现不正常的符号(与预期相反)
判断方式三:可以对线性模型中的每个输入特征计算其方差膨胀因子(VIF)。如果vif的值超过4或者更大的特征就是可疑的,如果vif的值大于10就有多重共线性的极大可能性。VIF的计算步骤为:
1)用某特征作为输出,其他作为输入计算;
2)
在R中可直接使用VIF函数:
> library("car")
> vif(cars_model2)
Mileage Cylinder Doors Cruise Sound Leather Buick
1.015273 2.471937 4.557266 1.574238 1.150307 1.198939 2.647783
Cadillac Chevy Pontiac Saab convertible hatchback sedan
3.550876 4.555824 3.540746 3.598162 1.656380 2.434106 4.454989
2)离群值
离群值一般通过残差图来看。残差就是预测值和真实值之间的差异。残差图可以直接用plot画出。
plot(cars_model2)
再来看一下特征选择。在线性回归中我们提到了,特征选择包括了:向前选择、向后剔除、逐步回归、最优子集等。在R中,可以使用step函数来进行,使用AIC来作为选择标准。一般来说AIC越小越好。
#建立一个只有截距项的模型
machine_model_null = lm(PRP~1,data=machine_train)
#采用向前选择方式来进行特征选择
machine_model3 <- step(machine_model_null,
scope = list(lower = machine_model_null, upper=machine_model1),
direction = "forward")
#预测
machine_model3_predictions <- predict(machine_model3, machine_test)
#评价模型
compute_mse(machine_model3_predictions, machine_test$PRP)
#建立包含所有系数的模型
cars_model2 <- lm(Price~.-Saturn,data=cars_train)
#采用向后剔除方式来进行特征选择
cars_model3 <- step(cars_model2,
scope=list(lower=cars_model_null,upper=cars_model2),
direction="backward")
#预测
cars_model3_predictions <- predict(cars_model3, cars_test)
#评价模型
compute_mse(cars_model3_predictions, cars_test$Price)
最后来看一下本次内容的重点——过拟合
我们的模型在理想情况下,应该是对训练集和测试集都能拟合得比较好。如果模型只对训练集拟合得很好,对测试集拟合得一般,那就说明存在过拟合得情况。模型的鲁棒性较差,无法适应普片情况。
我们可以通过下图对过拟合和欠拟合进行直观的理解:
如何避免过拟合呢?
(1)丢弃一些对我们最终预测结果影响不大的特征,具体哪 些特征需要丢弃可以通过PCA算法来实现;
(2)使用正则化技术,保留所有特征,但是减少特征前面的参数的大小, 具体就是修改线性回归中的损失函数形式即可,岭回归以及Lasso回归就是这么做的。
从某种意义上来说,对于一条直线,斜率越大,代表的信息含量越大。例如,对于一根水平直线,无论x怎么变化,y都不变,证明x的变化无法引起y的变化,那么x跟y就是不相关的。如果一条斜线非常倾斜(趋于90度),那么x只要发生一点点改变 ,都会引发y值的巨大变化。所以我们才说,对于一个一元线性回归方程,系数的大小决定了信息含量的大小。那么正则化的思想就是降低这些系数的影响,以达到减少过拟合的情况。
我们前面讲过,对于线性回归的拟合好坏是根据MSE或者RSS(有时也叫SSE,MSE=RSS/n)大小来判断的。越小的MSE或者RSS,代表拟合程度越好。我们可以在此判断条件上在加上一个约束,即,我要同时满足RSS最小,同时参数值也最小。用公式来表示就是:
(岭回归)
或者:
(Lasso)
我们可以发现,岭回归和Lasso的区别就是在于一个是取系数的平方,然后求和,一个是取系数的绝对值然后求和。两者的目的都是为了让系数为正,避免因为符号问题产生相互抵消问题。
称为元参数,如果较大,就会把参数压缩到0,欠拟合;如果较小,就对过拟合没有效果。如果 = 0,就是普通的线性回归。
所以,正则化的关键就是寻找合适的。一般我们采用的是交叉验证法来确定。
交叉检验法:
为了对模型进行评估,我们需要用一个“测试集” (testing set)来测试学习器对新样本的判别能力。我们希望测试集的数据是训练集没有的,这样我们才能体现模型的泛化能力。而且测试集数据越大,越能检验模型的泛化能力。
而当我们数据比较小时,无法获得较大的测试集,此时最好使用交叉验证法
先将数据集D分为k个大小相似的互斥子集,即
每次用 − 1 个子集的并集作为训练集,余下的子集作为 测试集;获得 组训练/测试集,从而可进行 次训练和测试,最终返回的是这 个测试结果的均值。
留一法:
留一法是交叉检验的特例。就是每次只留下一条观测数据作为测试数据,其余的全部作为训练数据。那么我们就可以得到n(n=数据的总条目数)次交叉检验的结果。留一法不受随机样本的影响,评估结果一般来说较为准确。但是如果数据量较大时,会需要进行多次运算,效率较低。
还有P次k折交叉检验。因为我们将数据分成k份的时候,会有多种分法。我每次随机选择k份,总共选择p次,那么就会得到p*k次检验结果。将这些检验结果取平均,也能获得比较好的一个检测结果。
data("swiss")
#留出法(也即不用交叉检验,直接划分训练集和测试集)
training.samples <- createDataPartition(swiss$Fertility, p=0.8, list=FALSE)
train.data <- swiss[training.samples,]
test.data <- swiss[-training.samples,]
#建立模型
model <- lm(Fertility ~., data = train.data)
#预测
predictions <- predict(model,test.data)
#评价模型
data.frame( R2 = R2(predictions, test.data$Fertility),
RMSE = RMSE(predictions, test.data$Fertility),
MAE = MAE(predictions, test.data$Fertility))
#留一法:
train.control <- trainControl(method = "LOOCV")
model <- train(Fertility ~., data = train.data,method = "lm",trControl = train.control)
print(model)
#K折交叉检验:
train.control <- trainControl(method = "cv",number=10)
model <- train(Fertility ~., data = train.data,method = "lm",trControl = train.control)
print(model)
#P次K折交叉检验
train.control <- trainControl(method = "repeatedcv",number=10, repeats = 3)
model <- train(Fertility ~., data = train.data,method = "lm",trControl = train.control)
print(model)
回到我们之前谈到的岭回归和Lasso回归。在R中,可以使用glmnet包来实现。glmnet是由斯坦福大学的统计学家们开发的一款R包,用于在传统的广义线性回归模型的基础上添加正则项,以有效解决过拟合的问题,支持线性回归,逻辑回归,泊松回归,cox回归等多种回归模型。
glmet接受一个矩阵,每一行为一个观测向量,每一列代表一个特征。y是响应变量。
alpha=0代表岭回归,alpha=1代表lasso回归
alpah如果介于0和1之间,则代表既有岭回归又与lasso回归的混合模型——弹性网络,此时aplha代表混合比。
对于每种模型Glmnet都提供了glmnet用于拟合模型, cv.glmnet使用k折交叉验证拟合模型, predict对数据进行预测(分类/回归),coef用于提取指定lambda时特征的系数。
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)
#逻辑回归
cars_models_lasso= glmnet(cars_train_mat,cars_train$Price,alpha=1,lambda=lambdas)
#选出第70个lambda
cars_models_ridge$lambda[70]
#选出第70个模型的系数
coef(cars_models_ridge)[,70]
#画出250个模型的系数随着lamda的变化而变化。横坐标是lamda,纵坐标是各特征参数的取值
layout(matrix(c(1,2), 2, 1))
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)
plot(lasso.cv)
同时我们也可以使用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)
参考资料:
glmnet
机器学习中的损失函数分析