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.