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")
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)
#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