library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ 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(readxl)
library(pastecs)
##
## Attaching package: 'pastecs'
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
## The following object is masked from 'package:tidyr':
##
## extract
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
setwd("C:/Users/David/Desktop/My Class Stuff/Wednesday Class")
data_florida <- read_excel("Data_Florida.xlsx")
## New names:
## • `Recipients` -> `Recipients...6`
## • `# of Loans Originated` -> `# of Loans Originated...7`
## • `$ of Loans Originated` -> `$ of Loans Originated...8`
## • `# of Disbursements` -> `# of Disbursements...9`
## • `$ of Disbursements` -> `$ of Disbursements...10`
## • `Recipients` -> `Recipients...11`
## • `# of Loans Originated` -> `# of Loans Originated...12`
## • `$ of Loans Originated` -> `$ of Loans Originated...13`
## • `# of Disbursements` -> `# of Disbursements...14`
## • `$ of Disbursements` -> `$ of Disbursements...15`
## • `Recipients` -> `Recipients...16`
## • `# of Loans Originated` -> `# of Loans Originated...17`
## • `$ of Loans Originated` -> `$ of Loans Originated...18`
## • `# of Disbursements` -> `# of Disbursements...19`
## • `$ of Disbursements` -> `$ of Disbursements...20`
## • `Recipients` -> `Recipients...21`
## • `# of Loans Originated` -> `# of Loans Originated...22`
## • `$ of Loans Originated` -> `$ of Loans Originated...23`
## • `# of Disbursements` -> `# of Disbursements...24`
## • `$ of Disbursements` -> `$ of Disbursements...25`
fl_lm <- data_florida %>%
dplyr::select(
total_loans = `$ of Loans Originated...8`,
recipients = `Recipients...6`,
school_type = `School Type`
) %>%
dplyr::mutate(
total_loans = as.numeric(total_loans),
recipients = as.numeric(recipients),
school_type = as.factor(school_type)
) %>%
dplyr::filter(!is.na(total_loans),
!is.na(recipients))
nrow(fl_lm)
## [1] 3820
summary(fl_lm)
## total_loans recipients school_type
## Min. : 0 Min. : 0.0 FOREIGN FOR-PROFIT: 4
## 1st Qu.: 72299 1st Qu.: 18.0 FOREIGN PRIVATE : 71
## Median : 666556 Median : 159.0 FOREIGN PUBLIC : 305
## Mean : 3404240 Mean : 735.8 OTHER : 1
## 3rd Qu.: 3062910 3rd Qu.: 720.5 PRIVATE :1360
## Max. :283322438 Max. :67590.0 PROPRIETARY : 992
## PUBLIC :1087
pastecs::stat.desc(fl_lm$total_loans)
## nbr.val nbr.null nbr.na min max range
## 3.820000e+03 1.140000e+02 0.000000e+00 0.000000e+00 2.833224e+08 2.833224e+08
## sum median mean SE.mean CI.mean.0.95 var
## 1.300420e+10 6.665555e+05 3.404240e+06 1.515814e+05 2.971883e+05 8.777184e+13
## std.dev coef.var
## 9.368663e+06 2.752057e+00
pastecs::stat.desc(fl_lm$recipients)
## nbr.val nbr.null nbr.na min max range
## 3.820000e+03 1.140000e+02 0.000000e+00 0.000000e+00 6.759000e+04 6.759000e+04
## sum median mean SE.mean CI.mean.0.95 var
## 2.810627e+06 1.590000e+02 7.357662e+02 3.272979e+01 6.416954e+01 4.092133e+06
## std.dev coef.var
## 2.022902e+03 2.749381e+00
table(fl_lm$school_type)
##
## FOREIGN FOR-PROFIT FOREIGN PRIVATE FOREIGN PUBLIC OTHER
## 4 71 305 1
## PRIVATE PROPRIETARY PUBLIC
## 1360 992 1087
hist(fl_lm$total_loans,
main = "Distribution of Total Loan Volume",
xlab = "Total Loan Dollars",
breaks = 30)
hist(fl_lm$recipients,
main = "Distribution of Loan Recipients",
xlab = "Number of Recipients",
breaks = 30)
fl_lm <- fl_lm %>%
mutate(log_total_loans = log(total_loans))
hist(fl_lm$log_total_loans,
main = "Log of Total Loan Volume",
xlab = "log(Total Loans)",
breaks = 30)
cor(fl_lm$total_loans, fl_lm$recipients, use = "complete.obs")
## [1] 0.974388
model1 <- lm(total_loans ~ recipients + school_type, data = fl_lm)
summary(model1)
##
## Call:
## lm(formula = total_loans ~ recipients + school_type, data = fl_lm)
##
## Residuals:
## Min 1Q Median 3Q Max
## -59988642 -510703 -55763 183084 44901315
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.665e+06 1.041e+06 2.561 0.01048 *
## recipients 4.519e+03 1.698e+01 266.133 < 2e-16 ***
## school_typeFOREIGN PRIVATE -2.564e+06 1.070e+06 -2.398 0.01654 *
## school_typeFOREIGN PUBLIC -2.601e+06 1.047e+06 -2.483 0.01306 *
## school_typeOTHER -2.666e+06 2.327e+06 -1.146 0.25190
## school_typePRIVATE -2.157e+06 1.042e+06 -2.070 0.03855 *
## school_typePROPRIETARY -2.868e+06 1.043e+06 -2.750 0.00598 **
## school_typePUBLIC -2.871e+06 1.042e+06 -2.754 0.00591 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2081000 on 3812 degrees of freedom
## Multiple R-squared: 0.9508, Adjusted R-squared: 0.9507
## F-statistic: 1.051e+04 on 7 and 3812 DF, p-value: < 2.2e-16
plot(model1, which = 1)
#rainbow test
lmtest::raintest(model1)
##
## Rainbow test
##
## data: model1
## Rain = 0.45669, df1 = 1910, df2 = 1902, p-value = 1
# Breusch-Pagan test
lmtest::bptest(model1)
##
## studentized Breusch-Pagan test
##
## data: model1
## BP = 1208.7, df = 7, p-value < 2.2e-16
car::durbinWatsonTest(model1)
## lag Autocorrelation D-W Statistic p-value
## 1 0.04612918 1.907735 0.012
## Alternative hypothesis: rho != 0
plot(model1, which = 2)
## Warning: not plotting observations with leverage one:
## 2391
resid_model1 <- residuals(model1)
shapiro.test(resid_model1)
##
## Shapiro-Wilk normality test
##
## data: resid_model1
## W = 0.36607, p-value < 2.2e-16
car::vif(model1)
## GVIF Df GVIF^(1/(2*Df))
## recipients 1.040655 1 1.020125
## school_type 1.040655 6 1.003326
cor(fl_lm[, c("total_loans", "recipients")], use = "complete.obs")
## total_loans recipients
## total_loans 1.000000 0.974388
## recipients 0.974388 1.000000
plot(fl_lm$recipients,
fl_lm$total_loans,
main = "Total Loans vs Number of Recipients",
xlab = "Recipients",
ylab = "Total Loans")
