Step 1: collecting data

The data has been collected and ready to be analyed.

launch <- read.csv("http://www.sci.csueastbay.edu/~esuess/classes/Statistics_6620/Presentations/ml10/challenger.csv")

Step 2: exploring and preparing data

# exammine the launch data
str(launch)
'data.frame':   23 obs. of  4 variables:
 $ distress_ct         : int  0 1 0 0 0 0 0 0 1 1 ...
 $ temperature         : int  66 70 69 68 67 72 73 70 57 63 ...
 $ field_check_pressure: int  50 50 50 50 50 50 100 100 200 200 ...
 $ flight_num          : int  1 2 3 4 5 6 7 8 9 10 ...

First recode the distress_ct variable into 0 and 1, making 1 to represent at least one failure during a launch.

launch$distress_ct = ifelse(launch$distress_ct<1,0,1)
launch$distress_ct
 [1] 0 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 0 1

Set up trainning and test data sets

indx = sample(1:nrow(launch), as.integer(0.9*nrow(launch)))
indx # ramdomize rows, save 90% of data into index
 [1]  7 11 22 21  3 18 17 14 16 20  5  1  6  2 12 19 10  4 23 15
launch_train = launch[indx,]
launch_test = launch[-indx,]
launch_train_labels = launch[indx,1] # label the first column: distress_ct is the chategorial dependent variable
launch_test_labels = launch[-indx,1] 

Check if there’s any missing values:

library(Amelia)
Loading required package: Rcpp
package ‘Rcpp’ was built under R version 3.3.2## 
## Amelia II: Multiple Imputation
## (Version 1.7.4, built: 2015-12-05)
## Copyright (C) 2005-2017 James Honaker, Gary King and Matthew Blackwell
## Refer to http://gking.harvard.edu/amelia/ for more information
## 
missmap(launch, main = "Missing values vs observed")

Number of missing values in each column

sapply(launch,function(x) sum(is.na(x)))
         distress_ct          temperature field_check_pressure 
                   0                    0                    0 
          flight_num 
                   0 

Number of unique values in each column

sapply(launch, function(x) length(unique(x)))
         distress_ct          temperature field_check_pressure 
                   3                   16                    3 
          flight_num 
                  23 

Step 3: training a model on the data

fit the logistic regression model, with all predictor variables

model <- glm(distress_ct ~.,family=binomial(link='logit'),data=launch_train)
model

Call:  glm(formula = distress_ct ~ ., family = binomial(link = "logit"), 
    data = launch_train)

Coefficients:
         (Intercept)           temperature  field_check_pressure  
           11.307353             -0.196882              0.007464  
          flight_num  
            0.017586  

Degrees of Freedom: 19 Total (i.e. Null);  16 Residual
Null Deviance:      24.43 
Residual Deviance: 17.62    AIC: 25.62
summary(model)

Call:
glm(formula = distress_ct ~ ., family = binomial(link = "logit"), 
    data = launch_train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.1239  -0.6218  -0.4997   0.4215   2.0906  

Coefficients:
                      Estimate Std. Error z value Pr(>|z|)  
(Intercept)          11.307353   7.567090   1.494   0.1351  
temperature          -0.196882   0.108010  -1.823   0.0683 .
field_check_pressure  0.007464   0.017755   0.420   0.6742  
flight_num            0.017586   0.182003   0.097   0.9230  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 24.435  on 19  degrees of freedom
Residual deviance: 17.617  on 16  degrees of freedom
AIC: 25.617

Number of Fisher Scoring iterations: 4
anova(model, test="Chisq")
Analysis of Deviance Table

Model: binomial, link: logit

Response: distress_ct

Terms added sequentially (first to last)

                     Df Deviance Resid. Df Resid. Dev Pr(>Chi)  
NULL                                    19     24.435           
temperature           1   5.7525        18     18.682  0.01646 *
field_check_pressure  1   1.0557        17     17.626  0.30421  
flight_num            1   0.0094        16     17.617  0.92263  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Only tempersture is significant from glm and anova output.

Drop the insignificant predictors, alpha = 0.10

model <- glm(distress_ct~temperature,family=binomial(link='logit'),data=launch_train)
model

Call:  glm(formula = distress_ct ~ temperature, family = binomial(link = "logit"), 
    data = launch_train)

Coefficients:
(Intercept)  temperature  
    12.4677      -0.1951  

Degrees of Freedom: 19 Total (i.e. Null);  18 Residual
Null Deviance:      24.43 
Residual Deviance: 18.68    AIC: 22.68
summary(model)

Call:
glm(formula = distress_ct ~ temperature, family = binomial(link = "logit"), 
    data = launch_train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.0092  -0.8104  -0.4453   0.5260   2.1326  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)  
(Intercept)  12.4677     6.8659   1.816   0.0694 .
temperature  -0.1951     0.1009  -1.934   0.0531 .
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 24.435  on 19  degrees of freedom
Residual deviance: 18.682  on 18  degrees of freedom
AIC: 22.682

Number of Fisher Scoring iterations: 5
anova(model, test="Chisq")
Analysis of Deviance Table

Model: binomial, link: logit

Response: distress_ct

Terms added sequentially (first to last)

            Df Deviance Resid. Df Resid. Dev Pr(>Chi)  
NULL                           19     24.435           
temperature  1   5.7525        18     18.682  0.01646 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

From the anova test, we tell that the model fits.

Step 4: evaluating model performance

Check Accuracy

fitted.results <- predict(model,newdata=launch_test,type='response')
fitted.results <- ifelse(fitted.results > 0.5,1,0)
misClasificError <- mean(fitted.results != launch_test$distress_ct)
print(paste('Accuracy',1-misClasificError))
[1] "Accuracy 1"

The misclassific error is 0 form the result,which indicates our model is really good.

Step 5: improving model performance

ROC Method: Because this data set is so small, it is possible that the test data set does not contain both 0 and 1 values. If this happens the code will not run.And since the test data set is so small the ROC is not useful here,but the code is provided.

‘’’ library(ROCR) p <- predict(model, newdata=credit_test, type=“response”) pr <- prediction(p, credit_test$default) prf <- performance(pr, measure = “tpr”, x.measure = “fpr”) plot(prf)

auc <- performance(pr, measure = “auc”) auc <- auc@y.values[[1]] auc ‘’’

LS0tCnRpdGxlOiAiTG9naXN0aWMgUmVncmVzc2lvbiBDaGFsbGVuZ2luZyBkYXRhIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgojIyBTdGVwIDE6IGNvbGxlY3RpbmcgZGF0YQpUaGUgZGF0YSBoYXMgYmVlbiBjb2xsZWN0ZWQgYW5kIHJlYWR5IHRvIGJlIGFuYWx5ZWQuCmBgYHtyfQpsYXVuY2ggPC0gcmVhZC5jc3YoImh0dHA6Ly93d3cuc2NpLmNzdWVhc3RiYXkuZWR1L35lc3Vlc3MvY2xhc3Nlcy9TdGF0aXN0aWNzXzY2MjAvUHJlc2VudGF0aW9ucy9tbDEwL2NoYWxsZW5nZXIuY3N2IikKCmBgYAoKIyMgU3RlcCAyOiBleHBsb3JpbmcgYW5kIHByZXBhcmluZyBkYXRhIApgYGB7cn0KIyBleGFtbWluZSB0aGUgbGF1bmNoIGRhdGEKc3RyKGxhdW5jaCkKYGBgCgpGaXJzdCByZWNvZGUgdGhlIGRpc3RyZXNzX2N0IHZhcmlhYmxlIGludG8gMCBhbmQgMSwgbWFraW5nIDEgdG8gcmVwcmVzZW50IGF0IGxlYXN0IG9uZSBmYWlsdXJlIGR1cmluZyBhIGxhdW5jaC4KYGBge3J9CmxhdW5jaCRkaXN0cmVzc19jdCA9IGlmZWxzZShsYXVuY2gkZGlzdHJlc3NfY3Q8MSwwLDEpCmxhdW5jaCRkaXN0cmVzc19jdApgYGAKClNldCB1cCB0cmFpbm5pbmcgYW5kIHRlc3QgZGF0YSBzZXRzCmBgYHtyfQppbmR4ID0gc2FtcGxlKDE6bnJvdyhsYXVuY2gpLCBhcy5pbnRlZ2VyKDAuOSpucm93KGxhdW5jaCkpKQppbmR4ICMgcmFtZG9taXplIHJvd3MsIHNhdmUgOTAlIG9mIGRhdGEgaW50byBpbmRleAoKbGF1bmNoX3RyYWluID0gbGF1bmNoW2luZHgsXQpsYXVuY2hfdGVzdCA9IGxhdW5jaFstaW5keCxdCgpsYXVuY2hfdHJhaW5fbGFiZWxzID0gbGF1bmNoW2luZHgsMV0gIyBsYWJlbCB0aGUgZmlyc3QgY29sdW1uOiBkaXN0cmVzc19jdCBpcyB0aGUgY2hhdGVnb3JpYWwgZGVwZW5kZW50IHZhcmlhYmxlCmxhdW5jaF90ZXN0X2xhYmVscyA9IGxhdW5jaFstaW5keCwxXSAKYGBgCkNoZWNrIGlmIHRoZXJlJ3MgYW55IG1pc3NpbmcgdmFsdWVzOgpgYGB7cn0KbGlicmFyeShBbWVsaWEpCm1pc3NtYXAobGF1bmNoLCBtYWluID0gIk1pc3NpbmcgdmFsdWVzIHZzIG9ic2VydmVkIikKYGBgCgpOdW1iZXIgb2YgbWlzc2luZyB2YWx1ZXMgaW4gZWFjaCBjb2x1bW4KYGBge3J9CnNhcHBseShsYXVuY2gsZnVuY3Rpb24oeCkgc3VtKGlzLm5hKHgpKSkKYGBgCk51bWJlciBvZiB1bmlxdWUgdmFsdWVzIGluIGVhY2ggY29sdW1uCmBgYHtyfQpzYXBwbHkobGF1bmNoLCBmdW5jdGlvbih4KSBsZW5ndGgodW5pcXVlKHgpKSkKYGBgCiMjIFN0ZXAgMzogdHJhaW5pbmcgYSBtb2RlbCBvbiB0aGUgZGF0YQpmaXQgdGhlIGxvZ2lzdGljIHJlZ3Jlc3Npb24gbW9kZWwsIHdpdGggYWxsIHByZWRpY3RvciB2YXJpYWJsZXMKYGBge3J9Cm1vZGVsIDwtIGdsbShkaXN0cmVzc19jdCB+LixmYW1pbHk9Ymlub21pYWwobGluaz0nbG9naXQnKSxkYXRhPWxhdW5jaF90cmFpbikKbW9kZWwKc3VtbWFyeShtb2RlbCkKYW5vdmEobW9kZWwsIHRlc3Q9IkNoaXNxIikKYGBgCk9ubHkgdGVtcGVyc3R1cmUgaXMgc2lnbmlmaWNhbnQgZnJvbSBnbG0gYW5kIGFub3ZhIG91dHB1dC4gCgpEcm9wIHRoZSBpbnNpZ25pZmljYW50IHByZWRpY3RvcnMsIGFscGhhID0gMC4xMApgYGB7cn0KbW9kZWwgPC0gZ2xtKGRpc3RyZXNzX2N0fnRlbXBlcmF0dXJlLGZhbWlseT1iaW5vbWlhbChsaW5rPSdsb2dpdCcpLGRhdGE9bGF1bmNoX3RyYWluKQptb2RlbAoKc3VtbWFyeShtb2RlbCkKCmFub3ZhKG1vZGVsLCB0ZXN0PSJDaGlzcSIpCmBgYApGcm9tIHRoZSBhbm92YSB0ZXN0LCB3ZSB0ZWxsIHRoYXQgdGhlIG1vZGVsIGZpdHMuIAoKIyMgU3RlcCA0OiBldmFsdWF0aW5nIG1vZGVsIHBlcmZvcm1hbmNlIApDaGVjayBBY2N1cmFjeQpgYGB7cn0KZml0dGVkLnJlc3VsdHMgPC0gcHJlZGljdChtb2RlbCxuZXdkYXRhPWxhdW5jaF90ZXN0LHR5cGU9J3Jlc3BvbnNlJykKZml0dGVkLnJlc3VsdHMgPC0gaWZlbHNlKGZpdHRlZC5yZXN1bHRzID4gMC41LDEsMCkKCm1pc0NsYXNpZmljRXJyb3IgPC0gbWVhbihmaXR0ZWQucmVzdWx0cyAhPSBsYXVuY2hfdGVzdCRkaXN0cmVzc19jdCkKcHJpbnQocGFzdGUoJ0FjY3VyYWN5JywxLW1pc0NsYXNpZmljRXJyb3IpKQpgYGAKVGhlIG1pc2NsYXNzaWZpYyBlcnJvciBpcyAwIGZvcm0gdGhlIHJlc3VsdCx3aGljaCBpbmRpY2F0ZXMgb3VyIG1vZGVsIGlzIHJlYWxseSBnb29kLgoKIyMgU3RlcCA1OiBpbXByb3ZpbmcgbW9kZWwgcGVyZm9ybWFuY2UgClJPQyBNZXRob2Q6IApCZWNhdXNlIHRoaXMgZGF0YSBzZXQgaXMgc28gc21hbGwsIGl0IGlzIHBvc3NpYmxlIHRoYXQgdGhlIHRlc3QgZGF0YSBzZXQKZG9lcyBub3QgY29udGFpbiBib3RoIDAgYW5kIDEgdmFsdWVzLiAgSWYgdGhpcyBoYXBwZW5zIHRoZSBjb2RlIHdpbGwgbm90CnJ1bi5BbmQgc2luY2UgdGhlIHRlc3QgZGF0YSBzZXQgaXMgc28gc21hbGwgdGhlIFJPQyBpcyBub3QgdXNlZnVsIGhlcmUsYnV0IHRoZSBjb2RlIGlzIHByb3ZpZGVkLgoKJycnCmxpYnJhcnkoUk9DUikKcCA8LSBwcmVkaWN0KG1vZGVsLCBuZXdkYXRhPWNyZWRpdF90ZXN0LCB0eXBlPSJyZXNwb25zZSIpCnByIDwtIHByZWRpY3Rpb24ocCwgY3JlZGl0X3Rlc3QkZGVmYXVsdCkKcHJmIDwtIHBlcmZvcm1hbmNlKHByLCBtZWFzdXJlID0gInRwciIsIHgubWVhc3VyZSA9ICJmcHIiKQpwbG90KHByZikKCmF1YyA8LSBwZXJmb3JtYW5jZShwciwgbWVhc3VyZSA9ICJhdWMiKQphdWMgPC0gYXVjQHkudmFsdWVzW1sxXV0KYXVjCicnJwoKCgo=