R Markdown - A tall white mountain played
options (scipen = 100)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(stringr)
library(readxl)
library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.5.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ ggplot2 4.0.0 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(MASS)
##
## Attaching package: 'MASS'
##
## The following object is masked from 'package:dplyr':
##
## select
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:purrr':
##
## some
##
## The following object is masked from 'package:dplyr':
##
## recode
library(ggplot2)
library(webshot2)
## Warning: package 'webshot2' was built under R version 4.5.2
library(stargazer)
## Warning: package 'stargazer' was built under R version 4.5.2
##
## Please cite as:
##
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazer
library(gtsummary)
##
## Attaching package: 'gtsummary'
##
## The following object is masked from 'package:MASS':
##
## select
library(gt)
CAFB_SetUp <- read.csv("Capital_Area_Food_Bank_Hunger_Estimates.csv")
CAFB_Report <- CAFB_SetUp[c("F15_FI_POP", "F15_DISTRIB", "F15_LB_UNME", "F14_DISTRIB", "F14_LB_UNME")]
summary(CAFB_Report)
## F15_FI_POP F15_DISTRIB F15_LB_UNME F14_DISTRIB
## Min. : 0.0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 174.7 1st Qu.: 8478 1st Qu.: 23523 1st Qu.: 7158
## Median : 351.2 Median : 21884 Median : 46737 Median : 16968
## Mean : 427.7 Mean : 32752 Mean : 57063 Mean : 29882
## 3rd Qu.: 609.1 3rd Qu.: 44673 3rd Qu.: 79975 3rd Qu.: 39788
## Max. :2178.6 Max. :243138 Max. :290836 Max. :222517
## F14_LB_UNME
## Min. : 0
## 1st Qu.: 26103
## Median : 50496
## Mean : 59048
## 3rd Qu.: 82542
## Max. :297219
#This section will set up LM, LOG, and Square
CAFB_LM <- lm(F15_FI_POP ~ F15_DISTRIB+F15_LB_UNME+F14_DISTRIB+F14_LB_UNME, data = CAFB_Report)
CAFB_LOG <- CAFB_Report |>
mutate(F15_ULOG = log(F15_LB_UNME), F15_DLOG = log(F15_DISTRIB), F14_DLOG = log(F14_DISTRIB), F14_ULOG = log(F14_LB_UNME))
CAFB_SQR <- lm(sqrt(F15_FI_POP)~sqrt(F15_DISTRIB)+sqrt(F15_LB_UNME)+sqrt(F14_DISTRIB)+sqrt(F14_LB_UNME), data = CAFB_Report, na.action = na.omit)
summary(CAFB_SQR)
##
## Call:
## lm(formula = sqrt(F15_FI_POP) ~ sqrt(F15_DISTRIB) + sqrt(F15_LB_UNME) +
## sqrt(F14_DISTRIB) + sqrt(F14_LB_UNME), data = CAFB_Report,
## na.action = na.omit)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.6970 -0.3695 -0.2369 0.1404 3.8550
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.1694868 0.0510807 3.318 0.000938 ***
## sqrt(F15_DISTRIB) 0.0396156 0.0004877 81.234 < 0.0000000000000002 ***
## sqrt(F15_LB_UNME) 0.0556136 0.0004246 130.975 < 0.0000000000000002 ***
## sqrt(F14_DISTRIB) 0.0001179 0.0004939 0.239 0.811415
## sqrt(F14_LB_UNME) 0.0019155 0.0004365 4.388 0.0000126 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6205 on 1034 degrees of freedom
## Multiple R-squared: 0.9942, Adjusted R-squared: 0.9941
## F-statistic: 4.401e+04 on 4 and 1034 DF, p-value: < 0.00000000000000022
###The lower the pvalue the greater the significance. If a value has stars, that means it's very important to the data interpretation. The more stars means the greater evidence against the null hypothesis.
stargazer(CAFB_SQR, type = "html", out = "CAFB_SQR.html")
##
## <table style="text-align:center"><tr><td colspan="2" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left"></td><td><em>Dependent variable:</em></td></tr>
## <tr><td></td><td colspan="1" style="border-bottom: 1px solid black"></td></tr>
## <tr><td style="text-align:left"></td><td>sqrt(F15_FI_POP)</td></tr>
## <tr><td colspan="2" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left">sqrt(F15_DISTRIB)</td><td>0.040<sup>***</sup></td></tr>
## <tr><td style="text-align:left"></td><td>(0.0005)</td></tr>
## <tr><td style="text-align:left"></td><td></td></tr>
## <tr><td style="text-align:left">sqrt(F15_LB_UNME)</td><td>0.056<sup>***</sup></td></tr>
## <tr><td style="text-align:left"></td><td>(0.0004)</td></tr>
## <tr><td style="text-align:left"></td><td></td></tr>
## <tr><td style="text-align:left">sqrt(F14_DISTRIB)</td><td>0.0001</td></tr>
## <tr><td style="text-align:left"></td><td>(0.0005)</td></tr>
## <tr><td style="text-align:left"></td><td></td></tr>
## <tr><td style="text-align:left">sqrt(F14_LB_UNME)</td><td>0.002<sup>***</sup></td></tr>
## <tr><td style="text-align:left"></td><td>(0.0004)</td></tr>
## <tr><td style="text-align:left"></td><td></td></tr>
## <tr><td style="text-align:left">Constant</td><td>0.169<sup>***</sup></td></tr>
## <tr><td style="text-align:left"></td><td>(0.051)</td></tr>
## <tr><td style="text-align:left"></td><td></td></tr>
## <tr><td colspan="2" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left">Observations</td><td>1,039</td></tr>
## <tr><td style="text-align:left">R<sup>2</sup></td><td>0.994</td></tr>
## <tr><td style="text-align:left">Adjusted R<sup>2</sup></td><td>0.994</td></tr>
## <tr><td style="text-align:left">Residual Std. Error</td><td>0.620 (df = 1034)</td></tr>
## <tr><td style="text-align:left">F Statistic</td><td>44,011.370<sup>***</sup> (df = 4; 1034)</td></tr>
## <tr><td colspan="2" style="border-bottom: 1px solid black"></td></tr><tr><td style="text-align:left"><em>Note:</em></td><td style="text-align:right"><sup>*</sup>p<0.1; <sup>**</sup>p<0.05; <sup>***</sup>p<0.01</td></tr>
## </table>
webshot("CAFB_SQR.html", "CAFB_SQR_SUM.png")
## file:///C:/Users/JCGon/Desktop/SchoolStuff/UTSA/Applied Quantitiative Methods/JCGonzalez_FinalExam/CAFB_SQR.html screenshot completed

CAFB_SQR_TBL <- tbl_regression(CAFB_SQR, intercept = TRUE) |>
modify_caption("CAFB Square Regression Summary") |>
add_n()
gt_table <- as_gt(CAFB_SQR_TBL)
gtsave(gt_table, filename = "CAFB_S_SUM.png", vwidth = 800, vheight = 500, expand = 20)
## file:///C:/Users/JCGon/AppData/Local/Temp/RtmpGE7rzx/file33f830c01607.html screenshot completed
#this section will report on imagery
#histogram
#png("Table1.png", width = 500, height = 500)
hist(CAFB_LOG$F14_DLOG, main = "Food distributed between FY 14 - FY 15",
col = rgb(1, 0, 0, 0.5),
xlab = "Lbs of food distributed in log")
hist(CAFB_LOG$F15_DLOG,
col = rgb(0, 0, 1, 0.5),
add = TRUE)
legend("topleft", c("FY 14", "FY 15"), col = c("red", "blue"), pch = 15)

#dev.off()
#histogram
#png("Table2.png", width = 500, height = 500)
hist(CAFB_LOG$F14_ULOG, main = "Unmet Food Need FY 14 - FY 15",
col = rgb(1, 0, 0, 0.5),
xlab = "Lbs of unmet food need in Log")
hist(CAFB_LOG$F15_ULOG,
col = rgb(0, 0, 1, 0.5),
add = TRUE)
legend("topleft", c("FY 14", "FY 15"), col = c("red", "blue"), pch = 15)

#dev.off()
##point plot
ggplot(CAFB_Report, aes(x = F14_DISTRIB, y = F14_LB_UNME, colour = F15_FI_POP)) +
geom_point() +
labs(x = "Food distributed in lbs for FY 14", y = "Unmet food need in lbs", color = "Food insecure population")

ggsave('Table3.png', width = 8, height = 5, dpi = 100)
##point plot
ggplot(CAFB_Report, aes(x = F15_DISTRIB, y = F15_LB_UNME, colour = F15_FI_POP)) +
geom_point() +
labs(x = "Food distributed in lbs for FY 15", y = "Unmet food need in lbs", color = "Food insecure population")

ggsave('Table4.png', width = 8, height = 5, dpi = 100)
#This section is to determine correlation
pairs(CAFB_Report)

cor.test(CAFB_Report$F15_DISTRIB,CAFB_Report$F15_LB_UNME, method = "kendall")
##
## Kendall's rank correlation tau
##
## data: CAFB_Report$F15_DISTRIB and CAFB_Report$F15_LB_UNME
## z = 20.336, p-value < 0.00000000000000022
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## 0.4216726
cor.test(CAFB_Report$F14_DISTRIB,CAFB_Report$F14_LB_UNME, method = "kendall")
##
## Kendall's rank correlation tau
##
## data: CAFB_Report$F14_DISTRIB and CAFB_Report$F14_LB_UNME
## z = 22.166, p-value < 0.00000000000000022
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
## tau
## 0.4596528
##Low kendall p-value means there is a correlation between food distribution and unmet need
#rainbowtest
plot(CAFB_SQR, which = 1)

raintest(CAFB_SQR)
##
## Rainbow test
##
## data: CAFB_SQR
## Rain = 2.3634, df1 = 520, df2 = 514, p-value < 0.00000000000000022
##High rainbow test means you cannot reject the null hypothesis. There is linearity in your model
#Durbin test
durbinWatsonTest(CAFB_SQR)
## lag Autocorrelation D-W Statistic p-value
## 1 0.1351627 1.723189 0
## Alternative hypothesis: rho != 0
#bp test
plot(CAFB_SQR, which = 3)

bptest(CAFB_SQR)
##
## studentized Breusch-Pagan test
##
## data: CAFB_SQR
## BP = 39.39, df = 4, p-value = 0.00000005788
#Shapiro test
plot(CAFB_SQR, which = 2)

shapiro.test(CAFB_SQR$residuals)
##
## Shapiro-Wilk normality test
##
## data: CAFB_SQR$residuals
## W = 0.75323, p-value < 0.00000000000000022
#Vif report
vif(CAFB_SQR)
## sqrt(F15_DISTRIB) sqrt(F15_LB_UNME) sqrt(F14_DISTRIB) sqrt(F14_LB_UNME)
## 5.194738 4.384620 5.225873 4.497885
##Might consider a glm for he homoscedastic test.