Using List Wise Deletion and Multiple Imputation and Understanding Missing Data

In this analysis I will look at variables that contain missing data. That dataset I am “fixing” for my missing value analysis is data used before in previous homeworks. The data was collected through Social Explorer’s Health Data Set on Obesity including variables such as Consumption of Alcohol for Adults and Free Lunches. For this analysis I would like to look at the data between Alcohol Consumption (Drinking Adults) and Free Lunch on Obesity.

The two different types of analysis I will demonstrate are List Wise Deletion and Multiple Imputation.

*List Wise Deletion: In this method, an entire record is excluded from analysis if any single value is missing.

*Multiple Imputation: This method builds multiple imputation models to approximate missing values.

We wil use this analysis to compare results of each method.

library(Amelia)
library(Zelig)
library(ZeligChoice)
library(texreg)

Load the Data and Rename the Variables

library(dplyr)
AlcoObesity2 <- rename (AlcoObesity,
          "STATEFP" = Geo_STATE,
          "Fair_to_Poor_Health" = SE_T002_001,
          "Current_Smokers" = SE_T011_001,
          "Drinking_Adults" = SE_T011_002,
          "Persons_with_Limited_Access_to_Healthy_Foods" = SE_T012_001,
          "Access_to_Exercise" = SE_T012_002,
          "Obese_Persons" = SE_T012_003,
          "Physically_Inactive" = SE_T012_004,
          "Free_Lunch" = SE_T012_005)
select(AlcoObesity2, STATEFP, Drinking_Adults, Persons_with_Limited_Access_to_Healthy_Foods, Obese_Persons, Free_Lunch)
head(AlcoObesity2)
AlcoObesity2 <- subset(AlcoObesity2, select =-c(Geo_FIPS))
AlcoObesity2 <- subset(AlcoObesity2, select =-c(Geo_NAME))
AlcoObesity2<- subset(AlcoObesity2, select =-c(Geo_QNAME))
AlcoObesity2 <- subset(AlcoObesity2, select =-c(Geo_COUNTY))
AlcoObesity2$STATEFP <- as.factor(AlcoObesity2$STATEFP)
dim(AlcoObesity2)
[1] 3141    9

List Wise Deletion

z.alco <- zelig(Obese_Persons ~ Drinking_Adults + Free_Lunch, model="ls", data=AlcoObesity2, cite = F)
htmlreg(z.alco, doctype = FALSE)
Statistical models
Model 1
(Intercept) 31.74***
(0.61)
Drinking_Adults -0.27***
(0.03)
Free_Lunch 0.08***
(0.01)
R2 0.21
Adj. R2 0.21
Num. obs. 2978
RMSE 3.89
p < 0.001, p < 0.01, p < 0.05
names(AlcoObesity2)
[1] "STATEFP"                                      "Fair_to_Poor_Health"                         
[3] "Current_Smokers"                              "Drinking_Adults"                             
[5] "Persons_with_Limited_Access_to_Healthy_Foods" "Access_to_Exercise"                          
[7] "Obese_Persons"                                "Physically_Inactive"                         
[9] "Free_Lunch"                                  

Using Amelia

a.out <- amelia(x = AlcoObesity2, cs = "STATEFP", logs = "Obese_Persons")
-- Imputation 1 --

  1  2  3  4

-- Imputation 2 --

  1  2  3  4

-- Imputation 3 --

  1  2  3  4

-- Imputation 4 --

  1  2  3  4

-- Imputation 5 --

  1  2  3  4
a.out

Amelia output with 5 imputed datasets.
Return code:  1 
Message:  Normal EM convergence. 

Chain Lengths:
--------------
Imputation 1:  4
Imputation 2:  4
Imputation 3:  4
Imputation 4:  4
Imputation 5:  4
names(a.out)
 [1] "imputations" "m"           "missMatrix"  "overvalues"  "theta"       "mu"          "covMatrices" "code"        "message"    
[10] "iterHist"    "arguments"   "orig.vars"  
tmp<- amelia(a.out, idvars = c("STATEFP"))
-- Imputation 1 --

  1  2  3  4

-- Imputation 2 --

  1  2  3  4

-- Imputation 3 --

  1  2  3  4

-- Imputation 4 --

  1  2  3  4

-- Imputation 5 --

  1  2  3  4
View(tmp$imputations$imp1)
View(tmp$imputations$imp2)
View(tmp$imputations$imp3)
head(tmp$imputations$imp1)
head(tmp$imputations$imp2)
head(tmp$imputations$imp3)
z.out <- zelig(Obese_Persons~ Drinking_Adults  + Free_Lunch, model="ls", data=tmp, cite = FALSE)
summary(z.out)
Model: Combined Imputations 

                Estimate Std.Error z value Pr(>|z|)
(Intercept)     31.50212   0.61821    51.0   <2e-16
Drinking_Adults -0.27456   0.02622   -10.5   <2e-16
Free_Lunch       0.08888   0.00545    16.3   <2e-16

For results from individual imputed datasets, use summary(x, subset = i:j)
Next step: Use 'setx' method
summary(z.out, subset = 1)
Imputed Dataset 1
Call:
z5$zelig(formula = Obese_Persons ~ Drinking_Adults + Free_Lunch, 
    data = tmp)

Residuals:
     Min       1Q   Median       3Q      Max 
-18.9483  -2.1229   0.3924   2.6186  11.1083 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)
(Intercept)     31.485617   0.601622   52.34   <2e-16
Drinking_Adults -0.274062   0.025768  -10.64   <2e-16
Free_Lunch       0.089074   0.005289   16.84   <2e-16

Residual standard error: 3.931 on 3138 degrees of freedom
Multiple R-squared:  0.2256,    Adjusted R-squared:  0.2251 
F-statistic:   457 on 2 and 3138 DF,  p-value: < 2.2e-16

Next step: Use 'setx' method
summary(z.out, subset = 2)
Imputed Dataset 2
Call:
z5$zelig(formula = Obese_Persons ~ Drinking_Adults + Free_Lunch, 
    data = tmp)

Residuals:
     Min       1Q   Median       3Q      Max 
-18.9370  -2.1451   0.4029   2.6054  10.5402 

Coefficients:
                 Estimate Std. Error t value Pr(>|t|)
(Intercept)     31.636171   0.599768   52.75   <2e-16
Drinking_Adults -0.279387   0.025714  -10.87   <2e-16
Free_Lunch       0.087731   0.005279   16.62   <2e-16

Residual standard error: 3.936 on 3138 degrees of freedom
Multiple R-squared:  0.2238,    Adjusted R-squared:  0.2233 
F-statistic: 452.4 on 2 and 3138 DF,  p-value: < 2.2e-16

Next step: Use 'setx' method
z.out$setx()
z.out$sim()
plot(z.out)

Conclusion

So there were a couple of differences. When using Amelia Package, the missing data that were filled in were very similar in numbers. Nothing stood out as being too extreme. I think if my data set were larger, dealing with countries instead of states, and using more missing data there would most likely be larger extremes. I think either list wise deletion or Amelia package would work.

LS0tDQp0aXRsZTogIk1pc3NpbmcgRGF0YSBhbmQgVXNpbmcgQW1lbGlhIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KI1VzaW5nIExpc3QgV2lzZSBEZWxldGlvbiBhbmQgTXVsdGlwbGUgSW1wdXRhdGlvbiBhbmQgVW5kZXJzdGFuZGluZyBNaXNzaW5nIERhdGENCg0KSW4gdGhpcyBhbmFseXNpcyBJIHdpbGwgbG9vayBhdCB2YXJpYWJsZXMgdGhhdCBjb250YWluIG1pc3NpbmcgZGF0YS4gVGhhdCBkYXRhc2V0IEkgYW0gImZpeGluZyIgZm9yIG15IG1pc3NpbmcgdmFsdWUgYW5hbHlzaXMgaXMgZGF0YSB1c2VkIGJlZm9yZSBpbiBwcmV2aW91cyBob21ld29ya3MuIFRoZSBkYXRhIHdhcyBjb2xsZWN0ZWQgdGhyb3VnaCBTb2NpYWwgRXhwbG9yZXIncyBIZWFsdGggRGF0YSBTZXQgb24gT2Jlc2l0eSBpbmNsdWRpbmcgdmFyaWFibGVzIHN1Y2ggYXMgQ29uc3VtcHRpb24gb2YgQWxjb2hvbCBmb3IgQWR1bHRzIGFuZCBGcmVlIEx1bmNoZXMuIEZvciB0aGlzIGFuYWx5c2lzIEkgd291bGQgbGlrZSB0byBsb29rIGF0IHRoZSBkYXRhIGJldHdlZW4gQWxjb2hvbCBDb25zdW1wdGlvbiAoRHJpbmtpbmcgQWR1bHRzKSBhbmQgRnJlZSBMdW5jaCBvbiBPYmVzaXR5Lg0KDQpUaGUgdHdvIGRpZmZlcmVudCB0eXBlcyBvZiBhbmFseXNpcyBJIHdpbGwgZGVtb25zdHJhdGUgYXJlIExpc3QgV2lzZSBEZWxldGlvbiBhbmQgTXVsdGlwbGUgSW1wdXRhdGlvbi4NCg0KKkxpc3QgV2lzZSBEZWxldGlvbjogSW4gdGhpcyBtZXRob2QsIGFuIGVudGlyZSByZWNvcmQgaXMgZXhjbHVkZWQgZnJvbSBhbmFseXNpcyBpZiBhbnkgc2luZ2xlIHZhbHVlIGlzIG1pc3NpbmcuDQoNCipNdWx0aXBsZSBJbXB1dGF0aW9uOiBUaGlzIG1ldGhvZCBidWlsZHMgbXVsdGlwbGUgaW1wdXRhdGlvbiBtb2RlbHMgdG8gYXBwcm94aW1hdGUgbWlzc2luZyB2YWx1ZXMuDQoNCldlIHdpbCB1c2UgdGhpcyBhbmFseXNpcyB0byBjb21wYXJlIHJlc3VsdHMgb2YgZWFjaCBtZXRob2QuDQoNCg0KYGBge3J9DQpsaWJyYXJ5KEFtZWxpYSkNCmxpYnJhcnkoWmVsaWcpDQpsaWJyYXJ5KFplbGlnQ2hvaWNlKQ0KbGlicmFyeSh0ZXhyZWcpDQpgYGANCg0KIyNMb2FkIHRoZSBEYXRhIGFuZCBSZW5hbWUgdGhlIFZhcmlhYmxlcw0KDQpgYGB7cn0NCmxpYnJhcnkoZHBseXIpDQoNCkFsY29PYmVzaXR5MiA8LSByZW5hbWUgKEFsY29PYmVzaXR5LA0KICAgICAgICAgICJTVEFURUZQIiA9IEdlb19TVEFURSwNCiAgICAgICAgICAiRmFpcl90b19Qb29yX0hlYWx0aCIgPSBTRV9UMDAyXzAwMSwNCiAgICAgICAgICAiQ3VycmVudF9TbW9rZXJzIiA9IFNFX1QwMTFfMDAxLA0KICAgICAgICAgICJEcmlua2luZ19BZHVsdHMiID0gU0VfVDAxMV8wMDIsDQogICAgICAgICAgIlBlcnNvbnNfd2l0aF9MaW1pdGVkX0FjY2Vzc190b19IZWFsdGh5X0Zvb2RzIiA9IFNFX1QwMTJfMDAxLA0KICAgICAgICAgICJBY2Nlc3NfdG9fRXhlcmNpc2UiID0gU0VfVDAxMl8wMDIsDQogICAgICAgICAgIk9iZXNlX1BlcnNvbnMiID0gU0VfVDAxMl8wMDMsDQogICAgICAgICAgIlBoeXNpY2FsbHlfSW5hY3RpdmUiID0gU0VfVDAxMl8wMDQsDQogICAgICAgICAgIkZyZWVfTHVuY2giID0gU0VfVDAxMl8wMDUpDQoNCnNlbGVjdChBbGNvT2Jlc2l0eTIsIFNUQVRFRlAsIERyaW5raW5nX0FkdWx0cywgUGVyc29uc193aXRoX0xpbWl0ZWRfQWNjZXNzX3RvX0hlYWx0aHlfRm9vZHMsIE9iZXNlX1BlcnNvbnMsIEZyZWVfTHVuY2gpDQoNCmBgYA0KDQpgYGB7cn0NCmhlYWQoQWxjb09iZXNpdHkyKQ0KYGBgDQoNCmBgYHtyfQ0KQWxjb09iZXNpdHkyIDwtIHN1YnNldChBbGNvT2Jlc2l0eTIsIHNlbGVjdCA9LWMoR2VvX0ZJUFMpKQ0KQWxjb09iZXNpdHkyIDwtIHN1YnNldChBbGNvT2Jlc2l0eTIsIHNlbGVjdCA9LWMoR2VvX05BTUUpKQ0KQWxjb09iZXNpdHkyPC0gc3Vic2V0KEFsY29PYmVzaXR5Miwgc2VsZWN0ID0tYyhHZW9fUU5BTUUpKQ0KQWxjb09iZXNpdHkyIDwtIHN1YnNldChBbGNvT2Jlc2l0eTIsIHNlbGVjdCA9LWMoR2VvX0NPVU5UWSkpDQpBbGNvT2Jlc2l0eTIkU1RBVEVGUCA8LSBhcy5mYWN0b3IoQWxjb09iZXNpdHkyJFNUQVRFRlApDQpgYGANCg0KDQpgYGB7cn0NCmRpbShBbGNvT2Jlc2l0eTIpDQpgYGANCg0KIyNMaXN0IFdpc2UgRGVsZXRpb24NCg0KYGBge3IgcmVzdWx0cz0nYXNpcyd9DQp6LmFsY28gPC0gemVsaWcoT2Jlc2VfUGVyc29ucyB+IERyaW5raW5nX0FkdWx0cyArIEZyZWVfTHVuY2gsIG1vZGVsPSJscyIsIGRhdGE9QWxjb09iZXNpdHkyLCBjaXRlID0gRikNCmh0bWxyZWcoei5hbGNvLCBkb2N0eXBlID0gRkFMU0UpDQpgYGANCg0KDQpgYGB7cn0NCm5hbWVzKEFsY29PYmVzaXR5MikNCmBgYA0KDQojI1VzaW5nIEFtZWxpYQ0KDQpgYGB7cn0NCmEub3V0IDwtIGFtZWxpYSh4ID0gQWxjb09iZXNpdHkyLCBjcyA9ICJTVEFURUZQIiwgbG9ncyA9ICJPYmVzZV9QZXJzb25zIikNCmBgYA0KDQoNCmBgYHtyfQ0KYS5vdXQNCmBgYA0KDQoNCmBgYHtyfQ0KbmFtZXMoYS5vdXQpDQpgYGANCg0KYGBge3J9DQp0bXA8LSBhbWVsaWEoYS5vdXQsIGlkdmFycyA9IGMoIlNUQVRFRlAiKSkNCmBgYA0KDQpgYGB7cn0NClZpZXcodG1wJGltcHV0YXRpb25zJGltcDEpDQpWaWV3KHRtcCRpbXB1dGF0aW9ucyRpbXAyKQ0KVmlldyh0bXAkaW1wdXRhdGlvbnMkaW1wMykNCmBgYA0KDQpgYGB7cn0NCmhlYWQodG1wJGltcHV0YXRpb25zJGltcDEpDQpgYGANCg0KDQpgYGB7cn0NCmhlYWQodG1wJGltcHV0YXRpb25zJGltcDIpDQpgYGANCg0KDQpgYGB7cn0NCmhlYWQodG1wJGltcHV0YXRpb25zJGltcDMpDQpgYGANCg0KDQpgYGB7cn0NCnoub3V0IDwtIHplbGlnKE9iZXNlX1BlcnNvbnN+IERyaW5raW5nX0FkdWx0cyAgKyBGcmVlX0x1bmNoLCBtb2RlbD0ibHMiLCBkYXRhPXRtcCwgY2l0ZSA9IEZBTFNFKQ0Kc3VtbWFyeSh6Lm91dCkNCmBgYA0KDQpgYGB7cn0NCnN1bW1hcnkoei5vdXQsIHN1YnNldCA9IDEpDQpgYGANCg0KYGBge3J9DQpzdW1tYXJ5KHoub3V0LCBzdWJzZXQgPSAyKQ0KYGBgDQoNCmBgYHtyfQ0Kei5vdXQkc2V0eCgpDQp6Lm91dCRzaW0oKQ0KcGxvdCh6Lm91dCkNCmBgYA0KDQoNCiMjQ29uY2x1c2lvbg0KU28gdGhlcmUgd2VyZSBhIGNvdXBsZSBvZiBkaWZmZXJlbmNlcy4gV2hlbiB1c2luZyBBbWVsaWEgUGFja2FnZSwgdGhlIG1pc3NpbmcgZGF0YSB0aGF0IHdlcmUgZmlsbGVkIGluIHdlcmUgdmVyeSBzaW1pbGFyIGluIG51bWJlcnMuIE5vdGhpbmcgc3Rvb2Qgb3V0IGFzIGJlaW5nIHRvbyBleHRyZW1lLiBJIHRoaW5rIGlmIG15IGRhdGEgc2V0IHdlcmUgbGFyZ2VyLCBkZWFsaW5nIHdpdGggY291bnRyaWVzIGluc3RlYWQgb2Ygc3RhdGVzLCBhbmQgdXNpbmcgbW9yZSBtaXNzaW5nIGRhdGEgdGhlcmUgd291bGQgbW9zdCBsaWtlbHkgYmUgbGFyZ2VyIGV4dHJlbWVzLiBJIHRoaW5rIGVpdGhlciBsaXN0IHdpc2UgZGVsZXRpb24gb3IgQW1lbGlhIHBhY2thZ2Ugd291bGQgd29yay4g