Most Important Predictors of Online Help Seeking
Qiang Hao
Sunday, August 23, 2015
Synopsis
The following R codes serve the purpose of finding the most important predictors of three types of online help seeking: online searching, asking teachers online for help, and asking peers online for help.
Load Analytics Data
Load the necessary libraries before data analysis.
Load the analytics data.
Online Searching
The selection of most important predictors for online searhcing follows the following procedures: 1. Determine the number of predictors of the best model - based on cross validation 2. Estimate coefficients of predictors of the best model - based on full data set
# seed
set.seed(1)
# prepare predict function
predict.regsubsets = function(object, newdata, id, ...) {
form = as.formula(object$call[[2]])
mat = model.matrix(form, newdata)
coefi = coef(object, id = id)
xvars = names(coefi)
mat[,xvars]%*%coefi
}
# get a new data frame
newdata <- data.frame(data$OnlineS, data$Level, data$Score, data$Gender, data$Age, data$FAC1_1, data$FAC2_1, data$FAC3_1, data$FAC4_1)
# give columns meaningful names
names(newdata) <- c("Online_searching", "Learning_proficiency_level", "Academic_performance", "Gender", "Age", "Interest", "Prior_knowledge", "Epistemological_belief", "Problem_difficulty")
# get predictor numbers
pred.number <- dim(newdata)[2] - 1
# 10 fold cross validation
k = 10
# loop for 1000 times
# In every loop: identify the model with smallest test error
# In every loop: save the number of the predictors of the best model in a vector
lowest.error.factor.number <- integer()
for (t in 1:1000) {
folds = sample(1:k, nrow(newdata), replace = T)
cv.errors = matrix(NA, k, pred.number, dimnames = list(NULL, paste(1:pred.number)))
for (j in 1:k) {
best.fit = regsubsets(Online_searching~., data = newdata[folds != j,], nvmax = pred.number)
for (i in 1:pred.number) {
pred = predict(best.fit, newdata[folds == j,], id = i)
cv.errors[j, i] = mean((newdata$Online_searching[folds == j] - pred)^2)
}
}
mean.cv.errors = apply(cv.errors, 2, mean)
lowest.error.factor.number[t] <- which(mean.cv.errors == min(mean.cv.errors))
}
# make a table summary of for the number of predictors of best models
summary <- table(lowest.error.factor.number)
summary## lowest.error.factor.number
## 4 5 6
## 634 358 8barplot(summary,
main="Number of Predictors of Selected Best Models",
xlab="Number of Predictors",
ylab="Number of Models",
col = "cyan4")
# predictor selection on whole data
column.number <- which(summary == max(summary))
biggest.number <- as.integer(names(summary)[column.number])
reg.best = regsubsets(Online_searching~., data = newdata, nvmax = pred.number)
coef(reg.best, biggest.number)## (Intercept) Learning_proficiency_level
## 2.8780 0.5397
## Academic_performance Epistemological_belief
## 0.1485 0.3493
## Problem_difficulty
## 0.2014The regression model with only the selected predictors is as the following:
model <- lm(Online_searching ~
Learning_proficiency_level +
Academic_performance +
Epistemological_belief +
Problem_difficulty, data = newdata)
summary(model)##
## Call:
## lm(formula = Online_searching ~ Learning_proficiency_level +
## Academic_performance + Epistemological_belief + Problem_difficulty,
## data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.943 -0.474 0.064 0.502 1.483
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.8780 0.0572 50.28 < 2e-16 ***
## Learning_proficiency_level 0.5397 0.1278 4.22 3.7e-05 ***
## Academic_performance 0.1485 0.0517 2.87 0.00452 **
## Epistemological_belief 0.3493 0.0596 5.87 1.9e-08 ***
## Problem_difficulty 0.2014 0.0597 3.37 0.00089 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.721 on 194 degrees of freedom
## Multiple R-squared: 0.299, Adjusted R-squared: 0.285
## F-statistic: 20.7 on 4 and 194 DF, p-value: 3.26e-14Asking Teachers Online for Help
The selection of most important predictors for asking teachers online for help follows the same procedures as predictor selection of online searching.
# seed
set.seed(2)
# get a new data frame
newdata <- data.frame(data$OnlineE, data$Level, data$Score, data$Gender, data$Age, data$FAC1_1, data$FAC2_1, data$FAC3_1, data$FAC4_1)
# give columns meaningful names
names(newdata) <- c("Asking_teachers", "Learning_proficiency_level", "Academic_performance", "Gender", "Age", "Interest", "Prior_knowledge", "Epistemological_belief", "Problem_difficulty")
# get predictor numbers
pred.number <- dim(newdata)[2] - 1
# 10 fold cross validation
k = 10
# loop for 1000 times
# In every loop: identify the model with smallest test error
# In every loop: save the number of the predictors of the best model in a vector
lowest.error.factor.number <- integer()
for (t in 1:1000) {
folds = sample(1:k, nrow(newdata), replace = T)
cv.errors = matrix(NA, k, pred.number, dimnames = list(NULL, paste(1:pred.number)))
for (j in 1:k) {
best.fit = regsubsets(Asking_teachers~., data = newdata[folds != j,], nvmax = pred.number)
for (i in 1:pred.number) {
pred = predict(best.fit, newdata[folds == j,], id = i)
cv.errors[j, i] = mean((newdata$Asking_teachers[folds == j] - pred)^2)
}
}
mean.cv.errors = apply(cv.errors, 2, mean)
lowest.error.factor.number[t] <- which(mean.cv.errors == min(mean.cv.errors))
}
# make a table summary of for the number of predictors of best models
summary <- table(lowest.error.factor.number)
summary## lowest.error.factor.number
## 1 5 6
## 273 709 18barplot(summary,
main="Number of Predictors of Selected Best Models",
xlab="Number of Predictors",
ylab="Number of Models",
col = "darkolivegreen2")
# predictor selection on whole data
column.number <- which(summary == max(summary))
biggest.number <- as.integer(names(summary)[column.number])
reg.best = regsubsets(Asking_teachers~., data = newdata, nvmax = pred.number)
coef(reg.best, biggest.number)## (Intercept) Learning_proficiency_level
## 1.77187 0.25850
## Academic_performance Gender
## 0.09927 0.21212
## Epistemological_belief Problem_difficulty
## -0.10085 0.14553The regression model with only the selected predictors is as the following:
model <- lm(Asking_teachers ~
Learning_proficiency_level +
Academic_performance +
Gender +
Epistemological_belief +
Problem_difficulty, data = newdata)
summary(model)##
## Call:
## lm(formula = Asking_teachers ~ Learning_proficiency_level + Academic_performance +
## Gender + Epistemological_belief + Problem_difficulty, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.6487 -0.5597 -0.0235 0.6164 2.0417
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.7719 0.1827 9.70 <2e-16 ***
## Learning_proficiency_level 0.2585 0.1400 1.85 0.066 .
## Academic_performance 0.0993 0.0561 1.77 0.078 .
## Gender 0.2121 0.1392 1.52 0.129
## Epistemological_belief -0.1008 0.0646 -1.56 0.120
## Problem_difficulty 0.1455 0.0651 2.24 0.027 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.782 on 193 degrees of freedom
## Multiple R-squared: 0.0827, Adjusted R-squared: 0.0589
## F-statistic: 3.48 on 5 and 193 DF, p-value: 0.00492Asking Peers Online for Help
The selection of most important predictors for asking peers online for help follows the same procedures as predictor selection of online searching.
# seed
set.seed(3)
# get a new data frame
newdata <- data.frame(data$OnlineP, data$Level, data$Score, data$Gender, data$Age, data$FAC1_1, data$FAC2_1, data$FAC3_1, data$FAC4_1)
# give columns meaningful names
names(newdata) <- c("Asking_peers", "Learning_proficiency_level", "Academic_performance", "Gender", "Age", "Interest", "Prior_knowledge", "Epistemological_belief", "Problem_difficulty")
# get predictor numbers
pred.number <- dim(newdata)[2] - 1
# 10 fold cross validation
k = 10
# loop for 1000 times
# In every loop: identify the model with smallest test error
# In every loop: save the number of the predictors of the best model in a vector
lowest.error.factor.number <- integer()
for (t in 1:1000) {
folds = sample(1:k, nrow(newdata), replace = T)
cv.errors = matrix(NA, k, pred.number, dimnames = list(NULL, paste(1:pred.number)))
for (j in 1:k) {
best.fit = regsubsets(Asking_peers~., data = newdata[folds != j,], nvmax = pred.number)
for (i in 1:pred.number) {
pred = predict(best.fit, newdata[folds == j,], id = i)
cv.errors[j, i] = mean((newdata$Asking_peers[folds == j] - pred)^2)
}
}
mean.cv.errors = apply(cv.errors, 2, mean)
lowest.error.factor.number[t] <- which(mean.cv.errors == min(mean.cv.errors))
}
# make a table summary of for the number of predictors of best models
summary <- table(lowest.error.factor.number)
summary## lowest.error.factor.number
## 2 6 7 8
## 811 93 23 73barplot(summary,
main="Number of Predictors of Selected Best Models",
xlab="Number of Predictors",
ylab="Number of Models",
col = "coral1")
# predictor selection on whole data
column.number <- which(summary == max(summary))
biggest.number <- as.integer(names(summary)[column.number])
reg.best = regsubsets(Asking_peers~., data = newdata, nvmax = pred.number)
coef(reg.best, biggest.number)## (Intercept) Interest Problem_difficulty
## 2.6116 -0.2621 0.3506The regression model with only the selected predictors is as the following:
model <- lm(Asking_peers ~
Interest +
Problem_difficulty, data = newdata)
summary(model)##
## Call:
## lm(formula = Asking_peers ~ Interest + Problem_difficulty, data = newdata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.806 -0.621 0.114 0.652 1.719
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.6116 0.0567 46.08 < 2e-16 ***
## Interest -0.2621 0.0625 -4.19 4.2e-05 ***
## Problem_difficulty 0.3506 0.0652 5.38 2.1e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.799 on 196 degrees of freedom
## Multiple R-squared: 0.192, Adjusted R-squared: 0.184
## F-statistic: 23.3 on 2 and 196 DF, p-value: 8.21e-10