From 2fdb717066ae8b0431c8027eee36b82f021ae990 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 20 Mar 2022 18:46:16 -0500 Subject: [PATCH 01/19] Remove Problematic Files for Merge Self-explanatory - I think these are the files we need to remove to merge so, I removed them. --- Outline.Rmd | 30 --------------------------- cities.csv | 59 ----------------------------------------------------- 2 files changed, 89 deletions(-) delete mode 100644 Outline.Rmd delete mode 100644 cities.csv diff --git a/Outline.Rmd b/Outline.Rmd deleted file mode 100644 index 2831da86..00000000 --- a/Outline.Rmd +++ /dev/null @@ -1,30 +0,0 @@ ---- -title: "Outline" -author: "Team DAREZ" -date: "10/5/2020" -output: html_document ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) -``` - -## R Markdown - -This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see . - -When you click the **Knit** button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: - -```{r cars} -summary(cars) -``` - -## Including Plots - -You can also embed plots, for example: - -```{r pressure, echo=FALSE} -plot(pressure) -``` - -Note that the `echo = FALSE` parameter was added to the code chunk to prevent printing of the R code that generated the plot. diff --git a/cities.csv b/cities.csv deleted file mode 100644 index aa140d0e..00000000 --- a/cities.csv +++ /dev/null @@ -1,59 +0,0 @@ -Places to consider, -City,State -Madison,WI -Appleton,WI -Green.Bay,WI -Milwaukee,WI -Bremerton,WA -Bainbridge,WA -Spokane,WA -Burlington,VT -Provo,UT -Salt.Lake.City,UT -Ogden,UT -St..George,UT -Bend,OR -Portland,OR -Hanover,NH -Concord,NH -Bedford,NH -Manchester,NH -Portsmouth,NH -Lincoln,NE -Omaha,NE -Bozeman,MT -Billings,MT -Great.Falls,MT -Columbia.Falls,MT -St..Louis,MO -St..Cloud,MN -St..Paul,MN -Minneapolis,MN -Traverse.City,MI -Grand.Rapids,MI -Ann.Arbor,MI -Detroit,MI -Kalamazoo,MI -Lansing,MI -Portland.1,ME -Wichita,KS -Kansas.City,KS -Des.Moines,IO -Cedar.Rapids,IO -Urbandale,IO -Iowa.City,IO -Indianapolis,IN -Peoria,IL -Springfield,IL -Urbana.Champaign,IL -Boise,ID -Moscow,ID -Pocatello,ID -Idaho.Falls,ID -Coeur.d.Alene,ID -Wilmington,DE -Boulder,CO -Denver,CO -Colorado.Springs,CO -Greenley,CO -Fort.Collins,CO \ No newline at end of file From de2d429c61f4754ae5fc59861a60e454557d50e3 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 20 Mar 2022 18:49:10 -0500 Subject: [PATCH 02/19] Submit Updated Dataprep.Txt This txt file contains the same programming that would work in R. --- Financial/dataprep.txt.txt | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 Financial/dataprep.txt.txt diff --git a/Financial/dataprep.txt.txt b/Financial/dataprep.txt.txt new file mode 100644 index 00000000..0ea1750d --- /dev/null +++ b/Financial/dataprep.txt.txt @@ -0,0 +1,37 @@ + +# Financial Data Prep + +# Packages +require(dplyr) +require(stringr) + +# Source +df <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vSNwyF0GHoS_VUYOzXkw4yWie44Zx_9rBJ5iXZesRgYpRcXnes8TMKWpIXyLs0YPEZcSp0E31BzAP6M/pub?gid=1021108104&single=true&output=csv") +df$Date <- as.Date(df$Date) +df$Cost <- as.numeric(stringr::str_remove_all(df$Cost, "\\$")) +df$Category <- as.factor(df$Category) +df$Account <- as.factor(df$Account) +df <- df %>% + dplyr::select("Location", "Date", "Description", + "Cost", "Category", "Account") +df <- na.omit(df) + +df %>% + filter(Category == "alcohol") %>% + ggplot(aes(Cost)) + + geom_histogram(fill = "white", col = "light blue", alpha = 0.5) + + theme_minimal() + +hist(df$Cost) # Needs to be fixed, current bin size is 0 - 50 with 800+ transactions +as.Date.character() # Does this work to format the date or will we need to change the source data type? +# Location - Should this be a factor data type with lots of levels? We shop at a lot of the same stores +# Category - needs an amount associated with each +# Amount - needs an amount associated with each and needs fixing (extra 11 transactions under Zach +# would otherwise be unclassified) +# Big picture - what do we want to gain from this as a shiny? +# Are there any particular questions that we ask each time we want to make a purchase that could save us money? + +plot(df) +summary(df) + +df[which(is.na(df)),] From 6e83ebb374252004ebc647e49d28b7832a49e6f7 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Mon, 21 Mar 2022 20:57:55 -0500 Subject: [PATCH 03/19] Create cleaning.R It is the same as the datapreptxt or financial branch --- Financial/cleaning.R | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 Financial/cleaning.R diff --git a/Financial/cleaning.R b/Financial/cleaning.R new file mode 100644 index 00000000..0ea1750d --- /dev/null +++ b/Financial/cleaning.R @@ -0,0 +1,37 @@ + +# Financial Data Prep + +# Packages +require(dplyr) +require(stringr) + +# Source +df <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vSNwyF0GHoS_VUYOzXkw4yWie44Zx_9rBJ5iXZesRgYpRcXnes8TMKWpIXyLs0YPEZcSp0E31BzAP6M/pub?gid=1021108104&single=true&output=csv") +df$Date <- as.Date(df$Date) +df$Cost <- as.numeric(stringr::str_remove_all(df$Cost, "\\$")) +df$Category <- as.factor(df$Category) +df$Account <- as.factor(df$Account) +df <- df %>% + dplyr::select("Location", "Date", "Description", + "Cost", "Category", "Account") +df <- na.omit(df) + +df %>% + filter(Category == "alcohol") %>% + ggplot(aes(Cost)) + + geom_histogram(fill = "white", col = "light blue", alpha = 0.5) + + theme_minimal() + +hist(df$Cost) # Needs to be fixed, current bin size is 0 - 50 with 800+ transactions +as.Date.character() # Does this work to format the date or will we need to change the source data type? +# Location - Should this be a factor data type with lots of levels? We shop at a lot of the same stores +# Category - needs an amount associated with each +# Amount - needs an amount associated with each and needs fixing (extra 11 transactions under Zach +# would otherwise be unclassified) +# Big picture - what do we want to gain from this as a shiny? +# Are there any particular questions that we ask each time we want to make a purchase that could save us money? + +plot(df) +summary(df) + +df[which(is.na(df)),] From 08e8534e2d0a3fdae492e91e58cf441d4a017f05 Mon Sep 17 00:00:00 2001 From: Zach <70336307+palmorezm@users.noreply.github.com> Date: Mon, 18 Apr 2022 18:39:13 -0400 Subject: [PATCH 04/19] Update README.md Revised the wording to describe what is currently present in the drive and tried to give it some clear origin and direction. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index fbe8f89b..63ee8651 100644 --- a/README.md +++ b/README.md @@ -1,2 +1,2 @@ # Home - What is the best place to live? +Contains basics of the home directory from our shared drive with some project areas we can focus on like our financial projects, the home affordability model, cost of living estimator, the time project, and more. From 2cf5feaf4f4fca5888bfaef46b90cb7ef81427d2 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Tue, 10 May 2022 20:02:23 -0500 Subject: [PATCH 05/19] Update LockScreenLocations.R --- Vacation/LockScreenLocations.R | 89 ++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 Vacation/LockScreenLocations.R diff --git a/Vacation/LockScreenLocations.R b/Vacation/LockScreenLocations.R new file mode 100644 index 00000000..8c0bbdf1 --- /dev/null +++ b/Vacation/LockScreenLocations.R @@ -0,0 +1,89 @@ + +# Lock Screen Locations +# Web-searching List +# Published via Glink + +file <- "https://docs.google.com/document/d/e/2PACX-1vSrVkVvQBE75wh9Pb095eY5WphbaclpuS5dzwfqII8Ht4e9hY_Pu5NHc_6P3xJI7qBqjzmLmfmBAmm8/pub" +locations <- read.delim2(file = file, header = F, sep = "\t") +print(locations) + + +##### Example text + +# Travel  List

+#

Lake Mezzola, Italy +#

Serengeti, Tanzania +#

himalaya, Gokyo Ri, Sagarmatha National +#

Catalina, California +#

High Coast, Sweden +#

Anhui, China + +##### + + +library(stringr) + +# Extract the characters that contains our locations + +# Attempts to reach 5e +# str1 <- stringr::str_extract_all(locations, "class=c0>(.*?)") +# str2 <- stringr::str_extract_all(locations, "c0>(.*?)(.*?)" +# str3 <- regmatches(locations, regexec(pattern, locations)) # Nothing good +# str4 <- stringr::str_extract_all(locations, ">(.*?)<") + +# Functioning Below: +str5 <- data.frame(stringr::str_extract_all(locations, ">(.*?)<")) +str5a <- data.frame(stringr::str_remove_all(str5[1], ">")) +str5b <- stringr::str_remove_all(str5[,1], ">") +str5c <- stringr::str_remove_all(str5b, "<") +str5d <- data.frame(str5c) +# head(str5d, na.rm = T) +str5d$str5c[which(str5d$str5c == "")] <- NA +# sum(is.na(str5d$str5c)) +str5e <- na.omit(str5d) + + + + +# Image Collection +require(rvest) +# require(purrr) +require(httr) + +# To see an image of "london" in the url: +# https://www.google.com/search?tbm=isch&q=london +image_query_base <- "https://www.google.com/search?tbm=isch&q=" +str5e$str5c[[9]] # Where locations begin +url <- paste0(image_query_base, str5e$str5c[[9]]) +res1 <- GET(url = url) + +# *Consider using selector gadget to select in CSS first 3 images using london example +# then read in html nodes and collect image? +# from selector gadget: .Q4LuWd (gives all images on the page) + +html_res1 <- read_html(res1$content) + +read_html(sprintf(url, 1)) + +images <- str5e(1:10, function(i) { + + # simple but effective progress indicator + cat(".") + + pg <- read_html(sprintf(url_base, i)) + + data.frame(wine=html_text(html_nodes(pg, ".review-listing .title")), + excerpt=html_text(html_nodes(pg, "div.excerpt")), + rating=gsub(" Points", "", html_text(html_nodes(pg, "span.rating"))), + appellation=html_text(html_nodes(pg, "span.appellation")), + price=gsub("\\$", "", html_text(html_nodes(pg, "span.price"))), + stringsAsFactors=FALSE) + +}) + +dplyr::glimpse(wines) + + + + From 62a019f78bfcb32788c313fd0875d9af00b44409 Mon Sep 17 00:00:00 2001 From: Zach <70336307+palmorezm@users.noreply.github.com> Date: Sun, 15 May 2022 21:51:27 -0400 Subject: [PATCH 06/19] Update .gitignore Add environment (env) to gitignore - consider alternatives for storing packages, their versions, and other dependencies when applicable --- .gitignore | Bin 12 -> 12 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/.gitignore b/.gitignore index 457e4bc3340e75c2160262432987d1fb3bd4c3a7..6ddb288591a0d7b87495d491d0766ff069e73997 100644 GIT binary patch literal 12 QcmYezE7MEOE8_xT035Ic9smFU literal 12 TcmezWFO?yWp^Sl-fr|kEAy@-m From 2e6b51c974a6417e208fae4ab6a2b22f44f9d28d Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 14 Aug 2022 13:07:10 -0500 Subject: [PATCH 07/19] Add index.qmd For review before posting --- index.qmd | 741 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 741 insertions(+) create mode 100644 index.qmd diff --git a/index.qmd b/index.qmd new file mode 100644 index 00000000..58ef08f9 --- /dev/null +++ b/index.qmd @@ -0,0 +1,741 @@ +--- +title: "Claim Prediction" +subtitle: "An Auto Insurance Example" +author: "Zach Palmore" +date: "2022-08-14" +categories: [news, code, analysis] +image: "image.jpg" +format: + html: + code-fold: true + code-tools: true + code-link: true + highlight-style: pygments + html-math-method: katex + df-print: paged + cache: true +--- + +# Assignment 4 + +------------------------------------------------------------------------ + +```{r Packages, warning=F, message=F} +#| label: load-pkgs +#| code-summary: "Packages" +#| message: false +library(tidyverse) +library(kableExtra) +library(ggcorrplot) +library(reshape2) +library(bestNormalize) +library(caret) +library(MASS) +library(pROC) +library(stats) +library(ROCR) +theme_set(theme_minimal()) +``` + +\newpage + +## Purpose + +In this homework assignment, we will explore, analyze and model a data set containing approximately 8000 records representing a customer at an auto insurance company. Each record has two response variables. The first response variable, TARGET_FLAG, is a 1 or a 0. A "1" means that the person was in a car crash. A zero means that the person was not in a car crash. The second response variable is TARGET_AMT. This value is zero if the person did not crash their car. But if they did crash their car, this number will be a value greater than zero. + +Our objective is to build multiple linear regression and binary logistic regression models on the training data to predict the probability that a person will crash their car and also the amount of money it will cost if the person does crash their car. We can only use the variables given (or variables derived from the variables provided). Below is a short description of the variables of interest in the data set: + +```{r} +# short descriptions of variables as table from matrix +vardesc <- data.frame(matrix(c( +'INDEX', 'Identification variable', +'TARGET_FLAG', 'Was car in a crash? 1 = Yes, 0 = No', +'TARGET_AMT', 'Cost of car crash', +'AGE', 'Age of driver', +'BLUEBOOK', 'Value of vehicle', +'CAR_AGE', 'Vehicle age', +'CAR_TYPE', 'Type of car', +'CAR_USE', 'Main purpose the vehicle is used for', +'CLM_FREQ', 'Number of claims filed in past five years', +'EDUCATION', 'Maximum education level', +'HOMEKIDS', 'Number of children at home', +'HOME_VAL', 'Value of driver\'s home', +'INCOME', 'Annual income of the driver', +'JOB', 'Type of job by standard collar categories', +'KIDSDRIV', 'Number of children who drive', +'MSTATUS', 'Marital status', +'MVR_PTS', 'Motor vehicle inspection points', +'OLDCLAIM', 'Total claims payout in past five years', +'PARENT1', 'Single parent status', +'RED_CAR', '1 if car is red, 0 if not', +'REVOKED', 'License revoked in past 7 years status', +'SEX', 'Driver gender', +'TIF', 'Time in force', +'TRAVETIME', 'Distance to work in minutes', +'URBANICITY', 'Category of how urban the area the driver lives is', +'YOJ', 'Number of years on the job' +), byrow = TRUE, ncol = 2)) +colnames(vardesc) <- c('Variable', 'Description') +kbl(vardesc, booktabs = T, caption = "Variable Descriptions") %>% + kable_styling(latex_options = c("striped", "HOLD_position"), full_width = F) +``` + +------------------------------------------------------------------------ + +\newpage + +## Introduction + +There are 8161 observations of 26 variables in this data set. Each variable is a statistic describing the behavior of an individual driver. Presumably, they are connected to the presence or absence of an accident and contain enough information to estimate the cost of a claim for the accident. To begin, we read in two data sets, one for model training appropriately named, 'tdata,' and one for evaluation named 'edata.' + +```{r} +tdata <- read.csv( + "https://raw.githubusercontent.com/palmorezm/msds/main/Business%20Analytics%20and%20Data%20Mining/HW4/insurance_training_data.csv") +edata <- read.csv( + "https://raw.githubusercontent.com/palmorezm/msds/main/Business%20Analytics%20and%20Data%20Mining/HW4/insurance-evaluation-data.csv") +``` + +We capture the first four initial observations of driver behavior. In this case, we are looking for any immediate or glaring problems with the first few rows. For example, we check that the data type matches the intended variable, that the observation makes logical sense for its intended column header, and that the data is organized appropriately into rows and columns among other big picture things. Those observations are displayed in table 2 titled "Initial Observations." + +```{r} +initialobs <- tdata[1:4,] +kbl(t(initialobs), booktabs = T, caption = "Initial Observations") %>% + kable_styling(latex_options = c("striped", "HOLD_position"), full_width = F) %>% + add_header_above(c(" ", " ", "Row Number", " ", " ")) %>% + footnote(c("Includes the first four observations of all variables in the data")) +``` + +As a positive, each row does seem to contain the proper corresponding variable. There is no blatant mixing. However, there are noticeable issues. The variables 'INCOME' and 'HOME_VAL' contain '\$' character symbols which are completely irrelevant and will cause major problems if we were to interpret or analyze with the data as is. Interestingly, there is also a 'z\_' present in some categories and not in others. To understand how these variables may affect the analysis as is and to learn exactly what must be done to prepare the data, we must explore further. + +------------------------------------------------------------------------ + +\newpage + +## Data Exploration + +Before we delve into the nitty gritty of this data set, we should consider what effect each of these variables might exert on the outcome. Since there are two targets of different types, and thus two models (one binary logistic classifier and one multiple linear regression) there could be an influence on either or both models. As we understand it, the theoretical effects of each variable are recorded in the table below. + +```{r} +# theoretical effects +vareffects <- data.frame(matrix(c( +'INDEX', 'None', +'TARGET_FLAG', 'None', +'TARGET_AMT', 'None', +'AGE', 'Youngest and Oldest may have higher risk of accident', +'BLUEBOOK', 'Unknown on probability of collision but correlated with payout', +'CAR_AGE', 'Unknown on probability of collision but correlated with payout', +'CAR_TYPE', 'Unknown on probability of collision but correlated with payout', +'CAR_USE', 'Commerical vehicles might increase risk of accident', +'CLM_FREQ', 'Higher claim frequency increases likelihood of future claims', +'EDUCATION', 'Theoretically higher education levels lower risk', +'HOMEKIDS', 'Unknown', +'HOME_VAL', 'Theoretically home owners reduce risk due to more responsible driving', +'INCOME', 'Theoretically wealthier drivers have fewer accidents', +'JOB', 'Theoretically white collar+ jobs are safer', +'KIDSDRIV', 'Increased risk of accident from inexperienced driver', +'MSTATUS', 'Theoretically married people drive safer', +'MVR_PTS', 'Increased risk of accident', +'OLDCLAIM', 'Increased risk of higher payout with previous payout', +'PARENT1', 'Unknown', +'RED_CAR', 'Theoretically increased risk of accident based on urban legend', +'REVOKED', 'Increased risk of accident if revoked', +'SEX', 'Theoretically increased risk of accident for women based on urban legend', +'TIF', 'Decreased risk for those who have greater loyalty', +'TRAVETIME', 'Longer distances increase risk of accident', +'URBANICITY', 'The more urban the area the greater the risk of accident', +'YOJ', 'Decreased risk for those with greater longevity' +), byrow = TRUE, ncol = 2)) +colnames(vareffects) <- c('Variable', 'Effect') +kbl(vareffects, booktabs = T, caption = "Theoretical Variable Effects") %>% + kable_styling(latex_options = c("striped", "HOLD_position"), full_width = F) +``` + +This table considers the effects of both models but they are only theoretical and may not necessarily reflect the true influence. We will evaluate these directly in the model selection process. For now, they will serve as general baseline expectations for exploration and preparation. We continue by exploring the data to determine where munging may be necessary. + +Unfortunately, this data needs work even before we are able to make visualizations and contemplate improvements to the model. We consider the amount of missing values in relative proportions to each variable, followed by their respective data types, an example observation of each type, and the quantity of unique factors to each variable. We already know that some major work needs to be done in readjusting data types but we do not know the extent to which each variable needs improvement. This will help narrow down what is needed to prepare the data for modeling. Results are shown in the table: + +```{r} +tdata.nas <- lapply(tdata, function(x) sum(is.na(x))) +tdata.len <- lapply(tdata, function(x) length(x)) +tdata.permis <- lapply(tdata, function(x) round(sum(is.na(x))/length(x)*100, 1)) +tdata.types <- lapply(tdata, function(x) class(x)) +tdata.firstob <- lapply(tdata, function(x) head(x, 1)) +tdata.uniques <- lapply(tdata, function(x) length(unique(factor(x)))) +tdata.tbl.natypes <- cbind(tdata.nas, tdata.len, tdata.permis, tdata.types, tdata.firstob, tdata.uniques) +colnames(tdata.tbl.natypes) <- c("Missing", "Total", "%", "Data Type", "Example", "Factors") +kbl(tdata.tbl.natypes, booktabs = T, caption = "Data Characteristics") %>% + kable_styling(latex_options = c("striped", "HOLD_position"), full_width = F) +``` + +Three variables contain incomplete records including 'AGE', 'YOJ', and 'CAR_AGE' with 0.1%, 5.6%, and 6.2% of their data missing respectively. Theoretically each variable would have 8161 total observations as noted in the table. The data types are either integer or numeric and the examples display what the type looks like for easy referencing. A calculation of the unique factors for each variable is included to gauge whether converting to a factor data type would be right for the variable and count the number of unique values to each. These are major concerns. + +Minima, quartiles, averages, and maximums were computed to compare the numeric integer variables. Although the order of the variables remains the same as in the previous table, we added a missing values column with the row identifier 'NA' to count the number missing for tracking purposes. We put this together in a table called Summary Characteristics. Of course, several of the variables will need to be altered before we can evaluate if the data makes sense in a real-life scenario. These are shown as NA in the table. + +```{r} +tdata.summary.tbl <- summary(tdata) +kbl(t(tdata.summary.tbl), booktabs = T, caption = "Summary Characteristics") %>% + kable_styling(latex_options = c("striped", "scale_down", "hold_position"), full_width = F) +``` + +Notice, there are quite a few NA values and our binary outcomes such as 'KIDSDRIV',and even our 'TARGET_FLAG' appear to be skewed heavily. It will require a closer at their distributions look to be sure of this but regardless, they will need to be dealt with if we plan to use them in our models. Factors like the single parent indicator, 'PARENT1', the individuals binary gender 'SEX', whether a driver's license was revoked 'REVOKED' and others like 'MSTATUS,''URBANICITY,' and 'CAR_USE,' take on a character data types that are not useful in modeling. For practical purposes, they should be made factors so that their categories may be understood fully. + +Several of these variables also have statistics that do not make logical sense. For example, 'CAR_AGE' has a minimum value of -3. This is not possible. Other numeric variables are clearly sets of dollar values but show as character strings. These will need to converted to numeric data types and the quantitative value portion of the string extracted. This and the factorization of cateogircal variables without a necessary order should help eliminate the many missing or 'NA' calculations performed above. + +Generally, it is best to avoid reviewing the distribution of variables prior to munging the full data set to visualize all variables simultaneously.However, we have enough variables that are already of the numeric type that plotting them each together might overcrowd the chart. A new strategy should be considered. In this effort, we review the density of the numeric variables as they exist now to evaluate agreement with the assumptions of linearity. + +```{r} +tdata %>% + select_if(is.numeric) %>% + gather %>% + ggplot() + + facet_wrap(~ key, scales = "free") + + geom_density(aes(value, color = value, fill = key, alpha = .5)) + theme(axis.title = element_blank(), legend.position = "none") + ggtitle("Numeric Variable Density") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Variables 'CLM_FREQ,' 'HOMEKIDS,' and 'KIDSDRIV' show integer values for a discrete distribution. These will be treated differently in the preparation process because their non-conformity with a linearity will not effect their ability to predict in the binary logistic classification model. Results in that model to examine the probability of 'TARGET_FLAG' will remain stable. However, the multiple linear regression model suffers a loss of potential predictors due to their inability to meet the assumptions of linear regression. + +Our continuous variables, 'AGE,' 'CAR_AGE,' 'TRAVTIME,' 'MVR_PTS,' and 'YOJ' are much better suited to predict 'TARGET_AMT.' To our benefit, age is normally distributed with the bulk of the driver ages' falling between 30 and 60. Given the theoretical effect of younger drivers on the likelihood of an accident this variable could be useful in our logistic regression model especially when converted to a binary outcome of young or not. But there are now reasons to doubt their agreement with the assumptions. + +Consider the assumption of normality where only the 'AGE' variable satisfies. All other non-discrete and non-integer values, including 'CAR_AGE,' 'YOJ,' 'MVR_PTS,' 'TIF,' and 'TRAVTIME' are poorly classified as normal, if at all. There are at least two distinct peaks in the distribution of 'YOJ,' 'TIF,' and 'CAR_AGE.' Our 'MVR_PTS' is too dense at the front of the distribution but still manages to have less skewness than our 'TARGET_AMT.' The variable closest to satisfying this assumption is perhaps 'TRAVTIME' which has an unproven theoretical effect to increase the chance of an accident as the time increases and may also be bimodal. + +Given the problematic nature of a major assumption of linear regression it would be tough to say modeling with any of these could make useful predictions. Without intense transformations we risk guessing wildly at the resultant amount. However, the degree to which transformations must be performed to cause this data to appear normal would grossly misrepresent the data and greatly increase our error rate in both models if we chose to use assign them places in each. However, we must continue knowing this and attempt to improve upon the expectation. In this endevaour, we also check a few other assumptions with violin plots and a boxplot estimation. + +```{r} +tdata %>% + select_if(is.numeric) %>% + gather %>% + ggplot(aes(value, key)) + + facet_wrap(~ key, scales = "free") + + geom_violin(aes(color = key, alpha = 1)) + + geom_boxplot(aes(fill = key, alpha = .5), notch = TRUE, size = .1, lty = 3) + + stat_summary(fun.y = mean, geom = "point", + shape = 8, size = 1.5, color = "#000000") + + theme(axis.text = element_blank(), + axis.title = element_blank(), + legend.position = "none") + + ggtitle("Numeric Variable KDE & Distribution") + + theme(plot.title = element_text(hjust = 0.5)) +``` + +While the good news is our discrete integer values (that will be partially reorganized into unordered factors) continue to give us hope that model accuracy will be reasonable for our binary model, the existence of numerous outliers, high levels of variation in some distributions, and little to no normality, reduce the ability of our multiple linear regression model to produce accurate results. In this visual we can clearly note the presence of outliers for our 'TARGET_AMT' variable. Unfortunately, it appears nearly all of our useful data (where the amount is greater than zero) are considered outliers. A selection of all values greater than zero might be useful but it eliminates the option of the multiple linear regression model to predict a value of zero when there is no claim made. This is an interesting conundrum and one we should consider of the utmost importance when preparing the data and building models. + +While some other numeric variables appear to confirm our density plots, others show new issues. The normally distributed 'AGE' variable contains many outliers above and below its distribution with a slightly larger number of older drivers stretching the distribution upwards. The outliers for our discrete integer values shown as black dots would be much better suited to a bar chart. This might also let any other variables that exhibit a discrete pattern with categorical values show through a bit better. + +```{r} +tdata %>% + select_if(is.integer) %>% + gather() %>% + filter(value == 0 | 1) %>% + group_by(key) %>% + ggplot() + + facet_wrap(~ key, scales = "free") + + geom_bar(aes(value, color = value, fill = key, alpha = .5)) + theme(axis.title = element_blank(), legend.position = "none") + ggtitle("Integer Frequencies") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Outliers contained in the 'TRAVTIME' variable in the violin plot were mainly commute times of the 'greater than' kind. However, in this we notice there are more drivers with a zero minute commute time than at the average of all commuters. A similar spike in the years on job or 'YOJ' variable indicates that there are just as many drivers with near zero year on the job as there are drivers with 10 years on the job. We select a few of these to take a closer look at their categories and how they fall into equally weighted bars. + +```{r} +tdata %>% + dplyr::select(TARGET_FLAG, MVR_PTS, CLM_FREQ, HOMEKIDS, KIDSDRIV, TIF) %>% + gather() %>% + ggplot(aes(value)) + + facet_wrap(~ key, scales = "free") + + geom_bar(aes(value, color = key, fill = key, alpha = .5)) + theme(axis.title = element_blank(), legend.position = "none") + ggtitle("Select Integer Frequencies") + theme(plot.title = element_text(hjust = 0.5)) +``` + +The quantity of drivers who do not have kids that drive is much larger than any driver that has kids. The same applies to the number of kids at home and the claim frequencies. The magnitude of difference in these categories is severe and may cause issues when trying to predict the probability of an accident. If the claim frequency is majority zero, along with the number of kids at home and almost every other variable follows the same pattern, then predicting the minority class becomes more difficult. We should expect a noise-filled model with faint signal. This issue in the binary logistic classifier makes it even worse for the multiple linear regression model. + +Building on these insights, this infant minority class must be focused on to improve the accuracy and precision of both model types. Some might consider it productive to oversample the minority class, however, if we cannot reasonably assume the majority class fits the assumptions of linear regression nor that either case is particularly well-cleaned (transformed, prepared, and error-controled) enough to base real predictions on than the purpose of oversampling is moot. Otherwise, we would be trying to build a model off of incorrect assumptions and inevitably come to the wrong conclusions. Not to mention, these conclusions would be far from the reality on which the data is supposed to be representative. + +To get a better sense of where these data may overlap and the strength of their relationships we consider the correlations of the numeric variables. This includes the discrete integer values with categories and the continuous numeric variables that have not undergone data type changes. There is less of a need to consider the other non-numeric variables at this time since the binary logistic classification model does not rely on the same rules as multiple linear regression to interpret the data. + +```{r} +tdata %>% + select_if(is.numeric) %>% + cor() %>% + ggcorrplot(method = "circle", type="upper", + ggtheme = ggplot2::theme_minimal, legend.title = "Influence") + coord_flip() +``` + +Again, since this is prior to the data preparation stage, we include the index of each observation. This is a good base indicator of variables with little to no correlation with our target variables 'TARGET_FLAG' and 'TARGET_AMT.' The directional vector of the influence in each variable is color coded from -1 to 1 with the most positive correlations being closest to 1. The size of each circle represents the strength in magnitude of the relationship between the variables. + +Of course, our two target variables, 'TARGET_FLAG' and 'TARGET_AMT' are quite strongly positively correlated. The same applies for the variables 'KIDSDRIV' and 'HOMEKIDS' given that one driver should not be able to have a kid driving without having at least one kid at home. These stronger correlations pass the sanity check. + +Alternatively, the weaker, but perhaps more interesting variables, include mostly positive correlations. It seems it is much easier to increase your chances of an accident than it is to reduce them. Our only negatively correlated (blue) relationship comes from 'TIF' and our targets. Looking at this variable with 'TARGET_FLAG' you can reduce your chance of getting into an accident increasing the time you spend at the same insurance company. This is likely a result of people who stick around because they have not had an accident and their rate has remained steady. Otherwise, the driver would probably search for new insurance. + +These correlations elucidate the relationship of our 'TARGET_FLAG' or the chance of an accident better than the relationship of the variables with the 'TARGET_AMT.' Keep in mind that all of these variables are numeric types that could be used model with multiple linear regression. They are not going to be, since several of them are categorical factors and not continuous distributions, but recall that all but one fails at least one assumption of linear regression. As mentioned, the accuracy of this linear regression model will be affected by these poorly correlated data. + +------------------------------------------------------------------------ + +\newpage + +## Data Preparation + +This section will implement the changes necessary to build models with the data. Since we have two model types, we must separate the data into groups. One group will have data specialized for the binary logistic classification model and the other for the multiple linear regression. We have already determined that we will have a limited pool of data to model with for the multiple linear regression. With that said, we still attempt to scrape together some resemblance of a realistic linear regression model ignoring the fact that the data is not in accordance with the assumptions of linear regression. + +To begin, we extract the numeric variables present in 'INCOME,' 'HOME_VAL,' and others like it. In doing so we drop the '\$' sign but retain the value. Then we impute the median value for those that had missing values and evaluate the changes with summary statistics. These are recorded and calculated separately. Once the differences are checked to ensure that the variables are not drastically far off from the original values we recombine them with the training data. This process is shown below along with the first table of summary statistics from the numeric imputed variables. + +```{r} +# Select character variables +chars <- tdata %>% + dplyr::select_if(is.character) +# Use function to extract dollars +to_num <- function(x){ + x <- as.character(x) + x <- gsub(",", "", x) + x <- gsub("\\$", "", x) + as.numeric(x) +} +# Specify those dollar variables +income.values <- to_num(chars$INCOME) +home.values <- to_num(chars$HOME_VAL) +bluebook.values <- to_num(chars$BLUEBOOK) +oldclaim.values <- to_num(chars$OLDCLAIM) +concept_df <- as.data.frame(cbind(income.values, + home.values, + bluebook.values, + oldclaim.values)) +income.values.stat <- to_num(chars$INCOME) +home.values.stat <- to_num(chars$HOME_VAL) +bluebook.values.stat <- to_num(chars$BLUEBOOK) +oldclaim.values.stat <- to_num(chars$OLDCLAIM) +# impute median values for missing variables +income.values[is.na(income.values)] <- + median(income.values, na.rm = TRUE) +home.values[is.na(home.values)] <- + median(home.values, na.rm = TRUE) +bluebook.values[is.na(bluebook.values)] <- + median(bluebook.values, na.rm = TRUE) +oldclaim.values[is.na(oldclaim.values)] <- + median(oldclaim.values, na.rm = TRUE) +# Recombine into data frame +dollar.values <- + data.frame(cbind(income.values, + home.values, + bluebook.values, + oldclaim.values)) +dollar.values.stats <- + data.frame(cbind(income.values.stat, + home.values.stat, + bluebook.values.stat, + oldclaim.values.stat)) +# Join with training data +tdata <- data.frame(cbind(tdata, dollar.values)) +# Check the difference +dollar.values.tbl <- summary(dollar.values) +dollar.values.stats.tbl <- summary(dollar.values.stats) +kbl(dollar.values.tbl, booktabs = T, caption = "Imputed Summary Statistics") %>% +kable_styling(latex_options = c("striped", "hold_position"), full_width = F) +``` + +We compare this to the second table and observe the changes. If the differences between these is small, we can add the imputed variables to our original training data rather than eliminating the rows with missing variables altogether. The second table is shown here: + +```{r} +kbl(dollar.values.stats.tbl, booktabs = T, caption = "Original Summary Statistics") %>% +kable_styling(latex_options = c("striped", "hold_position"), full_width = F) +``` + +Since the differences between these variables is small and the values that were missing are no longer missing, we recombine the imputed data with the training data for later use. It turns out, it was reasonable to make these imputations, even though the data sets are skewed and do not contain total linearity or normality. + +Next, we convert the categorical variables to factors rather than the integer or characters they were. Although the analysis will still interpret these factors as integers to perform computations, we will be able to recognize the various levels associated with each variable rather than a non-descriptive number. As a special note, we are going to interpret each of these factors as an unordered set. + +```{r} +# Covert categorical variables to factors +factors <- tdata %>% + dplyr::select("PARENT1", + "MSTATUS", + "SEX", + "EDUCATION", + "JOB", + "CAR_USE", + "CAR_TYPE", + "RED_CAR", + "REVOKED", + "URBANICITY") +factors <- data.frame(lapply(factors, function(x) as.factor(x))) +factors <- factors %>% + rename("parent1" = "PARENT1", + "mstatus" = "MSTATUS", + "sex" = "SEX", + "education" = "EDUCATION", + "job" = "JOB", + "car_use" = "CAR_USE", + "car_type" = "CAR_TYPE", + "red_car" = "RED_CAR", + "revoked" = "REVOKED", + "urbanicity" = "URBANICITY") +tdata <- cbind(tdata, factors) +``` + +There was a highly unrealistic value for the variable 'CAR_AGE.' This should be excluded from the data set to avoid further damage to the modeling process. We simply find where the value is less than zero and set that value to NA. A summary of both is run to see how this changes the data. + +```{r} +# Exclude unrealistic values +tdata <- tdata %>% + mutate(car_age = ifelse(CAR_AGE<0, NA, CAR_AGE)) +summary(tdata$car_age) +summary(tdata$CAR_AGE) +``` + +As we can see there was only one value in the 'CAR_AGE' variable that contained a negative number. For our purposes, we will consider the rest realistic. Another variable that we do not need as it provide not value to the model is the 'INDEX' variable. We remove this and other unnecessary variables from the training data by selecting the variables that we suspect we may need. The total number of variables present after this selection process is shown. + +```{r include=F} +full41 <- tdata +full41 +full41[c(2:7, 15, 18, 22, 24, 27:41)] +``` + +```{r} +# Drop INDEX and other unnecessary columns +tdata <- tdata %>% + dplyr::select("TARGET_FLAG", + "TARGET_AMT", + "KIDSDRIV", + "AGE", + "HOMEKIDS", + "YOJ", + "TRAVTIME", + "TIF", + "CLM_FREQ", + "MVR_PTS", + "income.values", + "home.values", + "bluebook.values", + "oldclaim.values", + "parent1", + "mstatus", + "sex", + "education", + "job", + "car_use", + "car_age", + "car_type", + "red_car", + "revoked", + "urbanicity") +# Check total variables present +length(colnames(tdata)) +``` + +Because these variables still have missing values, further imputation is needed. The variables of 'AGE,' 'YOJ,' and 'CAR_AGE' are filled with the median value from each of their respective distributions. Of course, we created one of the missing value for 'CAR_AGE' but this one value does not effect the overall variable distribution but by 0.01% or about one in our total observations nor does it change the other 510 missing observations. This difference is negligible but we impute, continue, and repeat the process of imputation on the other aforementioned variables. + +```{r} +# More imputation +tdata$AGE[is.na(tdata$AGE)] <- + median(tdata$AGE, na.rm = T) +tdata$YOJ[is.na(tdata$YOJ)] <- + median(tdata$YOJ, na.rm = T) +tdata$car_age[is.na(tdata$car_age)] <- + median(tdata$car_age, na.rm = T) +sum(is.na(tdata)) +``` + +As expected, there are exactly 510 missing values. These all fall into the 'CAR_AGE' variable that will no longer need to be used. At this point, we consider excluding the non-imputed variable for the age of the driver's car from the data set to avoid confusion later. While we do not perform the exclusionary action, it is best to think of it as such. We do this because it may also be useful to our classification model's accuracy given that some of our new features, like if we include a young driver categorical factor, would work well with the driver's car age. Consider the nonbinary classifiers to briefly explain. + +```{r} +tdata %>% + dplyr::select(is.factor) %>% + dplyr::select("car_type", "education", "job") %>% + gather() %>% + ggplot(aes(value)) + + facet_wrap(~ key, nrow = 3, scales = "free") + + geom_bar(aes(, fill = key )) + theme(axis.title = element_blank(), axis.text.x = element_blank(), legend.position = "none") + coord_flip() + ggtitle("Nonbinary Classifiers") + theme(plot.title = element_text(hjust = 0.5)) +``` + +We suspect that based on our exploration, these three categories will have the most influence over the probability of an accident if that person is a student with a high school or less than high school education, and if they drive a sports car. These are based on the notion that, citation rates are higher for those who operate sports cars (such as by driver behavior or oversampling by police forces and ultimately police behavior), that less education leads to more risks, and that students are the most likely to take those risks because they are often younger and more susceptible to unintentional reactions from new situations that require experience to navigate safely. These circumstances, create what we might refer to as the risky people category but we refrain from categorizing because such a notion is, at this time, unfounded. + +```{r} +tdata %>% + dplyr::select(is.factor) %>% + dplyr::select("car_use", + "mstatus", + "parent1", + "red_car", + "revoked", + "sex", + "urbanicity") %>% + gather() %>% + ggplot(aes(value)) + + facet_wrap(~ key, scales = "free") + + geom_bar(aes(, fill = key )) + theme(axis.title = element_blank(), axis.text.x = element_blank(), legend.position = "none") + coord_flip() + ggtitle("Binary Classifiers Counts") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Taking a closer look at the counts of the binary classifiers, we can easily see how a model would unfairly and unintentionally pick from the counts that hold the majority of the data. This is problematic but without drastically changing the data and grossly misrepresenting reality, we cannot improve this. Oversampling to try and adjust for the small amount of minority vectors would likely exacerbate the misrepresentation of reality and increase the standard error rate. Instead we keep the variables as is and will place emphasis on using these to make accurate predictions in our binary logistic classification model. + +For our multiple linear regression model, things are a little more complicated. None of our variables are well-suited to predict the 'TARGET_AMT' and we are reliant on the results of our first model to inform it. Given this dependent relationship between models, we should reexamine their distributions with our newly formed 'INCOME,' 'HOME_VAL,' and other numeric variables to see if we have anything worthwhile to pull from. + +```{r} +tdata %>% + select_if(is.numeric) %>% + gather() %>% + ggplot(aes(key)) + + facet_wrap(~ key, scales = "free") + + geom_boxplot(aes(key, value, fill = key, alpha = .5)) + theme(axis.title = element_blank(), axis.text.x = element_blank(), legend.position = "none") + ggtitle("Numeric Distributions") + theme(plot.title = element_text(hjust = 0.5)) +``` + +It is going to difficult to pull anything of value from the 'TARGET_AMT' variable. However, we may still be able to increase the accuracy of the model overall with a transformation of the target and a little bit of history. Consider how this model works in a real-life scenario. Often, there is a host of existing data to pull from wherein the analyst can use this data to draw conclusions. This is what we are going to do. In treating some of the data as a historical reference, we will be able to increase the accuracy of the model. However, this is not likely going to improve the ability of the regression to predict future values due to the assumption failure of the values in linear regression. To extract useful information from this we will need a few new features. + +```{r} +# New features +tdata <- tdata %>% + mutate(city = ifelse(urbanicity == "Highly Urban/ Urban", 0, 1)) %>% + mutate(young = ifelse(AGE < 25, 1, 0)) %>% + mutate(clean_rec = ifelse(MVR_PTS == 0, 1, 0)) %>% + mutate(previous_accident = ifelse(CLM_FREQ == 0 & oldclaim.values == 0, 0, 1)) %>% + mutate(educated = ifelse(education %in% c("Bachelors", "Masters", "PhD"), 1, 0)) %>% + mutate(avg_claim = ifelse(CLM_FREQ > 0, oldclaim.values/CLM_FREQ, 0)) +``` + +New features are created to increase the availability of useful prediction points that our first model, the binary classifier, can implement to make the best predictions from. Since our second model relies on the outcome of the first, we should make every effort to improve this model as much as possible. Without an impeccable source of data to pull from, we cannot hope make realistic predictions for our multiple linear regression model when predicting the target amounts of each claim. + +The features include a value for city drivers, since we suspect based on the theoretical effect on the driver from our exploration that the probability of accidents for drivers who drive within areas that are mostly urban increases compared to their less urban counterparts. This likely comes down to car density and the greater the number of cars on the road in a smaller space, the higher the chance of one of those cars getting into an accident. + +We also create the feature young, for those who are aged 25 or younger, and clean_rec for those who have zero motor vehicle points. This is based mainly on car rental agreements that state anyone under 25 must pay a higher rate, that is, if they are allowed to drive the vehicle. For those who have a record, which many of them check, they are often prohibited from operating that vehicle until their record is cleared. We do not know what effect these will have on the outcome, but we hypothesize that these features will increase the chance of accidents if the data indicates a yes to any of these features. To enhance their practicality, we make their data type factors. + +```{r} +# Convert to factors +tdata$city <- as.factor(tdata$city) +tdata$young <- as.factor(tdata$young) +tdata$clean_rec <- as.factor(tdata$clean_rec) +tdata$previous_accident <- as.factor(tdata$previous_accident) +tdata$educated <- as.factor(tdata$educated) +``` + +Additionally, features are created to indicate whether a driver has been in a previous accident and the education level of the driver. Hypothetically, the less educated would take more risk. Meanwhile, we also are testing the notion that those who have been a previous accident are more likely to have one in the future. These new binary features are showns in the bar chart of 'New 'Features' to demonstrate their amount of drivers in each bin. + +```{r} +tdata[26:31] %>% + select_if(is.factor) %>% + gather() %>% + ggplot(aes(value)) + + facet_wrap(~key, scales = "free") + + geom_bar(aes(fill = key, alpha = .5)) + theme(legend.position = "none", axis.title = element_blank()) + ggtitle("New Features") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Our highly urban group compared to less urban is weighted in favor of those who a less urban. Indicating that most of the drivers in this study drive in areas that are not highly urbanized. Also, more people are educated with at least a four year degree than not. We would guess that this is likely due to lower rates of insurance for people who do not have at least a four year degree. Very few drivers are less than 25 years old and about half of the drivers have been in a previous accident. Comprehending this hints that the drivers in this study are less likely to have accidents and how results will conclude for the amount. At this time, we suspect the target amount of claims that do get processed will either be a larger than a few thousand dollars or no claim. These drivers' behavior will have a significant impact on the predicted claim amounts since they are directly dependent on the occurrence of an accident. + +To deal with the failed assumption of linear regression, we will transform the data but attempt to keep some resemblance of realism for practical purposes. Rather than guess at the best transformation, we use a function to run through many kinds of transformations and have it tell us what the most gaussian distribution is. Then, we reassign those values to a variable 'accident_costs' where the costs are greater than zero. This will be used later. Finally, we chose to focus on select variables for the transformations because none of them were great choices for prediction and transforming each send the error rate even higher. + +```{r} +# Produce recommended transformations +bestNorms <- tdata[1:11,1:16] +df <- tdata %>% + select_if(is.numeric) +for (i in colnames(df)) { + bestNorms[[i]] <- bestNormalize(df[[i]], + allow_orderNorm = FALSE, + out_of_sample =FALSE) +} +``` + +```{r} +# Continue focusing on realistic values +accident_costs <- tdata$TARGET_AMT[tdata$TARGET_AMT>.0] +``` + +```{r} +# Focus on selected variables +bestNorms$target_amt$chosen_transform +tdata$target_amt <- scale(log(tdata$TARGET_AMT + 1)) +tdata %>% + dplyr::select(where(is.numeric)) %>% + gather %>% + ggplot() + + facet_wrap(~ key, scales = "free") + + geom_density(aes(value, color = value, fill = key, alpha = .5)) + theme(axis.title = element_blank(), legend.position = "none") + ggtitle("Numeric Variable Density") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Although these are still a long shot from adhering to the condition necessary for performing linear regression, they have improved at the expense of our standard error and its dependencies. For example, the display below shows the differences between the transformed predictor 'TARGET_AMT' and its original form. In some ways the data is more normal since everything above zero resembles a near perfect bell-curve. However, there is an ominous presence of values less than zero, which for a graph where we are displaying the dollar amount of a claim, is completely useless. These changes are strictly for modeling purposes and the true values will need a reversal of this transformation to make sense of them. This is the cost of multiple linear regression without normality and it assumes the other conditions of independence, homoscedasticity, and linearity are fulfilled which, we have reasons to doubt. + +```{r} +tdata %>% + dplyr::select(where(is.numeric)) %>% + dplyr::select("TARGET_AMT","target_amt") %>% + gather %>% + ggplot() + + facet_wrap(~ key, scales = "free") + + geom_density(aes(value, color = value, fill = key, alpha = .5)) + theme(axis.title = element_blank(), legend.position = "none") + ggtitle("Numeric Variable Density") + theme(plot.title = element_text(hjust = 0.5)) +``` + +Bearing that in mind we split these variables into training data sets and testing data sets for the model. A 70-30 split should do just fine and one set of the data is used for each model. This makes it easier to differentiate the model types and statistics later. With this split, we can begin building models. + +```{r} +# Split 70-30 training test +set.seed(1102) +tindex <- createDataPartition(tdata$TARGET_FLAG, p = .7, list = FALSE, times = 1) +train <- tdata[tindex,] +test <- tdata[-tindex,] +rindex <- tdata %>% + filter(TARGET_FLAG == 1) +reg.tindex <- createDataPartition(rindex$TARGET_AMT, p = .7, list = FALSE, times = 1) +reg.train <- rindex[reg.tindex,] +reg.test <- rindex[-reg.tindex,] +``` + +------------------------------------------------------------------------ + +\newpage + +## Model Building + +In this first model we are only going to consider how well a previous accident can predict if a driver will have a future accident. We specify that it is a binomial model and exercise the training data set with it. A summary is shown for reference although it will be discussed in more detail in the selection process. + +```{r} +model1 <- glm(TARGET_FLAG ~ previous_accident, + family = binomial(link = "logit"), train) +summary(model1) +``` + +The coefficient is significant, however, it is clear this would not be the best for the model. Our standard error is only marginally greater than that of a model without any coefficients. Using the previous accident as a predictor results in a higher chance of the driver having an accident as shown with the estimate above. This is only meant to be a dummy test though because we know that there are more factors to consider in the probability of having an accident as a driver. We should expect improvement in this classification from here. + +```{r} +model2 <- glm(TARGET_FLAG ~ previous_accident + + city + young + clean_rec + + educated, family = binomial(link = "logit"), train) +summary(model2) +``` + +This model consider what we would consider the riskiest model. It takes the young, city driver, who we think would take more risks and compares the coefficients. Each one is a significat predictor at the .001 alpha level. All but one of these predictors had a better standard error than the null model. Education stood out as a negative estimator with those in this category probably being mostly students or having less than a bachelors degree and less experience driving overall. We suspect this model is better than the previous one. + +```{r} +model3 <- glm(TARGET_FLAG ~ previous_accident + + city + mstatus + income.values + + sex + car_use + educated + KIDSDRIV + + revoked, family = binomial(link = "logit"), + train) +summary(model3) +``` + +Since there are a few other factors to consider, we added the predictors of 'mstatus,' factorized 'car_use,' 'KIDSDRIV,' and other important considerations to us when estimating the risk of a driver getting into an accident. This model has a lower AIC and should be better at predicting the target because it has a better fit. Interesting the addition of the factorized 'sex' predictor seems to have a positive effect on driving (lowering the chance of accident). This may be due to the sample sizes and how the counts are created, but it does not agree with the theory that females are worse drivers, in implies the opposite. + +From here we begin the multiple linear regression modeling. In this first model, we throw everything we have at it to see what works. This model will give us a good indication of what could be useful to us and although it is not likely a good predictive model, we will try to find the best predictors possible. + +```{r} +model4 <- lm(target_amt ~ ., train) +summary(model4) +``` + +Since the many of the model's predictors are transformed the estimate of those predictors will not be a useful indicator of anything. However, there are two values that are signifcant at the 0.05 alpha level. These coefficients are 'CLM_FREQ' and 'jobHome_Maker.' These indicate that their presence is a significant addition to the model to help determine the amount of a claim. However, from our exploration and preparation of these points, these particular predictor confer no numeric value to estimate the claim amount by. This renders them useless for our purposes but significantly so. We will rearrange with a select few numeric variables next to see if this improves. + +```{r} +model5 <- lm(target_amt ~ income.values + + home.values + bluebook.values + + oldclaim.values + avg_claim, + train) +summary(model5) +``` + +These continuous numeric predictors are significant. The 'avg_claim' predictor is present soley to assist in the control of unrealistic estimates. It is not a signifcant predictor. However, the others are. Additionaly, 'bluebook.values' a near natural indicator of the value of a car is a ironically, a good indication of the claim value. This model is much better since it does not pretend to have historical data to build on. However, as expected, the realistic ability of this model to predict is impractical with a coefficient of determination around .05. Such a model is worse at predicting true values on the surface because the data's transformation must be reversed to see logical values. Unfortunately, this model does not bode well with such a reversal as it repeatedly fails conditonal assumptions of linear regression. + +```{r include=F, eval=F} +model7 <- lm(target_amt ~ + income.values + + home.values + + bluebook.values + + oldclaim.values + + # 2nd Degree + ident(avg_claim, train^2) + + I(income.values^2) + + I(home.values^2) + + I(bluebook.values^2) + + I(oldclaim.values^2) + + I(avg_claim, train^2) + + # 3rd Degree + I(avg_claim, train^3) + + I(income.values^3) + + I(home.values^3) + + I(bluebook.values^3) + + I(oldclaim.values^3) + + I(avg_claim, train^3), train + ) +pm <- stepAIC(model7, trace = F, direction = "both") +p <- summary(pm)$call +pm <- lm(p[2], df) +summary(pm) +``` + +```{r} +model6 <- lm(target_amt ~ . -TARGET_AMT -TARGET_FLAG, train) +pm <- stepAIC(model6, trace = F, direction = "both") +summary(pm) +``` + +Lastly, we took a new approach. Our kitchen sink model is the model that contain the most realistic expectations and so we optimize the model to perform a a stepAIC in both directions and ideally improve accuracy. With this, we attempt to create the most realistic model with a higher AUC regardless of coefficient significance. This method should produce the highest coefficient of determination without compromising the data's integrity. We will review these results in the model selection process. + +------------------------------------------------------------------------ + +\newpage + +## Model Selection + +To select the best model we will run some statistics on each. We will utilize a prediction model statistics function called 'modstat' rather than repeating the same estimates by hand. This will put all models on the same level of focus. It includes and confusion matrix, predicted probability and amount values, the AUC, F1 scores, a ROC plot for each model. The process is documented in the function below. We start with the binary logistic classification models and then move onto the multiple linear regression. + +```{r} +# Calculate predicted values +# Classifier Model +mod1.pred <- predict.glm(model1, test) +mod2.pred <- predict.glm(model2, test) +mod3.pred <- predict.glm(model3, test) +# Regression Model +mod4.pred <- predict(model4, test, interval = "prediction") +mod5.pred <- predict(model5, test, interval = "prediction") +mod6.pred <- predict(model6, test, interval = "prediction") +``` + +```{r} +modstat <- function(model, test, target = "TARGET_FLAG", threshold = 0.5){ + test$new <- ifelse(predict.glm(model, test, "response") >= threshold, 1, 0) + cm <- confusionMatrix(factor(test$new), factor(test[[target]]), "1") + df <- data.frame(obs = test$TARGET_FLAG, predicted = test$new, probs = predict(model, test)) + Pscores <- prediction(df$probs, df$obs) + AUC <- performance(Pscores, measure = "auc")@y.values[[1]] + pscores <- performance(Pscores, "tpr", "fpr") + plot(pscores,main="ROC Curve", sub = paste0("AUC: ", round(AUC, 3))) + results <- paste(cat("F1 = ", cm$byClass[7], " "), cm) + return(results) +} +``` + +```{r} +modstat(model1, test) +``` + +This model was our dummy run. It is not expected to perform as well as the intentionally hand-picked models but it did give us some baseline information to go on. Perhaps the first thing we notice in the nonapplicable F1 score because this model correctly classified 1812 as true positives while 636 were false positive. None were present in the other categories due to the misrepresentation of the minority class. This model is not particularly useful for prediction but it is a great start to see how influential the majority class is. + +```{r} +modstat(model2, test) +``` + +In this model we consider a few more predictors and ended with a reasonable espectation of sensitivity (24%) specificity (93%) and accuracy at 74%. This is an improvement on the previous model and garners an AUC of 0.743. Our trouble lies in the F1 score where we have relatively poor precision and poor recall when predicting the probability of an accident. Let's see how we improved upon this. + +```{r} +modstat(model3, test) +``` + +For our final binary classification model, this is an improvement. the F1 score did increase to 0.42 with a better accuracy of about 77%. It appears addint factors beyond just those that many would consider risky, determines the probability of an accident better than the risk behavior alone. Our AUC for this model is 0.782. + +```{r} +modstat(model4, test) +``` + +Here, we purposefully made a prediction from a rank-deficient fit that contained misrepresentative variables. For example, our target contained values that were between -2 and 2 when they should have been on the scale of 0-100,000 as dollars. For this reason, we made this model to show how we could improve the model's accuracy to a perfect value by including many transformed values in the model itself. However, the reality is that this model is completely useless because to gather any information from it that is real, the data must be reversed from its transformation and reformed to represent a true value of the claim amounts. Rather than go through this effort, we let this one inform our next model. + +```{r} +modstat(model5, test) +``` + +Here again we are pulling from a tough data set. The ability of this model to predict true positives is great and with an accuracy of 73% we are gaining traction at predicting with it. Our AUC was also 0.643. However, this model incorrectly assumes almost all drivers are going to get into accidents. this comes from the distribution and sampling of the data. The majority class greatly outnumbers the minoirity causing them to be misrepresented. This should be improved upon, which mean improving our F1 score from 0.090 to something closer to 1. + +```{r} +modstat(model6, test) +``` + +Importantly, this model acheives the goal we set with our last model. Our F1 score improved to 0.484 which, although it is still not great, is better than 0.090. Additionaly this model offers the best accuracy of the multiple linear regression models with about 79%. Our AUC is also 0.812 which serves us better in prediction than the other models. However, it should be noted that the ability of this model to make accurate predictions is still poor and that if data were to be run through this model, it would need a reversal of its transformation to make logical sense and be used in practice. + +## Conclusion + +Given insurance data of the same types and identities, the third and sixth models should be used to export the most favorable data sets for making realistic predictions. The third runs a binary logistic classifier and the sixth the multiple linear regression model. However, it should be noted that the use of the sixth model to produce results for informing insurance practices is ill-advised with results as is. These data should be reformed into useful figures by reversing the transformation of the target, the claim amount. + +Additionally, reliance on the third model is minimized as much as possible but it should be known that better data collection may be necessary to produce more realistic results. The current rate of accuracy is only about 77% without more gaussian data. Prediction of the claim amount after predicting whether an individual will get into an accident is also tedious and tempermental due to the data's failure to comply with the conditional assumptions of linear regression. The best accuracy we could produce with this claim prediction model is about 79% but the fit of the model judging by the coefficient of determination is only about 0.22. + +Predicting the claim amount is more difficult than determining whether an individual will get into an accident. Future models should consider how to limit the influence of the majority class on the surpression of the minority class to make better predictions since the minority class is where the accidents and claim values larger than zero are. We also recommend a better collection method in which people can be more honest and open about their responses. If this data did come from a valid insurance provider, which it appear to have been, then the models will be skewed based on the data, as is demonstrated. From d9b7512fa5110aae84b35b8d31794160c9c01244 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 14 Aug 2022 13:09:41 -0500 Subject: [PATCH 08/19] Add Index to Posts --- index.qmd => Posts/index.qmd | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename index.qmd => Posts/index.qmd (100%) diff --git a/index.qmd b/Posts/index.qmd similarity index 100% rename from index.qmd rename to Posts/index.qmd From 3fa4cb129cff7746c2b94d55985e8779221c6a4b Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sat, 20 Aug 2022 21:35:38 -0500 Subject: [PATCH 09/19] Add Notes --- home_afford_app/notes | 53 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/home_afford_app/notes b/home_afford_app/notes index 4bb19e77..b4cdf845 100644 --- a/home_afford_app/notes +++ b/home_afford_app/notes @@ -2,25 +2,56 @@ Notes -Goal: - - +Goal(s): +When will we have enough savings to make a down payment of 20% on a home we can afford? Deliverable: -1. Mel wants to be able to take the output from down payment (dp) amount from bottom section +1. To be able to take the output from down payment (dp) amount from bottom section then spit out the date in the top section of when we would have the dp amount. -2. Mel wants to plot a vertical line on the graph at the point where dp occurs +2. Add to plot of savings a vertical line on the graph at the point where dp occurs and maybe this line can have a hover feature? -3. Mel wants a function where user can input existing savings, expenses, and income - +3. A function where user can input existing savings, expenses, and income + +4. A plot of real expenses and real income (preferably on the same plot) + these should go back to at least February of 2022 + +5. Visible dates on Plot that make sense to user + +6. Change plot background and aesthetics + a. White background + b. Minimal gridding + c. X axis name + d. y axis name + e. Good title + f. interactivity (hover features) + +7. Display dollar outputs in grid with larger/built in format (flexdash style) + Ex: https://shiny.rstudio.com/gallery/nz-trade-dash.html + +. (perhaps another app) link the savings data with a map + a. input your area (where you live/work) + b. input where you are looking to buy a house + c. then it shows you homes that you can afford (like a zillow search) + d. estimate how far away you would need to move to find a house in your price range + +. (this may be for a separate app) Another tab for expense analysis where we can see + a. where the categories of expenses are greatest/least + b. comparison of prices at Walmart vs Aldi + c. Can I purchase this thing and still be within budget? + d. Do we need to collect any additional data for learning purposes? + Ex: collecting size/amounts for equal items to compare prices + e. How much would it increase our expenses to make [x] transaction? ('What if' scenario) + + -It would be nice to have (wish list): - - - +Other Thoughts: -Objective: +What if we built a model into the app that could classify the category based on location, description, price? +- Can I purchase this thing and still be within budget? +Comparing prices of goods (one store from another): + Ex: Aldi vs Walmart - what items are cheaper? From f05e67b9d574dde322fb4dd035efda461ab1fa1f Mon Sep 17 00:00:00 2001 From: palmorezm Date: Thu, 25 Aug 2022 10:07:34 -0500 Subject: [PATCH 10/19] Replace Notes --- home_afford_app/.Rhistory | 6 ++++++ 1 file changed, 6 insertions(+) create mode 100644 home_afford_app/.Rhistory diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory new file mode 100644 index 00000000..bcd07602 --- /dev/null +++ b/home_afford_app/.Rhistory @@ -0,0 +1,6 @@ +shiny::runApp() +install.packages("gridlayout") +runApp() +runApp() +runApp() +runApp() From d9e1e0621fbed12afe05b36c1ec24c03295cf287 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 11 Sep 2022 17:45:49 -0500 Subject: [PATCH 11/19] Create App UI Alternatives --- home_afford_app/.Rhistory | 145 ++++++++++++++++++++++++++++ home_afford_app/app.R | 22 +++-- home_afford_app/app2.R | 146 +++++++++++++++++++++++++++++ home_afford_app/app3.R | 108 +++++++++++++++++++++ home_afford_app/app4.R | 31 ++++++ home_afford_app/card_with_button.R | 37 ++++++++ 6 files changed, 483 insertions(+), 6 deletions(-) create mode 100644 home_afford_app/app2.R create mode 100644 home_afford_app/app3.R create mode 100644 home_afford_app/app4.R create mode 100644 home_afford_app/card_with_button.R diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory index bcd07602..a90ec472 100644 --- a/home_afford_app/.Rhistory +++ b/home_afford_app/.Rhistory @@ -4,3 +4,148 @@ runApp() runApp() runApp() runApp() +shiny::runApp() +source("helper.R") +library(shiny) +library(gridlayout) +install.packages("gridlayout") +install.packages("shinyuieditor") +install.packages("updateR") +library(installr) +install.packages("installr") +installr::updateR(copy_packages = TRUE) +library(gridlayout) +library(shiny) +# library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +install.packages("remotes") +library(remotes) +remotes::install_github("rstudio/shinyuieditor") +runApp() +library(flexdashboard) +install.packages("flexdashboard") +install.package("shinydashboard") +library(shinydashboard) +shinyuieditor::launch_editor() +shinyuieditor::launch_editor(app_loc = "Home/home_afford_app") +shinyuieditor::launch_editor(app_loc = "Home/home_afford_app/app.R") +shinyuieditor::launch_editor(app_loc = "app.R") +setwd("C/Users/Zachary Palmore/GitHub/Home/home_afford_app") +setwd("C/Users/Zachary Palmore/GitHub/Home") +setwd("C:/Users/Zachary Palmore/GitHub/Home/home_afford_app") +runApp() +shinyuieditor::launch_editor(app_loc = "app.R") +shinyuieditor::launch_editor() +shinyuieditor::launch_editor(app_loc = "C:/Users/Zachary Palmore/GitHub/Home/home_afford_app") +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +runApp() +?dateRangeInput() +runApp() +gc() +library(shinythemes) +runApp('app2.R') +runApp('app2.R') +runApp('app2.R') +runApp('app2.R') +runApp('app2.R') +runApp('app2.R') +runApp('app2.R') +library(shinydashboard) +## Only run this example in interactive R sessions +if (interactive()) { +library(shiny) +ui <- dashboardPage( +dashboardHeader(title = "Dynamic boxes"), +dashboardSidebar(), +dashboardBody( +fluidRow( +box(width = 2, actionButton("count", "Count")), +infoBoxOutput("ibox"), +valueBoxOutput("vbox") +) +) +) +server <- function(input, output) { +output$ibox <- renderInfoBox({ +infoBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +output$vbox <- renderValueBox({ +valueBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +} +shinyApp(ui, server) +} +server <- function(input, output) { +output$ibox <- renderInfoBox({ +infoBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +output$vbox <- renderValueBox({ +valueBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +} +## Only run this example in interactive R sessions +if (interactive()) { +library(shiny) +ui <- dashboardPage( +dashboardHeader(title = "Dynamic boxes"), +dashboardSidebar(), +dashboardBody( +fluidRow( +box(width = 2, actionButton("count", "Count")), +infoBoxOutput("ibox"), +valueBoxOutput("vbox") +) +) +) +server <- function(input, output) { +output$ibox <- renderInfoBox({ +infoBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +output$vbox <- renderValueBox({ +valueBox( +"Title", +input$count, +icon = icon("credit-card") +) +}) +} +shinyApp(ui, server) +} diff --git a/home_afford_app/app.R b/home_afford_app/app.R index 330b32e5..567017ab 100644 --- a/home_afford_app/app.R +++ b/home_afford_app/app.R @@ -1,9 +1,13 @@ source("helper.R") library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") library(gridlayout) library(tidyverse) library(lubridate) library(scales) +library(flexdashboard) +library(shinydashboard) # App template from the shinyuieditor ui <- grid_page( @@ -35,17 +39,19 @@ ui <- grid_page( numericInput( inputId = "monthly_income", label = "Monthly Income (net)", - value = 1000L + value = 4290L ), numericInput( inputId = "expenses", label = "Monthly Expenses", - value = 1000L + value = 3241L ), dateRangeInput( inputId = "dates", label = "Date Range", - format = "mm-dd-yyyy" + format = "mm-dd-yyyy", + start = "2022-01-01", + end = "2028-01-01" ) ), grid_card_text( @@ -79,7 +85,7 @@ ui <- grid_page( ), numericInput( inputId = "rate", - label = "Interest Rate", + label = "Interest Rate (%)", value = 4L ) ), @@ -105,8 +111,10 @@ server <- function(input, output) { end_date = input$dates[2]) # plot savings over date range ggplot(df, aes(x = Date, y = Savings, group = 1)) + - geom_line() + scale_x_date(date_labels = "%b-%Y") + - scale_y_continuous(labels=scales::dollar_format()) + geom_line() + + scale_x_date(date_labels = "%b-%Y") + + scale_y_continuous(labels=scales::dollar_format()) + + theme_minimal() }) output$homeAmount <- renderText({ @@ -123,6 +131,8 @@ server <- function(input, output) { paste(homePrice, downPayment, mortgageAmount, monthlyPayment, sep="\n") }) + output$PriceofHome <- renderText(expr = "$367,924") + } shinyApp(ui, server) diff --git a/home_afford_app/app2.R b/home_afford_app/app2.R new file mode 100644 index 00000000..d32ff377 --- /dev/null +++ b/home_afford_app/app2.R @@ -0,0 +1,146 @@ + +source("helper.R") +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinydashboard) +library(shinythemes) + +ui <- navbarPage( + "Home Savings", + theme = shinytheme("cosmo"), + # header = "Header Section for all Tabs in Navbar", + tabPanel( + title = "Plot", + # column(c(4, 8), + # Title = "Selection Options"), + sidebarPanel( + h3("Heading 3"), + numericInput( + inputId = "init_savings", + label = "Current Savings", + value = 1000L + ), + numericInput( + inputId = "monthly_income", + label = "Monthly Income (net)", + value = 4290L + ), + numericInput( + inputId = "expenses", + label = "Monthly Expenses", + value = 3241L + ), + dateRangeInput( + inputId = "dates", + label = "Date Range", + format = "mm-dd-yyyy", + start = "2022-01-01", + end = "2028-01-01" + ) + ), + mainPanel("Main1", + plotOutput(outputId = "linePlot")) + ), # End Tab 1 + tabPanel( + title = "Key", + fluidPage( + sidebarPanel( + h3("Heading 3"), + numericInput( + inputId = "yearly_income", + label = "Yearly Income (gross)", + value = 60000L + ), + sliderInput( + inputId = "percent", + label = "Down Payment %", + min = 0L, + max = 100L, + value = 20L, + width = "100%" + ), + numericInput( + inputId = "term", + label = "Loan Term (years)", + value = 30L + ), + numericInput( + inputId = "rate", + label = "Interest Rate (%)", + value = 4L + ) + ), + mainPanel("Main2", + textOutput(outputId = "homeAmount")), + ) + ), + tabPanel( + "Name Card", + box(title = "Home Price", + footer = "Footer here", + background = "aqua", collapsible = FALSE) + ), + valueBox(value = "$367,900", subtitle = "subtitle", color="aqua") + ) + + + + + # Define server logic required to draw a histogram +server <- function(input, output, session) { + + output$linePlot <- renderPlot({ + # calculate savings from income and expenses + savings <- monthly_savings(input$monthly_income, input$expenses) + # create df from init_savings, savings, start_date, and end_date + df <- create_savingsdf(init_savings = input$init_savings, + savings, + start_date = input$dates[1], + end_date = input$dates[2]) + # plot savings over date range + ggplot(df, aes(x = Date, y = Savings, group = 1)) + + geom_line(size = 2) + + scale_x_date(date_labels = "%b-%Y") + + scale_y_continuous(labels=scales::dollar_format()) + + theme_minimal() + }) + + output$homeAmount <- renderText({ + # calculate how much home you can afford based on inputs + mortgage <- mortgage_payment(input$yearly_income) + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + home_price <- calculate_home_price(loan) + down_payment <- down_payment(loan, input$percent) + # display results + homePrice <- paste("Home Price: ", dollar(home_price, largest_with_cents = 100)) + downPayment <- paste("Down Payment: ", dollar(down_payment, largest_with_cents = 100)) + mortgageAmount <- paste("Mortgage Amount: ", dollar(loan, largest_with_cents = 100)) + monthlyPayment <- paste("Monthly Payment: ", dollar(mortgage, largest_with_cents = 100)) + paste(homePrice, downPayment, mortgageAmount, monthlyPayment, sep="\n") + }) + + # output$PriceofHome <- renderText(expr = "$367,924") + output$PriceofHome <- shinydashboard::renderValueBox( + shinydashboard::valueBox(value = "$367,924", + title = "Title", + subtitle = "Home Price", + icon = NULL, + color = "aqua") + ) + + output$box1 <- renderValueBox( + expr = valueBox( + value = scales::number(x = 100*10000), + subtitle = "subtitle", + icon = NULL + ) + ) + } + +shinyApp(ui, server) diff --git a/home_afford_app/app3.R b/home_afford_app/app3.R new file mode 100644 index 00000000..bc8890b8 --- /dev/null +++ b/home_afford_app/app3.R @@ -0,0 +1,108 @@ +library(shiny) +library(flexdashboard) +library(shinydashboard) +library(scales) +library(tibble) + +header <- dashboardHeader(title = "Home Savings") + +sidebar <- dashboardSidebar( + sidebarMenu( + + id = "tabs", width = 300, + + menuItem("Plot", tabName = "dashboard", icon = icon("list-ol")) + + ) +) + +body <- dashboardBody( + + tabItems( + + tabItem(tabName = "dashboard", titlePanel("Plot"), + + fluidPage( + + column(2, + + box(title = "Plot", width = 75, + sliderInput( + inputId = 'aa', label = 'AA', + value = 0.5 * 100, + min = 0 * 100, + max = 1 * 100, + step = 1 + ), + + sliderInput( + inputId = 'bb', label = 'BB', + value = 0.5 * 100, + min = 0 * 100, + max = 1 * 100, + step = 1 + ), + + sliderInput( + inputId = 'cc', label = 'CC', + value = 2.5, min = 1, max = 5, step = .15 + ), + + sliderInput( + inputId = 'dd', label = 'DD', + value = 2.5, min = 1, max = 5, step = .15 + ) + ) + ), + + column(8, + shinydashboard::valueBoxOutput(outputId = "box1", width = 3), title = "boxs") + ) + ) + ) +) + +ui <- dashboardPage(header, sidebar, body) + +server <- function(input, output, session) { + + ac <- function(aa, bb, cc, dd) { + (aa + cc) + (bb ^ dd) + } + + reac_1 <- reactive({ + tibble( + aa = input$aa, + bb = input$bb, + cc = input$cc, + dd = input$dd + ) + }) + + pred_1 <- reactive({ + temp <- reac_1() + ac( + aa = input$aa, + bb = input$bb, + cc = input$cc, + dd = input$dd + ) + }) + + output$box1 <- shinydashboard::renderValueBox( + shinydashboard::valueBox( + value = scales::number(x = pred_1() / 100, accuracy = 0.01), + subtitle =ifelse(test = pred_1() / 100 <= 2.33, yes = 'AAAAAAAAAA', + ifelse(test = pred_1() / 100 <= 3.67, yes = 'BBBBBBBBB', + no = 'CCCCCCCCCC')), + color = ifelse(test = pred_1() / 100 <= 2.33, yes = 'red', + ifelse(test = pred_1() / 100 <= 3.67, yes = 'green', + no = 'blue')), + icon = icon(ifelse(test = pred_1() / 100 <= 2.33, yes = 'fa-times-circle', + ifelse(test = pred_1() / 100 <= 3.67, yes = 'fa-exclamation-circle', + no = 'fa-check-circle'))) + ) + ) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/home_afford_app/app4.R b/home_afford_app/app4.R new file mode 100644 index 00000000..309984b9 --- /dev/null +++ b/home_afford_app/app4.R @@ -0,0 +1,31 @@ + + +source("helper.R") +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinydashboard) +library(shinythemes) + +ui <- dashboardPage( + dashboardHeader(title = "Dynamic sidebar"), + dashboardSidebar( + sidebarMenu( + menuItemOutput("menuitem") + ) + ), + dashboardBody() +) + +server <- function(input, output) { + output$menuitem <- renderMenu({ + menuItem("Menu item", icon = icon("calendar")) + }) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/home_afford_app/card_with_button.R b/home_afford_app/card_with_button.R new file mode 100644 index 00000000..58c80489 --- /dev/null +++ b/home_afford_app/card_with_button.R @@ -0,0 +1,37 @@ +library(shinydashboard) + +## Only run this example in interactive R sessions +if (interactive()) { + library(shiny) + + ui <- dashboardPage( + dashboardHeader(title = "Dynamic boxes"), + dashboardSidebar(), + dashboardBody( + fluidRow( + box(width = 2, actionButton("count", "Count")), + infoBoxOutput("ibox"), + valueBoxOutput("vbox") + ) + ) + ) + + server <- function(input, output) { + output$ibox <- renderInfoBox({ + infoBox( + "Title", + input$count, + icon = icon("credit-card") + ) + }) + output$vbox <- renderValueBox({ + valueBox( + "Title", + input$count, + icon = icon("credit-card") + ) + }) + } + + shinyApp(ui, server) +} From 6006c72752fa6506710841d791cf4d116022bd74 Mon Sep 17 00:00:00 2001 From: palmorezm Date: Mon, 12 Sep 2022 19:54:26 -0500 Subject: [PATCH 12/19] Dash Styling --- home_afford_app/app4.R | 11 ++- home_afford_app/app5.R | 167 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 176 insertions(+), 2 deletions(-) create mode 100644 home_afford_app/app5.R diff --git a/home_afford_app/app4.R b/home_afford_app/app4.R index 309984b9..d6585fd5 100644 --- a/home_afford_app/app4.R +++ b/home_afford_app/app4.R @@ -12,11 +12,15 @@ library(flexdashboard) library(shinydashboard) library(shinythemes) +# Review +# https://rstudio.github.io/shinydashboard/structure.html#background-shiny-and-html + ui <- dashboardPage( - dashboardHeader(title = "Dynamic sidebar"), + dashboardHeader(title = "Home Savings"), dashboardSidebar( sidebarMenu( - menuItemOutput("menuitem") + menuItemOutput("menuitem"), + menuItemOutput("menuitem2") ) ), dashboardBody() @@ -26,6 +30,9 @@ server <- function(input, output) { output$menuitem <- renderMenu({ menuItem("Menu item", icon = icon("calendar")) }) + output$menuitem <- renderMenu({ + menuItem("Menu item", icon = icon("calendar")) + }) } shinyApp(ui, server) \ No newline at end of file diff --git a/home_afford_app/app5.R b/home_afford_app/app5.R new file mode 100644 index 00000000..609436b0 --- /dev/null +++ b/home_afford_app/app5.R @@ -0,0 +1,167 @@ + +# Shiny Dashboard (by shinydashboard) + + +# Packages +library(shinydashboard) +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinydashboard) +library(shinythemes) +source("helper.R") + +# --------- # +# Define UI # +# --------- # +header <- shinydashboard::dashboardHeader(title = "Home Savings") + +sidebar <- shinydashboard::dashboardSidebar( + sidebarMenu( + menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), + menuItem("Widgets", tabName = "widgets", icon = icon("th")) + ) +) + +body <- shinydashboard::dashboardBody( + tabItems( + tabItem( + tabName = "dashboard", + fluidRow( + box( + valueBoxOutput(outputId = "homePrice", width = 3), + valueBoxOutput(outputId = "downPayment", width = 3), + valueBoxOutput(outputId = "mortgageAmount", width = 3), + valueBoxOutput(outputId = "monthlyPayment", width = 3), + width = 12 + ) + ), + fluidRow( + box( + title = "controls", + numericInput( + inputId = "init_savings", + label = "Current Savings", + value = 1000L + ), + numericInput( + inputId = "monthly_income", + label = "Monthly Income (net)", + value = 4290L + ), + numericInput( + inputId = "expenses", + label = "Monthly Expenses", + value = 3241L + ), + dateRangeInput( + inputId = "dates", + label = "Date Range", + format = "mm-dd-yyyy", + start = "2022-01-01", + end = "2028-01-01" + ), + numericInput( + inputId = "yearly_income", + label = "Yearly Income (gross)", + value = 60000L + ), + sliderInput( + inputId = "percent", + label = "Down Payment %", + min = 0L, + max = 100L, + value = 20L, + width = "100%" + ), + numericInput( + inputId = "term", + label = "Loan Term (years)", + value = 30L + ), + numericInput( + inputId = "rate", + label = "Interest Rate (%)", + value = 4L + ), + width = 3), + box(plotOutput(outputId = "linePlot", + height = 650), width = 9), + ) + ), + tabItem( + tabName = "widgets", + h2("Tab for Widgets") + ) + ) +) + +ui <- shinydashboard::dashboardPage(header = header, sidebar = sidebar, body = body, + skin = c("black")) + +# ------------------- # +# Define Server Logic # +# ------------------- # +server <- function(input, output, session) { + + output$linePlot <- renderPlot({ + # calculate savings from income and expenses + savings <- monthly_savings(input$monthly_income, input$expenses) + # create df from init_savings, savings, start_date, and end_date + df <- create_savingsdf(init_savings = input$init_savings, + savings, + start_date = input$dates[1], + end_date = input$dates[2]) + # plot savings over date range + ggplot(df, aes(x = Date, y = Savings, group = 1)) + + geom_line(size = 2) + + scale_x_date(date_labels = "%b-%Y") + + scale_y_continuous(labels=scales::dollar_format()) + + theme_minimal() + }) + + output$homePrice <- renderValueBox({ + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + home_price <- calculate_home_price(loan) + valueBox( + paste(scales::dollar(home_price, largest_with_cents = 100)), + subtitle = "Home Price", + color = "blue" + ) + }) + + output$downPayment <- renderValueBox({ + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + down_payment <- down_payment(loan, input$percent) + valueBox( + scales::dollar(down_payment), + subtitle = "Down Payment", + color = "yellow" + ) + }) + + output$mortgageAmount <- renderValueBox({ + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + valueBox( + scales::dollar(loan), + subtitle = "Mortage Amount", + color = "orange" + ) + }) + + output$monthlyPayment <- renderValueBox({ + mortgage <- mortgage_payment(input$yearly_income) + valueBox( + scales::dollar(mortgage), + subtitle = "Monthly Payment", + color = "aqua" + ) + }) +} + +shinyApp(ui, server) \ No newline at end of file From 03063f8f1c2e22f0503020e4967d3b9a6c52d576 Mon Sep 17 00:00:00 2001 From: Zachary Palmore Date: Tue, 13 Sep 2022 16:00:33 -0500 Subject: [PATCH 13/19] Add Sim for Point and Theoretical Realistic Savings --- home_afford_app/.Rhistory | 653 +++++++++++++++++++++++++-------- home_afford_app/sim_lineplot.R | 50 +++ 2 files changed, 557 insertions(+), 146 deletions(-) create mode 100644 home_afford_app/sim_lineplot.R diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory index a90ec472..956c7c11 100644 --- a/home_afford_app/.Rhistory +++ b/home_afford_app/.Rhistory @@ -1,151 +1,512 @@ -shiny::runApp() -install.packages("gridlayout") -runApp() -runApp() -runApp() -runApp() -shiny::runApp() -source("helper.R") -library(shiny) -library(gridlayout) -install.packages("gridlayout") -install.packages("shinyuieditor") -install.packages("updateR") -library(installr) -install.packages("installr") -installr::updateR(copy_packages = TRUE) -library(gridlayout) -library(shiny) -# library(gridlayout) -library(tidyverse) +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(City == "Janesville") +df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(City == "Janesville") %>% View() +df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Janesville") %>% View() +df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Janesville") %>% View() +CT_Janesville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Janesville") +CT_Beloit <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Beloit") +View(CT_Beloit) +View(CT_Janesville) +View(CT_Beloit) +View(CT_Janesville) +CT_Clinton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Clinton") +CT_Edgerton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Edgerton") +CT_Evansville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Evansville") +CT_Milton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Milton") +CT_Brodhead <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Brodhead") +CT_Hanover <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Hanover") +CT_Footville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Footville") +CT_Orfordville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Orfordville") +CT_Avalon <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "CT", +City == "Avalon") +write.csv(CT_Janesville, "CT_Janesville.csv") +write.csv(CT_Janesville, "CT_Janesville.csv") +write.csv(CT_Beloit, "CT_Beloit.csv") +write.csv(CT_Avalon, "CT_Avalon.csv") +write.csv(CT_Brodhead, "CT_Brodhead.csv") +write.csv(CT_Clinton, "CT_Clinton.csv") +write.csv(CT_Edgerton, "CT_Edgerton.csv") +write.csv(CT_Evansville, "CT_Evansville.csv") +write.csv(CT_Footville, "CT_Footville.csv") +write.csv(CT_Hanover, "CT_Hanover.csv") +write.csv(CT_Milton, "CT_Milton.csv") +write.csv(CT_Orfordville, "CT_Orfordville.csv") +# ---------- # +# Export GCs # +# ---------- # +GC_Janesville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Janesville") +GC_Beloit <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Beloit") +GC_Clinton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Clinton") +GC_Edgerton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Edgerton") +GC_Evansville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Evansville") +GC_Milton <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Milton") +GC_Brodhead <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Brodhead") +GC_Hanover <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Hanover") +GC_Footville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Footville") +GC_Orfordville <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Orfordville") +GC_Avalon <- df_Locations11 %>% +mutate(AgeGroup = case_when( +Age <= 17 ~ "0-17", +Age >= 18 & Age < 25 ~"18-24", +Age >= 25 & Age < 35 ~"25-34", +Age >= 35 & Age < 45 ~"35-44", +Age >= 45 & Age < 55 ~"45-54", +Age >= 55 & Age < 65 ~"55-64", +Age >= 65 ~"65+")) %>% +group_by(AgeGroup, City, Disease) %>% +summarise(Count = n()) %>% +filter(Disease == "GC", +City == "Avalon") +write.csv(GC_Janesville, "GC_Janesville.csv") +write.csv(GC_Beloit, "GC_Beloit.csv") +write.csv(GC_Avalon, "GC_Avalon.csv") +write.csv(GC_Brodhead, "GC_Brodhead.csv") +write.csv(GC_Clinton, "GC_Clinton.csv") +write.csv(GC_Edgerton, "GC_Edgerton.csv") +write.csv(GC_Evansville, "GC_Evansville.csv") +write.csv(GC_Footville, "GC_Footville.csv") +write.csv(GC_Hanover, "GC_Hanover.csv") +write.csv(GC_Milton, "GC_Milton.csv") +write.csv(GC_Orfordville, "GC_Orfordville.csv") +View(df_facility) +# Line Plot +# Using simulated data +library(dplyr) library(lubridate) -library(scales) -install.packages("remotes") -library(remotes) -remotes::install_github("rstudio/shinyuieditor") -runApp() -library(flexdashboard) -install.packages("flexdashboard") -install.package("shinydashboard") -library(shinydashboard) -shinyuieditor::launch_editor() -shinyuieditor::launch_editor(app_loc = "Home/home_afford_app") -shinyuieditor::launch_editor(app_loc = "Home/home_afford_app/app.R") -shinyuieditor::launch_editor(app_loc = "app.R") -setwd("C/Users/Zachary Palmore/GitHub/Home/home_afford_app") -setwd("C/Users/Zachary Palmore/GitHub/Home") -setwd("C:/Users/Zachary Palmore/GitHub/Home/home_afford_app") -runApp() -shinyuieditor::launch_editor(app_loc = "app.R") -shinyuieditor::launch_editor() -shinyuieditor::launch_editor(app_loc = "C:/Users/Zachary Palmore/GitHub/Home/home_afford_app") -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -runApp() -?dateRangeInput() -runApp() -gc() -library(shinythemes) -runApp('app2.R') -runApp('app2.R') -runApp('app2.R') -runApp('app2.R') -runApp('app2.R') -runApp('app2.R') -runApp('app2.R') -library(shinydashboard) -## Only run this example in interactive R sessions -if (interactive()) { -library(shiny) -ui <- dashboardPage( -dashboardHeader(title = "Dynamic boxes"), -dashboardSidebar(), -dashboardBody( -fluidRow( -box(width = 2, actionButton("count", "Count")), -infoBoxOutput("ibox"), -valueBoxOutput("vbox") -) -) -) -server <- function(input, output) { -output$ibox <- renderInfoBox({ -infoBox( -"Title", -input$count, -icon = icon("credit-card") +# The original data inputs: +savings <- monthly_savings(input$monthly_income, input$expenses) +# Recreate monthly savings given some number +start_date <- as.Date("2020-01-01") +end_date <- as.Date("2025-12-31") +monthly_income <- 3000 +monthly_expenses <- 1500 +current_savings <- 10000 +Date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = seq(1, length(month)), +test = month*(current_savings + (monthly_income - monthly_expenses))) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = seq(1, length(month)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = rep(seq(1, length(month), 12)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +rep(1, 12) +?seq() +rep(1, 12) +seq(1, length.out = 12) +seq(rep(1, 12), length.out = 12) +seq(from = rep(1, 12), length.out = 12) +rep(seq(rep(1, 12), length.out = 12), 1) +rep(1:12, length(df$date)) +rep(rep(1, 12), length(df$date)) +rep(rep(1:12, 12), length(df$date)) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = rep(rep(1:12, 12), length(df$date)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = rep(rep(1:12, 12), length(df$date)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = rep(rep(1:12, 12), length(month)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings, +month_tally = rep(rep(1:12, 12), length(df$date)), +test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() +length(df$date) +rep(rep(1:12, 12), length(df$date)) +rep(1, length(df$date)) +rep(1, 12) +data.frame(df) +data.frame(df) %>% +mutate(month = lubridate::month(date)) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings) +data.frame(df) %>% +mutate(month = lubridate::month(date), +current_savings = current_savings) %>% +group_by(month) %>% +summarise(Count = n()) +setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +create_savingsdf <- function(init_savings, savings, start_date, end_date) { +# initialize total_savings to init_savings +total_savings <- init_savings +# create df with column for savings +df = data.frame( +Savings = c(total_savings) ) -}) -output$vbox <- renderValueBox({ -valueBox( -"Title", -input$count, -icon = icon("credit-card") -) -}) +# calculate num_months +num_months <- months_passed(start_date, end_date) +# add savings to total_savings for num_months +while (num_months > 0) { +total_savings <- total_savings + savings +num_months <- num_months - 1 +df = rbind(df, total_savings) } -shinyApp(ui, server) +# add column for dates +Date <- seq(as.Date(start_date), as.Date(end_date), by="month") +df <- cbind(Date, df) +return(df) } -server <- function(input, output) { -output$ibox <- renderInfoBox({ -infoBox( -"Title", -input$count, -icon = icon("credit-card") -) -}) -output$vbox <- renderValueBox({ -valueBox( -"Title", -input$count, -icon = icon("credit-card") -) -}) -} -## Only run this example in interactive R sessions -if (interactive()) { -library(shiny) -ui <- dashboardPage( -dashboardHeader(title = "Dynamic boxes"), -dashboardSidebar(), -dashboardBody( -fluidRow( -box(width = 2, actionButton("count", "Count")), -infoBoxOutput("ibox"), -valueBoxOutput("vbox") -) -) -) -server <- function(input, output) { -output$ibox <- renderInfoBox({ -infoBox( -"Title", -input$count, -icon = icon("credit-card") -) -}) -output$vbox <- renderValueBox({ -valueBox( -"Title", -input$count, -icon = icon("credit-card") -) -}) -} -shinyApp(ui, server) +# Calculate monthly savings +monthly_savings <- function(income, expenses) { +savings <- income - expenses +return(savings) } +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source(helper.R) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +View(df) +mean(df$Savings) +calculate_savings(current_savings, savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +monthly_income - monthly_expenses +rnorm(100, mean = monthly_income - monthly_expenses, sd = 1) +rnorm(100, mean = monthly_income - monthly_expenses, sd = 400) +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 400) # Insert realistic standard deviation +plot(df$Date, df$Points) +plot(df$Date, df$Savings) +plot(df$Date, df$Points) +df %>% +mutate(cumsum(Points)) +df %>% +mutate(Theory_Savings = cumsum(Points)) +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +plot(df$Date, df$Theory_Savings) +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 800) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +plot(df$Date, df$Theory_Savings) +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1200) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +plot(df$Date, df$Theory_Savings) +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1500) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +plot(df$Date, df$Theory_Savings) +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1700) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +plot(df$Date, df$Theory_Savings) +plot(df$Date, df$Theory_Savings) + abline() +plot(df$Date, df$Theory_Savings) + abline() +plot(df$Date, df$Theory_Savings) +abline +plot(df$Date, df$Theory_Savings) +abline() +library(ggplot2) +ggplot(df, aes(Date, Theory_Savings)) + geom_point() +ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth() +ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") diff --git a/home_afford_app/sim_lineplot.R b/home_afford_app/sim_lineplot.R new file mode 100644 index 00000000..a90c121a --- /dev/null +++ b/home_afford_app/sim_lineplot.R @@ -0,0 +1,50 @@ + +# Line Plot +# Using simulated data +library(dplyr) +library(lubridate) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +# The original data inputs: +savings <- monthly_savings(input$monthly_income, input$expenses) +# create df from init_savings, savings, start_date, and end_date +df <- create_savingsdf(init_savings = input$init_savings, + savings, + start_date = input$dates[1], + end_date = input$dates[2]) +# Recreate monthly savings given some number +start_date <- as.Date("2020-01-01") +end_date <- as.Date("2025-12-31") +monthly_income <- 3000 +monthly_expenses <- 1500 +current_savings <- 10000 +# seq(from = start_date, to = end_date, by = ) +Date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +data.frame(df) %>% + mutate(month = lubridate::month(date), + current_savings = current_savings, + month_tally = rep(rep(1:12, 12), length(df$date)), + test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() + mutate(date = seq.Date(from = start_date, to = end_date, by = 1), + theoretical_savings = current_savings + (monthly_income - monthly_expenses)) + +df <- create_savingsdf(init_savings = current_savings, + savings = monthly_income - monthly_expenses, + start_date = start_date, end_date = end_date) + +calculate_savings(current_savings, savings = monthly_income - monthly_expenses, + start_date = start_date, end_date = end_date) + + +df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1700) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +library(ggplot2) +ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") + +ggplot(df, aes(x = Date, y = Savings, group = 1)) + + geom_line(size = 2) + + scale_x_date(date_labels = "%b-%Y") + + scale_y_continuous(labels=scales::dollar_format()) + + theme_minimal() \ No newline at end of file From 311f5d85cd9da428727a7a5a2f553f539c382a2c Mon Sep 17 00:00:00 2001 From: Zachary Palmore Date: Wed, 14 Sep 2022 16:00:52 -0500 Subject: [PATCH 14/19] Update sim_lineplot.R --- home_afford_app/sim_lineplot.R | 84 ++++++++++++++++++++++++---------- 1 file changed, 60 insertions(+), 24 deletions(-) diff --git a/home_afford_app/sim_lineplot.R b/home_afford_app/sim_lineplot.R index a90c121a..6f542a32 100644 --- a/home_afford_app/sim_lineplot.R +++ b/home_afford_app/sim_lineplot.R @@ -2,16 +2,17 @@ # Line Plot # Using simulated data library(dplyr) +library(ggplot2) library(lubridate) # setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") source("helper.R") # The original data inputs: -savings <- monthly_savings(input$monthly_income, input$expenses) -# create df from init_savings, savings, start_date, and end_date -df <- create_savingsdf(init_savings = input$init_savings, - savings, - start_date = input$dates[1], - end_date = input$dates[2]) +# savings <- monthly_savings(input$monthly_income, input$expenses) +# # create df from init_savings, savings, start_date, and end_date +# df <- create_savingsdf(init_savings = input$init_savings, +# savings, +# start_date = input$dates[1], +# end_date = input$dates[2]) # Recreate monthly savings given some number start_date <- as.Date("2020-01-01") end_date <- as.Date("2025-12-31") @@ -19,32 +20,67 @@ monthly_income <- 3000 monthly_expenses <- 1500 current_savings <- 10000 # seq(from = start_date, to = end_date, by = ) -Date <- seq.Date(from = start_date, to = end_date, by = 1) df <- "" df$date <- seq.Date(from = start_date, to = end_date, by = 1) -data.frame(df) %>% - mutate(month = lubridate::month(date), - current_savings = current_savings, - month_tally = rep(rep(1:12, 12), length(df$date)), - test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() - mutate(date = seq.Date(from = start_date, to = end_date, by = 1), - theoretical_savings = current_savings + (monthly_income - monthly_expenses)) - df <- create_savingsdf(init_savings = current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) calculate_savings(current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +goal_purchase_date <- as.Date("2024-06-01") +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + + geom_smooth(method = "lm") + + geom_point() + geom_line(aes(Date, Savings)) + + scale_x_date(date_labels = "%b-%Y") + + scale_y_continuous(labels=scales::dollar_format()) + + geom_hline(yintercept = dp, lty = 3) + + geom_hline(yintercept = current_savings, lty = 3) + + geom_vline(xintercept = goal_purchase_date) + theme_minimal() +# Scenarios +# in each scenario we want to change the amount of savings that gets accrued starting at a given time +# inputs: start time of new job, new monthly income, new monthly expenses? +new_date <- as.Date("2022-11-01") +new_monthly_income <- 3000 +new_monthly_expenses <- 500 -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1700) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -library(ggplot2) -ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") +df %>% + mutate(Scenario1 = case_when( + Date < new_date ~ as.numeric(0), + Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), + mean = new_monthly_income - new_monthly_expenses, + sd = 500))) + )) -ggplot(df, aes(x = Date, y = Savings, group = 1)) + - geom_line(size = 2) + - scale_x_date(date_labels = "%b-%Y") + - scale_y_continuous(labels=scales::dollar_format()) + - theme_minimal() \ No newline at end of file +# Value at current time +# Value after first boost +# Cumulative values after boost +x <- rbinom(1:100, 10, (1/6)) +plot(x, main= "Binomial") +x <- rgeom(1:100, (1/6)) +plot(x, main= "Geometric") +x <- rpois(1:100, lambda = (1/6)) +plot(x, main= "Poisson") +x <- runif(1:100, min = 1, max = 6) +plot(x, main= "Uniform") +x <- rexp(1:100, rate = 1) +plot(x, main= "Exponential") +x <- rnorm(1:100, mean = 3, sd = 1) +plot(x, main= "Normal") + +library(mnonr) +mnonr::mnonr(72, 2, 2) +mnonr::unonr(72, mu = monthly_income - monthly_expenses, + Sigma = matrix(c(1,0.5,0.5,1), 2,2)) +unonr(100, c(1, 2), matrix(c(10, 2, 2, 5), 2, 2), + skewness = c(1, 2), + kurtosis = c(3, 8)) +mnonr::mnonr(n=10000,p=2,ms=3,mk=61, + Sigma=matrix(c(1,0.5,0.5,1),2,2), + initial=NULL) From 51ed13d5f810e047e26bb4c207efac58ab1ea72f Mon Sep 17 00:00:00 2001 From: palmorezm Date: Fri, 16 Sep 2022 21:11:19 -0500 Subject: [PATCH 15/19] Scenario Simulation and Minor Adjustments Created the first scenario to add (or remove) new income and expenses which can be seen in the elbow generated in the plot. Also changed widths in ui of dash --- home_afford_app/.Rhistory | 978 +++++++++++------------ home_afford_app/app5.R | 31 +- home_afford_app/r_distribution_options.R | 16 + home_afford_app/scenario1.R | 67 ++ home_afford_app/sim_lineplot.R | 71 +- 5 files changed, 608 insertions(+), 555 deletions(-) create mode 100644 home_afford_app/r_distribution_options.R create mode 100644 home_afford_app/scenario1.R diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory index 956c7c11..c5b24ce3 100644 --- a/home_afford_app/.Rhistory +++ b/home_afford_app/.Rhistory @@ -1,512 +1,512 @@ -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(City == "Janesville") -df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(City == "Janesville") %>% View() -df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Janesville") %>% View() -df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Janesville") %>% View() -CT_Janesville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Janesville") -CT_Beloit <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Beloit") -View(CT_Beloit) -View(CT_Janesville) -View(CT_Beloit) -View(CT_Janesville) -CT_Clinton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Clinton") -CT_Edgerton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Edgerton") -CT_Evansville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Evansville") -CT_Milton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Milton") -CT_Brodhead <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Brodhead") -CT_Hanover <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Hanover") -CT_Footville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Footville") -CT_Orfordville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Orfordville") -CT_Avalon <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "CT", -City == "Avalon") -write.csv(CT_Janesville, "CT_Janesville.csv") -write.csv(CT_Janesville, "CT_Janesville.csv") -write.csv(CT_Beloit, "CT_Beloit.csv") -write.csv(CT_Avalon, "CT_Avalon.csv") -write.csv(CT_Brodhead, "CT_Brodhead.csv") -write.csv(CT_Clinton, "CT_Clinton.csv") -write.csv(CT_Edgerton, "CT_Edgerton.csv") -write.csv(CT_Evansville, "CT_Evansville.csv") -write.csv(CT_Footville, "CT_Footville.csv") -write.csv(CT_Hanover, "CT_Hanover.csv") -write.csv(CT_Milton, "CT_Milton.csv") -write.csv(CT_Orfordville, "CT_Orfordville.csv") -# ---------- # -# Export GCs # -# ---------- # -GC_Janesville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Janesville") -GC_Beloit <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Beloit") -GC_Clinton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Clinton") -GC_Edgerton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Edgerton") -GC_Evansville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Evansville") -GC_Milton <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Milton") -GC_Brodhead <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Brodhead") -GC_Hanover <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Hanover") -GC_Footville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Footville") -GC_Orfordville <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Orfordville") -GC_Avalon <- df_Locations11 %>% -mutate(AgeGroup = case_when( -Age <= 17 ~ "0-17", -Age >= 18 & Age < 25 ~"18-24", -Age >= 25 & Age < 35 ~"25-34", -Age >= 35 & Age < 45 ~"35-44", -Age >= 45 & Age < 55 ~"45-54", -Age >= 55 & Age < 65 ~"55-64", -Age >= 65 ~"65+")) %>% -group_by(AgeGroup, City, Disease) %>% -summarise(Count = n()) %>% -filter(Disease == "GC", -City == "Avalon") -write.csv(GC_Janesville, "GC_Janesville.csv") -write.csv(GC_Beloit, "GC_Beloit.csv") -write.csv(GC_Avalon, "GC_Avalon.csv") -write.csv(GC_Brodhead, "GC_Brodhead.csv") -write.csv(GC_Clinton, "GC_Clinton.csv") -write.csv(GC_Edgerton, "GC_Edgerton.csv") -write.csv(GC_Evansville, "GC_Evansville.csv") -write.csv(GC_Footville, "GC_Footville.csv") -write.csv(GC_Hanover, "GC_Hanover.csv") -write.csv(GC_Milton, "GC_Milton.csv") -write.csv(GC_Orfordville, "GC_Orfordville.csv") -View(df_facility) +plot(df$Date, df$Theory_Savings) +plot(df$Date, df$Theory_Savings) + abline() +plot(df$Date, df$Theory_Savings) + abline() +plot(df$Date, df$Theory_Savings) +abline +plot(df$Date, df$Theory_Savings) +abline() +library(ggplot2) +ggplot(df, aes(Date, Theory_Savings)) + geom_point() +ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth() +ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") # Line Plot # Using simulated data library(dplyr) +library(ggplot2) library(lubridate) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") # The original data inputs: -savings <- monthly_savings(input$monthly_income, input$expenses) +# savings <- monthly_savings(input$monthly_income, input$expenses) +# # create df from init_savings, savings, start_date, and end_date +# df <- create_savingsdf(init_savings = input$init_savings, +# savings, +# start_date = input$dates[1], +# end_date = input$dates[2]) # Recreate monthly savings given some number start_date <- as.Date("2020-01-01") end_date <- as.Date("2025-12-31") monthly_income <- 3000 monthly_expenses <- 1500 current_savings <- 10000 -Date <- seq.Date(from = start_date, to = end_date, by = 1) +# seq(from = start_date, to = end_date, by = ) df <- "" df$date <- seq.Date(from = start_date, to = end_date, by = 1) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = seq(1, length(month)), -test = month*(current_savings + (monthly_income - monthly_expenses))) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = seq(1, length(month)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = rep(seq(1, length(month), 12)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -rep(1, 12) -?seq() -rep(1, 12) -seq(1, length.out = 12) -seq(rep(1, 12), length.out = 12) -seq(from = rep(1, 12), length.out = 12) -rep(seq(rep(1, 12), length.out = 12), 1) -rep(1:12, length(df$date)) -rep(rep(1, 12), length(df$date)) -rep(rep(1:12, 12), length(df$date)) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = rep(rep(1:12, 12), length(df$date)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = rep(rep(1:12, 12), length(df$date)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = rep(rep(1:12, 12), length(month)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings, -month_tally = rep(rep(1:12, 12), length(df$date)), -test = month*(current_savings + (monthly_income - monthly_expenses))) %>% View() -length(df$date) -rep(rep(1:12, 12), length(df$date)) -rep(1, length(df$date)) -rep(1, 12) -data.frame(df) -data.frame(df) %>% -mutate(month = lubridate::month(date)) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings) -data.frame(df) %>% -mutate(month = lubridate::month(date), -current_savings = current_savings) %>% -group_by(month) %>% -summarise(Count = n()) -setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -create_savingsdf <- function(init_savings, savings, start_date, end_date) { -# initialize total_savings to init_savings -total_savings <- init_savings -# create df with column for savings -df = data.frame( -Savings = c(total_savings) -) -# calculate num_months -num_months <- months_passed(start_date, end_date) -# add savings to total_savings for num_months -while (num_months > 0) { -total_savings <- total_savings + savings -num_months <- num_months - 1 -df = rbind(df, total_savings) -} -# add column for dates -Date <- seq(as.Date(start_date), as.Date(end_date), by="month") -df <- cbind(Date, df) -return(df) -} -# Calculate monthly savings -monthly_savings <- function(income, expenses) { -savings <- income - expenses -return(savings) -} -# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source(helper.R) -# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source("helper.R") -create_savingsdf(init_savings = current_savings, +df <- create_savingsdf(init_savings = current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) +calculate_savings(current_savings, savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) +start_date <- as.Date("2020-01-01") +end_date <- as.Date("2025-12-31") +goal_purchase_date <- as.Date("2024-06-01") +monthly_income <- 3000 +monthly_expenses <- 1500 +current_savings <- 10000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) df <- create_savingsdf(init_savings = current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) -View(df) -mean(df$Savings) calculate_savings(current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) -monthly_income - monthly_expenses -rnorm(100, mean = monthly_income - monthly_expenses, sd = 1) -rnorm(100, mean = monthly_income - monthly_expenses, sd = 400) -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 400) # Insert realistic standard deviation -plot(df$Date, df$Points) -plot(df$Date, df$Savings) -plot(df$Date, df$Points) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +theme_minimal() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +theme_minimal() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", +breaks = c("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", +breaks = c("2024-01-01", "2022-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", +date_breaks = c("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +?scale_x_date() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", limits = "2024-01-01") + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", limits = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", date_breaks = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Scenarios +# in each scenario we want to change the amount of savings that gets accrued starting at a given time +# inputs: start time of new job, new monthly income, new monthly expenses? +new_date <- as.Date("2022-11-01") +new_monthly_income <- 3000 +new_monthly_expenses <- 500 df %>% -mutate(cumsum(Points)) +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), +mean = new_monthly_income - new_monthly_expenses, +sd = 500))) +)) +new_monthly_income <- 3000 +new_monthly_expenses <- 500 df %>% -mutate(Theory_Savings = cumsum(Points)) -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -plot(df$Date, df$Theory_Savings) -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 800) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -plot(df$Date, df$Theory_Savings) -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1200) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -plot(df$Date, df$Theory_Savings) -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1500) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -plot(df$Date, df$Theory_Savings) -df$Points <- rnorm(72, mean = monthly_income - monthly_expenses, sd = 1700) # Insert realistic standard deviation +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), +mean = new_monthly_income - new_monthly_expenses, +sd = 500))) +)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses), +)) +new_monthly_expenses <- 1500 +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses), +)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Savings = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Savings1 = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500) +Savings1 = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500), +Savings1 = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500), +Savings1 = cumsum(Scenario1), +Savings1.5 = cumsum(Points1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Savings1.5 = cumsum(Points1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500), +Savings1 = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = sum(Savings1, Theory_Savings)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = cumsum(Savings1, Theory_Savings)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) +new_monthly_expenses <- 200 +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +ggplot(., aes(Date, Total_Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# The original data inputs: +# savings <- monthly_savings(input$monthly_income, input$expenses) +# # create df from init_savings, savings, start_date, and end_date +# df <- create_savingsdf(init_savings = input$init_savings, +# savings, +# start_date = input$dates[1], +# end_date = input$dates[2]) +# Recreate monthly savings given some number +start_date <- as.Date("2022-09-15") +end_date <- as.Date("2025-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +calculate_savings(current_savings, savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation df <- df %>% mutate(Theory_Savings = cumsum(Points)) -plot(df$Date, df$Theory_Savings) -plot(df$Date, df$Theory_Savings) + abline() -plot(df$Date, df$Theory_Savings) + abline() -plot(df$Date, df$Theory_Savings) -abline -plot(df$Date, df$Theory_Savings) -abline() -library(ggplot2) -ggplot(df, aes(Date, Theory_Savings)) + geom_point() -ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth() -ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") +# Visualizing +ggplot(df, aes(Date, Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +ggplot(., aes(Date, Total_Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +# Scenarios +# in each scenario we want to change the amount of savings that gets accrued starting at a given time +# inputs: start time of new job, new monthly income, new monthly expenses? +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 0 +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +ggplot(., aes(Date, Total_Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +filter(Date >= as.Date("2023-09-01")) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +filter(Date >= as.Date("2023-09-01")) %>% View() +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +filter(Date >= as.Date("2022-09-01")) %>% View() +# Scenarios +# in each scenario we want to change the amount of savings that gets accrued starting at a given time +# inputs: start time of new job, new monthly income, new monthly expenses? +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 1 +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), +mean = new_monthly_income - new_monthly_expenses, +sd = 500))) +)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), +Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500), +Savings1 = cumsum(Scenario1), +Savings1.5 = cumsum(Points1)) +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +ggplot(., aes(Date, Total_Theory_Savings)) + +geom_smooth(method = "lm") + +geom_point() + geom_line(aes(Date, Savings)) + +geom_hline(yintercept = dp, lty = 3) + +geom_hline(yintercept = current_savings, lty = 3) + +geom_vline(xintercept = goal_purchase_date) + +scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + +scale_y_continuous(labels=scales::dollar_format(), +breaks = c(10000, 80000)) + +theme_classic() +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +filter(Date >= as.Date("2022-09-01")) %>% View() diff --git a/home_afford_app/app5.R b/home_afford_app/app5.R index 609436b0..34b23921 100644 --- a/home_afford_app/app5.R +++ b/home_afford_app/app5.R @@ -12,7 +12,6 @@ library(tidyverse) library(lubridate) library(scales) library(flexdashboard) -library(shinydashboard) library(shinythemes) source("helper.R") @@ -34,10 +33,10 @@ body <- shinydashboard::dashboardBody( tabName = "dashboard", fluidRow( box( - valueBoxOutput(outputId = "homePrice", width = 3), - valueBoxOutput(outputId = "downPayment", width = 3), - valueBoxOutput(outputId = "mortgageAmount", width = 3), - valueBoxOutput(outputId = "monthlyPayment", width = 3), + shinydashboard::valueBoxOutput(outputId = "homePrice", width = 3), + shinydashboard::valueBoxOutput(outputId = "downPayment", width = 3), + shinydashboard::valueBoxOutput(outputId = "mortgageAmount", width = 3), + shinydashboard::valueBoxOutput(outputId = "monthlyPayment", width = 3), width = 12 ) ), @@ -128,40 +127,44 @@ server <- function(input, output, session) { output$homePrice <- renderValueBox({ loan <- calculate_loan(input$yearly_income, input$rate, input$term) home_price <- calculate_home_price(loan) - valueBox( + shinydashboard::valueBox( paste(scales::dollar(home_price, largest_with_cents = 100)), subtitle = "Home Price", - color = "blue" + color = "blue", + width = 12 ) }) output$downPayment <- renderValueBox({ loan <- calculate_loan(input$yearly_income, input$rate, input$term) down_payment <- down_payment(loan, input$percent) - valueBox( + shinydashboard::valueBox( scales::dollar(down_payment), subtitle = "Down Payment", - color = "yellow" + color = "yellow", + width = 12 ) }) output$mortgageAmount <- renderValueBox({ loan <- calculate_loan(input$yearly_income, input$rate, input$term) - valueBox( + shinydashboard::valueBox( scales::dollar(loan), subtitle = "Mortage Amount", - color = "orange" + color = "orange", + width = 12 ) }) output$monthlyPayment <- renderValueBox({ mortgage <- mortgage_payment(input$yearly_income) - valueBox( + shinydashboard::valueBox( scales::dollar(mortgage), subtitle = "Monthly Payment", - color = "aqua" + color = "aqua", + width = 12 ) }) } -shinyApp(ui, server) \ No newline at end of file +shinyApp(ui, server) diff --git a/home_afford_app/r_distribution_options.R b/home_afford_app/r_distribution_options.R new file mode 100644 index 00000000..18e977e1 --- /dev/null +++ b/home_afford_app/r_distribution_options.R @@ -0,0 +1,16 @@ + +# Value at current time +# Value after first boost +# Cumulative values after boost +x <- rbinom(1:100, 10, (1/6)) +plot(x, main= "Binomial") +x <- rgeom(1:100, (1/6)) +plot(x, main= "Geometric") +x <- rpois(1:100, lambda = (1/6)) +plot(x, main= "Poisson") +x <- runif(1:100, min = 1, max = 6) +plot(x, main= "Uniform") +x <- rexp(1:100, rate = 1) +plot(x, main= "Exponential") +x <- rnorm(1:100, mean = 3, sd = 1) +plot(x, main= "Normal") diff --git a/home_afford_app/scenario1.R b/home_afford_app/scenario1.R new file mode 100644 index 00000000..ccde40b0 --- /dev/null +++ b/home_afford_app/scenario1.R @@ -0,0 +1,67 @@ +# Packages +library(dplyr) +library(ggplot2) +library(lubridate) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") + +# Starting data +start_date <- as.Date("2020-09-15") +end_date <- as.Date("2023-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, + savings = monthly_income - monthly_expenses, + start_date = start_date, end_date = end_date) + +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) + + + +# Scenarios +# in each scenario we want to change the amount of savings that gets accrued starting at a given time +# inputs: start time of new job, new monthly income, new monthly expenses? + +# New data +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 5 + + +df %>% + mutate(Scenario1 = case_when( + Date < new_date ~ as.numeric(0), + Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, + sd = 500)), + Savings1 = cumsum(Scenario1), + Total_Theory_Savings = Theory_Savings + Savings1) %>% View() + +df[c(1,2)] %>% + mutate(Scenario = case_when( + Date < new_date ~ as.numeric(0), + Date >= new_date ~ (new_monthly_income - new_monthly_expenses) + ), + new_savings = cumsum(Scenario), + total_saved = new_savings + Savings) %>% View() + ggplot(aes(Date, total_saved, color = Scenario)) + + geom_line() + geom_point() + +ggplot(df, aes(Date, Total_Theory_Savings)) + + geom_smooth(method = "lm") + + geom_point() + geom_line(aes(Date, Savings)) + + geom_hline(yintercept = dp, lty = 3) + + geom_hline(yintercept = current_savings, lty = 3) + + geom_vline(xintercept = goal_purchase_date) + + scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + + scale_y_continuous(labels=scales::dollar_format(), + breaks = c(10000, 80000)) + + theme_classic() + + diff --git a/home_afford_app/sim_lineplot.R b/home_afford_app/sim_lineplot.R index 6f542a32..7830e42c 100644 --- a/home_afford_app/sim_lineplot.R +++ b/home_afford_app/sim_lineplot.R @@ -14,11 +14,13 @@ source("helper.R") # start_date = input$dates[1], # end_date = input$dates[2]) # Recreate monthly savings given some number -start_date <- as.Date("2020-01-01") -end_date <- as.Date("2025-12-31") -monthly_income <- 3000 -monthly_expenses <- 1500 -current_savings <- 10000 +start_date <- as.Date("2022-09-15") +end_date <- as.Date("2023-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) # seq(from = start_date, to = end_date, by = ) df <- "" df$date <- seq.Date(from = start_date, to = end_date, by = 1) @@ -28,59 +30,24 @@ df <- create_savingsdf(init_savings = current_savings, calculate_savings(current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -goal_purchase_date <- as.Date("2024-06-01") + df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation df <- df %>% mutate(Theory_Savings = cumsum(Points)) # Visualizing ggplot(df, aes(Date, Theory_Savings)) + geom_smooth(method = "lm") + geom_point() + geom_line(aes(Date, Savings)) + - scale_x_date(date_labels = "%b-%Y") + - scale_y_continuous(labels=scales::dollar_format()) + geom_hline(yintercept = dp, lty = 3) + geom_hline(yintercept = current_savings, lty = 3) + - geom_vline(xintercept = goal_purchase_date) - theme_minimal() - -# Scenarios -# in each scenario we want to change the amount of savings that gets accrued starting at a given time -# inputs: start time of new job, new monthly income, new monthly expenses? -new_date <- as.Date("2022-11-01") -new_monthly_income <- 3000 -new_monthly_expenses <- 500 - -df %>% - mutate(Scenario1 = case_when( - Date < new_date ~ as.numeric(0), - Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), - mean = new_monthly_income - new_monthly_expenses, - sd = 500))) - )) - -# Value at current time -# Value after first boost -# Cumulative values after boost -x <- rbinom(1:100, 10, (1/6)) -plot(x, main= "Binomial") -x <- rgeom(1:100, (1/6)) -plot(x, main= "Geometric") -x <- rpois(1:100, lambda = (1/6)) -plot(x, main= "Poisson") -x <- runif(1:100, min = 1, max = 6) -plot(x, main= "Uniform") -x <- rexp(1:100, rate = 1) -plot(x, main= "Exponential") -x <- rnorm(1:100, mean = 3, sd = 1) -plot(x, main= "Normal") + geom_vline(xintercept = goal_purchase_date) + + scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + + scale_y_continuous(labels=scales::dollar_format(), + breaks = c(10000, 80000)) + + theme_classic() -library(mnonr) -mnonr::mnonr(72, 2, 2) -mnonr::unonr(72, mu = monthly_income - monthly_expenses, - Sigma = matrix(c(1,0.5,0.5,1), 2,2)) -unonr(100, c(1, 2), matrix(c(10, 2, 2, 5), 2, 2), - skewness = c(1, 2), - kurtosis = c(3, 8)) -mnonr::mnonr(n=10000,p=2,ms=3,mk=61, - Sigma=matrix(c(1,0.5,0.5,1),2,2), - initial=NULL) +# TODO: +# On the y axis to show only starting savings and required down payment amount +# On the x axis show only necessary dates? +# Place text box with date of goal +# Have another text box to show difference between savings at goal date and what's needed to reach goal +# Show when scenario 1 occurs, stop linear trend for old data, then update trend with new scenario 1 data From fe4e94c4fcbb66ec5d82a4543ffdaa6cb497e70d Mon Sep 17 00:00:00 2001 From: palmorezm Date: Mon, 14 Nov 2022 18:33:55 -0600 Subject: [PATCH 16/19] Rethinking process for simplot --- home_afford_app/.Rhistory | 834 ++++++++++++++++----------------- home_afford_app/sim_lineplot.R | 24 +- home_afford_app/test.R | 29 -- 3 files changed, 440 insertions(+), 447 deletions(-) delete mode 100644 home_afford_app/test.R diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory index c5b24ce3..d721a706 100644 --- a/home_afford_app/.Rhistory +++ b/home_afford_app/.Rhistory @@ -1,284 +1,3 @@ -plot(df$Date, df$Theory_Savings) -plot(df$Date, df$Theory_Savings) + abline() -plot(df$Date, df$Theory_Savings) + abline() -plot(df$Date, df$Theory_Savings) -abline -plot(df$Date, df$Theory_Savings) -abline() -library(ggplot2) -ggplot(df, aes(Date, Theory_Savings)) + geom_point() -ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth() -ggplot(df, aes(Date, Theory_Savings)) + geom_point() + geom_smooth(method = "lm") -# Line Plot -# Using simulated data -library(dplyr) -library(ggplot2) -library(lubridate) -# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source("helper.R") -setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -# The original data inputs: -# savings <- monthly_savings(input$monthly_income, input$expenses) -# # create df from init_savings, savings, start_date, and end_date -# df <- create_savingsdf(init_savings = input$init_savings, -# savings, -# start_date = input$dates[1], -# end_date = input$dates[2]) -# Recreate monthly savings given some number -start_date <- as.Date("2020-01-01") -end_date <- as.Date("2025-12-31") -monthly_income <- 3000 -monthly_expenses <- 1500 -current_savings <- 10000 -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -calculate_savings(current_savings, savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) -start_date <- as.Date("2020-01-01") -end_date <- as.Date("2025-12-31") -goal_purchase_date <- as.Date("2024-06-01") -monthly_income <- 3000 -monthly_expenses <- 1500 -current_savings <- 10000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -calculate_savings(current_savings, savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -theme_minimal() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -theme_minimal() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", -breaks = c("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", -breaks = c("2024-01-01", "2022-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", -date_breaks = c("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -?scale_x_date() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", limits = "2024-01-01") + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", limits = as.Date("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", date_breaks = as.Date("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Scenarios -# in each scenario we want to change the amount of savings that gets accrued starting at a given time -# inputs: start time of new job, new monthly income, new monthly expenses? -new_date <- as.Date("2022-11-01") -new_monthly_income <- 3000 -new_monthly_expenses <- 500 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), -mean = new_monthly_income - new_monthly_expenses, -sd = 500))) -)) -new_monthly_income <- 3000 -new_monthly_expenses <- 500 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), -mean = new_monthly_income - new_monthly_expenses, -sd = 500))) -)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses), -)) -new_monthly_expenses <- 1500 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses), -)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Savings = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Savings1 = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500) -Savings1 = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500), -Savings1 = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500), @@ -290,62 +9,6 @@ Date < new_date ~ as.numeric(0), Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500)), Savings1 = cumsum(Scenario1), -Savings1.5 = cumsum(Points1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500), -Savings1 = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = sum(Savings1, Theory_Savings)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = cumsum(Savings1, Theory_Savings)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1)) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) -new_monthly_expenses <- 200 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), Total_Theory_Savings = Theory_Savings + Savings1) %>% ggplot(., aes(Date, Total_Theory_Savings)) + geom_smooth(method = "lm") + @@ -353,10 +16,231 @@ geom_point() + geom_line(aes(Date, Savings)) + geom_hline(yintercept = dp, lty = 3) + geom_hline(yintercept = current_savings, lty = 3) + geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + +scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + scale_y_continuous(labels=scales::dollar_format(), breaks = c(10000, 80000)) + theme_classic() +df %>% +mutate(Scenario1 = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, +sd = 500)), +Savings1 = cumsum(Scenario1), +Total_Theory_Savings = Theory_Savings + Savings1) %>% +filter(Date >= as.Date("2022-09-01")) %>% View() +library(shiny); runApp('app5.R') +# Packages +library(shinydashboard) +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinythemes) +source("helper.R") +# --------- # +# Define UI # +# --------- # +header <- shinydashboard::dashboardHeader(title = "Home Savings") +sidebar <- shinydashboard::dashboardSidebar( +sidebarMenu( +menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), +menuItem("Widgets", tabName = "widgets", icon = icon("th")) +) +) +body <- shinydashboard::dashboardBody( +tabItems( +tabItem( +tabName = "dashboard", +fluidRow( +box( +valueBoxOutput(outputId = "homePrice", width = 3), +valueBoxOutput(outputId = "downPayment", width = 3), +valueBoxOutput(outputId = "mortgageAmount", width = 3), +valueBoxOutput(outputId = "monthlyPayment", width = 3), +width = 12 +) +), +fluidRow( +box( +title = "controls", +numericInput( +inputId = "init_savings", +label = "Current Savings", +value = 1000L +), +numericInput( +inputId = "monthly_income", +label = "Monthly Income (net)", +value = 4290L +), +numericInput( +inputId = "expenses", +label = "Monthly Expenses", +value = 3241L +), +dateRangeInput( +inputId = "dates", +label = "Date Range", +format = "mm-dd-yyyy", +start = "2022-01-01", +end = "2028-01-01" +), +numericInput( +inputId = "yearly_income", +label = "Yearly Income (gross)", +value = 60000L +), +sliderInput( +inputId = "percent", +label = "Down Payment %", +min = 0L, +max = 100L, +value = 20L, +width = "100%" +), +numericInput( +inputId = "term", +label = "Loan Term (years)", +value = 30L +), +numericInput( +inputId = "rate", +label = "Interest Rate (%)", +value = 4L +), +width = 3), +box(plotOutput(outputId = "linePlot", +height = 650), width = 9), +) +), +tabItem( +tabName = "widgets", +h2("Tab for Widgets") +) +) +) +ui <- shinydashboard::dashboardPage(header = header, sidebar = sidebar, body = body, +skin = c("black")) +# ------------------- # +# Define Server Logic # +# ------------------- # +server <- function(input, output, session) { +output$linePlot <- renderPlot({ +# calculate savings from income and expenses +savings <- monthly_savings(input$monthly_income, input$expenses) +# create df from init_savings, savings, start_date, and end_date +df <- create_savingsdf(init_savings = input$init_savings, +savings, +start_date = input$dates[1], +end_date = input$dates[2]) +# plot savings over date range +ggplot(df, aes(x = Date, y = Savings, group = 1)) + +geom_line(size = 2) + +scale_x_date(date_labels = "%b-%Y") + +scale_y_continuous(labels=scales::dollar_format()) + +theme_minimal() +}) +output$homePrice <- renderValueBox({ +loan <- calculate_loan(input$yearly_income, input$rate, input$term) +home_price <- calculate_home_price(loan) +valueBox( +paste(scales::dollar(home_price, largest_with_cents = 100)), +subtitle = "Home Price", +color = "blue" +) +}) +output$downPayment <- renderValueBox({ +loan <- calculate_loan(input$yearly_income, input$rate, input$term) +down_payment <- down_payment(loan, input$percent) +valueBox( +scales::dollar(down_payment), +subtitle = "Down Payment", +color = "yellow" +) +}) +output$mortgageAmount <- renderValueBox({ +loan <- calculate_loan(input$yearly_income, input$rate, input$term) +valueBox( +scales::dollar(loan), +subtitle = "Mortage Amount", +color = "orange" +) +}) +output$monthlyPayment <- renderValueBox({ +mortgage <- mortgage_payment(input$yearly_income) +valueBox( +scales::dollar(mortgage), +subtitle = "Monthly Payment", +color = "aqua" +) +}) +} +shinyApp(ui, server) +# Packages +library(shinydashboard) +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinythemes) +source("helper.R") +# --------- # +# Define UI # +# --------- # +header <- shinydashboard::dashboardHeader(title = "Home Savings") +sidebar <- shinydashboard::dashboardSidebar( +sidebarMenu( +menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), +menuItem("Widgets", tabName = "widgets", icon = icon("th")) +) +) +runApp('app5.R') +runApp('app5.R') +runApp('app5.R') +runApp('app5.R') +runApp('app5.R') +runApp('app5.R') +# Line Plot +# Using simulated data +library(dplyr) +library(ggplot2) +library(lubridate) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +# Packages +library(dplyr) +library(ggplot2) +library(lubridate) +# Starting data +start_date <- as.Date("2022-09-15") +end_date <- as.Date("2025-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +# New data +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 1 # The original data inputs: # savings <- monthly_savings(input$monthly_income, input$expenses) # # create df from init_savings, savings, start_date, and end_date @@ -366,7 +250,7 @@ theme_classic() # end_date = input$dates[2]) # Recreate monthly savings given some number start_date <- as.Date("2022-09-15") -end_date <- as.Date("2025-12-31") +end_date <- as.Date("2026-12-31") goal_purchase_date <- as.Date("2023-10-01") monthly_income <- 4000 monthly_expenses <- 2800 @@ -378,44 +262,11 @@ df$date <- seq.Date(from = start_date, to = end_date, by = 1) df <- create_savingsdf(init_savings = current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) -calculate_savings(current_savings, savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -# Visualizing -ggplot(df, aes(Date, Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = as.Date("2024-01-01")) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -ggplot(., aes(Date, Total_Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -# Scenarios -# in each scenario we want to change the amount of savings that gets accrued starting at a given time -# inputs: start time of new job, new monthly income, new monthly expenses? +View(df) +# New data new_date <- as.Date("2022-10-01") new_monthly_income <- 4700 -new_monthly_expenses <- 0 +new_monthly_expenses <- 1 df %>% mutate(Scenario1 = case_when( Date < new_date ~ as.numeric(0), @@ -433,6 +284,61 @@ scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + scale_y_continuous(labels=scales::dollar_format(), breaks = c(10000, 80000)) + theme_classic() +View(df) +# Packages +library(dplyr) +library(ggplot2) +library(lubridate) +# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") +source("helper.R") +# Starting data +start_date <- as.Date("2022-09-15") +end_date <- as.Date("2025-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +View(df) +end_date <- as.Date("2023-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +# Starting data +start_date <- as.Date("2022-09-15") +end_date <- as.Date("2023-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +View(df) +# New data +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 1 df %>% mutate(Scenario1 = case_when( Date < new_date ~ as.numeric(0), @@ -446,67 +352,161 @@ Date < new_date ~ as.numeric(0), Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500)), Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -filter(Date >= as.Date("2023-09-01")) +Total_Theory_Savings = Theory_Savings + Savings1) %>% View() +df +df[c(1,2),] +df[c(1,2)] +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date > new_date ~ as.numeric(0), +Date >= new_date ~ new_monthly_income - new_monthly_expenses +)) +# New data +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 1 df %>% mutate(Scenario1 = case_when( Date < new_date ~ as.numeric(0), Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500)), Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -filter(Date >= as.Date("2023-09-01")) %>% View() +Total_Theory_Savings = Theory_Savings + Savings1) %>% View() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ new_monthly_income - new_monthly_expenses +)) +new_monthly_expenses <- 0 +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ new_monthly_income - new_monthly_expenses +)) +new_monthly_expenses <- 5 df %>% mutate(Scenario1 = case_when( Date < new_date ~ as.numeric(0), Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500)), Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -filter(Date >= as.Date("2022-09-01")) %>% View() -# Scenarios -# in each scenario we want to change the amount of savings that gets accrued starting at a given time -# inputs: start time of new job, new monthly income, new monthly expenses? -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 1 -df %>% -mutate(Scenario1 = case_when( +Total_Theory_Savings = Theory_Savings + Savings1) %>% View() +df[c(1,2)] %>% +mutate(Scenario = case_when( Date < new_date ~ as.numeric(0), -Date >= new_date ~ as.numeric(cumsum(rnorm(length(Savings), -mean = new_monthly_income - new_monthly_expenses, -sd = 500))) +Date >= new_date ~ new_monthly_income - new_monthly_expenses )) -df %>% -mutate(Scenario1 = case_when( +df[c(1,2)] %>% +mutate(Scenario = case_when( Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses)), -Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500), -Savings1 = cumsum(Scenario1), -Savings1.5 = cumsum(Points1)) -df %>% -mutate(Scenario1 = case_when( +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) + Savings +)) +Date < new_date ~ as.numeric(Savings), +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(Savings), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) + Savings +)) +df[c(1,2)] %>% +mutate(Scenario = case_when( Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -ggplot(., aes(Date, Total_Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() +Date >= new_date ~ cumsum((new_monthly_income - new_monthly_expenses) + Savings) +)) +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ cumsum((new_monthly_income - new_monthly_expenses)) +)) +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), cumsum(Scenario)) +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), new_savings = cumsum(Scenario)) +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% +ggplot(aes(Date, total_saved)) + geom_line() +# Starting data +start_date <- as.Date("2020-09-15") +end_date <- as.Date("2023-12-31") +goal_purchase_date <- as.Date("2023-10-01") +monthly_income <- 4000 +monthly_expenses <- 2800 +current_savings <- 24000 +dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) +# seq(from = start_date, to = end_date, by = ) +df <- "" +df$date <- seq.Date(from = start_date, to = end_date, by = 1) +df <- create_savingsdf(init_savings = current_savings, +savings = monthly_income - monthly_expenses, +start_date = start_date, end_date = end_date) +df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation +df <- df %>% mutate(Theory_Savings = cumsum(Points)) +# New data +new_date <- as.Date("2022-10-01") +new_monthly_income <- 4700 +new_monthly_expenses <- 5 df %>% mutate(Scenario1 = case_when( Date < new_date ~ as.numeric(0), Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, sd = 500)), Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -filter(Date >= as.Date("2022-09-01")) %>% View() +Total_Theory_Savings = Theory_Savings + Savings1) %>% View() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% +ggplot(aes(Date, total_saved)) + geom_line() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% +ggplot(aes(Date, total_saved)) + geom_line() + geom_point() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% +ggplot(aes(Date, total_saved, color = Scenario)) + +geom_line() + geom_point() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% +ggplot(aes(Date, total_saved, color = Scenario)) + +geom_line() + geom_point() +df[c(1,2)] %>% +mutate(Scenario = case_when( +Date < new_date ~ as.numeric(0), +Date >= new_date ~ (new_monthly_income - new_monthly_expenses) +), +new_savings = cumsum(Scenario), +total_saved = new_savings + Savings) %>% View() diff --git a/home_afford_app/sim_lineplot.R b/home_afford_app/sim_lineplot.R index 7830e42c..8e17fa3d 100644 --- a/home_afford_app/sim_lineplot.R +++ b/home_afford_app/sim_lineplot.R @@ -31,10 +31,11 @@ df <- create_savingsdf(init_savings = current_savings, calculate_savings(current_savings, savings = monthly_income - monthly_expenses, start_date = start_date, end_date = end_date) +# What is this intended to do? df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation df <- df %>% mutate(Theory_Savings = cumsum(Points)) # Visualizing -ggplot(df, aes(Date, Theory_Savings)) + +ggplot(df, aes(Date, Theory_Savings + Savings)) + geom_smooth(method = "lm") + geom_point() + geom_line(aes(Date, Savings)) + geom_hline(yintercept = dp, lty = 3) + @@ -51,3 +52,24 @@ ggplot(df, aes(Date, Theory_Savings)) + # Place text box with date of goal # Have another text box to show difference between savings at goal date and what's needed to reach goal # Show when scenario 1 occurs, stop linear trend for old data, then update trend with new scenario 1 data + + +# The variation should be controlled by the user. +# It should demonstrate that if you're loose with ya money ya lose money +# And there is not a lot of ways of getting back without earning more + +# Part 1 +# Create a simulated dataset that takes the income, expenses, and savings variables as inputs +# and produce some 'natural' (or normalized) variation. + +# A) +# Acknowledging the inputs and their effects: +# Current savings shifts the savings plot by adjusting the starting point +# Date Range controls start and end points for savings goals +# Monthly income (net) is the total money earned in a month +# Monthly expenses is the total money spent in a month +# The rest of the controls do not impact the savings plot + +# B) Forming a data frame with those components +# C) + diff --git a/home_afford_app/test.R b/home_afford_app/test.R deleted file mode 100644 index 033d343f..00000000 --- a/home_afford_app/test.R +++ /dev/null @@ -1,29 +0,0 @@ -library(tidyverse) -library(lubridate) -source("home_afford_app/helper.R") - -init_savings <- 29000 -savings <- monthly_savings(4052.46, 2800) -start_date <- '2022-02-01' -end_date <- '2026-02-01' - -total_savings <- calculate_savings(init_savings, savings, start_date, end_date) -total_savings - -df <- create_savingsdf(init_savings, savings, start_date, end_date) -df -df %>% ggplot(., aes(Date, Savings)) + - geom_line() + scale_x_date(date_labels = "%b-%Y") - -yearly_income <- 75108.80 -rate <- 4 -term <- 30 -percent <- 20 - -mortgage <- mortgage_payment(yearly_income) -loan <- calculate_loan(yearly_income, rate, term) - -home_price <- calculate_home_price(loan) -down_payment <- down_payment(loan, percent) - - From d6576242ffab2587ce83962daf6ac9f8ee40675b Mon Sep 17 00:00:00 2001 From: palmorezm Date: Tue, 29 Nov 2022 21:45:50 -0600 Subject: [PATCH 17/19] checklist notes for edits --- home_afford_app/notes | 8 ++++++++ home_afford_app/scenario1.R | 2 ++ 2 files changed, 10 insertions(+) diff --git a/home_afford_app/notes b/home_afford_app/notes index b4cdf845..2d80a25a 100644 --- a/home_afford_app/notes +++ b/home_afford_app/notes @@ -55,3 +55,11 @@ What if we built a model into the app that could classify the category based on - Can I purchase this thing and still be within budget? Comparing prices of goods (one store from another): Ex: Aldi vs Walmart - what items are cheaper? + + +Checklist: +Vertical line at Date when savings amount equals down payment +Horizontal line at at dollar amount that equals down payment +Autopopulate end year to be 1 year after the date when down payment amount is reached +Incorporate interest rate into monthly payment (monthly payment varies based on amount borrowed and rate) +Develop realistic simulation of natural 'normal' variation with user-controlled standard deviation from mean net monthly income. Greater variation should show greater uncertainty in savings growth. diff --git a/home_afford_app/scenario1.R b/home_afford_app/scenario1.R index ccde40b0..bc80c375 100644 --- a/home_afford_app/scenario1.R +++ b/home_afford_app/scenario1.R @@ -5,6 +5,8 @@ library(lubridate) # setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") source("helper.R") +# This script is trash + # Starting data start_date <- as.Date("2020-09-15") end_date <- as.Date("2023-12-31") From c287d8dab26da680840ede646256e1ce22b91ce0 Mon Sep 17 00:00:00 2001 From: Zach <70336307+palmorezm@users.noreply.github.com> Date: Wed, 30 Nov 2022 17:03:24 -0600 Subject: [PATCH 18/19] Day of Discomfort --- home_afford_app/.RData | Bin 0 -> 287955 bytes home_afford_app/.Rhistory | 996 +++++++++++++++++++------------------- home_afford_app/app5.R | 6 + 3 files changed, 504 insertions(+), 498 deletions(-) create mode 100644 home_afford_app/.RData diff --git a/home_afford_app/.RData b/home_afford_app/.RData new file mode 100644 index 0000000000000000000000000000000000000000..1983963119d38dafa81b1d9b6f68cc5e7e3a2801 GIT binary patch literal 287955 zcmeFa30M=?`Z)aE+xEIuX={~Ml+;qCikMnOR3N!(6%~cLA|ONsMMa2$>?Bj`!fh4f z2B<8lRiuaz79niOR44{Ph{_Tmz!VVzgb+L4`@2%%o!V>-{MsllGv z16Z9Lt0ZBaT*ydgO1ir-g&Eod=-5mnLW6$HjQE&S>80RBkeMG-sS0^J7K?WDihE}` zt>xU{KGr^ldj$vh-Ph>FJzm-Rgn<7(wN%-%^a+BP8ee|*B1n0K9{G^#*yA;NTcl4I zqj2>JV-&f{7Ls`Jh1?i6T~C3O41PBpQ=`=QuzfsI#4yqI-dV=`TjSE%UxZeTb@%B1T9BW+1FqHeJgRx^M{jfB?PC-i)))oSX7c6k42Wak)6@*GA7(ack=t?{zmW=_+F+?z*x^C~Id@cMJ@$4)r`$2H zP}S?GyaIuvvcbK1lY6tu+A$bMWY->N9M~0`!vrb>RYt^?kd-}z2AOOWVOLHO*4E_F z2p=?!@XSPzK!i@OVp}3eAcBOEi3|}W5JAGow3i4Hh#-N;B$!e?M1JLY0*nX}h#-Lo z5=Qg8L?(gAB#f*D5SaublRyLsL?&TG21XYEiRA`jxnU$$CW3_j{|5=x*ge`FGKg@Q z6_CM5!crjY3>B@A+G9yjq}~hDVl|M_46A2hM$oWhSLKZe+m0XQmC=eDRhV@H9W_IE zkGYTSqR#p_({IRcXdkm4$JE$C!L{67DqGQipT6Aj@}`Y29F^@Dg|4z4ql~o$2HzV~ zHf9-f3k<$D<}bIvgz(d_PceB%3FO7}@~IIhL-mD5ehdxWIrzs7FaNz0<}WwE;M-#U zV)x7FZ7H*HjDqjF8KbY}`Umm*r^V)f)!JUnGV-~S@gWq4Vzatd|-F(o5}d^&gZowkG#d<=e1uP!a?3o9BKW@+qaJY zMKR|&+&J(RR&N9HzU_;KLhX*%F#hoGDPrE}{xgI2ksUtBu5}GM zQx9*8GWj)D9(~2TzXyzS(d9X=T`Jx*oV}x5pNF&d{5!}Afh`h4DL~#2iAN1-T5#0W*01?405!{aExQWc|-^V7SNq8c- zeWO_+g4@3rAYx&KSXdcdSt5elHyRNlxP9BTAR@T^TLB`1TOzn6g4E!PKihj5y34H-2R=GJkN*_!7Y&* zB2q(RZGd>WGDqwhB6bZCyN2FERq#iMT|;9o_!GN^#w5>(01;c_i7oNOmiRYqg88p| z#IB+LBFP`z6tV6}ta}pcp2WK69~ORzT|3?fhuAVQ`JL^X6&gbmvRXd|G+Vu~>mfT%?@{Gf%} zAW-|11EL1$tAiYT41!(HudzWRBQmTELqM5#y{Qe}5Q`ns$`RJ{PDXkXK^O}F1TP+# zWq_$#Ep#7BER9AqG>qq_dkui8Yna|E2W3tz&s&W4i|OU^=MT!k)d2R62_A&W0W2D$ z{){>RN(k+vVsv~^`V{<|I&@4;LmJswH}*6f(6Z10HrfpstpSa{=}84(bi)R);Zi^^ z0Tcp2=M3m+n1X~g($GN?GDyM()hs3^$L;~cG8$?QD6Fv|8g@f~bqWBD8>)w?F&G^k z#*7LPmPrD1EbK9e#$w%6bQ~~5Mpb|Y#)bgIpNi?&h#u>a$h|Qg4Xfc|-Jq@uG+1L# z6*S{LF;!=d4FIq+Fbu*ROKjK-YXl8cw2_AOvC%;`rl#uM&}VK~ubkpTl5;p5IfPY! z#(DrvV(Cf&wK;&`II$6Yu=oHPAtW8plQ9^(0%5fhr$OK$9RX1eprRUKPzkVlf!NH5 zk2#fI3SI=6`7sUC8r!j0w4+ztJHu%$=LYw&_A%TmIKc0|MlbI1%GM_Y{P(G)%9f>1 zc+)3_@Y|v>3s;{oMv<#*$NJDvhs0})!hFazUZLyp?+N+xyK&@jTu3TgYLD0RisgU( zp`l<@ekXz-3UZBwWeKcqsWMQ{(DRMC_$PM?Y3e|*U(9U$?@tVwDq1-un#^qEcEEq1 zT8{OhArW$WjDo`&qu}2Vg0z`@x%(SFF@#rij9Hii?npDokV{j);S)o6MKMhs0>0rB zLwH329VW`#Q{aE)Cx#@L<>r8A2)%Hvr&ZPk=caW5H|_H7uAP!~Alq+i_KwF}1@#R#5}^)n)|BpliZ0iNK)!9lNnNrA85L_+*g z74^bPFpjUtIwl>!I~OkCLq8bjn1?ed@zwDEg4$&V6RAu7i-L;k;IFrU4#YjILch`1c`$srALT3}0QGpt1`~I6q z_+*CO==SU-7_+}+4KAK|ujBwf6DK{bSh$o{jX8=D0ib(Y$$|V=bT)w*6{wN6r<YgmtbBa>tC>DL_3s;c3+z~IjU~Y{#qtq(9=Haf);FfMQ4))yg?`bK*GCg zDcIEIFThm2lFZj+{zd<@x1XPfRZHGGvoAX5rTxC<@v=p; zzbn30e4|+LkasCszHUeJwuyHiB@~w3eKfuGpY31TGUf$df5b1cO*?iY+9Geonfzwg ziIdxZ+SHM6#3aU4hw!yl9$_($(E1tb`#?6OvDd|->#wG#Ya`g z>K?7bLFUaLfr}&gX54V}@bcrywM)NPvSkhq>FR2~)h4Pus=EEt1$=~WUnDea5r*7(!G@Ro z7~^F5xVVo;d6;Pugrv7?d-aPYU#Bd7#f=ftjneJUxZ&vG<@4(oCXWc$$+bNnw0!%5 zA$~7K+Rakoe;NC^8ScMjc{Xxbfa|p6K>D-1|QSv z5#hRiVfi;pU#f@4sC>NLF?h<1c`s!Lm;SeF_4WD#ek=T6XtGHyaSTW4_GjEi^=8cr z6EPv~;q1KYFVv%Ilm~Bl40*I}^9$L*rGMTCf&RAb`c+o-%U8e9WV}6&;d8qE3Aa&2 znfKB}9PpcRVe(7$*ztDeage0E{%gB&O2#k?cAQA$v zQb=!_;}Z#ixR3v8(oG};#xTf4Lg0Ch<}Z?{M6UH!9{A7sOd{9%CR03WsEJ(bNM8Q0 zGpIza)#_y)n8>vf%UHxR7O{+l#~?5BnMBk|M6JXQfxpbt5(xn!AwcX9Aabq5=BqKX zro=K9v5ZA*zWR#|PXDKO2mnxhRfbF9xZ+w0fAAPEG_-nBzzNMSV!6|?lKRMHF;St$ z`}YE=OX4v*rsDfkXkW+bOxa?al#VYO?uDPt0y>U-MeSYSx=B_v|CgEy$f;A_Ius5V zcKCGcXG2ttw5FV6URsk<r)|r$4$Z*X&tFoXYrfjQ2>6gvU_qLE*x4YNr^W8o7Qk>@`@V;E9w62mpNjM%-3HPAGNfv zw8r1FLX#0BzsY_W1nXwQMMqb(cf=G;?mTblAsarOvd1ajy}(m>!pLjNR<41Y3c7d8 zYAh`KYSinTk`fjPG!hs%i z>P7%mw(J1sSXh%JyYX7S6R+5gs{i`*Bxe0$_J`!JK*pK}^t`V06vb1w`*q(mWG6@} zIX^-!=HW+v7JD@p=PYY)?VZ6a^{I&XIk@8KsUZgGaKV(yGZvcV17-gH(Gek+gJnV2 zg7mT7pSyBhlOt7=`*cA?8I)PeErjX54wo0gn69hD?IzPPo0{#>J7R!NA^TYZLppglN5 z!4bvRt7wNKE|MEB?Hc4pXK6M7S;-=F#)2o+lZA&$?AD2vo$QS7`LyRmpifG!%@#9< zX%RW9)by1NQYd1(|n9mC=+r>)cde+L*Zb0oNE%IG< zbJWommg1V>=AQ#+)m*mEi1!ZPR-e^ax0`b3VDoJSd*h0g4jJ~ke?8^R=l0K0KfbtW z)3R8#G!8J0e5b;86C!ElzUvt!VK{y7!{~>|?7w&HLz~{M-Nn zX#+S|AC0QyAD!w5&YT$Fa8kw`FBoJy7}P4}W_IGU1Go1ySX;JrKkn78s`}I+y(V!* zO=op`OpJ1Ap;FW=+rWLm`v z{#;{9ju2e61>|$$)wF|s0W$3(M#>!^<)%Vg-zit;p=({}36T7D)xn+1%xnOMhAcqRk&T#pzA#lPdj^xB6=ZQJLFK`SGpfWgei+dy~k z;Vo!RoyMR9_0e`Gjovn)t{LqrSpJz*>k$>Z3p&wBZ=wK~ZZaA2_W^p!P&9OS@AJC#cih?q%Hul8910WyFD1q3IsBfp@OMRg3vC#n@AA42%znk`bHJ+V*7T= zix|vPcwZgU(T?RN(s$*d8(cW-+j`%HMqWDwxNwt+njOZWpknI*Y)u}T62|PxwLuxt zI(V*^T*%{SAwj4QWtaUP#;)}4E}bFLOY_OJdQS4~Zq=4A*@>$RFAiposUOAU3%3Nnn^IG#y2MJ&B7G=-mW1JaK=Z!O5SJlG6bIVda`ogmmQy zvji<2FnI5irW}A(815gT6NSOqQu*EC zUyP`~AL2DfZPar85GS0(s{AmL@71!3EoA7agzDd?##PLdkF^hJRl#%)`%r=$ARCb< zINcB=(gXY4g=Q zx2Of!G9!{c0n{ScR1Y94Efw%ZjqyX;OpQMC3$+n;tAKzjCK7V04enkgThC$aQy>t; zhQ7#e;E-P8uWdW0Fh4*{+mVT2+;9<2SyOP)c3 z;Bp9-sa$Lsscj%M9w4Qfo`v@z-CGOZSIU6TjEn>2Q5X_C_b^QaG@rxL@L~6uJ&}+K zhWFv8J{U{bV!bLV&ZH!%fMufEeM7$hdoZLu2piwKcwep9Nu7qKUK@(0qHZ;Y%sFu& zO9U_Ol>ab6ifG-c^BI`VanM(vQ+0XJr1jFg9}6I^RFn7z`=1q{KOUYcRxpaZU7j{^oOkdcc$}&~Y z(MJnTszp2XLla@+w5^k|Qrl;Jf#gCV=X^tTY~XATJ-X7QVYCIfksqED43sMi6I&$Y z_=Z#{klb!EeTkczF&A9V2aF5$Cp2(qHBF@)g&Kt|e#6TA$_+W$om7Dc>`17+bhAO~ zc2rC^J~hYaXE)n=k?I4U8QNx|LAgRsegiXL4l5hbQSXQ(8(9CQJV|hnxa=&f#9YlT!H|Q)&w2u6IILQ=hgHJ4FERR z19z33U!JY7@ZvDsUK31P=c{UT8j$EUTm@- zD!KiL#j?jO*3gBbg(;9!hDP*@X`htx`5gebBn${eoFcuesrIdsMe&Bl!f9S$eUo5Y zzq@!x1@tQgjJjRup;xI=hqUduYzpkpt3{sk)tP}6L)`sraKjc5xG|*lHi<3m5^kwX z4P8%x&I9>LU#OMR;eUZz8TE5qqca*fg$yqpJOz&7++<>WhRNH5zUBJ$$h>T?a9pFq z#YpJ`6KHEOdOmA}>J4s%3_u5m!baR@7_bjLfV8x7YcBG5Nc)aPe`ZdB;XxsFI?6nP z`vD#B?yUz;JIqCt(BPCuUCusE63#jxCvZbx5b2j0XaA%-Q7A<8j!e zNdU0NWL#)hav0v2xpgu-8#`LctRJx}XJM96&S{p2cJ_|sD^W2l zi53?|$$+Y6j#_6jBGe>PTcOEeso|+?475O*9TedDO&^MpH>9;0u_}=sK<&1DcbP`; z1C;rg0=nYv6+=x7!hSY6XxkR%vshNEgf=H5(G0{VQVf{ox(wu8RD)l48VrVLWyvvY zm6KIGm>Pxjvc*y4@EDvJv<>>ZzU2lQSIOWqEVstVvAQN`uatiEP!AjX1V!^1%;K~T z{xmj-T`oO&2gaqIT4RuS^`o{uEbJqcSwR6kw+N|nd>T698t7F9b5FzG78I_4#>rHP z>-xpmzjd(Aq!ZLHrL;o_U9yF-<&g7$$|T{!SbGystfp!>dP!F>(;j!?CRbXJ5CyMu z1l?jm>j9PhhJFclbx7-FVlS|&$<3=@X00$-aIcZB&3h*t!K8!Hb2`b=XX$E)3U&KF8FIkmDxvBcfw zklsJq@w7Q^80c8A2e!(E$D9RNF!K>T?msTJBJIrX5p|+9MbD23h}P9=0&wzdIHaY+ zb{57CE+9LpnhJa($|~iTplM;){=at@(%Mu&0dw(3v56*C@&V3C zNd2qCv_LlaZ=4A3Beo*bdVtnXKkB`L%BhbyqzHiH3i)>N#c{Y-fWC;4R8DPjV<`$0 z>JImsnv++eFy6PWL2SLrbRS*~);0--XB1O9VX;;$5qZpyp+`UStuav@B1>t9GlqDw z>kC>@JPO=^M}Zx)rL=t+cj04I9#uYAV zquELD2Huqf__hgbe!{sZgFZ#4;BnH0C6+Y5bX+B>OmxNLHj#%RO3YkPIwck?oqGqz z+s>p#RVP*TYG;|DJxJ<1UuGe;0!oDx;CPx3^S(5kuEYHu-dcW1O}=ZgL2@&Io-d@$ z=_^cjGbuWqZPGEZAEV}ps7mc%iT0R!7H(?hX9KXQXL*h^JQjBq2>>3n%kxZ*lFg!z z2dqa3zR*PQEkHAhTl1um8IMGgG$M3KIK8`s6C6PMmZeT=CH-*|9MXrYzKhbxk0>|9 z3aZ%(bxonsP7}E?h4q_K?sVOF2K~Jjw=rA54$4FzeLxkkKrJ;_$vt&&yD9i$UsQ{{ z4#j*C52RN>@@5HbUIqj?`yn<9LMi4oAa35~u5Txmxi^82pCol_p}Epm_&YK;(=>5SoVWwUCQEQAGm>coqT$uxW=fhUv{H9yO1{-5>|kRvT(? z%R}POpG8CdY;fZi5C!l^@CO_j8Nj{+;1&S=fQ8{2O)3!5$Qd*?HP2*VfMexoff1QH zwT>pje)5L6%~5WM4&A1M_rS&{8Lf$8j+~8~=shOGNnL=4D%+4o)=7|x<1i;fz@<(_ zQKN}%`1}aCo;Jwx)f*+{5X%*xAYqRuh(&6ES+4IhfV)NV@3OQFLb-K0M9UMB3$}3} zx6>fF$TS}Uzc6*ofoM3SMhfoKSae{H5g8uo__nEIoa1mnr##)na;(7=jImQq!5F<+ z?QlS9=4z+Irx?>vW)lT$+tO(*#-JhXh`|DOG*M|=AQZy87MQvQnN)KWZ5-+P9Nx9b zMB@=S8Ry{_YPBf<&%=WZe3l4Mj7a%OH6P0ff~j|foWvzT)XNev#=isP;`22SH?7AR z=tt{$M*W=S6a+V`q$&+3B?l!{%Q+WhumNv}J0J3;C4e%;CNv?a7f@07#jNGV#eJ19q!2 z`BcNfGCnRX!dBc$<5o1ol;OYzP9g!w@7w|7{=lTv`(Q5*E6oar25`;Yh+;)FOe|RxN{LwQ_>9a{V82P^3vtgtXHORSJ10{C1a9=ouyN&E01v0u%bYxKqy^_wj= zSole3AmV{ZAUU}0%OCFEnikXkq4ME5^G&!G0gp}6p19EzfNUvcI^#a2Ti^cSUd6dl zpQ5#II2B$t64-FgtKB{4BQ{}WUmJONWR9m5Fj|30%{i$#0FTefRjDYEsjaHguC-or zeYFUd(=Qse$_dhRK`L(JECb4fkZ6-#D>?k(Nr`=vnLJm$sL^QA-|wKo{iD}yy|!>j zWD0dKrfG7?$8-bjmgtTFRiaD3Ryzfc@3zKKvitN5+?&MX*&an}Ou-#G?hEut(mn*A zJ0qB<2cA|zjim8_Jhi&(NchhAF$bK#6o${l?RD<3XEF17S-V1wI~kGu{2e?jq@odw zRgq;~L9lTx9!j2y$?f8sj2dJs4fiyxU5=h-hnF={*!cWL_;@7oB|V9_VDUvkf@G8E z_K?Ec$WnUl@Y3b{(M(L~O&^qJYjj#>(ub}*L~4D9eF*{|Z1Fvn5fk&7k;gCvl;UnJ zE`;mrxV87B@NJBYOC!k~3|wTi9Z6Fp`62Omta`+G=!yfsk^=mIQ=Qam znt#!+<^UO3WoVyqkQ*4)-`#aFODn0vsSeo+C3vogb2i?sOBx-SyZndRRrWz&x89ZM zg9CvI-5t9dXhllLk@-#yd$Kkmi?wyp@-i$nb}$NNWTIqfA%u>eD?18r2ihO4rPNyKWl0gTx*IQtD zQuOZfYTKFj@>3GS+H^8W$U0Dx*P(k)96Fd;omKiJcd!rG^Q0D7;a^-JHXhRqCC}?! ziYgW#ja$eVs(Ktfg+mqg+%JTjG9H$l|EGHIw13gdmYup+Nj|@n_ods7vY(m_h{s{? zqq;!zf=4A!m|tr(4h&$A*>)!f{o$wXJ|88L`pqm4nZ>qW;uU@Df5yo3EZX`Jb)3sn ze@$of{;wN*gtgNrs{Qqkqr!f?5**0xZcoYlj<{-Hle?q-_CYKT>^*2)#?=P|Wbe}MzcV3PWB+c@F{h==zt0Gn^*}dGtSD*cs2(;f z%MOihFZ4H_h%4;tQz^xvOC94vMSCl3v!mIMB1%prTJnz!q{T`A2|E$`M**5`Py4P2 z&8CHAd!Gx8Z2vG$*7;Aeu6fTcT_Z(u#)9LmeR^L7wvw+5t>OjO3fwBGfTx+nq7HWY z&fSiGw{yAcig-nU;o>H!nHwMMyZ4^v>~zaH702uye^HO4pk3bPO3FQ#dhxpgVeU*p zA!in~+^cSTMEtIt%IFn}0C7i=-YWbb<~gbLC3ao!DHGUTA(y9Ka+7`Ua%Pi{B(hc~ zb(}Z1Zu7>n{ZjJB?LG@7h4w6Jyn4X?d!dns!KH-}`m+guxx00nMgW6=|xZc0XQ`G${Yscj+Ei zTgnsaKK)WCvE_@-g6UxuHTip@O|`>D=7ZhktB>C5Pt=$W=mJEk6{g5YkrLl9zG#dT^V{up8Ui#xo(fx zm3a8bE}!vPplg@cBvJo%g-R&)@KJBY*_di8TBBH&^Dk=^)SK8*4IVbr0MRFF% zFLitE(=YYtAlGnf@&>}!Y8+p)1Gx{F^h-#`T$r~>6P+}m9j!p}pfQRV z@2`eQPeeKv!aQ$Hbm@RLtVJ%v`x~i{pGP`o!@Sj+=-2`6lot7{JjlTh46kCEDmr1_ zk^~FxFU>dhuC4T$25)P-{dDOxczav+D%Nh6HTovu~qX8=N#u3 z6`wkNKStr<&D7&H{T~iAS~X`n=eV*40 z;63BGNIx79S&dfw9)`EVI~Q3Md9&VhG5E-;Xf^BiDNf%z43Gcw#iOr}uC4j)Q`@Qj zcQ++{E&NR=MM9oI~D|Z+<$(xzy^QhNBoKD$44GB zJ+UBj((~J)rkkywCloC79chc-ZhY@~gOXqKs=t19{;Km#+r1vr7d3l5ymyZ_#XHSh z@VpxW070Tru_L5tM1=@NGubG@RE(HnTqg)?N;sSmKTNpH=OGIbRSkb(BIA{vs-W;BNS-xwY*iakQzf~lWFIjkR;rj3&__7%C z%9ehn!-*^WjszM#3VV;P4ij(LNb{}XEMma;)fD`Sliw}f2p#2n&B8P_cBPf@qB$*r z)lUM=liT^{?UmCMN#addVW2)T6mjo2%xihtXoGYdSg%SC+UFHw!}&y9J-N$^w*u|? zwQe4weQ$lJSj>$$nF!x-)WEZ9AuxDA%efkHn63|ZV+u2woq=vCUCj#*2EmQK;wYK9 zwUL?R&B{#8NdGM5o^Bdy-1cB)-&rc1O;c}lvQvNg%#+zsSW=r^E0INc!(d+L_3G*oQPbVW?1|`SYdW%A9FBhf;6Ol2> zo7bOSElj;({prQR6qk>$OZ*S7L&aZN`E5qcyVJg(xboCbpLaXp$5r1d_KjSw`gZm& z8$aAOe*Q>x+GY8>@g?iG(#GQ*q%E8}irkMlYNioXCQcZ| z_0&&auX%xJ{1*PyZT+9W1pmzk+YVoN4OdgceLvziO#Q!(>%8yrn=fheNBF0H!f|~G ze*;d7*YGi2{YZX}n~AP}L74ILO{kg3N1HoJw`t#3fBX{B4SLsaGtP|kZ0h2}mEY#B zc^y|1iC@t1bzJ{Qn?J&z_C1d43&xC}zh;D$FRpRQjGxaRW!iJ5zL7Aqe_4m4W+GS2 z)#r2@KY!~>MCajBl(z7rQPxaciLf3769P_H@aLB5f5d{v`!D`wqj#Rue*)3YUrL{RdV2Q}#s{L4!~Gc< zGHmEq5IeI~0nP0@ZhOmLc!AQo5s2xZ*>}Us1=!nv@YcA(E2&P-h69U{2l>8zHzbK@ zT1Lptard9(*AA0O&7V0%pKH)y?zgV>(b~UsI&yA!Ao3O~m1YnPEJIswT&ibZYuy|5 z`^>(U+=fC-Bs`a9s;u8CxoY`|i!dk^jeEyyBYrn51_(KHrtkQJKH%qkZmBYVIuQ#Du zJ1loivBL2)wFm7BRvLPnp0L@ipN(Mouf7{e>EP}@h`mBM{Oj^3`S?`?zwd@{qrqjX zFgWV>@+ZJop~w4c}4nKa-M;04sOOan@ z32qcZz}?2-f$8I!E=Z%-dJrFHKi0qiEkiIK^o z@P^r&@KNKVX?H{l-tp~gk*qWH>eH~8LnnrR?db!TxkqUn>z%FBvEY9E*WL|l#E}T| z!TNE6;JguO^dR$CKp)4=`&q*|l}PB5JPgfj-aFDNsSixSN1e0skXX;vz<|ApMv=D) z*?<DWPB6ikAFL)M$9WO0+_>WbAg{HyP{ z$_2uS8nt_YQ)#7%5cG|K=P4zT2GqnDoIFA2aap1s(crRFJA7iRZ{P8dn|ME@6<;N! z&T=6I-XdL{;bOLHchrvh_fK&2Pq*y_w@x`lUfy6Cy2@~>`~=mnOnzfJof^6#-K|-{ z?5&MN1eD}@H}oK!+6YiWzL1)Ik_bPdcMs>%AFzS@O1ZOJ&+rfL6rz)sBMsQYzI0$o zx?5{#49JjM-KSDD`5LD)61M&hLoRI9V7)E(wUoxf23_ye#AcM9gR~{qn++Bs$%V2Q zH&-fJS_ryz4tH|0#?H1Uj(qN{_W^>hq8*Ali)i!unfAo?FZf z1~x~pGK(p1!VaNEMYv>mF{>4&?3eheKZHZp{jvmIh3hr}MUb^p2U3{tD zT4tae6ehAI&T$xHcvAxY(k!HH)$0*-y8|;5ix~!=sY&_EhEM807n+lbTeC$D*Ca?Y zsRmNT4E0f)9P2K+6-wlhe8UjCP!=~3?%u6NXEGY9d2UYo1tGi?d1x3v451oU7b5SK zy3+h5aCI`JcyT(($nq5+RHcLoQ5biN*(}TaF63vVqd(k-@3^SCkIpP$06mAhRxo>K zI8bZo?6S5x{ADUPU?G4Wr}_#4^%x@za0Hl#nufhLc@^ufnu(9bB&7%)0)dp|sO88r z@8w7w^^gP*Hi!0#6}*PK@j@1~ACBDQ3UrABdEM^-Q>bcIAT@ymfr4||=n%s*uWJJ2 zw@v;QuvRy8Mc?FR+Y;FlM%k@}7um#8_o(-g&77#fz()>d(XJGoPpPHIPOE*e9Bxli zO59qsl;MRA91d4K-JV@Um70N%&Q(KhKJ7^fFSYifyjc za1U1q+zaJPq>yI}+$$L!BUuxubQ8dPKjV}jJFLKZtJB@j}k2y(YfDFX(Ig^g{O0Bd{ z7%%A(+==;8-_3;E*>}4N!kA=MS#lV(s}2%M=@PkJe;6Vb-F(Qx>hPE<@j` z33Ht8??_=hT`xv)qfl34uU+h87C8`K+ogmx3UI$f%?P7R=dkg28&W0p^g_guoNfs^ zQhOUY!az^`Au?(KeN0rKwsEKie8BSFCPBJ8o(GkAcf&U zI@IjQ7x*NF&P!ZCL1fM{c*nUY)X+?qsM-AdNW@sw7M>V0{1g5%?H#H@I}jtNcIIFd z3casppu__`3V39T&F^Pd$imQ`tz~V-9K~-6l?vYRv`-`vrcAwT+}(W^vS-z#`2=?R z&!fp}GvIfCL8oj+P+|(Jk&2Wsj2X#jv)yvWlT>ReOPSot7%q}@5BM`{&%x%`pm3T@ zE9`>kF;DJxFD9F}`Ns^;7lZL49}4qurN*HLETi;^DpWF^HdSX;E8{`uMC_>&2U1C~ zK2o8eirTV8UA&oUiE_O|svr8V_hfnXYI>#27bt>@(T zjJz!@ZcOT;O|`V{9=SptCMz+o>FJ1#6e$HZLphs9dMw;7lhUlH}2fFgF} zyNMOc%xu)tS@mJRio@Ep-Sx<9?VW)feJM{nn-RbE;$U_*f^oHOyx> z1pJyU{y9+cAbEwEBBock`3H;i0mC_kFUNlcUEh1}4mAiVNai?(2DDGQ_tK>g!p5R>;zkEwqAzGGD zw8!zzWs9Dv$%`G;V2GiQRDJM=sfDv7#cbohV3b{zkqDE-mkLDDY{NTYv)W^?xFHSv zr~TS zsO+tD&QL_Z{@1SWAS&xjr96o~U-*NB9^f9r97slvO6kALKJp>Q7$-W=&xE6G)0w+7 zM44^!2uj4E^XgdeJ|7!*I2sewiL39W`|KBVtCvxON?lXg#ufSy&!>0ey_k$L%YHaA z7;tU3UgoUqI%cVQ_7w-qx|+NKFg9BprruAaKCYHdip>dDW<71ym2-(TDd4 zQgtig_Rpk8nZ~39Fa^-7hn5YPP-lCBYgND zHQ|F@Jny0-yDi9_veR`=RC@PuNeD*^Xn=0Hq~c-}KYmhOCRG*hZz1B`4d*$ervlW& zNF8;rHfzXNT$k?F1HmENs{>WEIxFf^*}oHe)M;gRA(qOQLp31t)w$-a>aV7B8=Lh5 zYmLn{TP4R**{Q(`dtpTsSfFAUu>#~8Fx)jPY39^hYs5!CaW@oIZsqt#!Y66wk_m&E z8+a9B_biH(|5Jn6LnyM8p;*+!(JG)7;^tJ96G%Q)b2i>3t*t;=SG>1)VFJyCnWxO$ zWv04Ly1Q&>kpj~Ml>yTF^(w@#%^qv++bq7>M(Sk`@9Q2%sl7NejI z&?Y62kzz&g{hEDbEZK_jw5t&FE(E#;2TP6N9YJuXbFim@cITQVX20y)G~`$DY=JUS zD;|p2-U{0e>O$blT!9zGDB~2U@?&}_ZBpktSu!b_q75!*+kmch=0-ylFKw5*4QXPc zA-oncU+AxIK>YeRU*DgGM8Z1TLYh!CJ$*y5uc%!-%VoK4*48*_pZX&q_Y?`Bxl)aZ zvLc>SuOYt{@iH#x{@$Bg&O)Lhn5tlrKDW{r{}7#F+MRSx2h&34eDtYVFfeMoB|zRB7;jo5UZ<1(NikWu+8L@`lL%?u+r_L1DX_ z)4?u_vXtISG+)u<`~T20<|9SS20l>HazBi!unJ4w0S&{Q#s*}2=bEO}r?N>t^5}uB zg$xTeoGXy6Xbu_92=8eSPZo5YqNRTn{*V*TT;(g9FbK3ePh$?qsykSfENEFGJcEp- zM&WB?V8a7zP4ZcYDm3rN_KF!cvtx+?iTb3OXW0?3Kl!I2UykD zNjkZ%qybt0nKSnyzoi-`d6={Pv=HNlRytqcFA}O+mcE7;x^8|Nrpx-w&hn-D~sf%d$tq+@7 z_rn0(LCrm~BY-*_{77{?WHvQONbNY+539p&eIyvrmEmtP_x>P}G}Q2(svf!(V;VUe z`iU@n(1us0DH_yQi>=CN-%-sfMXd__MdYGd_V38Jn$SG-rX|D!w#dZ))Gxbw5=x#Pm@!s_=U4aaHbYXY^kuQs?`Yn_W)jY)A>dALrg- z;rcW6lZBz~h>eyL_OB>U@`@%>*o~lB{qIZ0wQu*(8cW5z$G_N>Hdvlr*puOul9|(@ z2A!^oRw09C z3#o-|gX$9AB`>s6B_Cw3Xz&ja0a)$M!Iodz6hxAGr_CQ{Dtx2S%ax7xYKa~x|{`^C0_1xvB+GphPFn#IHL(^*}! zv4U|b7q9uvP2M$|xQ*jCxu?-P>Svw${ut9{`QfK#*>0r!ZS}Olg*Vf0?aM4AF?Q$E zQsLc&5S81~KdG&MdRItSz|@7ue38U&939pmzXcQxdPx|&=lvvlaw{^y@P2BvZ<4$; zH&?xOuTAA(q@{2ThV)pp?c4>pRn_tKRJDW`NJ=}k?FL>kGhE;1RrJAT5h-@+zMOZ25(~ zt1QcGua~i-#4Ous#)iIozZ5L%<=l-zHn&vCp=lP*|2F_MK+C^{u_AozQf}tLH@PKs zRW+RxN{X^hzJK0Jn;qi%eO`WWd3kQsUR>O;RN1tuvsu;ZSzb5kT3qtru_FgJ{j_nr zx3>AMee3$T;pJ|uq=!m>|J|MW(N=b|(6~c>=^&{x(~Ln%a_j{ zYQ4SJ9kte0L!GzN8ueTE&$S-tv{$zJg-Z?{KX~tiTrhY4vGt2vyU$mIlA@(W#g2E} zchCC8&93%(;?w|*N7}uU{k73Wz4=@C%2uNL`cEc5Ta&MeEUpU;mmTdb_U~=4Zb>#u zt_Kevnw#6gRloA^sj$ys>z@9}37gU7_21n5x9itR2)lnP$F}3pea9!C>Q)}?O>)m> zJH7UJcldCuw1yiIa`f85xhsJ3w7l@%?);!X>@SYe12^FtmmZ(*_ZH7jtj}Q2Sk67K z9CxA7xN<XRb(>b*a-CO;~yLTz|gXUT)2{SG%F0*!0sEKd{stw!(kM)=n&U=Uchz z@6qtSgR}kCgPjxIUVCsJ*JiUUb#+?zV1MxN$w7Z@D;H=h6yw6~;e;dK>T%RvzhE|e zB|QL@+-zl6n;raShw;3(t+fZEQsoZuWY!q)S2O(v|gJJ2+u)C%EuMgw;+U>eSSoe%>_E=nYcc(w! zUwFFq{dvcO1!)gA${fwrT4s!wU-^rzjm~!L>+5gli|5*>q7ypZ9WAv&0lYR??QgAe zvROE~z)*F5x%E8C?)5&Tc^l8;uAYO1NVRypRegPB^J-&Ut$Rb}D`o7C*>blxH4|I> z+S~(MX;izoUmLqM)g3k9!xndRNm%p@{_1())&(?t9rabSaI;*vw1mHzqz zl0|ub#%o}c_jFsdD6s^)vpxUt>GojZO*vrXjM9B?Zbe-T-glC7n$D_qsIwY^^-4JR zR&M8sTfDE+Ss2EAIlnd>*5|l^+3pj}RuAx+cXa#9dC#-`wccp!-`ME$>yC8>;UrdK zCT|_@oa%N?Pq?PfJ96ZnVanb^KWuQ&uRPitbxy{M9I?icbUzLsY0aG(jyfynx>mY8>7XZB=S{BICaW6P zZiCX`CHIEoPY?d2{zIGWtC8O~xi4RFXJ<4D&wxGq4=jZW&dH@zY^*Qyw&J%NCsKc^ zA8&Z#*Ula~dTe4xsqykJlzIn`pXaG=aEY%8`x z^7%fUo0kroUjAkox54GsDzY z`~8#QCJ&NLX$|KG?Nz_kms?HCG1Y}u73GR-dh0gb#zbbl>E z$#4l%UDksRSbP_b#>4`)n3k3zhnK=ox#DiQGX@QVSZlQylyVus9~r@wwJ@5 z3%?m`dLhs27|!d<8$OTm-!(EE;(Gt#Lb$l`YFDB$b)M-pu>hO6%Zr=7Fy-CYcF@w> za(zVqMExz6Y-WA$VZDq<`4gtqLFJ@+-d zJl5BwC+Vy2>x_Z{e>fEzhdQgv{WA$rjP*mmfIYt~0)$i`_7__RPj-3>?FPtr8YlH7 z`|9t@uUtKQXtwoWzZd+J41sv=etN~++Tc{@OpRKTzjl$&yp(Kn?>L$srUyF1#7XA5 zHP64~&|Ir{nrH~RtIOS9=K^+j!AHOOA&fti7h@Y!Pvhh-Y+Fxf?X@v7o#+pGoz~Ii z?tk!sxo3R;&)nMcEb1@DZF@S0>)V(x0O4Y6_V-HqN@ezmzjxAI%~1A2 zzC7WAU$Eg#UNDVz4dvj<+VaIPqA$%A)ls;?os-@9*4V(!XLz&c_}WD}xC?w%pKIx5 z_pdfaMr@q3&Lh)J`0B;{=sYj|WwT42`G=1_TeYi;eupmZ;a?Uz8LZFlV;^trTQ9sP z1mBQ(TK9zO-s>!!-;r;ykBf9-7r6Cv{A}!$HaNqJd}dGcnAbg>N9Q}cP7FHjhYRVt zIM?o+<#(g$y%n1(2hxJQ)yAiQO7PfU?czRK9ql~=8;%F?)T{kbr#Fhj)P}iXb?5M=*yUr`=`FEqU626LABhrB3Tqd(e&jX{KAFcIu{{=4EL0d#%$;?a__HR<_x{?f4dLYwtR|&Jhlep|^*Wt}&cbx+LJ+UjYCAW6u-#{M zyRW(@JgluWQXy^NPO8XAi5Dc2Fc%l=_ss>`eH9cnD^`d}yek(7 zVV5V<{HyT^AEiAV94;+~M`~w!N@Fq78Qj!5(T>kizw9BD9i>Gn5%hHYU)PSMgNLX$ zz_ zDA`&E2lICyoeP^Du7;c#;?i>Io*7U1nSSgZh|%rdJlRIfth4PdHaH+ihyJ=+i43*|!k zNjlYcoSBZ}ItHU&C~1-?or9w|^=Gk9>4({Hg~N&G@Qyg2K_~#{)8U4z zdg#d9bj+Hm@varSE2Jx!3czr>!`9A_Z98!`gyl1>rO{}0_@>>vPp2LYH_tE3-+Z!v zYWK?g!p%#gmF1hJLk6+q?u3mmT1g*^_vv(PtULPA*+aYb+!71K+7kli@tqPTbt>?;fOS zxrYz+&Ws*f>aTPj3jTGzv)hjHwTE-5H*IH=7UyGJNzd7!y*O&^vG0D}rr)jo(PIbd z)}%SJN}wy7oSt27hevkt%!HgBd|!I>mt$rf)w$s>^G_KkLEI;$b9~)jR~rg zkyNYiy#!j#y42!@mJuN@x8iW+2yj9@MAiM0-BXy3zB{^DH>@H_kRLh0nEg zGWe!ms)fWyYS8G#_UvARXLoP24+ItJZNsI0KVM&&_db?T*>;5rTnJ0SHFO5kt?=E` ztyqef4f}m?nXZ=!9>1hd$UE=tjPj~d;g9*fz5H7lfZVx=9P zrf3Uu;4G!rjP2lCtUye^%4^c^=ABQ>_j{2l5g_;tn?S+G-cTjwQc&7e2N1d|9!Lfeo1@Y>aUK3iovN^fGmcq9cF@x&kK zuk;6l{^{_1TdtlCd!1iiORS*tNPA^9-p;jHEHC#@w$c#oY{3p6JJ>q8mM(1!`i&X= zU)LyAR@#Gy7y74rt%rlFP3PAM`yBX}k48havYK+xyx0Ex+7FYpXa{SN@5|!ebX4xz zV!Z1PgAdhtsyBI9XA@=%kAmi618Sirv`~$ag&C_xuPrW~NwalzPI@P;*WcA$UN$3? z1CzUhG+AR<=(W3p=iawpY55=z`N&oMM5hi159M{_T~-axHb=~B+-wlq$@ zGEPwuV@Cc}>+Zu3B+e9$Vdv0^-&ZD(xan8E<6gDaU)Nb4cH+e!Ec8#cW3f5x$D1BU zYsR{NctHC7htrL0C$^h1Si~EHelM8Nl~CBlk#7U@aOYZgIk^OTH$~c9ILYbk<74KE zbGe1ejqw;`4&h$7#g4!5;%+qTEc?Jq0~xtQTc{6gC?xJ|4^G@@d}`SSdAa**jCJ1Z z;_MF|K75eRGFA41EsR5<+Jzm&!eyg4uykkVWVrQBAeQp$>Gqk7p-W{yU*%yq!uEm{ zpcW4A4z-a8?BeA-G_n|TN{!Lw{%eINZ!(eYP^gC*YcAj> z&h$4c`7GKZYq&^1h?nsGxl((LM-XKCb!%rYMz%9C$9i#avlW`@z;dnDfkZML`6`w( zwO`#IpUiwlF=MB%CLg!bez;RySjtl6r|D2)As*>{FZ-*ocvq;n3@_5{x$A-4juWpz ztPl92jlk#0FvaQ$#5Eh*ohQhtj$*_Y` z%7k?hX8FEy)j16a%ZG7ue&kNKWA5#@7TXbzE#_w{)F%e9JYUWJJo2=wr|$FNYlr;c;|YbIjt^XW4*dE% z$8VtDvgzsg)8=2Xb{J(bvxq~Xi+F%LORmGUu(;Ss4^Rq6 z4~36HbQlENGTl0v41Q*Y%U11A2 zkm18H&-OX!oO~!A-^~LV+Wuy5Vq9IdEsW&6J%86GnRsZY$A=eQV;jkCVX)#p?I&Ut z-ak&2-nfIzKw=4yc}%!|3v2VamFkSK&Dc+(b+onA4t{Vs_pb|AWNny=&6qRK2%L|X z>a<>_a5mlPR^DzW2gk7|wH!xjHjA9#y&ZGl@kM@8_ztz(|1N(*{369TTMVz4$o$){h5*uX7x6dAG?R>@Ov`xh@%+q3@T3hY~XKPuc8&2(!Yz-~14!iC&qX$e#q|>r@64Yl@!B_ZR+}&;i zbGs9*D+hVKz>Y2rbi&y7|X}l@#4fjT) z7;-`HWNxJ`7e0pe#xriec=d6+9pxtEb`k%f^Zk4K3$epc@$=rilq~aTWjWOIPb_yM zS90_Ar|!=sh&{H`rD-cXSgXTnYw6V954P)*eV^^7QCUjOq8-O{F$2ZfcY4A5M}{|a zG9Z=UMVkfM99DawjuiO8dS52r7CW6#6Y4#j^X17rEmf{sT21hD=S03z;agp6?K~c% z)+5WqN2YUy!{A%W0uRNL4i{e@gG7O&9dL$lq_e!5i^-IqV->nLJRJ_U)>CrP79D0O zng^ZSzH)9;J$l<({Lsp|)Cq24+!^}(MnkE_$CLKsm~P#0B*f(9emvMJh+=(p#Wrem*_SXkujkfCwvMPs>Uyn^?}%vy?Nj`=rNl~&W` zlY0Bp_{r$-cxErpN$@QObp7|@M{^X+kzrCr!9#Yf0jvkE-y~(nbSk07%Y(Gjkh|6f zodU)}>9dj>hX*H(Y=;XvOgA?dL%BHfovh0ZAryp?GTfrkQm;E74z!b2`SE2#;=9wh zp7s?x<8?+3dAy5;HE^e!8ZUgFNMo)uIAuG{ZQW&huh{Cn+?;Chxw4Jr^SdjN?sR)= zovq&(%PuXMQT$)b*3Op_O5WW+QMzb!5^#zvHa^a=CX{xz93sJ5`=kZ0{wULp{&Hbu zHzsvsC__8T3%UPfYJ!TL7d!EdC9R#^#qi@Zv4=!Gio9w#-(T(2-eT=uJDl!9+bWPY z;hX`EW^cB8C!bN+YA?5{hfm6O)29pFcB=Xpj z)sIDJt%t?vTOQ!BY8Zq3JC5C#H@)r7!zD_E+hs*n{QBwSL9<&N)<&Y8<=}J6!Rb*Z zt2f0O-^q|OTE(2!V*PY~Z8_Sr7-|-Bp_?1lLSdPSXUa8+WTu~nlL$wfYkr{sT^r=e zV%UGaKYqFs;<_Klf;DfnN446p&<|HXTDq8d+m=y=;X=2p4L|KA8MOH0VL#VE=i9yb zqZ6I7->!N;yGcK6GgZ_=F&Q1daCXI{uVm^l6iz*4-A-}E_P~sC%iKbZC*9=Y2e}hN z$hPu;v{Ik1bnM}5Pv;94Z@2pQMemVqZZE{p*en)`$O*>Z?n^?$jVqYyrnyU1j+x=X z97IexI27-c0@aVbxwA2Mjn(W$4sJb zGe6+NFY$i=+_SykXe+|aUFjBtkh<2!el1~-)`XDvX;1p4V?9|)$K6ywNp4!q6wRhS zDa{(?!4Jp2+)8F+=nXfK;IzZ(jB;f&K0w+EnD!8lv0tsh(7Q(HiVK3R7dkK_}w?H~p zwRWbGJN5NSH3oI-v87=(PMk384~ChCEVXmtnTqL^{9rDwEyqmpmYb%vVwU@>FOTAT zGDhJZ4yB8sHpb-MOtq~jKOV6IKza_+&k5f^3Hjmk}<>l%{D(&YLG6?$)`%Qcq1$2933KZoSG;0fEsqpxL6K45gw9Gr&nXg zv$~gyQGs}O8Y`H-9Ltr~9q~}ivk#|Bv6I(@i{BeYyBHqokmV*7YK{))^Ux=E8mqO( z_rqqnQmNk_hKFZfO-}J%u~&aYq!9vW-_UBtrfbfKm3|}A^PQXtWQv7PH#(afZ^s^N zsie$3Ol*_ZD4Ro3c&wMwqa7=sl7+RkL{W0iysN1Yh)1x~da$>Hy-HLnlmQ|8C&ZKT zeZ0(hCYhz&chyGWj84b4ubsIqr5g+P(s?JD_wYEb#wPVsol?@2sO*i@Kjx7Cd^5$g zk(J^&>#fp0)4l z5Q7skSJ#I%2Jhca9ZfPGk5B7#2m>dFIS0k;?R(2}dXM$w&Q*%uC$PjlDfb_x8V@oxM$aTXt^4%fThM zvuPg@Gq(Ti^rl;j%k7gVyS3Nsu+go_t1jWmA9xq1GCW56t`&@&%6xsh{qOhl|Esyf zSlH5PD;`E3@e;OsWA3pWTy*XP8UkP}g7c7$udo{~LFgHg&a-t4m#}^-t%)gdPl?P^9i!@r~o5 z^6a%zcUkc^rFTh|Ds?=X+#4boyzJ1s-j^shaYrNX*wUI7V&%2cTs!7JZ@un}Id%rC z{dmbw#13$!M^JQO&ZtsIo=$8!&TLe!Rdh|saLJ%JtKZo>kUG-0F1I1ctxHa9zGIUG zmb_y}`3)t)589_EHh^UF6*jrcpNeqYH`e8cQa6$K%b8nd_S_sB+ipx3%|Y<2xYYSU z$i(6yQe|v9ckr`{K;^^j$ltRuiQmnAs-gui#&%sd2dz}3r`_*mJ2nr-(UGZbYd!+y zeyVhY>^dDYQP=7#X>e_)Q6KE;L+(H!k<~a_GY(F0;}vUsBX68alR3<%S7=SUOY?jZ zD$HxCYHMyk-lSe^r3fE-Gl4?}X)QdKp4#|?z3q5vlgN9r*3i_4(I4%lu*rzdbAI>t zQTYRGjV19A=a>6y3(@y=Y7J(-zr426%RLxu-+$V&bF((uuHzbRTC%YN6Y)Wc5Bf?$ zY!O>}x6h~(>+zO`7-Y_v-K|5ya`Bjp?nFmZmw0P*kKLg%=1OpJ(seB@0-g1@~I z`H^*z^q!_t!$_Uv^Xvxmok41g2-_T3r{7qTuda5Y+mCh7G=?|Lz#yf1qH}prMTWg0 zn`KrOS!-u`HTT}I&LgK|gMDhuXb&Iu8cBcF4N*OHrwvh~y6hPJzI?^J*JR2f3>y?4fE ztgD@;c zKCpVG+?4TqUrIH-Q>pZvFEf{fXDH$+^8l&0oeW88^jJ!D^hSx9?oWBRz4_)uBx%F7 z)DJ7-<=E>k)X#I-ln_vC*hv0Qjw{Y@a%4I+ z-(t7vr^U`S&M5c!k349Y8W{3ur|H6%Q~$@67*2BA_;R+|YbRE0)ScYAblRibFDIJy z5S&lM^6X6C^3hUzScqCWfjGj{`?}?}sLrYfn18)crv(^mWy!Yigdc6B)IQ`jJ*d5q zWp>^lPxy2wt`RI>gJ9syCK8uwj z_s_l5u_<Sm}eQmT#;ZS$z zJ?{pcl?Yv%d+_|=)M@P3-je$c_bRpTorTM39}IuIF4aI9?_@YDkBq06;&{}4Z>;s~ zm)F;N;!)S&6OqHSDEE*ba^IPw9)Z0#iiQ2$Ad~$=B!@mFhz1fwe0X>`hIB&SqZjWy0&1l9j7RrWHog8$;O(<<#iuJ$>}yFjt$$nvTOpQl-iU;@g?+JzQqp64bD`>C`y()3-J{ z^@OWF7__rzYmVHijAnJb#cZtd_h&cnd_G3|;#wwqSZ-L8RTZGOS$qg&|gP91r3XM$va zC&cMS?r7M{L?MHF>CIcb@w$$qsi*TS#mm`^xok05H}4cE*d_a(+7BX|`n>6MFx_6r zTlwQ~3c-`b``#Iy${R z18KaV&c99rRa5(LjAbYDpr}?hnK=ff+Qcx`m3#EU2XwNU*=tC4Xe#g?6!`1!CXXAR* zc@%4%)A{_O4!!a-9n{*T0<~KQO{BVCawVON1HIth zwl+5Zian9LQhS6A=TJ44V^@!+tKhENhhUtzJEV|%5A(qcrKZE?`c!idi zgTD(U)~P%lfOWv$^>C-NTC2+a<^IWpb?SJML3^c>@<2SU#kEn&8r>Bg!xAyj;wa4p zr=?S_ODAYyhn3n(I;&Ry55hd>d)C@HtlFb!v-mcQgAYi{-MsSE3k6rS-{Zq19vB~F zcDi{pVg!nXTb&ZgsuAJN@0yRZd8DCy&69iz^EQ=0rfTV-JEH)}s6@zbsmpb{dj7?39^m3*ThG{mN_W9n+;nYxcF0?$hS9qF zO*Ry1K6T6v#fGo#j#3j->XcIsIqxv;$0{_rUK_vc{9(QuOvxjyou^AB#;9fb=3Bf5 ze}fNDO4ZN=XLCR7TD7uoervH^Ww38~mfo`#f4v^4#v@!gQ|351(Mb*{&2-Yu{jvIM z!$bt8-3ZpAK<3J_L-_5AeH!<#^lkFXoXXv!4@{?flAcKKpP#NouKPJ5h{h^+G(QtZ zK6TAn#5ogNJI^E%y$+PgsJ_*;G)~T=O4x3HZBULRRzLGN+xTf5>pH9xdNc@6%AvlgZquyK$#dVMw#Hi+(r`ALRU{s)eec?%z2H&oDr@8Q@81=7){I?75SAw`_hpP> zqfp;ueTSXnsTj)D%jfWxM&lWyj6jKVJ$YkIJI;LVG&41?_0wc%t>t#?PgrnPom4iD z3`v6$LjfHhj5K|JZW;Gh$NNiro7xcVgcwJ7r^PZuT%9_nw6lj=MkfxVPS@h$Jl$65 zR5-sdKfPi3;5;(-YPWfl?C6dj9L9Q93{AQE-W_O*sP`V#F7rEM`PA-)0wR=4@dkw7 zo?P?R_@%q@3>2|@T<#Me@1cw=9SzQyq4lxPA>_sKxRx9ClhS|mL@HcE84&&}jM(<~ zq0GYSK=fdSI^9#*UxlmFX~%YDuVGr0N=ASG#ONyOrTp| zshF>12z{j^OVh1?ja|1q)-aCu2*F}87+E9l_s-c+aAPO_#e^(v8!v0P8=Hq|)MZ;L>qa>248i@MrFjuCQV1weXn0z+r(EiZcV-m7F)Ocjqme&ky?5UM5VD5iBMW& zOY&2}fTd9v#xr7lJfiDP$m}PRcegPZV&}qB=iOb_jWlW32%jv7ciBGrfUfWvtdGpK zcIF2wH|O27{xuysVTm%c>f_=D(s;o6`8XWU2TGNJH$FQ-dUBg{1jHTObMU_DGEqUJ zz_7mh`^JsuLT534H?^!ZI+EF-5o<`bp4!FPR*vVTz2Qq6(w@r5h52`ee?I1UO4+wR;$ z!5_Ab`bWI^o*FA^kF(x_1);G!o~wTT+?UzV{(23JwP!-yeaR=G;u-eQjdjj5TGSSU zwPN#&4s-u9Z(WZqIW{~_=iVGIL+qNA87v3=WrN4#Q~TQyzsqiJo*U)nn zqDdX9(pg{sc;@%;2cEe-Ot%`h;34~dOoJ~!k*?(M=HuS1+B}erzJ1Xzz-%m8`AWn#9`5iTqZD$U}y8$p4u*tTs(sQbLt= z&C0o<4!kcGB5ZTr_PRD8I&N;-27|}rHe*#cnS2X4CMc+%5R9M&}&-{S6lL>Xg!)yq#@RsYPzD)QJ%of#=|bg$!Fc(b$ju7i8H9@D%B{>vuRI` zt~BDmw(3*aFNbF^5yjHjA&ouVQL5k6x?^cbm@cC$SHjf_oA-x(kM{~sO+GqoA@8v{ z#cUiEVLyD0!R5`&n|<}?tw8bqW~siSP4}T1cJJ(i`GQrFS6&EX!{TiMrqY`4CM}(M zXSsXQJ5Z%=tAlp*m_EcL)&tk&@6>rP_)DuW&-=J#8$Pn|`!oOl`Pw^a!w3*pj>Ujf zyyqwoFN;sMk^=jQ7$27NOnmW?sq>^Q5QGy-ik;&6Er(R9g zdRc6aXXtp3+skp~pbn&Q;(yMYEK_yZyo=VUUAS6vsCw>yA>Eb3Q8#@~TX>p?(-Y@AG z85QgUOHdM zRCYFcHcVgK3n*i1CSR2_3CoRg5#lwtQLoWXukVgujo1bkvRFJKZ|8h4T8d`iE_JWm z|2jolGbU*$$;29T>SU7UP>bhNdPQ)}CtUMyub`}SV64P!E%&rZ?fp7GMTmN7o&lfV z*GCVYN^Qk8?8Zv+ATjH)F#twry@|y;8hQxyxiwQ;mXGU*AIlucb;xG8N@to?!A-sJ zpVr07>hN|Lzp#*$t1{ig4|C-rR1na_M>>S5B(54ZK|x3f(L zox)mtcJeG0+4P4@G8m3*?yg}PbrFk>)MTC`VcguX^fg~9-A%tazKk`WWE^~FgHTEa z^eJF_sVhjH`*1O~pe#w>nE7^^U8`B&J*3S)@2-swjd$1h1jy5Q(%ME>HSeV)FIe?i zF*68D;D0T`;5Zl4!R|oGf9x%%*(%mwEbrvUGQX41#)o<>Blg8?$G3^5*4+tlTjo?g z9XrR@FPGs7$7hcn$+N%4ecFxa_a9C`zf-|{*E7L;X8WsW^g2i4nV@Lxac4jv4W5`k z)0(^gn9S~`1Na+X4_~{nVR`KLw&Ppp(y;z=L}{xrHu-zRL;7M0^pbH<8Km1ZTc6&_xw<(2#GTu&=LBc51p$(l~( zR6DjZd8eH?_kKH%po!r)JY9=U5F^ZK;!cE@Tg*-A_FGm0lj9 z=(G9ZM)sbCIG;dgS9z84f_15%)&kM0zU7_8YQn6UHqDu|tBwUpy+-mu$A>vj_7yi^ zJiA>6^@P*i>_pq%yDzbofDTW#wMF?qju|((GtmF|E0A=r18|g_6Se zZ#X2D8fofDeHr*)K4zAsdUNmDvz~VitJSc*XgRM~FK0o&p{bCmubQ;q9-1ppTbYWv zJWb&&&7+7n`HJRyvnP}}|2e--FH|Vqb9EnyJt~*Wt1Z)P(Rt>z0ycAqDJ5#~{PCTn z%}_hBf>8!!r=GcWz_w3o9D_t0#~IEq4hA0OS&qZCy7$iAUw5SR=k4UVW6HZe^t#D> zz1tql)u`0hr(WxM?@-`xttwZz0xq{P%bmrM1Jd$79q&SB7d2mt`8=nxP1lh|r0TT% zxhb*Zb};w#3UQ#kI3nN1JWWM-7`oZYlwPjs&c#Px!lCCm@8;kgOY>8iL77+HdJ{<^>cRQg zqGMu1OJ9^Sp0jpvY7~*-EG(z@iaS5um}}Z+CW>~X`q)&fn64embA=-I7R;SuZ0e{y zT}H|_X=6L<*oQMWWomK8M|CX5uJq+fm)VPotwHzJ&$UwN^()=ko0HQ`l+IAnNQ3Y=8d zjE$e*s(&f2`qVXz(jlDEmra-Ud-7Su@aT1}2?dDb@}-GQhP}=sqtv2g+x+{Dt1-JY zNL8d*YW3zrl_P9n!Czas+%Z<)D3Eq$q90o|qvJ_qYGgu=T^UBS(=_5Mo!x86GKF~S z-_y}OQU@U_-7rJXi+fT4>RZA-tt^zGci*tT|C zddX3K*?I<*6NUt@##y@4M7wSQ9L7C(_|V*3tVgBU`kHO5f6fkcaV>17?dYLAJbi1c zU0IR0K>M^O?tb!+Qa`d;uM4`ViEnJEKaIKH#sWpgnji1n88g2|%%`p?cJ625@Eflf z`qU12!u)VTsRv7Zquz4q6Cb&g&XT%d^QP2Wo}5-%6JJY{-bp0mdaS>u|Hk@8^q0k` zry;bywfeHN*xA{RdcS+>v6~aFW9sj;Zu+?9TXFyLT>MF$IQf`-eY*4n?q#67Y_H>S z)3er#fH*u=F~7G5XS@E)PNia4rc={Q;lS|Tu{YuRbEZR4OGkpHYc6eV_Vx(n8ZzO>$mVEEPt&MhFHiQM zD;6HYBNpu6&QskudyU+a@3IcnsYNK3E&bAzlyk(X99-gX0N>$wjQ!C`?}HZ}KCv;Yfn>7-jodai&&fPy9{(pb|&Cv&}$4B4s-;W=(ZbfUWV@%!Sb9&a( zBT*jBWc%&Bp#MbpRMOJ;2`}Fwl(v$R#GZh1d%sm^5&Dxl3FPyTm>Cv)y$D1!S zYg%{ajeLU*p%|r?Qw?+~on{kq8tN)NO47r2t_yoIwl(CYp}jdgma{Z?HOwzA-kD$f zY9n|3MOt~7Lfd(!mND;Mi%km)3kfjz>o0wFk#yt2Wl=l*lq1t1us^6by%8eyoZYqt3m?yj}18b-AR8%!o+jr~8+tk3?cprUv zb9T(U-QmN@w`p5_dMRG)VpLG99ns6n6tKB})w(g3=lsHZy>%_OyNovjmC+W3*;~tw z%|x7^xAF>wl{69cunt8IMNn&I|1G!d38ntgxd*0ehIB?g_4DQ7Zr8U~gu*I*^VktB z&eL=2uh_{WpHJ68f(1Sh2gmF{$A%$`r^(M6qnPWuh~#lI@vn1Hi#JL zSgc!xl4&j+O&YluewAhizH_+~ZsOpkRJ7#xC@ec4{z>l<|EyoY>DIc&`xJ%afmlC* zW=q;1@k!fe#n7~Kp^{$rwbYMIkq>vyl*XL}8xC1qWh>UBN25A}XKW=tlRS6s@(|8A zMXosB$Tkrt)gA8Ymsfmu~>lw+xLl-sO4(%lisJ8Yt~ z`0nUo9l)@V`_bkOvvFNsWz(a_T}FdyV-$SOO^>I4q_l=@T6K`4s#OT9I@l&Nrg_-9 z*-bYm(f0dj^RcG|!5rK@fGY*Fi9+m>EcUSU$42|qogqyFg3YR${9xT~8Ri@n3;AVM8$ z1Msnphh=Qzd~?F|VI9{v0qHz77aJc-D`FZAl>6Dm0XJ!8`F1j^$%N+#6b56hlB?}A zamvPSf5GOjPH+E8=a{QHg%Ko6U)EZkv1~clG!|3yj1LwW-$s7XSU9tGnzc8+(s$j# zA5Ig0H9FC_^`$a=wsgwHKG;3oyOk zVeVh)HTcq*^kn!rA;@%)`D}MrcJ6c7HqRxWW3n+accV=>>J_)IyUWLs*%SfY#!w%d zNZ{_9ZLXzsz;BIJ^ZDF(6gTO`nQijmgPjxcMZxhZ9tkDTY3vM75Xrr|_O-p?Fn*fvMdFHMq>9XXxS*(k(Z9_YxB`Pv1Q&P9*)0QEfBL{upUrQ!gFPz4Z-;G1-u^X>Na0fOwbAP3i8UjbgOLB2+ldIRmZUs? zdwkb{Z+DoUfEWPm{&@NScYKymd9!Bhp`BkYotQ*(X5xzdYUta&Ztp(leSBc+IMFm< zsJ#0(*+=W4HOjLP<<=H^&U{+S+}j~_PBH^#&-bc#&Pit(_tG7B2=D>(rBkZ(dP;9a zu%2M`fsA=lI$sugU%#6=!mX|Ld$}t?oL(Yl@_?xsN#HhrK^Xmehh ziS4QRZa+si@(uP*Qyo-Ws|MrUm+$Ql+Pxd&1pYqRdTes=j{rwI0_@+tXZOr4Gc#e$>Da=PhAb|$-Ed#~ zc6*mZT(R%wnVa``zjTMvDL_Q_b!I(U?b-+k_e1A(D@y%1;ncDFGQ5~~_nl)yT%zBK zHOa(l^ZZu!;*3~POPvzd^{K6MxoI2mdG$y9o5{@iP}IfNYzFLi&z7AmuD$oYaqz@w z-e&gf#20U5q7XlLYY4Bq9t^elWizJ_cH+Ys?*ChZZHc#cF88*|EmJ9st$*=$Hhrb1 z$q6sWf<4b>Jq}DMFWYcKYVSS|C6K&#B-w~znTjt>a8)LP4W=M`m?mg`T0xyhGv%ck6cu3;A{Jev+c45lh%TBj;W}JPKjS*eEgIa{RIPygToy;f~iC#ut};vfQz;KG`Qu7;s~+4~xAkV)v|+OG*RP zmwNxNob|VHtuCDzrfa^`>8@H|!e@N<_hozU4FS39+-WOU?DgrHlO)d(JDqD+bDM|0 z6XTckgns6ZclJJ;MEQaIj;e0ExBG$kuE03cY>tRN0R+swmZG{bkHW%-yZ))F$ zjlcE1L}lsjZq5kF`nfyz9`xo63chULkfVQpsLlZJ&k!YCx60k;Yzn zHb^6FESlA}M%*9Eq*V*5`3>S$?IJbTUb%5tXEPakN5v2q>WA6KXqDXKns*t?11IvF zJQ+6@nw{T>>yOGit@cp3YldkHoqih1Ryq(S#8@Y1)5*I_QKF-c3uwJH^^fdDteonA zsfH8cUVfLJy&P+7C|mIx&s@&@>cdj-XA9Dp>qiNuzZB3ZsNdg zmzVp}$EEl(tD_84Zzq}lH}z@_&sCyBx#NxX@s>B0{o1;TOXIIkcKT^PVT~gxcE)$d z`NV4ZIcwh7?#cB2x1Ke9`gW}QWSllC)bDn!MzR*)f)rzL&vz3an}dV-yN}M)2)QuZ`?QXk{vA>!WVx^Jt^o4^K-5V41}v*OVKpEZp0kQ(fVa;BG6tiWT!Z zTExDdi_l(~&SyGz-D~G9TU&-7^y&Q8ul!8cS?tmtW4G-7!*!5weJi7#$HV@zk64zh zrMH>Kt}~rP&!k6=_5t;?jUhW#Cj7XkBX~ShPGIcp{nFiXEW!inZZ#cftFI zWWJR?iP+Y=mfEY9lcgD~d2#X=HtM(^`wy2(xfcSu|Bl+|_`)t@?y zXHe6e^EckE*&_#c&xT7Bi=y#8IE!+BB9X zXj|x}84B!@rFX0@dJVeHh2^bc)n5q?LDm9rs6wW3daI3ZRVEB3L z{dn_D(y2EQb#Gqm_cT`J(FUn-9qTDEntXRkZ#YLb-T4qr!Yw;tUD49BX+0JTmut)$ z5HFE-P0Tf{_=1+aHuEaX|IQ|rcVTX<;Q-087cl!C^YPs*o_mR%_{?e$GE zW;FHV?w0|QhukORx43JAWJC=^dlBO>wt`wEG`qpI(P|oj)0!WiIg3;EiUXxA9Iu4Z-YcBX{SjtAaCb66=?*O{r1ugl zR2#Gxx>n~fGjifg>Wenr9H)?(sn>B*bjjm}@+)Y)D|XN4PR?v2bx{uaBafgJfAMqA zt)r?<5&mx2IKraLG|@Qp6YHLiWPnm^c3RPZDU11y8L7=NpKJQ~1}`6P$nh~|(?NRS z?fI4Zi?w@R8AqL=Q*4(=eUHjq&Ic6}e_TMVFE!I;`q z{nxG;MjJJb6Ir&KlTe+*fJl}20Ly^PNbb9^S zLMIn(7P8`w{B?A07Gw0c(zZ5X>^WE;XMdZCb%YHU!YJ;sI3CQtSc2rl;~bBdS`e0mivDgjkd*^y*1}~@GrE*_sSdpwzeyKF z+ugk}2c*s(X;zuq)uYj)C*Lc3$Gpr_>=rq!jk7-bM!&~iL6s*Oa57m&!xv0w)+-fu zDd3g1K@SRx-SOSpz0n5QupG{CCC!YLUgDa&WO+?teVr?!p+TOY^~}hp-8>noK`*|A zJN2W8k^0MdsM$RameGef>%|BB=mSkiS>{aXr*U}xl7-Uy$lnTgVs zFZBpPwwvC`^JR7gpNVaLu<=5Km=O;*%~tM|+im3D1dilw%>M3FKcIAQWuAzozO$)F zf9`+B(L?J;jmmqP#;brf2S=_(G@dPrhBxzQ+&{8IC4=QwOcxP!}?LnYE1C)9{F zw^-<=`pW7k_HTFdV|{sZYfht6Z*%;7c|FW9HhV|VXuJNI*>;(#JC7)Uf8%^`G~FaT#mh|_F=#Kor5+F zewh_){W$IAPHc)!Bb>^FiScw!_IG7ekoyJ8O&{6t?MDAunb9Ekw^NiGC?zQ?+I=p$W#@d}QpV?|-&VsawdV;w-Vj=dnFhr92zIN-mBxzPT~}&Gp3^dL*V!!UG$-Db&kp0KR?cBgqpNAWA9!eQQSL7^Dp3U{ zl;I$;*1eYRL|fi&+A441h%W{9T(98g1-J*3Y|t`ACoEZG1M5{L3zn|GCnfU>Tzf@lP|ux>W09jLq)2u7FXM_3Te(a!6Y45Z6 zK42eD=@S;zYt@cqrk5thw3Zp27%FDK#%PICsoP1o@Onvy{l(GgI_2b_sh+1{8l-t5 z54>vbTyACb`Z`UCW$DJD<*GxhQJ(h!{!=SNZ1|UqiH^^jw}j-EO{{fC_OkfS!upO# z&w-Qq#@X6pJUZR?%%qLSJ`Y}cS85sj7JI+j0G?F&Ux<~fL3jw-u?>8AxmR0?R!V#F zbm|vn-J+Jyq_>83eTw4xw#EKRf4OUK_lw3b4XJe`Zszrl-FN6^TF1%1%c#H2NRsEY ziPI*=3|vu!y$!ih?2W%ndfJaOm%GdDdH-s>;num?Ul4r8-!O8*FYynLx(liCGYx8M zv^JMgyltcRQicC?$0u^vo0$8=q;4^JcGSduGWpIUXsoX1ci3vfG5fu{e`1(gEp6za z>=88<9XklmY`S^RM-~!GJnI9i*Pj$(7{uJACW`n=38%SxyEpl#kYzD0YyTAD$ZH ztKU@c<$AViXe|wlO-8tMjk9A5x3O(+u$}i7keQkAvpC2w?5p&1uU#a=xeogAYFVSq z>2)2jV*LR22RU)LV(4LgGgrNnv+UTkCP*Q29 zn72nJ*`xIX+`LX`2ll<=?R3%CM;DN*$Q`@YHgvJmNuk3gFIel<32gIQ+O68`Z_@QK zyuHrIz|HFN+R2ltmSA7)<^H~QG{1Z}J^x;s)<%sq&r3Sj_|iac&l~Dx85W=G&64?L zX6Z!2(wuhx~WNT6pL4xNGKOe%bjYO`ndy68e3fEgG;w?7;j-3MN~Q~*=hXU zQf|qO3=dB>-*x(78<|~avy1Zy_Y>bumoT!QRiM1@VQwFZqb+@^^I&N0)jO$E zV>q4@{YQ$oix%PJb2k{i=50<@YOi5!T6k~2@3`z2>imCS$^)M+!;UjA4VzC`vpbYF zs&WLQ`YO}8xuxhQ<>XR)iCdXH6Gy-u?+zaxzNz&<$Q8#!5K0}=(~6^!;IwU6TKdQb zaoVOI%qxqW8coBPaiWh$6j3GY1GIyG#xq4gSX^3t{>sp`ZFR^fGQ z?rO)j|5Afm@@Yx4tB4e?%*mK*M?N2c?e(vW4}o9b@h&}hHc9P!W0#CUBCzQJO$AAQ zCtHmJsV7COCHbV=t6d+F)-SomoqIcvNFUXAG^Cnp$r)kO-QqRA;~Ze5-jHAd;wI+T zPNe3ww!e`zj^foO=Q8Q$c=Kb9GkIq6vB{f%K^qxkBi&M{C8R2DIilzERa~iakV(U$ z4U_RsEYT`8UhLbC+_z`56_p7VtuKW~M(K)@yH>8)t7x}<^=z_{-k#GO7MD7j7?+4m zk!h4=C%rVLb+px9iM^RqNsuNDj~z7nxe{e#LZr<)a_Nx`e+(C6Ilb#Az4N2fORaA{ zhkWU}nJ9BNG2LG35*#P(3q^lF)t#C>kjkq$d=U1?H=Fx4#d3dCY{ys*7`D3$b%qQd zI+^lIo=`L&XF85ui@83w*4@44ab{~Bx464so_F_ft-`f?WllirX;)sTl5S?~LTWcN z-Pbz1wGYz#$HzPR2823ko=u~djet&_XU;9X`K93O+!9HX&lM}Iy+h(oSJ*+G-eRDWB%@YtR|H1 zURN3y;~X`s_6FJ1LYweM9r_Xh>Yh8Cp_Z#PcH>Xy8RQ3RJ(;MjyL_fWV7>jOG>4Sz zl%88_@klk^)TEXlxKmchwxwvXc`-PG)O$}8Mc7n{`Z9cm-~n>gRi^78b$860BasWZgHqA@-K z@od5_ZO)iPUE*k%)L&<%y?XPYT(dZYqIJlh_?wTfgr|PFJvbR(SlH-Zm8Zr@V_TBp z&u>i4WAfri-H{Afu(SSbtct{Ux+XwrW1k~eJ94m<#z&O>rnl$i*HSL#=Rd<3n?T8C zvh$Eu-jdiJ*4bZ9oY5C*noI8Gp7g_FLnqFI*sV9?M0%~McL1obn@QZEv?Z50?DXTU zj>!An+GSnIyTSGx-0!{9C+jjco?fw5-_(|ek>wa33#yn8YxIwAL`otJ*7HI)^-{1a zmnOq)ms)HdsFyP5nsrUd<4ZG#@|s<4g|Gu2YZu7JeaG&ZJvv?}ksX<-$s0aS$H_lZ zg`jr)s{@?8;<__;)6an;YP$17+ z!Q49|v(5FI(>|1jq|!Y+M&mpKyH9QCFYsU%_|lndJYuNu;W-jJy=O>z#d3K$V{jL#Sv1|(#;b~(FJ|ai zr*)n4qdG`wEsHQD_bDn&j;(qiQPY!$AtOCZB%rJdFtCVVPb1%7jo{OW@Cz~4^k9S=Rw*F*Et{`DJN=xHAVltzu0&e0owd(@=l zW24Bt4@{o2&_{jQM&EU`7oNC*b^goE66wjC@8_qsOrdPgaPkSmJS*`q7|GlvvvuFW zxx@E*Q<2VI>42nLYHbg3!`x^Rx5=#S z$@7;AdC0M^Jx9v)6%Tp++D9c%8kWbEj=ikhCk_i`RX@EpypwyHG{17}$aF3vd_uca zx$P`?0oK-8H&a>D92r`3pohV9T=CsYaq=g7!B-0IK98GEtzyvCcC@zft9hh3TJKJ& z0+hau+9KG|mYGGC(oY^FFLwKUVx3|J<+^DAt>TpBMl`q9u2M?NYs z*D`8vvC^GqAr9Y3PhhMA<(B!}WwAe4&94C~&3lz|O`U8`no-_tRt&XF1rW2ejW%uc zc&i=L>L|NX_*?s_pI)Ow%!zoj*5Vs3;~Z-tXZskJr8FoYhRF0<*F0hT{OZ!exUnBv z8?D!B%mbJ1U*9H|v#l>MN|7*6ZRv(S-AQ*Sxwm_y)a9;QuE{Nz<(3x@Y+ZNbP{443 zPITK}s$2Td*#7E}r_xE!US%_>AJWL)TG);+;ab<)CCxkE{ahH2#AYweHMs8L@r`K5Qk9u6R@H{?&*J;u-jhI_`-mu(l6-Z-qL2+AsO6FC~6@ zF|p1QC*YgHdg=e(j?>wvwnsll&lq{?5i{szzLCcVZo>3(A?zR;_dY=J`B}!=%HsNhb}~VaLmf; z1isY#97kY!J2)y!wzg;-!kEp((7JxF=?NAC&Dyk zN}S~*w{)fsNxcewV_D!66?@zG#Ae5+Ne%BlaJL4qG1`To%3j7c*8RO z&)OrJpkh_}8w#gbn(zwQblDCaJ=R2KxoM$&rqQQze2jt>but#_!a8`pI+t7tDjYd{ z@OXGedZVS~Gh-+9+O3qM_T8^;H)ix}lx`7br8jGY%r>f-uaui!&6${k%7smHKu$NO zYUrmqTD&vgB%1h#XMN(`azAvOQylgBz|jQj)3MLVDE#A%_rf2JOf@!MARgbbG9!05w!1s&tqHLY#-Jab z;bWn^Nwbq!nf#{K!8AL1+??&;FItIF8p~Ff`>~FaUUv{T>s-`_&8Mqe?ApkuJ@#&? zjpm9v#5I+%-iSJieXROY*@Hfe98hkfkUuxs(@V4X8(XDFAvPVoAPFJ{hz>sot*#lE-St8)kZw4HapZq|o!xK_OC`Ci6& zdgr*5PxnghADez`(AKzWF|{_)rOs6{6#fUE{WDIZh3mT*Q)fWmxgFKfO^<3_!J3Mq z$(hzRIJ>SLWV+Vcqgl-}{e=>yHu?49Ohs$CkE=```$M(YqzqLWd-0SZ0-F$Ie2$PZ z-$gQW-IKjE(NGHRejP{AeB1G^G^Rg2**#T0AIF5FEuW?g)sO*~Cpt^rp3JdX+C*|k z-V}I!s;y%3JP2-xD5W!1^l+1hU>sgJ**P5>)Z?_6os;3ASR3T=C2=Ol{3@71Z2x(8 zKaBud^BjC0o#DEN>huKmme1JG7U!t3nIQZ9lgsvw@$?kthN{$?EzPZbW?j{<+_7@$ zC9m9A9uOZ?7blfDnI|J#>@LT7yGNmdZ(o0R`FhUE*3jLHE%Wk{n>r#fwgfJvawCsX zZr4GY{>n2yqVnWqCu4g&{$R7-;DfDa8{MW}-#W6k63T+(dFub*+7`z8G9O;)3{J*Z zl@-VJ*5eZ!Z*qsq=}gpz4fN+lOU|M;tUFE#Xx}9A4YK+7lmRfU~ z5i8D?mHX=2b{DsHq%uEKJ;IE-(@~}ZBiipefMyg7LHgR#XvJqZ+G{U~^oZ0PKAb3f zC|h#N=Ge=j-@MSwz8lvay!%C-EF|%HKifw_d5}ugabM>z-LZbsvdt6A{XF+~nsY67 z{>ZZjS-Y@7hcw-8wY4$_dj6i@#X1#SjBl|$$11fp+Q|F(w8#Ba=?k=!XUS{Y)#drx zW2x;=cAnv=*LZ1@RYLr=aEtmLl-QJ8L2P_->VO;BrPm_gs1~^x(QyCPRx(1}U0+q@ z4_pF-UIkCJ7VF9t=MuIvOt>{RE$3NMk69~}?>$`6`{E>!v6t(fGQ#$p&8e>)EB%@; zHa8IMotK&u(c}it6T|qLljbZhdB(lWYP|jyHoP3Z_g*grU$#+X@Q%18=H`YE4f3{O zJKnt6>>A~j)nkMC#)gZ}`nd00H_G#iX-&m+1 zvzV~I_xH^exmf4)t6Qr}ld4L?Fe6 zmHto5D=}iP9qDAy?dLHpvA2ll$>vl01C48XBEI{&yotI5{WLgZsed}Y>&Fa%4Tou; zYIm38HJ@${vPf1T&54nRfadqDNiUIA%b?}WNBQpCQN3ce5w>h%sOFJBI95!=a@faE z#F71Fn(CF+_zJc(dq6R(1uKWxQC}l9e`dbGxvz_tGGrN>4c<#s8M7**1igb<+UJrF zqgflX_Gc#IF>|Y{4q&Wg&Rs#2yZF3-&Wh@6b}M~v2#}sMr3dR$*Gt0I>^e6vaXR{! zuZ)+d@j^(EIwMoz7sYaXMZy6n_uXz znuWJlJf@nP)C1xSLqn~+q$4VYXPvRecYbg@;-!3YuKJU`b#Q(;_>-`aM2PE1i(G1? zehr14r~b`(U{CC!8mfPt)U!8rvFgRTz{k%1nPKbB)Gw{J6nNIN7xKFMcu-zrw9#+Q zi_Ran*WGF5IOI8-JhR2zESWWj*1d(Xo&(;a$bo=Nyj=U-j63V*6cjcV zx}OGy<#NsD0BZCFj4|CGg4owL_uY?GEZg^g-)QcTh6NtmWF0cKdweF3GHb5CJI`KS zP; z#ybw}D8W9r*iN5GX01*y-sVdf{OC;V2U~=eV+GqdaUWt=THrg z^itSMC;!fx&&s8%{ZUE8@pVNzk6+PCN+iU)*b7- zk)FQcSSfeo`eN=mbuiz3Y(km4#U0rY3n|^}WU0*^dpt_A@5 z>U;UqORpB+s2gC4i;1B5cTYvkU>yy-5zvQ=rZ8FFNaFOa)VWqVal%v!s*Rzyb(qkJ zK@KT-g#U_oj0a43A68gu>3OzTwJ zt5B<37&KYONTdy9P-x?fhw(K4-sqg(6y?$1=FzUtVDvSm&U3o98~RIV@)Skk_774Q zQ}4fPePE?qY0Jmx#y6>YiM`P2##kRGR!r@qXN*hx_#`XhpNVSd{pDN~2c+(H8`SQb z?~kxjJ5=!-^CZ7jE>XDnyJGRV)?MgGrF|GPVjPOraCYk(R9hK+H z@e|BeFkXX+wcdnnee{mc-!akV-|=PSutx2E_dD*pr)9tJ9*4(M zzi=n4!$v>Jn59p3q+f;hsc3XV%N50mFWW3Nj)%|L?0wGbIW3*7n*KP|n1@zfC|T}1 zQn$wBKWu<@8ZlzWklz$qUKmiRSQ@@~j$@Hurz_I(4)*qf!3Zh5sx|J$&+Wv`evgiY z5;Km1JQ4Ev!;8^XHz#!|odr{6?PxC@#mQdRpBbMbG}-Xlj+9@QH|U;N^FxY2aiyy> z^X`6Iov*uEVw=5JX5bsMukUS6dnKK6Yb~$L@K(KNd8<#2CAA62g2?>DDW_{}^yVIW zcVTON6?pus7qxu*#?meji=Q~lpv@7tzR}<2MU&11gGOh9j&~-AuPATDfi$K0u2v3Y zH@S0X87W()aagXU;Q!Cwm%zzURR8Zx4#FMoOJqbe0XNs?7L{x^fdq1_yMZ96p?9Wt zcgXC_Fvo5d527NX;`s;f6YmR=OD-WGpm-u)+=Tl^yitFW|EsF^s;hdsXS%0*b{DLC zXlmYecXb`_y?WnQuc|1jpk3KiQ`hS3L_!_j7U7l09k3D*NgN_of~k_ZjZBbFL2&#@KK ztMmO##jPbjEtcORL?tOGly!QoV_cAXl1?Z)GGWiX?@m>8O7YCNMi_N4bkLMF{+wdabDo50dy7;<4}3aQlF5A;`i#6s&Iz7qV=l z2&r#q;-%3Ruhh(Hbi3mMA}5UiaLUqt#jk#bSEb4RxD! zo0y`^Yvvdw53`_MwoXJ0ViF(;8&O%N=fouO;kH&X07OYa*cjZ8S1eYX9od=u2;M8( zB9h+IbYcIdx3wjIgmhwFOg}o}&d~g5MXN3x!(ue|t=P-cx?+SXVURM9OHn8OkC#}p zyu_+A(Ug_>@xS>al*(Nc6Jy8D^Bn=I6RJFQ9-iO&>ePNBcHJUBvAE_(M70wjpX9t+ zPMRN}@*QCwu2YUWJQ1XKo9pidHLutHWxi~n<~m`C`!AE`&s!SwXZ-xv`X9*-+0CJp z)3|8X*z<{tHEZ5V&R@_>fs!7)6skm_ly$8f)zdGv6^htaVH!WVu(@%hIsLSt=HXh! z>6DD_B|Cy>-XJYgqlKb!b?Z1kE|DZHl$^J)rWItfN~WY|_R9JkG2qd2&5bpoTCV1! zljbd`?MulowK^g>Z(JN&wIh9PF~XptxRge_8DN zda|RAx~ubzI?vR$kpH+_SLuafeE(58wsDI7(k4^CnT=YAwIINcMKym}=>H=~hPAd# z>=N6$AF+S5wnHOov|3?k&iV@Vt=O9-REBlrzd3zY`$E104{e7GDT=`4uyw;pX5AsaSkd<6q%MGFCID%-`Fs%;_T1SP48prCqRa@6O zlN|J8(!#l<0+LJX3}tncaP2ce*r0W@9HBz^1P0@wZlZ+yNY2jhMG0Gs5xIky%A<%kQuwUs}{)lom}eFyJdkl3O9Gu zv_x`oQ{JWIyyhmH{pUQA9ZmWAy!fTLA2CgOz&O#I?rYhs$E5il!aZ+X=RLeYhnEQx z$|4N#a8eqZjwmEM{51|(r=jMW>nNH~^Po*C(MHoB$*x}dwfuzIU*Yf8e`ERP+ULUm zTDzg{H$s;*=-nv4qLkG6<<#8kSNQryX_uho3t#i_trkA#@HLO}%d1_Qke*n$J!res z=e3}3M3Il6Z56cD;*r`YEflxjXx%rwY8el2#G@_Z{#BpD>T_cK(#Jh6gx6u=~5@Qs34Y1mTCpDEc|VFdNfzarbXLfNg9|obV-xQp+ekQ{P04!n;w%)hMzW zHxLUdM?w1|?p)%rzUo8E2z>854;N`T8Cz2~ywZ>7xuA?0w=#-Sqwswc)HfGJB*$V% z2(RFyv|rq?FP^{EuWxui%~(iY_(3F!28sJuls1icKZ29PZ)R|E zS8u?+oxJ=6@88}z1Z;EPT!Z}X>XrFSUAsZK6SPIu9K8S9_=%~k{!LJ>ugEskelI`4 zqixl{s=ueQ9P9Qbw36OtzEq<&N_zG}9PJsX+@5{y$0uH;*83ugRH|PJ-uuZwPkHyh zFDKOH|H6A+M(&+dT;t@eytUJ zbM@y6wJ*G%(MnOT4;o2->wfw1lwTY8Js+q(9y%+W#tf!+{Ux@BSH1OX6S}^EtT z_0G9&y(c%&V!@oC;eQ2~k@ohKG&a}AVqUs&WBd6p8b9mn0jS4djZ4-@V4ECNgAKNU z&6S2;)nNI0Gk6fu)_iAmyaVx>3{lOpfcZ9U6#5Srb-X=I&0}ae_{?NA%B=|y?N@_F zLu6y0U1;;Oj$gki&Z*l&O$A7$!GyRO3m%<(j3 zl&P)bhR_ZC{$9OU|7&eB)o0(Q^rU*7$d?)x(W9z$@45>Sss^!?IAB9IQS&Gb6k`>F-;L|HCKUce#8-S@ zPxhoj6xPjw(;%bN@z$^vRVssXOcdS<*lU<)XbgwI{V| z!`dL!7-;Q=pP15>>Ke+ppN4WOJY6SSy+Xd3wW2{<{X3v&={1O`eEl;E^1F$K4$C^h zKjHJiz~yN6Oa4t5tZ}0Z>YfjH3x)hKG3S%V^+wa&>DYaY;QoM~f5eCoyo!X6A;rAuv!PQKvtGCy2 z3bf+hxHQn%ORL}ST9w`cTQ#~Wox0pA52m{6Wdo4)ja92uDKyF|T>X5VGULlQvGmJs zQZDKt!f{a*)39JMxd=jd)WTN9opn8gAFr^4$~K%&wmA*fM5{K}Mmq}`ZmqjGv=)fP z+KgT7d}r*NC|q=w3=jRMlO}L=xqnW<-tc?MvpP+H{yN^W=B#;N9TvW=cgIR=`FZ}a z;ajx^#IE=l`*Q%PX~vTwtL|B(h7IHSRy3zn!|X#=ESB%oZ=I0txIj!FfX|y462cTY z=$-JM!X{K>faVC;NA)>AN>j!=GLH>Rh=01Fo`wpfc$cs&WzY0~M9*(+A!Fx)d^uDx!qQsi zfg2-u`9c-G{==>Ya~0NoyM_+gFwM1v2N%?7t42kx$0DJa%cEG0N*d2A%~w8ZVFJi! zGyLsOxELlB8A?h5bEfOT=3Bs((atOEVy-aS3}d!Ji^QjY8nkqMG8m6W;gYb$4_2Z8 zZ-rpqdVJHMc>|O!M%HhxapGWs$e)RqOTyCirN42D)a%30&D)^vO{$wH%^xG#w5=A( z&Wb~MH!(iPnsa@g3|_-}joP$uheZa>k7uzco90cr781>uV`7HvjO&d^7%{NCGzXw! zRG&3UAr8wlRxlo~j5LtzcmVDMBU;;{FEzrnmLXo$L`>$$*r~qo5Vz%nQY_ExWRn@D_w{G-A zgJ6;{!4;tzG6d^{oY#vTvb2zh+xTdWU!X4L4II7|Q=nH1dt=Pe#e`@AzlgwHSLO$@ zdD|{2qPDzRhCh|dKJ-q#>8zbk+s%*-@@n+yn%6t?R&KOhiGy5g<*flnI2x2&e>!A2 z!&Rfv(-FEON`pmWi&pYjq{eQ*6;V1WVx40wNkplOD5V}MC)l6d`38F{BIniRhj3lE zduL`So6nXjC96^>`SfeuUT@T|Ve)FE;UY;<>vU4xcbnpf2H%fzxBkPf{;1!1QOX>O zr@}W_n4(3_J(Tut+2B|IL!N@}Zf9?8(2$>_^o92)qlj*}5pJT<;Z$I_K{RH|Hj*_J z$+`-{r*XDajEXPXa5;W3CuXr~Fwp293uL6|tKswtAx{nVSBulp1`oQZzyVmQa8bg(VA(jU2O4oLjyG&N`=ShKaIqik!Dh3 zRTZst<;H0r##xQ9Jsaa-+)@A(Wg;{hl8eIa5zWCd)SEF*p*DqGTZ&C1%_YUkOOez< zBpp7^$fuRAvxopPM%HRET#UKmV`+y)W9E>WFq)&!FNAi=$}MR-hs182NX9$n0$i{3sSOjhUJ-POM}CwmPa zI7s`32gf(n5&`wR`{VVWHbiqoP~H7fBkI(9j17mDC|X0blsJGB?Yv{!8)&9om1i4f z?D24eZ+W~C>WeQLB21fW#AHT9_;91<{GaK82}VRvj|~l*@fln0i#)U-rjy;aWW)E{r#W z#!VAn<3&(BF=zMEV*Q|hi+Q{nCqGzpT{m9s|I+8W=5$4C)$@et?eQJ`$IdirN@=`U zIH_^&V~vNJA*AD+PkPk((xKXe)R~>tN@2*V*g=cfng;@vEod`)P9?OI0h%Eqn}>So zJ=q{`7MciiTQ5$+e^c0TFIww83oo{=A79h;#Z%?h_xKo~%I2(vanbk_MxZCm7sj9X zU#MdXiG~29;RB5WN5VPzS}3w(r2ty*ryS!Z9dj2@OB%X4G~3G2-0N?CakFhEHK|EW zYEqM$)T9B^XO`OoRz6j-(_mv{^8+a>mjfziRqRZvSSp-urz-j%|9t z%ps7zjPRkCKv?@zBeuQy$XITVcjYEzBee8m6RW>oBJ5#OlbY0|CN-%^O&WjNHfaww zE3oYHk8*0+)qfKy(HE`~>DQ3{!EO5A&r6B)(j_AO^2z%B%kIJV@bBA>7wNZ`iS&lo ziuC+1;rAzt^#5Hf(o6nN|L)}n>i56DU8GljPNW}h!}3%_`c9-jgWt;|ec?8dUV!!b z80P=Y)9`!ei}Wk_ovXS<`Vsuz&;Fpd%U7`ezxaztZ^Ux{=v<`l6Y2M+i}d1lk$wul z_l4*5?`_*dq(AA=^S=_Gr}n;Ln*KiBr}nw+Xpw#Z>;FA05B0~7)`;}$m=E>Ob!{U3 zZc3!L;Qh~I`On1sZhE&!Ke1J$pDc=$`r$`6iS+6#Mf#;dk#5~CQsSSh_7&;vM~RgB z`G*Tc`tfZd{qk)hrG6{n--&N7-=Np;(x*jw$!;PgKKMSCgZPm6mdZu>U$RQCFO`eh z^U{k&dc{`#JH$U-8jlA-N%b`CLkG2aOazF=WG?}HQyBJZ7*PbQSPqEiIn7v+K=-6>X-CSZFOcH4H2NUy^0Ux)2L{jd$cb1s&L_>pL8AL9R?JTB6U zzl!;uCsNXDG%gSye*>R)%h?}#^>+9be)nfspNqC&`KaBeV|lPYh(D;msC-o3A0Le6 z>lW$PpBE|h8;x&LZ@x~X)NfQj(%;0N)PJ`>Bhp6?(BG%;Uw4^ENzQ-yAb#&gY=>=_ zA|GG-JA4o8O>#&1(0EAtfZB)j0rAn-P|wNnYP();(kqW&EmGnG>c1a;SEQfr7Af%& zals?bZX-4kRyRzub1IUQV*p9>nrJ@a?T4y$aJy@IB0*`jzC7 z>_F0g#9vf?vJYwep>k3`PU3ynL($0XnMeHy>1o;0pey+{t|Ig+Q#f1#Iy-lOu8 zUZDOUy-od0dW`Bx@=oO^d8cx2Lq5CaVZ9#I@ASO1>yaOScdSTB57Br?;~bTj#s%Vs zN8h(qE9Xrak&-^9_9cF%e271(JoFuEM`|aMTlyZ^8>H9Bj;HUFo}+%CdXxU7{-S=Q zd`a$W>>tuQsAp)Ly+tSn*)NxzEz)0Md2a02%R%)f`;6=)vb&|7OZpbyBfUU+kNT7N znDV9kh^FVLorqruUlD&^{dT=ws6B6X$-5la&(rgN;_rC>S6F`3d&G}q57T&lgA4Dv z?J&Y)R36HY+W#7Sj`S(%JK{IOYh)kLcz!*Ob7ZG|qlo3$rhlLKf%GNme;SWS?-CC9 z3Fbq%lJceTgT|TrFAyp9Guibt-V$FBpGrHF+7rJ^{XylRa#KC1pNSu6oP2PjNJ*|q zUZ{T8zFDMhJVE36Hf%q#XXw2rza>%{cb|OER-Td`rE*ET_jo;Dl5>(b>QAzpNxn!P z?m|65cKPpj#`-K1>Aj;Oy${Dj;zP1?uE6|>|7kpOkJm&~`A82?c}UNZT~6PjagXd> zl4mO4%{U&A+!KCy1j|GA3h~2DsFw*xlmCFeM|@3kc^7_%a0>Aa@gd0_)syliy-VX2 zjh{3=k=`Z#y8+vW^aYIz^gYsB^xd1Wo@8&4oZs@io*&_8>Yp3X9w7c9JwoFNwLi%x z_0!EIoxXiH{XO#Ax!Z^I2=)7I=jhK-O7c$aPWq49mHLJHlk_R+7aHGh#BqbZ+j zn?J{Lk-jJSBYwUT`-S9zG@S9&fDA<3~4bC{(OmXQiuJD#0uKJyzxo ztdipWy}L`zDWx{%LUn|iCIVS98F`&w@iKD|D_sk3BT_|9&}7y34JL1_jGCCYc#^_4-W%!WcC zC%4n)?K68GlGCyEHf5?M9`NSssGUoNk=fK)yTg^-3jf=&wsZX@oAL1ec)fs^;gAW(AvNN>=TISE8O)7tDqF)W zjIwR=)JfuzX}}+o7~imAf~h!WhVH>%6~7bs_dUe(JHzw4?C{YjQ_H2aU=m`E|GEk? zHJfK4negjBt~=B0Ezlxm&d2`|ZzrcZWo+AragnR6bCh(BLhl;3tTNZ##8-Iwa{T>r zq<3pN*WEEEmhOeW_d~~#54K^NXtoCr-obST+-Yk&gnrZ0I}tm{ zN93)HO&+9(^_D6UB;Pnrje(rl7dg$?eCjIpG`E!mu^&DGZ~b%bvv%o^sV9;TfBDNF?tJ#Hc@KQ@mH+L2ddCAl{qKw&KmW{ax7^cv z#0_8D^2BqWKIql&zi;Z*mmc`*OWuCkOOoj-fum!A9amG@pc^MzZ_+WCe*&RKNg)8`%YmY=<= z^2po|J#yZEI{O}f?8LWyVy{cK-gIs8T^~C1tLt9fckalsYkJnayhLykQ|Lu3~{{H^eUmbDtpCA4GC0*b8_?>T=|J07T@1EQ9)r-$K zdeu(vocSU9vEA2g_`iQnz4MooPQLx9z=rE@bXWr|K?7Iy=muT zf4A#hZ@YQ#Nr&Ee$&W8O^`^&Pzx|5;K5df z*Z*N3>!X<^cmC+tUUlhFhnKG#Ir{crjV`i+AO7<1zm`^<@TnDtExRhS^U_!UqVR*l-Va{+@TtGQ@Pa8%+}QJ$({BFGaL4n{ zEwa?T2T;>tv+%2kpdd|}fKo(6x>7|-L{tz2l&&<9-jUvthzJNs6OaxfU7FO;BV9m> zv``a}PJqxtdUE4?&Ue?ji zr2t3?4ggiBJ&4y!@XFL93DeGlAav~sIo)1`3;2Dn0~SERz586z|w6!~&Tr(Oa_5(LBBk-vHb1A)|^$jE0{Z#r;}H z3=Mw0mzfC#g;MsE+K=`OxJx@c64RXwEXX91Q_jqBACio3Wpe7+pi~k6m@y7RgSvPE zDFLL5rMaQozgdWNe)GG!&^JQ@;JZgvr(Txcb4Wy^&sO#C+yF8dDHGh6rgEx`)63to zdb3N)wrShMVFLBZ)8P_aozxpead&Wp=%PwvAl^)WpER-w4j!=pV2c+L2y^L^m_=Nc z+2}pIRhm^Nrkq$bhq&kHz4A-V6zoeeV?uzJ!DAua_g3px;c6(8NdaYicX%9FiGB!-vZ6^R4_Q&h3mC%h~%5MESX5CZmAZldzv-QDDUX6|a z{3iKij1xLk8A?tiZRD#^PCGIDxU2Y%c6bL3?xGwHC`W$ zRW~2M6@XG;W25b>QOJP2!!|~4v^6fx?o=CK6^zQP3AOJbWp?T!@EedNd|{)7Rtad$ ziZSroi@;I(G2U(5e1V&^PWvIe0@JdNfT$~Ykd?qHs|g+C018xEdUuNg+fNUp1e%ek zvtcO*y$CN?71SysXd0T|`UVxc$qyXW8l64b<9i0ek1sKBW^ z5ELP;Ef2fiLdnAmomHK?~aKKmGi3Acg*k7dBEd;M-ODOEI1Ag3LO{6SwO z;}Jr61R0qJuXb+M5cc_^t8u?W6R?wF&;=Bl&>nJ1(gi^%q9|&o8HFgd#JHE3Bae@% zPuaW*#KE;7r1eR!S@fpCZv9>%Ne*$`KN)4ZsI&(k0pJd`>b%rfG~2>Zb;1V3AH|el zSSTI*aAN=<=Q2};!1V(u&B$066-Alc+T}s;Q^Ncs`Wm&c#Pp8iEtna`>J;xHoU4SQ z#HoRfmNdC-z@v*xaQr4o9XzBrU`5)c7r?sJ1?`sREm1NmN|ru_qLnxEEVi&+nk@OG zHEZsoeC*4yIY=%hHxNEUu=L;g(f&t^IkZQ)udwsYshM>9=}#9-*p@=zB5|!pAjA!C z2h6u<9Nx77A*mg1c~j}2EwTsBCWitS$T@+NO9Md|o|wMq#RgKP3~(zPZe|YY6ar5+ z9kT@eIpy<7*PlO0&Tb3BZ4S31iYG22p0O$b&%B$rQ-|9|s61voq^dq*slvs=J z5`HW**Mv|}pUubHWAy3yJ78=U3B>N72>40oLbVFYVWtLp`{cBOkO{!E$>do(LJd3sn@J&( z_6BWK@pT5!VkeC6Sl9-WSKEn1ijDt~u)v%=zR4_X=l6j6>5;O58fm4bv!0+SN)DS) z!GK7y1Vxsmu#yC*m{6c0eLez}e#H8w3I^58cZapf-=NgA}ntlWPZHNgueR@Ab2AIf z!IZB&0xV!E`%2-yb4wOY(47G_uZ{x&QjFW^JpM-$#zTEGsz6tUa`1>7xDzc})4JRa z4p<6x#$XVXc{ML05T}RqyytDQlTmE57lwjW4Ge+tyUCQH9Q>XIrY$g$8m*O@*N6fiUaMCpSL1D!xk$AGp{Y2wm~jdeY-)=8-fj}`@61)Xf`-V-39 z7*W^}r+{5-0175e*!?U;A+2eY65sSqZSHrj!=RwG*zA3H?LNxM9y<93*4EjMTr77& zH0^&D1q6)i9ovwP5vGCnfP2>YD)xh^PMsYT15iM3r4kXVR-c%ID~O~l;b1Zduirmi z%mj{Gg_TUzp{wOuu~3i=;s?(*gyht-YJq6l_!?LR#bNz@OIZ>Z@l^w`r$F>+DA)(T z1NLfNH8_^Z24Sz&+{1K&J-`ix6o6o~&Hguc$_0}x{N;gQix z&p>mi{RN-R5$doXe7}H6wHmsCd~~V;4o*dP?_n%YiUokqtHMZi(o$b3WmhX-6(v)8 zDgSsHD64Dm;)r@@h92u0wRzzN>tUcZ0i?E=Z3{HfHqKMXkh;RY#xe)5KYuYW%3nJ$f%S0bP>1q_PJpTP{iDfbs zYjNp{1H@h3Vs0&?>4R}|+RkICwp5;e zFB)x>yq2zsuv|Afww3<<0&9h~pnugehhP~vNi(lbtzdrgOAClG!HzzCn%Enb&>dzI z5!}Ih>}m$jjYs|JX*idky^7!O#HxgQ9Of|k>iZtTFY1K6dr+G7I6B&{f;3l1 zA6HqJ@NMeRfjTg@KVEtp_t<@Hx5J2P0^6B-n;{$<@(U(2g}sQZU;fe?-4pu6rI?e& z65rftHL$YKhmBIQ; zE*+P2r*)c*8Xu;dYnqkD?Tp{tpO9$t$@pVbwA4459c$Y1%SueADb6bY#UB$(w6GCS zUDm<=c6PlL3u+Cf?KKV!`Pf$XjWLc~E)qOiTqfGaG1R3K^8JCpbVE`n9bZQA9=7e; zHcURZBFl&YT$<$Rbr1F;gI(7q9BLDOQu+B7haub}LNhjFtCzP2YlyssWF zTRfFM;;GKqe&WLn7zQ#)#hqQKH@- z;T7Iu<&COBzRoF%GJ4^R^#Du&CpiP4= z`CMtNohMP(bohR!2Q18Uo#t=CN){|)McOPK`Kl^Mopzj-3u52HARt3?L~nvCZEZu#vz+ph2@0-!##}OG|1E9qrUhY3&)Vp znHlo9;=s-qQz6DjYd0&GX3`~pn&0avrdnRT?iLd~g@YN--9i*mIA8Yn9L!jIu)l{C zJ*qR))qNdQ(Nd=$s3u%1C%-68dsd>H@i+E`-idm(bo{iY!21@{1idFWFZ)K`i695Q zjGPYeGV@TGf1NY8Vl!)odoXW;r0!KWb~RS`?7^4kEm}^y-E7)V-FzJzx37Qj6||;b zDZaNVmY=@jf6H3NtlBsNd7=Fj(`L zV@Xfj%zV+i#N6TJA=7qE4F%FobhnO9i-6^kP ziAY19pfjR1STSb6jdUL~8PZG8gT0!AKqPbpZHcvUQ=%n29{)tw!MARf`sp5&+ICH1 zutD6~yW9}A;>O=O{q_pE7T@zVVP}g*{mrQ{kub)-Dy5eg zrW$Gr`3{}qn!(eX-|;!-(33Zbj4S@;LCOqc%FoGMkOZcmbD>q%u(moU&7Ijiw3`uf z#>?Er^Wo0^3{SX58t9nGZgE>!l*yqO6VZ_rQ#1$1$BTHO5@Q2 zT!mYk7kb>Ej`b};56{%rD!l1V7u1m|Jb4Pd%^De4__5--y@KakPUD1kr&^0Gy>`Iq z=#OkzIO2W0Y|h83az5+rfn&>O{U0rO`X*b^FJ#KhBe|iq&nPQt!KtTwad{Uh5ImX* z<;KG(#t3-z@Hf{RDj`?$#y5atgx7$NHrFnO@0XUhbHku<{!;ehG~ahGQ7UsrfCMt1 zU076t2}0XK9Mp|qp3nAaJ)SGjQz0zSYw-#&dn!_*j;RqbY;fRgfv(v>l}iq^c3i9~ zf@I1}m&Jd|>tNLir4xrZ*$@t6%*xT7AFikEq`$*}WXFx*B-HRle;l|D&)IQa4PGG@ z9T*y#>M0&NgG8yLSq9{?{BBn}pDf4-GzPR9hv79seD{xHJiisC#{(ZIAD+&22cJ-HH&z|tcyN!H|bZk3@=85C@4wRSXI7DN4#boANi}?=Vn>=m}X(^3$OckbVVe_ETRKB(yP&HcI-QS*wW|3^-!UMW@DjY zWfLLcuPUcEqWqUgyZ4t!`?5Q;*C()a{yUMTU`NN!J2LQ>NQ>wTWFGuW zq*2}rJo$GbZ9v{3=r55r$P{++A4J+v;LG|>-@YCH0U>1vQk02AX!{2jD>u`CYTrD+ z$+ozvZ#gQH0CFjBM?(}s8@A%N*xoo$vI zBa3v|q-lJtW#Xd;cha?LdDGJY^L(<9y&j-=&P`|X)&a?wBYK@s7-ua}r;99U-c{eqXebu*88MZmNtWXIn(_;)Y zw;!+j)9;3A=)OMlA%>^zPPNkYg0>%(lUGk-o*zzs@V%<&P1k(JQ~_ zxq#(tC5@L3zutT;tJSZMj-)S@5=ec`la2)4d4KJi?Z-UtRkLIMVpgUSr}r^u^R9CzvPcQ8 zFnXM$!bVPhmF%Yf1vYB%7hsWyjlWqe%yTI@Q|!}gml-s_&%BbfTV(<6e0M((at%)yYO=F$tzIBjeAWbEPV?f4+~)OG*A&Pl0jJNA+>-N*)(Qc~cWM zz1m)vvr$)bdXj2iQ$Ej|3aQBG`(JSpm;X5Is=Bw~tjb;5IDYACOq9Ct2)6g%h$AVr z(bhOnk}$aFmz(46rsAr_#}X6?jfJ9?tcI9h6#v!}ox>4J zs&h=FS95{6Q1_P(PP(RIYIkEX^JeCp6-v2{$1b5pPH-LWBOW&+uSR+IL{Dm?PhDtS zKxf^5-gJ7w8T#cJFK2Nulf=lrDzT|b>MS?0%Hy((mBj)_b4eZDtHyV6>$QxQZFTLv zp&p?>8bxQEWlZ^+Pi-Bd-2ly}(a1B+%$7auPq^LKEquOEx&tnOQMsj$M0Q_Q_C-r@gU2L98F{wBs=?fLuv#fg9AeXr^No%sGO+y834f0_CJlHLFQ z)yK3ygK5@O&-&z@Q8sv+BYJ<7U2yYa(*HSiOz8ine*Pah&`aq$|BnjXWz`J1Y_E0^ z@JSH)Bnf@v=RY3R<KA46 z|9_>vf=EfHR>Qw`+KZ!U->ypT(=N+q6O_tN8fvH`n!bnKov7+K(c9*TKa;ZY(3uw~ca3OBvW zkkPQ7vH7s%KcLqJ|Lr=(zwGOOX#QTh=uU3`Q_<;XcxMdauC=gMp3;kQQSrv7JfhS( z|L8ajqydW_peFxGi)0$*yp%51Rg81#dGUxVu{Y21R~|7D+d&JiCrGM?>vY*Mh_>j+ z89dn(J4yXsoZO<%X|uA8Jis86^5*@jRc!Som$<>GxD$O_Uw;5FXf`Ygxe@G8wpMu$S-v`=4_L9U+?Yc!-}IexK;D=?-~CzqZ?XaoitcM=%WzX^>V1GAuP-k&_8nsKijBdBX=;a?ZY^l$z{ z2!Q)|dTpC`WB(A0%p<%Z_05J4s6t-Xw$YbY2P>cK+XB}~nqlNRZuo@Cyms%g8exLbQ1s%@b`*pdN%(d1eh>TZDQd7=Yb_E zwu8@2D6z(mAwEzA1O9lDNOczcaSZVuSXK#)hcR?aur3nx@{v!Vhkg5V~H{cWSL~L$ON=|6C624VL(xMw{6&| zW>HkZfFn-4{+dOMArdfNT6l;yg)5&TrB1PEr>GQxqfbzWIK=8PbbtW9k7uFA0`A?U ze88aY&zch-%MmN(1r2ir!2`YYNpf<=WN-}Za4#r%hsL? zwRQt5=3) zY2-q{6)(Ii=5BiQH2wTjh@v)RyS%|fY>7)ct*OeU^;eqbw2{lXw#h0cLtUT|pZX^%N4RyVTUGlGYSj==UPRuR@}aSiEPj-Q-=~%b+poQ0?bNGJc)#c-z!0 zc0Fab=y~fel{E9H2?wFcDxpb_6~ma~TT7;Zj^>fHzwY=KFSHvenI7xPxVR<#RiO1{ zthi*Cc66vN^(MtnICL4tXpjs;Jl!JvET}8L2yB%y7q6{Rv6>NF+DY-O$j86l{<2+1 zw>^V*VS3Dx<>{s;4m@XEHf`7w532vQqKu_`_%4}K{>{~}v(mH3pY&YS{Po|^vYON)n z#t=1i0V8)rTP>VL5Dq@M*pbIV(H{d7idEH+%BPfEY0J}t7;}nQ+)3^A4V8<>*ZT2j zyUtk~mPNq{E&g7VI>dyq&z}7df2m0rNC~f54y_qD)gbJ})SoAGO zBy~YD2ynEZsr6cIb2)S?9eCu0?SQ=^8{K{chEF~*Yxz#%4`FGd-%;4fZ$m`w9Rx^X z^zngtxDQx@O-OporcL~QdziLx4j7w-|l#oDMa zdbk!yFgR@YF_HOb-Rk%||K^92a=Q~BK=7LB9zovPT}uU1t5M0l;j45?2$&jX5gxrs z(hk$Zsm;fM!Bs)~+j8iDc8swkWsq8G*#_0zC&17@m}dZ8T+b<7-K2=6L$9c46V?2( zh(!og00JJlB&)ZjXrp+$H=pHs_Pp5(cd8{jnsNs0r+GR$>#F4AMlTtwNURaima1 zJGCb^U#&=6$5^!~qh7B-(%Iq2Q$ojP>`7;(H9v2S2<0kuTq&{RI`C+C)|%2EKupR5 z406UpKh?&%X*b!JM9a=?o zxyfUB-9g2nqrIm(%a~_1N$t-Wld`$ga5-`blAgyQgV=T=dy=8w~NaF?q^fjUQ6j?V*CiS~pEj5I6i_gyUEbJIJEY02xF`HTF4M^f*{Q8gPtJ{>W!_%(% zg@!PJk=Gpz=GKylQ#P}piLuB4av>u+Oxpl(muDClMGma9un#S?76H%>CQl*D(w!{@ z7j;22E&{8*?}Z`Mjc}U^a3Xd;L8)~}gLq&oIe@T2w|ZAtOS^0BfXfr_fP1wR0>V!i z1qIkfgARB)+7sCe`>< zSfcjYxWcJ?mT7ODLE#|gr|2Ph^m=hYgyrvvse8}Cd4fDGSt1-=A*yPcMQg5M44TXQ zK|Cc}^CE1YH7~aQDiYT)3b(v$K+!Eq%$G4#_WKZaqap=~`E7L2kr$HZy7Bk-x?bof42_)%03+7^K|cl<|U2bKPja~v&?0PeU$U*yd9h8*OR{eP-QkqP(?sS=`NTIp80)PXh10 z8j@pb*j&{OFP9Hbx9_&7odn!~U75~~dX*)6?`9Q+ofC(joy~io%h=ifN5WzKtGX#FQ;3p9$R$4 zjhVNHG|KKvFSorR3Qp#gBo$X&Nq;>)b-m>=B{t+OHrw*dm@3qS(0QwbhV)z}DUJ}M z`H(!7=i|ETmwXukj~3d)*a39RTDSamAa@f{uqIA|LYDb-oYiTrfQ2+S! z32Qa*GNxRDc3IIRC@md%QuyX0u=1 z$+FxPpTphZWY9Z+%zF3(#h>dUR$Uj=oQcFvSS!JmjpWTB3yA<34yEP(fj{78hBncAGq3BMj1 z4tZ20>sRXYgFQ+0`g%?b=VqT`pwN!%&H$|-ie?sk@hQ_(mk;!WZ1uf>xe*&+L z6{&ZFzLY;L7eK`9ec01&j>MX`W+7xI2%S;uC1ShgE79S6nQ$ch-65y>dEm8*C{~To#^XzGaix@uW!p{5HQq zS?*f%`+&Sl%07A;Nmfq-()|=BITRv$pW%K#dVI>V-B+5=apJpWBMAG2xIOjgh;b;c zjq*XpIo5n0wuxLX!CcTl>;vRwFmYZh$9imp&jM)QVOwBBzi! zawfhWqB32sr-jh&@s&Hh5rgao_9n}BrT{kP1|I1cDJtweIEui2KA06YXmZ&TvFf;T z8Q1GMD_y2l4DS|uy$#TAIntmE)^80gz!TO5p={~~LJ1QhaYi4DFdtZc8a!OTNiHZi z#Y^jH3?4ELYlY-fKLxkNrk><95XP&ohvwv!26!J+C&LxxyM&2$el2HY5D^Sc3XuMs zj;9DMwuV1osm*oWrD1qp{3h=~6yMhE|^haHh4~co*&)Ba*#zL&epd!*vr{+gD z+m(vlNKY!v#^<_4J)c%B8rB~3sHD6^AoBGVm{7azP0zlWx41hr-~hWzlhYlpkG{3p zr|*UJ{h=?XehYZWW?_NN0_@gti9f%UMqmFZ#2)xtx_o*b()Mgr_FiMRbgAy#S069f zYGqjQrybq~owU0ZT*aI_X-fAobv>mv~vul0r!%4MXk`jj9(5me7 zM1b=2xv-ziIV?rXuJa9^*7K~5DqtVICK?8XYwssjZDyk>$#0$urH^=TKUt|-+hIb( z-7PcL@bC~w_AiCyyH#o%zsKiEZ-n|EuZK3-ju;g%_R|MwA-5Wh9lpPDL_@0_Ox>Q* zK8Feovl9qtxf9XT7w2|!WX?GWxE0qQfM$ZLAxR?&qXj(OY@vxwOa5sd>*5g|kA~Ug zrAn89FQ6v5hVO&6AK~bM?e2!42sO^##tSwl%Ne;LLuszm`TCY6RyQ8rf)R}O?3ns1 zmcf3UEvDPfmRG*}X>gdh-8a{J&RcQpDEnOCcW~?J`rB_m-DXcsO&ZS`{@8RSe}}n_ zHy7)CgBoAaS!d+T9Hi_sftgT-1Jxy!PR~OFVn!85g%gCfh0sTNM`2qw=-8Kp5trN+ zORv5i6lR(g9?;ClJB`~gM;yDR4Dz*^`OlClW=LIiET>cIlB<@V&%QZx8acV=C-T$j zX4T&Ota0>yzkg67@bR>?nX8-;NME_yeqG|Mx?w59*|^{fG8~uf`r{T}x}^t!S^8^MX_7Mg%P`7DAFnU$z*hoBVp$T}FVB6fZdri(zZp z=F^8ujA-DKWzE&~6-o2X7>8q1v4;y&c2#QFj`+xljc~&P-lFh#LE>3R&BRaiQqjlT zORdXn(if=1PJfo}aCTbXDe0_rO%uPY-_tBxQJMACU!8jXXzZO*{x$&p(Ps142vxb@ z>7nVR&On9p)}adnK)>bMX;ttg+HkqoqC{RPr*mki_{YXANXZ2S*_Q^A0ry6wix@LE zMuH6Aw?4?3KUWfCa%#s#YWk+Rh<~b@aa7TPJe=QOs)6x3a!qJA$!5?*T1s&;cHP(Q zu>CeDBzYARHNM_>8UwEq3TX)+dl){p&x3w>yOkbaZ|D}zQ#_hGB@)_Joy>Mn3un@} zIq?VhYg!>;x=2}!2IMSDyg>(WmpU;NlbO;K$(Amy47=%XX?un2ygsRsA@`A`dkj@z zqRDAcJj>LcQn1S*Vu8t(W-+_p!S>bjVw$AuelTcoQmx=4i+bIi;7B#&GO45^qhw*F z2gl@z>yE9r^_muSy!dN%GGVdd4{tv`eR?Nio~5Za{n4~^*%U+Dg$OL`l$yv!ka+^q zUB$?em|6XKI6>9Tv&BEwVpMGTB&9Ag2kT>2kX1tq?na?P0~bWfdRgsGjT6;!8nsmC z{dT^YxV5g|s)Wx4R;5Ac%&S@-6Lt+_!=vg3e0NZ&lU?3&Dh>qQskHXnn8zD%g|VlL*Mq1 z|I|b>b)?%(ejv2!?+aT;nuUvvn+?sA$lz~MMJN~zr)L3Yyvh)Hc5Cgjl9u7R-=O%A9UI$=tM?q#y?LuSp?7hHLDYWa_*+x^y&VTQCr`{$vHLd`25#m?U5d+b};(xjDa~#xl7-Zk>tSON;hGi!Ld3%D*RaXSf@u zS*@=YL2NGEJPwi{1w`(?%Wb9GJK2~fKUMAA5%f+}`1bhcuK9t66rqiLb+=p%_G6jx zSL(}id-)K#6`lR#_zdwG`+X*BUz5Sos5>yp*O_ibe*W`$(`I#5BNOMi3>FlwGB=cC zIkHwlkbI*Y+AGGjKsm}HByj`VIVo4dm8BjnR9?&`69cUDhSz|P2nLQQ9Y z2o%ar{c3Y?*8+q;ohx1u`_QA|F)Fb>u%&a}-Br67Kp3gVBVYs@#)%81>by+hT|RDm ztwFkCc)Q41zdvoXfbl`_hV(iW9BkzGz7?q zC>!te|1j{AQKAZ6$QH1@Yn^+Uy$G8g7-({bV_IjuZk-|9O!Ci5Oa3@3N#otHNGY&H zT+D3dy6}rzPv%CQ%v%++`5SzdvqOUtAjdd&sFjXCXH!w7k1Or|_l8@JqefiBblwMQ zX(Ofg;)>lpyVKUzCEP2ne>E_YaBs_anS8Bj!ASCwS?%2fwgvW++DqaQ0j{&+4li=_ zL%+Q~ydBud^6*=dLHwncX*}!3aJb=<5y`JI$J)O(-b%kkORC=RN-SdNa~H}MD~+<3 z->a>7p;u3$#(uh`U6A_ZMRE8Js||UGS47P@tx`TNSITU5hlhV7#St|5KrFOGPx-ZH zY4tDrfui!Vu?%piJpE_rROZINOaMB{ZF_>V;WS zbM2uX5^5KKRn_cn>yt}-x-UkriritpAQH*-+Lymxx122boyR6AjlXh3DV@h@-9yFB zX+HSpS+|O>A~$uPcG_j3hGB2Nmtb}1^ST(4UZ@QCcelES$f^5ZwiuIyuR<7#&+1BR zoXvCOTl(Br>b+zoZBc%|U{~r<_W7^t!E>3kr*luuT%_@lmcMQp+woWM?Rh1AJ9^P^ zeecbu@;SEy;{xi3wR2%CW;a(j$;G2bub3aY-b^@X-%>NuS21yh6X3R~-N};mZ7Z0A~w(R)K4`qFY}y#GbwB z{rhDaNmPNMc}@qvExOh&{CEs$d@aY)Uung4E9j<9*zLYj z>(brNF(jk@OkF{oDE7-uyJ7LhT8FMqj@@$8#{S_}XIjV1(z(*%-36ZY1&zG9W^t9< z84+>Zm!;0I6=!h+`w$-E4@j$Y?>DadTeb5(f ztVH`a(fFo%^z~vLet9OPYVqmoJUZBUhg{Akk23juY+U#9yFcIW<@BCDIdeW^qc76b zs`eWsxAtcKiEixy9sHf;*$4i^<(WU46c-$Xl(Kj$jbqngqnUEu!h(*aa@%v~B3G0( zw}0(+4L#fc8Ssi#62g>;DJ*f?>BxmJMYYuIzr5oHw=7}JP5L83dIr(BRV?{bk!8A9 zD=oc%%Nhl?jZ|~r{PFGeH_h)1p$&nzvjrU9^tQ_k`D|oWs?C`)Zv4tdjK(qSHt@(R zh4S~uh{vgqIw&oSo6X63(Kw$~ytMw9$L%y?io=oRzFGyazCKb}q_Z(F*a*~6=koow zy%!BZ!DFn;kiXW@xg(&GiIVBK%8*|FY1-z=NRN|28KIJWbCjmm$U4+_FkIhp4xUzj z-=3hQc9(BgT^g_4U&-kN#yP@+JvsuLkDU68%d}sr#=6Dl=;>cI%Kv)F@Lto7m#Nkn znbO%hCr_zD(5-V`<|10I_)2-ih_Hd?*cJ1wn(c|Kcc(tQXWGQZo?l=u|HOq>Z1T9> zWP_YP!?E0S^r}E`-fT`K-{qEVz}dGEwiheu+NSc}IcXU_jr+oL3K)M%xW%WFQ1QOq zrOJv8a%0(v=((;~+G_Sa=hcnX2XF223MVxdWMBWJae3`naOH0C>CO+9oG6B5sL1{S zW@0U0oBQY&dl#Z9x>C~F^RmhaefZ-*hF^ST!VL@+j{RT7HifrUG$Su9(CN);a(Px< z|7LCoOB^dH;~}qq@v5SEb^8~GHlX32o1Sfe2|b;;q?DWYXN!OjQsEl2KaN;u>CJX4 z_?UBN-MvD&&6RRqW(9BDjbkCXy#U_^T&}=Ibw4XG7XSD*OxO(4V>a0$j^UiOs4TdS z92GYjZt1=sD|5(ob9QKdbn1SZk`&)bqtRLGVwW_biUwt)D}$wq5hlY(ryeEUlLJ@B zXH1;R^u-rR&ll2LTx`Q#gz&{+bs5eV9`5bKpSze%FwND%l~#)*bYH*t+_^V(=Ay&Z zo(s`D?|)B|$7zI@*5*=F*ovA}G%cZ!GB6Yol=J%&0h z_;(-OJ7%}$+8`7vhkIqBWteoOb7yJwWQ(lrq0PR?h}?=l&Nrq$&ZM&@pfvt~)H zUXZ>Ow{BYQMTal_1i3Sm&JAQtQnsU`B>=E7tW2N zTkSp`BR?pJFaExK5@#x{d9mt}xZzc<#B;{oR|6|s%&KXuZ3|tU`gwH@B^gI8cYVad zH3J;J-w*p`r`vbtN2)_YrA0%e@A-aQFk5`AvQ&?$(9$#0qHJE38ib7Ro3GM>Pq(jJ zs>IA2T^*7o@QzEq63bCalB50FYtoX6skF`xOCBHJfn|uSy{ZlWWO9{O`7!qsz$%AR z%UX5IE!L~b>64gi@0D!8&|Zs>TfJ1(ol(Oh6Kjr=-b`+Q%&sIh zSn^DU&(kH}UAjB@J@aqR7Ro+h*iD zQo^FCr#+=#Ru^o%v}mUNDk1*FN{J}TGYtK56ki}aGou~QSk-4Kp z*Vq3S09rt$zoQ2!c`R!-41tlJ8-?D@FwulAXC4{hToa{Y0~SrgbrpvCg!hxZ&BO2E zu@zK!Rv~!Rz2I#EynU9t1F6f}L7KMku2U6CIn`I?s)`95is?{_8$zt5VW_E8MpL7p zSil@g^8siS9vy|T5RB~poV_I@ci7-SZDJL}?s5E-sUfiS5c}bt4Wi$<#@@o0J*OED zkyBNf_hws2@g8BG3v?p!7ua}M9*>WmPir|vhJ4Z(MG54P?FGq3Y<80iMp^j6T!ral z;?Uo3a{=PR(I)s4j1DC*TiR0t+`t#U!yLkI#)PV1;X1prx=L#zm#vEe2ADkIzWcL# zcu(Ohrtnc@gcG7Hb`LGt1Dja+W|x#D@vo<;#$pk3s3`R&{&uEjSkXq@%Mzz!Cc;`M z4UwI8A%pVtXAXYZ2ZS$#X#nAuf%eN((_*%26n&g5ULv(RHE4l7m=ke$&?40`SDTD8 zM-?YMYpM~onV>e=_LRui7K5WpQe`>h^cnLPoN1#4&JG1sly6yGCNPU6gc^yBv(n%t zP2RKeICbZNIl{1N=XO9lxmtudR~GZTWu?VQK!y;WvO5AnS;9>q91}iFd1BX!)XWoE zd*pb*^m(r%p-L?DrNlc%dq=Hh zh9Yo5en8CD%7$k{yC&oK#$i3!9kLU|{0O~Be*U$E3=15R_B>59ag(_+lmndKm&-E$ z5*cq7tQQ&t#kO5eae-hJ%k4PhsYXHIrw0nOdyWQ{`1Ghv?mEUmY&V}g*#69yS0>MZ z0)qQ-mua-Htc^{*_@KhFOJ$u-wwIx^H z(k=i8I^j4AY+{v$##h9EdxM!dKt6<3cCIMYBJMv4{Tn8S(N zx}^3Jn34|{rGk|nY-iCcOj!ta5YA&BO@mzH26(R#z7}aRGyWA&smPm8!R--VsjPG} zyOa~KThOsf?<@AG7zM@1-~|+D$aWAwt>g7AitcFV8p^E?_(y@eswG=G#z6ZFiAmzp z0D8EgLCd^zg&Gp-j6PDs4KNgdri3o44Cb?GD5%YEQTc>HLZ4H|b^a|DlxJ7S$wQ$U zIMK~Jl{LKBfTPzg4dX|}oVVOQjLm-M^sO8xN*=jzy~4aZ*?iRw-Z987DP@Q9pLIDw zn95LcdZAB-YS`T2#C)+#oEZ}0AIrf=P_+hd@G4YjGpt>0g0VHl{hYk)ss%@=zjUd;&m|cgz z$b9)gs>C7`qd`GEqhmIPRY?~DGS>UxapRE`WzZ&(!vHe?FW z`pl$b%xfW|l%b(hIG4}A!VNU`a=9Q7XxhrNm-=k^-K=W+VJCeOceZepA~$rX;jqP& zm`NTu1XTytwWU>z0#gw)bQxzn$#N^cB!U@$Z507Y@z^h3cBt)$XgJp0s{P(ik=bbN z!5GS>$3R7T82;EV+%>GVAjhU6v`UPbAebfQrmTz>Z5C>dUn|P5sZrmIbFC6DDg|Qm z7PE4!VPQ-ySj@FUtutT?MlMOoK_gMkQwVr@oWJ|ovHmVIE1+|SveJdXLu^@m3w#l$ z5X3i8(xfpwY?Nu@hIw!-s7^(IO(sC8ss&so;0NOhK^@)@UehYd zz`eXDuK5vvgEX<%(g=0-DOh_1cxyTm_&}F>WnU9H^ z=cQ_%8RAxk^*s-wD}W`&iUzN&>0BqA9C>D2&MEZwa~reD@6}WnlPc>aJX_+Ov2V0k$cB2wMf)14e+2tJlrpHZt%8n_MkcILG1xm>ag+ zJu6AGk>5*k%Cjy|0<2Oqx#s3EUmP*0);gPMD6$O~%7s!{_(KLQp**>o9uk7tU(GS5 zIOfQ96_|;*^<0IWyHSBYEGwag>STaJP#c46dV!9c@H4>uc?WNcfm%;p2+)s*6NXzNuVL2_Xv6A3u7?Ii5J}eTdY@^|V9MlIw zV%vFV>=@Ip!~q~q=W7c2!%VNFma?Lt&0cPoYDe6I#?P0Txd=iHEa#=v$aR<&OQ6Wo zC_0hfo6+RrTHh*z@T65EN7`O2x}Uj7nG-;b5p|5Qc84<<=tqxq+7?WpY{Brj7HraE zu}C(qDMf?{W{H!sVkiQ!9^|6Uz^B5(>THSXN*2sp1L*p`|`j>U( z^sGpW)9ETz2!+rx6~uKcu%%d9ZZS7tS^QsgTz_&_G0S1Q?J&Yr{S z4|QchUMrZOX0pTC47@#~oYHTJ;X?q*A@(QpHS@Iz`nBiB=4T38c77m)lCg*eG&GHUFabR%<}pI3Id{@<;?9(el=5jX}p z7E`P^Vg(H3KSM+?gEcLJL17?ds#q-XfN%6?87|<)2Rz4P+$n&Bn~p59j0Z4)N=}!D znO82G7lsA;1j(5!CvLQocXw|-;JK~(F8NzdboBYfm z6ez$C7{?_Msf@FHJj1~(O_6{1I61ejnv%uAtb+dA#o|I56vLr+-hS&AtVQ{BvaBIRHRB*wip8C>a(}ZlbB%k9-Gskj)gAZWWcE&_m z#4UWWt*zn0tSao}Sl}L3wtAB-Rv-h6A-@VuQt{0l()_5dcCyxpPXIVqImAV)pLJ56 z%~rr4X}W-%4a%%xH znEhuvNG4s#RfqB-k^#T{31nv-m0Hd^hZ+4@=y;)Z3c?kOcuB{C7~)YZ6cxDz=v*jN z7?>)OeJff@b$KaxM7A83?m8@;B4`}j@fDWB**6y8MLYL+9AC_=4;f5!0A; z;#7-P9+-p8D3i`(PIiE27{mY&4j>iN56o}DJyA9Q$#exnB`M-mK^i<*UhH;|wo80Y z0`e?j@GsNk#iGrueuhQ)nqIymgQC^Bmrg9M5KdoUGvPC1K36+e6j2-)L^8rA?)jvK zRo+asKi#lxO8k^Q+U_(q5@?_VCDXCQcM2yTP?ZjoN3*1`=e^ z@X0e_(Ks{xPK1H7GY^?SII1dE51+sh-dIN`iZ#%*EI~L8ai)%YzS~oSqeUj#Wi~}9 ztOd9fxbOHYaY9e`wiWo-%J{i#ez=eumP-lFSaFmpTK zcSwZR@mg{(UX`D?h0oKxN1@1PvMgLE<|EFDy*3m_Wv96NUTQV9r?~b^%biR>hM1cQ zZ2%s1rz}m!TQ{L3VM@f2gzgX%zl)Q!EXAFV$Nwb60!fxFI46e4Pw<(yYw^j zILIM3oQOH{oG`hoeM7hkPw6^d?TU!cVMaR)&V5XujTVrP2CcI6tnmu46{i&QCg!B< zA`LLV%sATwxMo{~S=dLVW!`F90?P$84=gitJ*)6Ymd$Of=DmWmwB#<95&k^-kr@s( z!-sGyi@lBptRi~u>@>5F*nD`F1)(vJMD}x@2RO0d2KEtU=75xGF{67@%Wm&+yT)JI zWR;w&ui<`my&A^&xz?YZ>`Y$q;ZXe`Mc|d}A?AG5zd-yz-Y3`FG^2YG*(y#99uAl7 zv^c)U`Q;3xtS6yXG%}71vh}HjylWQi`dZY(N+}i{Vu)Zn&ZHfet*ol{@sRU!7P@g% zA{$Vtc7>VxRFF(NhM}>gQGAh~Q0PoY z+T1)B6TmLX<1LjP+LUMZs0^9pwdM-IrYEr1mFeL+QHB#GTx+7_G1yZjjv=rTZ@44|z~Y=FnzRq8VE+t&)Kj4$k|Z^zLDo*Mp0 z20a>@Y#0OGz~N-cR;&rt>&_=i*(fB;H|HHCXn>5pk~ln+Rw0%JY<5i{Lna(l;lg~Z z+5DAq7cRxs&|i0}9DMb7Ew~3-y;QP<&8Dy5a(pyJ_sp3K{C%c=5W36j$MW{v)d6)( zwK%I%n8k+%-0Bh3f%L_c#j&R9);`RhuvnNO%S;9z3e8U|4xI&5dY_6;@fd_X@dM_T z!F>;zvf(ENwsWP-+ozgimQIFmpTYZwVPR3}85F+G&FoXG^xzDNNcTUQ=W|iSjLvos^y0+io z@{!HY;%;b+;#X1m(5M#T;#$sw6X973-;={(nfHwJf@Np|JU5Ed%i>|yQn?%q=U}D` zi&fwlcROpdZ5JJ6RLB(uIEr_c5tOVUoAUxISAVs_StL88E?r=#zrVt_0wW)wGjq-{ zDi({o$L%7*Js{A;IHPI_Es7$Eo49J@1g%37(LJK|0L(IL%N-rR!M(O<-v|j~`VGk4BOlM&X+LD?%B5hW5Qt>B`A;5MxtxMskgZtt{_^o3} zOZA&0B2aV{%^c*^~m`3oDhgSQwe~UO0P-iUk3DEgC3jCK!D8b}RH|vo5e0mGL|fzNw@pz2Xa4&U}oGd2TQlQ z6aEIZgP}>FwQNb90HdHmHBx#e(@$0w6a?rc)&cPDK$Rw62agpS53r~x5em)vP+3q| zDUG6GOG{p1$Yc80(Hr=R3>)m@$`y0~{3l(4F6;AN;R12iA%jt5XNQHI1+8RTY&uau zly(}ec%ZHl`dv}?L*qNS(OfzXx--RqO5RuAE2}pg=`oYW{H)x1cS0)d)KGSyMB#w^^^K!Dc=T_cQ~=2Vlub$y@2>y@~m?bpJ-7S0%iPy4qab|?IxC*v2cGF zH2T4yMThI!UR()`keMFjo+`}aK+Vd*ZFnlSMWGHyv-m)bhj8sp))kb`#E0)jlRcB# z7PB~5>l)DuIK~Ek;{DVYe1Z@C4?L8fJEqXb&h08N#CXuXs1ctMWFAW!n0|oU@EC%x zm~|k16y;E}(7J8e+cvWv|rVubOi*sb{X$|Ur6{@SmvFBI@d^uP; z%~oU4IvKg{f)=N93D%d0vk$E4T-PqwscVV@L$w#U4bY6;&z|KDbuEqv*9_qN83yV~ z3)gYqkk&`96|QLJx-ye~6a1s)U+%!&A*)=rxVJ@L9r|)QI(S-&!t!k}hrxrpwG?EBmFpo1%b5aC<}g zhS+&Q?4u_Flx#7f##xL4kNCcNxZj|SmQR{*uAQ=oj{b}=UzD`wxBp2G@V7^hn~)C zRw{R4UfWa6%cT>}q761gGXPx@2AX()!+FOoMyqd+&2mk=B|B6FWKkXJ6PxTa|47+c z`8~>3SMuE}5P_<>v0o*RR5&K1L2(J_+jh7#%A?ThvZ{;nNAYCKnY^ ze>K0U--3FxF$7&`xCJe16dCiQOqXX*TJHu8S;OuAb;%bUp*#-rD8?+A>gX?I+u6|s*OE{p7EdytZum(4SIVH;`- zXeG8=M9EQa;tW8wNIRS7KnA&oQBHm+lR()D$2ks$loJc>a*^E-v=(Gf!ak3Jg85XC z8nrIIsP8n&g5vSTSE94Io)L$S{ty)kg&T3)qR!j`99!G9Q8bw2*^}pk;Oc1HheuB4 zl99%%Zs)QC6hFhG7E2bhHEE>*!-F;a&11*F&P3pxrsb=+dLZ+^$^Tz)f>V4)0Cv+g z25|K*Mgi6=wC4sN*!$S{kP{oSF_Ce$%gTs}6WmgP20+K{&PE9l+Dhx?v6QR4ckAUr zEjX(w%^YHA*2h+k-7GolC};+tVJ9m)HsJPq7}Koy+4L35V)|W)Rt51DQAh<1KH-c` zO5HI~5kzTEi|Ce|CaZkkVZL6!P{e(&P^)8*5Jd>F#-@2o*CsBa?^sZ2s#6J6fuYuz#W_X)CQ#fTBIks>Kb*4 z1TKj{Pk>nH?$nHJ7r?q?fHz>df)XjE@fg{*Yz@&u$?#-+X`>Iw1?||;X}Y?8SMyW;a7&!N?7#qT>r#my_r-4D6klR@--hH$!M_=WEiD?7>rO4= zp*`LPRF+hDw+i2jV}{ZQtPN(UZ8VecuDdnZoE)$iD-q3mZe%8fK5$FyCBkp{NQ;IE zUrFGJpn32K-%5+sM@C7QHuq@rcQ_6+8NcRu&Z;5;htL13+Z5#RxOLj*l@^Z;^SNVZ z*kvHO#C_MU5ODO=(v%Cunb8nPTP*UqEeh*re^$22byn;_D~;+GAG+5EfMlZg8yxs&ikQMyfJZs7jF&T1zq zOhYws)2vYHp-;3k1-m&zvWt4$<(X^PoJ3wQAKH~X;=~fdjX~X5TV7~BtTEXUn-vJ7 zADE<6uHY6z*eGgAId79TM-+}QJ^@f=&S17B zPiMBI&H%6|I+d*$enH+5VkwTO!{vd5GKSewGj_NnpY8P+x0S7RM_6pM^RSFg@9FAZ zB{l(N-^7k66gG3mzU?^Zv%~~vbQOxDYCAKJCwGcEk$C73;IZ@R(NypHZe^1%bse|% zI6O8(GkNfR{P4nFzPekMi08`2COTG1X+OA!?T0Vl@FMU+wG#;A`%9AAr;<8BU_)%b zYYCJY^C|4YmbOS-j}bOCvmqRwDqt1!p50lqoJ4S3o~_ETXz3XY-h7@1-)cW;-I~-2 zHjkUNaa3j>6^zBCN@XQNg)1|Tz9M^D;52Dxu!@Npt#+=bEH>LjK|E{=c1tXvzysms z4roqD0x_0Yt3boABh%>C4^e1ZD4s|pdJ zuROw5HNtSZmT#Ri%UKG*qew)dnJ|kzpI8Ry&$i^64ybOuidq!y$9-8`=^T@KljAsG z<2UnZw~?*#xA!zK4hWI%hF!!;c(1%6xGg8}xdVb=bAc z+>WfA=k4x7KXTd;Lo;!@u}o*ura)8B_t71~vedr1NFB7M%hE>{6U;LD(-c@hhZo5fb{t$}#^mh&3OPvS zu__c&hK(xPA}zMo#oZeCf<$$9b}^M`lQ}42zhE4Y=Ld*x6uT6FFl2=(Bcon<&oR+g zhC|{x3U{DDQz4bYQAXg6c0l0vFKgoL5Q~py-A8RB{F}veIg1PDQ}{e{+@SgpsHa5^ z!eAjEzw9B`pvbx%{e^5@DLG&@vrcxe0+*R_;B+A0ZByxYSz6psl^>WaUKYJ2yTG-I zLj<%y1%&$*8%?zpL3M0Lk7!#C)5bK+9C7Se zjw;%nKyv{oSoEL>j=>#-#BK?kZFpugowX37M+&dSD6R77XQB17rRC-|(yZVa;;Ls> zI#wWOS>i0fa4dwc)Bf}N@(Is)oPEw7lk z7&eI~4iH3OD@NNDg~N4?YdwW&_3>!+w&|L7fGWLcLfqGgTCw4gFqek{A$R$p=agaI z-csQ+N|@(WT5EI-mN-OWS}UIh$N@QI==8#zjlOzKA*UYadcg< z(N@Oy@ux+=G3K_2pLHY7-WHBZj}@UswplaZZi|3xuUn1;V8aon?A?-SuALO z6|%9&^&o|(fOEA&L&{;mwCe>~KYYErJSe7%upk*VY~z0CRmT0eHi-FHg?NjgOmUhN z?OY4vR~|*4i(}NEbL&loQ#oYekXOa%nWXu;dD8-wD=u%Itf3TMp@^B zahvoG#zqu!ilNTpZ_AXMbLJHbdd5;OCY##TIna(g-l=ByF#T}Uul2H5oc(jVmB-s< zL~vd>lyi703mHAtJaZ6(R55{0E}f^f(6=P9aw~QW@pLGsJT7JOjG8od(4luHifB(YVy^7^i%V0b z;53i0L5Fa701*T8Z{~28ZJvXk!6JYLIhV1J2d+5-9or|~3H#R+zF23g+TEuX%DNrM z*VwOJ-kw@_N_(pFSPZP@GeS(a6y#Kr;D}){xUgjb^g;I+`#G;;!4-eF=VX@Vk`)#( z8#{#ZlaZv3l|u#QZdhDTXTbY7Lk`L#2}>7Tfg zm(EiX%M~p0XR12p^eUTL$Yi*KflfiB%_VrpL9?jl^o!XObrZ)FxN1tUgyT1r9#fY{IE7potYb=7F8!>VLm*T0yO$deWS_I~~vu9OfyI1i}6x(;9 zlLuF@XSpRI4+pYbv#K8u8>KSMC#FhS5ygIoa-nUz*onv)s_|K8B`%*})s7{X2PiY< z&6YQFyG@;|=Vzm_5F_b|#S$GPcK{XfRW)la8$NI*&8~@g7xy%fTy-IR_BgYH8_^1R zlRN1T@%@O)&eCL1L8*?#bLY+jt-rc=L%YL}UfA>Hy?)Cz4du}1%GfR9~5(Z@mCi>rGeC{YKgglx*4_t&D0B} z;VbyyExtMI@|+EwSUQrc7O|avj{L)4p@{e~Z@~6c&E!2Fg;_x`PC%bY`ylPv)uk9T zmQX7E)ThA$n~L0QkIKoN3@(q9R%MFe=t{-ez>&=ok8+z^ggiiv`N+lA9bp!1Pu23Q zf;=f=$U!TnNH4k~>8q?ZYyiE23sTYY=e&EY-B+qI^|x4>C~LXyUaU?ND?1w7l~RF( z3-cZxpJ5-r{!i}w0BPlWu1Tv=Zju4b116)4zEvDl?qD7qMVwP)-4AH<@XkE9`0`B0 zk()VEnV5urr&wb;UWY5xJAlwXM#8diY@GtPGbba%1phCv5{O-tfB|hfyB7oEiW9mO$iGt^R<_aAL^!E zq-sy`;wM)-P9?S>Iv3JPp)y)@c==_=X2qm21zwhzb4NehzGJ1b#xbq$n_YI+H+r~s zp6+Fnka9MWuL=_Jc5LAd-(cM0Mk_bQ#fAzc*X(4`8f828WeXYH#+V-l#p@^_kMtFA z(_Y?1>?m^leZSr}8Lk z8$9hk4Lw-Fb+|TkQeg;Gtb-GaR#8OQxgHn0mh*M#^wLm)mIEo(#7P$ZAV|aASevX5$`AyuimZh@KXcNGwZIXP9N@M!S!l z8_Qaeosy2np#vsk3xxTBWfsG*h1@VTfk0zhSd>NDl4n0(xq=);>I^wj7 zf1P8dDf1{f8>G(};p?~fYAl9*ZQK_Ro?e}2fgM@7oQ%7Il}*+8PUFfBGu*#vmj>A; z(2S4Ojcb?_RBR#1lnKt9zDJ%5n3|pCF@Lj)Rj>w_LaS8Swk_-|FvW4A*HeU;@MaNv zwP2_*=Aj0raqmb)?o4c@`2iS+cGaERwQXU<3PM@{m{RuImi`)a{mm$2_t+K_ExfU3a z)S0qV%AxoLzA$zp9W3M8$nTu)tk`sQ-8wb}*V(;VG-P%_NO3OPZ%bTm3x9oC?AIvt zjqP@WgIITTneRj+EIjW z(5O7lJr{ud@_a@~Y~#(gyr+E2Tmsktfc-=I|1#P|R5@soMQY;_>0Gw74Qd_tpELB$ zsrfo>ea-~dSue^L4#}fnx%r5ZS{1P?k(hNsIiu|^MbrZiQbGd^<-15hI=q(bE7=ka z0km*l2B#{~PkeKHj0kfClJTSxgekrF&a*rqu39YQMMweLWT>dCNSv?8{<<Ch)Z>Gtpg3*Va#g_B`ZIJ?c+{+ZnLQe3W&{$2sS!$2*2gtzroW1)d*HRZ| zZ!sjv{kCGiD?C4e0W}_+P!n70?Cqw`6^DvT{2n*vXh~{+s!KT9kL!{j>93x7CR;>N zN#l;6HamYocof(lj)&oO)`SQh`JIpRD2k#J%?EseKO*t zj}#f0=fYTL3smHp3uKVuQP`k?l;bD38Bvy7^YIO@UN_7750z z$8>{`up`|l&{+*-5@BW|shPs9eI%|G5kU<6HLCbK)fIrgC!@KvCo`?IxF~tNgtR@W zL2$Jg<;-5D2)xi+#q~HlkN4+j6J6JuA7LkYEWE)}q*#;%3)A9UA}6ZG`}>D>(VTNcDDG|}FD{t32 z++2BsII1XX<>zc*N5-)oXvKI5>YFXsDh?Ldp>>*p*30^ovRdFf3G5tCBe$@ieGkd` zi>SysZh)5i;N0}gV^?$@DH~FW4#B42n%z0+oG&M3(R#R8gJ;H!RZAUlKQBD3s-jB! zj9X5qRIfEOqwMTzQl@}K7#EyB3Oh!H%! zXIjQC@Fi_BkdV6=olV-*O}(WmQCA;JN9#f!Cz)q%WsU(k!hvy59I1w9B)OKfNqeJp zoO$$0Mez$0MBDR6^^cf~Lou%|~t9x$QkD{sL&(g z@FyYD&Te-6i!405u-REG>>SRA_1H{@fG}NB<%e6d5E`3%&y>gpgeX>hA8&)CL;n83utSx5{!;RRQ6-y$h8-lfrRM%9g|lw(i3e zBW9ef>08EPBAD3Ow_r#{o%3pgnk(nB8HyVb{x1F(=EkLvQ#^r}n>eK^sh2PM1@yDH zV!67N2TVCTBC4v7X+LqaFh;EuExy{H2a*fNjlL%^>%Oj4opZXNiI{5Q$1w2{fXK3q zWThx7`vIKn-<~*L^3E=>DGx`MovAXuaa$(KcP_vt<414y6QXwZ$f8*?oU$$8G0&OTBJ_T?USnrIQMQVwNj&cG31#F=X76`PZyEv5%+ zf9#D_yNW|OpHM90?)EL;}@xM?;qeW&Lu~X&b zETeKvx;o6B8N*0+JRTTKd(wv+re52d#^ay)^t)o+slf?21Y$5MhPPu5n`-t}XKGSW zG~@%~e5%d#DoPZOds5bt^7!t8TsXOc>;`eTw>m+|Tn}YDpRdejMG=$=>#$lW@|8KM zba^-wlWld*MGykToRo-wvwVKup2dP~+5bTdWt>jUk+bq(C1FvjXIN7-lX7I7*rY-U z9Mu4*dTfHxOqW9HE2RDfL*i7CF&AHMqPS)UakfN^q&xezK zJY0;Aj7>}Y9Mo`HzuyVhlk2O66N=4K@K_|dM|1{Po;&y96&AZU!~(1N5eXWut&MG- ziw<>EjC_ujiLZWip0aER-#e*G9wjaGvhdr=QO23-qQMF>s^rwOxoBRTqhEb%l7jo7 z7$Ju<@cfdBvxC02=7J+YK4D+ce1*IOF0H_UXdwq$)|L*;y1UP_#gPH^Ik&F*_y*UYc-U^MP;llK;Tu=51@l8zy)g&3aN z`7vo3Tc|c1ve<{{*g7&6+31hj)|t|n*Xf8eopyqOvCt6c)$L~M#PC5mNP3pjJ?54b z1JOn!M>vYJImc&xP#2*Y0goj5k>0i@J|Dr~9$1m6@x&?0<9U*XZ?%KpVwN>cyg|g z28I5t`?J_L>I5zPh8hm>9kckMuOdW?kU}lyVy>c+*tm7HLfdf;Ft0(L9nQ?-D%eQ< zVqSu_W}{q{C|HjP`05S1(^BrGQsC?J=eL)v7Za0^h}uoL*kLafCux;ZxKB6dR-%jj9uERQ3lgS6RUA27&f`I$X0 znikaEbFC=vJ=%c@j3HO*MwbZI&1ziC9Z1S4&UDr)6^Iv3?jtc+ARiU;0mFjIWsG(Sm*T_4V@jm@=CVXAVdF^hI5k+{&A2F=x0DejYkTRR$CY5R?@gq*{2q zvJ*fj-pOS%Oi3|ImldXr$HVf86dbiV3>Wr^R8$nhr5+Hg275^N;wnBvgFspyc0`9i z=TLidETf(rCrUBMz4*dlA;hxM!G~IVi4tQ_ofv~T3c>gO-HF@e%U#22*Ky};Hbu=> zKFJLgS#<^qvxLh)#0x8(Ucu$vT3oHN@udhEV7q04!q+44$^{+-1m@b1#ey6F!&YXe zIu?l@VjD*AOqI-7R7NlNi0e6F$@vB!qU>VR$bo_oaBP7yWFUhj_91bW!8!=FzL!(3o7*bV58jtemY^OXV4kPNWDhIUPjDx6xWRu})kvy5dJ=gJ`uR z8(mq!@_w9Fwo**HDt4}-XUPF0`3UMsd?Zv7G8(r{Y;ndt9)vC8cW99p?L0GL3n5|w z`ZSS&1tiRER0rw z=-oJ$C4bTJ_-Ey`0y2i&0)X!vBSIOa6E@G0l)_4K{{hwi!JDdfjKSR>YZUYl?eXJt zB+pp(-^=Sepb2AiS1V|k4cLRsGzGcaY{MWR3@8k$78@u!3RlP^FB1D>%?UNkbtDe~ z#GqxloQSH8CWT}WX9?b@x z0^W>D1eb*=Yo(d2(Ts>VjG~&Y;NkLirZzxn0#xSBUCzvLWu!pNq)sB!K6(61RkmR+=7V z9gacIbdc~Uoj}q@P5jA9Hp3@D`C>P1)>&$C3s?1V;6Gy1M(=7TidY#QE+ckN<^CVx z0T(N45bIG7BPwR>cY2|(%x5ogNuj#u$GiPJf{LqBaS9^ySMymgK*^C>;t|f=DiQTt z*}VbxQWLSv+yDgqh%rViP$FF(cKKP~BHfs^K2~(G@ddNo5SAfxST^WJ3s1OB(@aQ5 z2fW4>AHug}{JRr633V+MSZm?r%t%dOHv1AswzM83QrPuDkd+MHU@-!6PZxaP#I;=P z)J-M22HE)V7Km;G>T%e9kc716(At8ja`jP8f}{o9k{7MHScV2 zD^7Dq*i0ww(%Rm`+0P*DI^d zQkHfuO;3u$&Ui)O*Sxu;l=-5qET7t|F!iczG$hng&UQ?uf(XRnYmVi9al8x5tPA<- zA{n%V)wo>hEu|wtc!croY)_0Uww>MX*nYzW?&sxA$b3IJvAhIZMMM`c%&iP%1=pU9 z0<#H~<`kSWT$$!@q#Kq3#iXynb^?D{YZOY^0lu3fpY9hYEqehdib)jnBy1HXZG{d7 zEgsFogB_tfeT6O3wqqv3z{DL4U-?GzsyNZa>J-D7g#x+Du5|VX9M6Kc%jL+zUkcfC zw`R7i%vH$}RGgzudwU0&J*iZVk1s5ju2Hr!t|wdGTz+k818_wT3_?6mo!?l^JUA9E zSL1)8#hsY-MsZd*4)C-#u>45xodOhE7i$HHd!|aD1k#MkORggjf#YQMHMqySN!i^Evu*IUaC=ehD@u z$yZ<6{7{+H>XbFaqMErT;G2rGK#hU`QMgt_nY(6w=?X53gvQA6vw--SAaVup+Nkm^n3EZr{G8gaiZb>UZ=eZO7oV#G&&Z8lGDT-NxsVuv3S z1X*k6nMgR2 zu<=l*tg>A`*h*~b8l??ajLUT)gA3&HIuw%yY} zp2F3zJo1Ql9%{oUz5$KUJ8U1ET&}%lX9uP{)tzIQYGfk7Y6G9dy=1u8g{_L=aXUj+ zadt_z8Cyz`T0s&&yJrZbK4+B%*nx&xn3dQvhp%zr2ERB_Rjk!xD|jo)!Ue4LGYpEb zGhexb64yjCzuKzK6kjJHzspb86USEe3;7q$7~EJ1cetY=O`f7?m7QH-`bO0QH_=MY zi-`KNG($c2N6b2%(Z`QHr2qiuI2!JEkaNj$Z#(tRL09Je#|d3mJ@4pj7lZrS<+OVt}g}-$hzZ5 z)ae+VNKuKBSGboOzp;fK83N)vAf`;jPDEKy$Z1r}`B7yTy1c#}gq%o{Vd88w7CW@l zmWOoE&k^(Iw$GhAm+vn%3OUevE(xP#PisN_7}wEXvY8#ow%t)ccO7)*dnk=CJlIe{ z%XE~nlOjX-5zO-NMzAjUv?%Xa?I>gY;07Cm*VVm191BvJEo06Q5mO|$(BQ@t+E3D^ zB0i{DFSfo{tPP{a)qrkUY>CS^QcTTc{=LC0-xX^JT|pvPNNmh^ z`m+OU(%J)lvnf5P26*K_vtw`*(*vA8MhdgoVOq-4df^+u=Faj0vRA~>23CnqucW|3 z8t9#(k+y%ePeZrUS|GlfTn0(|K3&nhh@&C;-s2}KDK6$C^iNiq-w1XQ9RIcF7+90bX*DnX#9YR9@Q4%i^%e5|(m{n83eO8vEeoS5ioI zxeex}kbN?BqscJ$H#&h1o>iW?C1aG!gFiQY@_2T_tVHdov@ZR`_k(yxO0=e3&KF!J zqIR#sxz;=Kw1Dbn4ILzT66z9gg`VZSl@^PHz6*?x<@T&fw!5;KOoKi9XR^D*K1wFc z9V9#tOea~rGznGh#CR=oYdsLhvk#sw@QgeBG1QIYozy`%m-qm_%t7)qX<{rxqdM*@ z8s2Bo9rsGLU*f)?ESEnq66s-4&U`7ZKr5EisiMv9e4@UDloy-9P}u{oLzUBc$NE@8 z{DzZRd8{Mu>=S%0 zU+?@}%=pxNF8-|W1Rad7d6Rn@Y=)ktJ9=-ips`VF~M#o4*mYBtTIPr zmvXyrDsx>GtRt!EA--ph`|x2>)P+=i7T&v0MsO){Nu)2a z4Zit6+OtE_pq2>m){+Uj38rstTOO7A-SJh96Sm zb1IAuQeLU_CPSwU`S$0;c6_?#R!*1kY5Hpo-y%w<0!dkiE*U&yFG}z5=v}`=?59Bb zPb~!`7kT83u2H+)lDgt6toro0_k+{!vtrrYiWHtHd%E?N8N5+z{!mAHM0<5COhCeU>FQ@UzQS|oyWU>6oP5L} zET_0EVaUs(TiBmLQD+y`C`)qp;jx5+pR9PsDa#abCckzi@~t)vvGQ+x2$$3QbUf~U z=7+nCLb#6&q{?n;+-lNPe`QMAOB8YIDpz=EZvTrZwdD|nsvh!NoiICf^6Mj)!ad^{ z3A*xbq{Qcn_P3}g%2Q@UsipgSA3VmRTyU5ZulSmvE#G=g!{Jhqh%X&6-sJvA9;B?^ zy`RPQHQM$&qTI>f?&GyGYvtb5dy&D)SvM8M%xkMMGu}yt@nsH2Ox{tPKR{=ozT#a| zR_!vHZlgm>;1d_5m!i_erW|m8H1!j($?!4rRncQRLvfA=>3-UCH$Gnbtm9Zo)jzMkh9gxVmjxoL~r^xKW% zK4q2TTG9qZ?m6Rco2eVVg`ycpOCBG4FnWl?oS#16I>lkvfk%=zPUQ}jgwv)sob0AE zQ+R29#+cx-oRZZ2fFpgQa%W#C+_yQGM80w{;^IRqpT}>faSc-hW1iG9M0P{i-bvk$ zz4Yv(&ATEJzgi0F)~aPH>I^qXPL2L&mXa&NxX0L7^(fO%`UDiM={)NLPjfE@HG1J$m(q4lXf)jt<->m}d4XPB?aE434B)!*`bdqo#&}Db zVp^*3>l03u1uJ*+4YcM1dvI``dPmQpIzI}etnUt5FWL8HJ01o zl*cze&;azdS_m!9pA)4B{!X9Q|M}#5(T3R~d^w1#n4vCo`UdT>`y(f3;}Ux<{&M}0 zpW2rhcgXmXidtgfzOil4Fo0UkpGCdNWuu@(bVnU^ z*U)+>{E$7YFXs9DC6D_x*9Np26QYx;{4Z!uFTLo(=e$LDOFR*kX87do#2vU}~ zD^|2C8}F2Q{MhxPy1b!~;Zy80Ni>@Q&WGg=1eG!SM|_`R$)&sTol3TH)}}&Lcm?lD zQ@M@dbF%9#min*nD)D~99fR|I(yLa}3C?&+5vmuheWF)ODzVsTCijCFAo8RsEn{;} z4~ypLhX_8fJxP0{h*1Wg@y+}@s$OfWw{-;vK1Qhi_4V|(_)gm|&&ic87B}3V@d(VJ zQ*`38I4g}33PdJV@ZnI1tA2h~FE*}bXJI_p6QE^wtS0Or^G3Rv{>{_9&XT?Ms6=b) zz+DO63!k`pSQ$sQ+S?QpGSjw6cn4UaRKL~$%9k)v1{5!LDv^Z zdHIX+NR7_l@MQ>=kMdA&dys(p7jM3smug#iJVXI$uzmgNzR+82L{JaOm(03F%+OX?{HeWF+H9* z=G;>Dy>-Wyldnf2DD=k?Zthoy3HFe}@0}0{O(7k+pS2Lx+m3e2z5c@KmAa}*`%X4Qf;#tg9&DMmF>L zkqt5}&O{VBRU9n5tMc70!R#q#t*>ozUG2TPK)3giHa9LS3Q$!>>AvHIRLdnU73kG2 zu*EE%=`y+HmrCpXIOljavHfsCI?DXCm4KBSM<9_C-g0^C@KASz%&iZ@+M*kL9%?Hy z@bwv3?8^_CtkDL-HvPrwpQ!XFw0QeFb;YKJR1)%{`7_fV9YiUZ;d_1L_0qR0I`Vc>BSEo`w3TcuyAH03x31^2+pkyGDezwY3o3LF#GdgZl1`6F#Yj*#gBU8b`%na(ceSUQ0HqmyJ%i;!1xx-bZ;>*e{^9zeKtDm5HFh_^XPqp=0YO=Thez zOJ3{Zewg4SXRUenwEqCfbZ~3?TT#N)(|3nn=gK@bJa^XfU1vc+yz~;N8 zJUWkt%-{&a%9lLxhcqg=1zOPb)DLc7PCt#4`a~tsDEcD5K?tW^byH4uj5+(KF>&!$ z4r$Xza#e)~y)wgXy^g3Ii7a8e%La}=ViN5(4U#FtJFqOA0)MPOaHrt4ECK`{3N~*PX z&m%ag5@XkS88b9rRPbE#ctj8sz(8QC?oX=EDqzO)kksUkCz%(+<2PeBLx>)lSzMbL zcq`BsdY5HD@S9K3Q>&Xf{rrw2)t?MfhRUpw1 z^hRE0JaUt*kZZ7;NPMxl4UghQ#^LEh)QJA(bQ4!S;xnwD%6liTb5z|Bl)56^r*D0= z|D`yQcx`BotMWx68zy{%4sDaMlGdK$-pjrZ88r>a`NCJ763b98h$1FmUoWbEspnir zY!Q`R`SM`J%?mR{=$xzEZI1|IrovM_Kg^2jby!-4EgrmsejB}H1R*>}(mIeVKH1&QpzE?gXDo~#nbFU>DQ{59 z+DPZDR9VU$b&FidgIX8!WKo-?QBF2H%Xigt22m@B2D#`teTCaRLA%{4iMf-pl z34<2FY35N{dx`U$H-gkG3a{6w9M5W6zDimcwvne+rWf5<`@KViI!W##_mSl8i|<24 zN+Onzn;C|R=lHExpvkCMh9Vfka>t^sH%X)iXGam6dE$oOdogQkGkllE_Vdbec-|sB zib~?BIj_2ec>8ke>twH`G?@eDG}p6dpRk2iM3Vv^iD>56yNY89i)v(fVq{x7-3~dlw|%zQ5F-8~BlQ*+q{pec<7PFM(^1WC%yp z93?n$#O%(5pOK6c5VpBdLZ%YTapK-cyidwv-q>NOYkcH-C)CHo&yIUVJn^GzHYjnB z=~SH58HiO+13X}0XJjO-oZZaRYAS?CrY-TvbIcYGr$CL)C$<(OwKtgL6^{^|PYO8j zsLtBHsu_~1cV_O4+`Y()pNln4N!Wi59C_DAi{~0?OZoCmlj*m!^aQ!*bP6m)PMQ#1 zIvy#n{{CAf)BI4O%9R63w{Lcz?gzZTRid=(UTz#4Wa&GfGx#~gIIUI6-28K2?{l6Z zbY)2d}so@iuN_HD!H-*0>6>Z*Bg}umWYlrFTNwO9mY8La@9*E@IfjBZiaM8 z&5HYnO!&`>dt0Wp-zyW9hR~8g#V6wNF&ynh%1K(b)G-LB>`!9=@96_G;=0{Ve>>DlN8^z+tIeR0Bo^nMegfli~8`$R-%cLJV`Z!UQYArB?)HUEZakIW~Gj9xH)-E zBMOT8gXiqc!$!>7ppc44|3^fh20`VpRT+(d#vJ#ZM#!)xjfk?T}npsCKPi1 z+^vp&EA{$Ii>8}7-ODI_ajH?3F-qH*6mwckYeA;piK-PHJsXGml$6Uk(up_6Zkhbm z<9iuw$!63Nabd0FMeS1yoqN5uO@4I;kTNPGpG8B17nP2kR6)| z1vc*E{=M#{oKa=@eiz;lKDErf!`Zd@5`+Ste2(p?X_UI!>^*x z5uLuv9Rx+ z#kyPzbJp~)`r)E`f(qW28&k3Ga3&wA2Y58qx5`gdX)4&5-fYa^dwcHFqfc$;qBQ#m z@-4<|7s;gLG%?HmP#OKU62~00Ft16q=$V=r*?I<1hQ`P#Br1JuT32H%KRc2%#`?9^HhZ9lu(AV>gBW5 zaw81nTw{jGJPWKRuhfudoOkOVtxb?&(;1Wvmp%cZ(2RdCAEQYm-?N zi;HVqo>a?%XI4=&&!gbuQI`E|grniA>zuTr*;cMCb}7v^HxWMP8E^JoG)k+YE0xz^ zvOu@Kw{+;ZLOtjsZpw*bdCZW~Y>eW~fv^ozGgeIH%q@__c)VKE)W@UIadrsN&*~7o zu?bxki?_&{>3-Lt(Ng|F{E};r1#3ge8g6!i$=eCthmoShxraw|>%$kam@@k0C^WA; zJIr=F#Hp}}@R*R67l*QIG-ckm`RnBNnCe5_E`z8g+g8&+z3F+;Z1G6MU8ZENAYJIEneGvaSBYjBXC3~UIr!LB$Z_@fAiUJ(ST|!?(b3g`4wl82@9jLS8I53RybhTBd16I% zbmVI--C*-%v<}2wye}2143#zD?VOP|qAzW9Nf9#-`9AG=t@o;2k-&OykZg%$#5Rl{v6_`TV!`8eKxYx9-Tw~ZC5Si-KX6ehe8LVDWHFG6>Lb1*}BKDYzWQ^-z#?6yBG<5MPoy*iL=dX=uWqLmT2%%#e zB>+C5dgzhWnerpwEZ_RMX!3sSe>PGfE50&sbk6>U4SIa6+NxIc?gTDZwex0&w=U(p zO~{<$jOyvMCYmy@_Ro+H=jTq7_Rdd6+h}`tem&aD7NN+wk#!)qW03kq^*6LygF26e znUIj!h@q>%0o3XAhqV;PEnaw-zrER=MK-95x0K04jB`r2QC6kKkQ`P-*zpBF!t&hJ z?Cb^H@m6CK;NZ91a4A*ZLi&ISoPv`ApK^WlR%DE=%Zl_vnE`5(`^jfmtRj^91_39e zXQu9vHh&4Y(hi7jZV)9HXz{UraFJ0wdfJl8(&qh96`r|OXOsy#tFSh2^XW!Nj1rQv ztA(+PbfKUIDH60^^EIY@zLX34-KmPBd2JPE^>PMdhk(YJ5byM(s|p{_J1OPQYTMJ^ z>Npohgk$!J!Gt=&?SA^Lx#Ho%dV9*8fDXhfs}S6pbow3j-QGDabe($ZsBN*62=smz(K5H$oaC*WKEtFj3UhtA?+Skxb*kldh+IK0KZ^!e!djyWC+g)aPWMo)-oiqoFKQ zmOWR&%cGUQu%Yph&$*1W5z&5W{TZqMC_hS*F+PcnPzdMl5JR4;QjnU@b1&QA4mjm& z-h)f>u7N>qA@lg}^*l}v!{n2bVh>KVKOns6a*I?-9!M zL6bJ3kQ%{hGpjCl zWd6Xd9_@!r^9#dpS@Mx&3vVT24XOefzxt-o9V+9!JYrjo61&h&{@C*o znK3>^RWglfCI71ob@2oDJ-dQ^kB%r_C$w`vm0{i*PH|78p0L$-KKt1HD+C8MMdpcy zZkkP3PzP-i9J+9;yXRE(^l_d*E~F!F>s_bB0IK&*_N8Om!{+WOQ4;xY2Q=;92s->o7KpSR2}m&+c-Lk!~Rc>#~kZ;Mytm7)kS;yMuMkEf1;>q$zQg? z7GLJlBMug6bW`dD(mp%pFRa;j;U?Wdd+nDrpT3zF$NLN~n4H;EVqb6JMLTGQiOZ-rYrJ7g?pfu49adQvq&Ojdk6kO_~>mrbKqFPNhEFIAC= zWFOnW>2L_AxrEP`*Y5G8J-T;LgqlDIW&{~l+g5K&{{NkLPM;>MHdfGW{t1?!p8Gqc)d^I(`z*MOK1qj zj`@7mrqH__(AAH}xF~;vEttIu@tSRlC9v~~Ssvsh^HXU&%~rFyYXa%_&N90_HvN7X zh>hs`1=pnd%%z7dsP43qZ`XMT6>UcPWlo)fo=7rz)4=(}md5+?m+B^6%BmE?4?z?* zaiU_Ux!j5T&Ae_gol>?cY076RxN~jhbitVB#F3Ly>qir~nQVzY9P%Fcsb4NUz07sL z@R;KDhifu)*$?7-+SQarIje}03{G1=!xyfer1a58RG*X@R`L!`RQUKVuljRLV6}}r zE*Vanua_iUBS}@ARB-#P3v2>Sr;|dPa(!AZi*=e@zVx(cSkKsawQM$^WrQmuu4u#k zXuFJh5xx1?v+e-m6yB5oPld!LL|*toB4)os%9S~!V~IJI`dKa zypx?YsdcKu>y+WD&Woqs7Z0U*cUUtJmU^hvE*X5j{2)KE*GzYLFxvTv4MdOI2WS_9?dn0buXMTo(`hFP^If5C>Xbhjffo8rUKn$ zyYo{#pD?C=%#n(GLG$a9)(04S9dYt`TI7l^Hgh+0j|?3}EI81$lk0MdL;%q~K5Q=A z$~YTyPaURnpDg2(d>xCrB1mWa@fFn#g6}Gl1zd-PWa=JF-|AUJUsiMqutdWH@ul6;k+*s3UDO-327VhBqG%2aN&;FK6nYouE1G(>e=Th6YQY9wrP zZZfwHs1+3CL6N}SQAK)wJZ^Drp=UYPysxcQs+!{c5-KL_-apT23!Szq zc%EOMVkW4}9%ja(NS!x>`)ooh6wY(_Lj0%_dvTA9^3mK;C0a|G=$yh9Vow(fP6Gn< zp0gMk!52AEqX9kl9GLm_7vYABXwSB1p*B|xpwi?EAMH|3Hj^zFthg)RHo#4>zW3ND*chlg~H~3yuD3+OkM%TWQ(zU&R=3SikvSc;2`|MrqW6;#F*wuA6 zsGp~TfjdcO{776ZegyB~wunC;hC96;jSQ^C8*v-oa?&si3U4^H=-aYr(H?!@ z;jnO`i3BN;wb2)-_3!}?j|r3a=^mm4sVNkhv`tJJU6wQRw(BZiumVO-K*Ew(NI_^| z^Qi=lzzry@3_4(Np1x>v)MKTT5@0{~onXr>G*y{5N}TrvDsjW;`UQa-GonB+>~E&Y zh_4R$+8ja?FKV*Lm{I(wE&_NO6!UrDJpE?u#_h7(9Peu$ItA59Er>Cr`Z7LwbF#~= ze_pw>7C1|c`TS0NN-z<$-w&y{t|&wV{k$?i zAnO}4eUPH?lVBV&c<}rtL(#d-vNJG7!HrvyIu;c6671vrIT(3Nn}ev6=cdfsi|He& zLMWPfoSugwifCh(c(|hA1@a5f_~mhdHp9w7)$|s)?3&kfkZH=%)&sj{l9*;@ZO{S8_QozW=+w3K1+Pg*LgXAzR@0|VRPUpbb zc{StV6$|~{S>YbNZqwX3uus(COB@sTT!OwInGl}T9X72CU!Z#x6K8jRlXgRN!wJ=g zvWs0R=}Ex(x&n=f!4N}h*5M|KnA@ciE|N=E0x&%9tg`zA>H5V+-)tn)WR{OfAf5|e z5WJuzzI3>!r)%Vz#8MxRpIV^#+OjW)1gs5MFGwd0Dvk@4yBvcmlyR1|TziB$0t|D8 zVpz4_Fu|~@F-*aE*gi!!`K*#fDh`Tg{zyO^fdvV3Eq^Uu2eOyPzdeA*s086PBW_1f zy8N|JL~>-|1+u43u`Nr9-I#zTYfNfE)><5Wdx^95Ol_5Rvd||T47y1T2FP(4UGW%h zL(oc0HRJM%G-s&yS6G?sTHv(J8h(I>KEaE#ijEf558b{-TUFAjQRnC;V=Ql>@4S1p zas0c$u-@~U;yL~&sy?zlNQtK8m=KN$U5Y}Zvk4FVtZ3%@@VW)#8I4?CBZJG{AP1kK zF0A{1T?-pSZ5&fo#Ppw=K2*yQ&ts$&yTs@i4|!h{|G5yE2p8YHZomF)@HGTJa~91j zdAlrSKpt6ZmjH>~ydWUC_N021@?pt2-njWER%6ZCTJdAI2Yp~!l@QuZ##IJa;h7uP zLS_*;q*FZ%3JX%t5N>rC#mdW^kl>ByuCjJ#0-W{575L>h+o0~F=gw~QX`@`&ZRgo~ zaN04PI&!5CU2HKgAfhIg6iDjwrE{fsHbm9}HW&ekfv#a9qs&bCiQ=03h{k1Ov01gv1Dz{|dEM81T6%4D`ysX#yb|t*1!GPW7CM1`Va}wKu4R~zrg5>HWkW#a8(za8ITAUb zU5Brp&??Q?v$~O(8ATuD-_x~PpQvnCpdZ@i5%+|mQ*G5PmFq@Po^U1^wQX+7Rm+4E zt55S&3Nu7x7-rH;x;srk6!!pcCNwm#04tI^sDS+ArZh za_9@B!nj7SIP%SfWEXOS*rJBBN>#F^w0m-CZOxk3@>6W5c+%r3Yx60ec_-%iLT$b{Q9ui) zmWhyV7}t|Xs!69HUfe-{xbD>ZnkaF`A>_+UXXgqO*+yyF6!kiU0*XWiGnU#vhHxA= zh*YX_CMf!9dgbz?luK8hvk8A*9??xyS+mCHI-dO6y>LW`-Lu$6n89{UY=UF_BuPuA z&e-w-aXXw}HtY4-M5TzlcMgV=H&W!-!h+R_B4okf?SnAc0I~m*OOV-%V1=7Erfn9qW0mX za%a}Y@q=@{oT|S>9!C8bPHu;wqcH0H9SVeC8f2rI>j6b#k;cLzSDLFP_}d`I3ss=3#9 zr{epyhd>`*Y%nJ6d`Og-R@vch&a6_{VPV{+h4FLki=JUVjpk`^Otrxfq9BpaN7y|) zX`L0bL!|pM&k{M|bJ&bpJ?0nBepp2edw>!2fI8p2-BI$wY0$f9fzRB#X8riax7mzg z9Gye$?slcCM>3)*rRZ8?HQ4x|0&Hkao&3FbBv95B`;&?AFzBBXA> za#q#4P{n%J2%2(kGiZKO+5tmWf>A8NTrI)alwhPvFs3CK$`UC5AckrXb7&BL2#N4r zMpmyc52M%nDutR8$=6vrxmT&1s_zxKhc2IaqJv;)cT|nMd#xWHfGK6EJNM{a4u6DV z=W{00Mg)tUak4Z`-jW&dAu|3)zIYlqd9?$t-!YZEmwub*+|rv8P*6pDsE>W6A+zpk z@yOL_%G`OLnVJNA$mjXxvK0t_n7OWt9ebI0b7O^d&UFH%!4t0toRQ~Pm&;cQg+s1T zxtq`V74-h)n3|?a&N6Y|6XN<=c#N|5$rYzV1)CS{AkJkn*a#f8xj!+u;%pfoWX#uP z5b-&OyQbk~;P;$Fo0-Zewba>TUCcl+?Lgk_M+6(CIBoTs_n$vvh8rgv%k;**y5JjI z@ILGlixvm1ADU50a_dGLqv}o4@)n{LS6^nHwC|*eLT-Lxhny+xSeH69d(y50 zY42FTa6~?@BPU3Assg@AH3-eB{T%JR9_=)W$jGqphfRJS_7H^90K5M6y$SNEowoL+ zcP!?t9uqh?9C?ZKAalXH%3b>0r*rW((BA?4Oy(r|P|B%LPbz_z3 z+_~hT<}%~7Ic7JLN6RV!Yxoh0B#XLzU)i4}DHuO#Wd1%jn~_5n(sqqvH49(-yP`2e zvE->V+t>sBV|fbGeiQ5wvri{D@7RBQl*EnWb=4^~EiYSxZR12Si>_L>a!5D9v(y_A zA10a{X570h>O^O=1m<4_b`92vKGw)@@9|tm*A1u`7dku59w@=D^xx{z*<4BfxPsC< zMfl}YqtbPk^GD(jbmblBqW&w>mEntRvJKbh2Z^T#5U~hiov0}2A#<{_jVGCdju%^F zi58XbyGgPt`HEi5R-+F~u2gtV1=z6^T(WU|oF-*rY%R&26!{WyWTx#z0c~|{v7rgV zEK=SoVfY!WR2u4hc{z`a3?^E30QD{ztc&?M4PA9tbXoRFu(s6Y++e9cn8A7?FK4gB zEdY|A!`fb#Bgay|SE8*hM}npPd6juJ@+B~X^V-xz`GEH5zNBD~57|AET-jCLL^TH|R+eE^v zq;QiMom9s?6RE-+%HBGu_@zozPAPof6>P^7CR?OBV#9X;t3a)(gjZSNCS^LQdn7bo zhnu+Rq#kifAsbKFE8z)1CKEK0!%bp!Quj*4hnocJq>2K?CK5FENK^rksRWJmaFcAE z)V&gK!cBa2Qt6#i!T<{PNF)FdfP&O;lN6oQe@#3Z7>u1-!q+aeAAese+%-e>-U8WT z>+GG`$NxVCs&T=iIz#e6F5>3Bqn^AWTlX_0iO-LE8pq$fchOibLXrZTWCoHHTgfvd z49p%CCvmSbHN>98rE7bADU_4x4m}>O;%$!#rJuJ^G1yw;({+(-%iQkCS!o zVBew`p!@ZuXpm%(%b;NF4qI^e{hVpQ8RM7v925*tFu(;H)G&v3Mrue1J3|#vA(HCZaw@@DnK@X(f~>WI4H1F2*?JI4O=TAxKdyh0+0MV zg)O64kyGm1fK|2Th3uG7J%Rcfr?4OtE6tR;U}vsNy5SDMMxcJoDXbaA3IhOLxh|Q8 zt6I$qMKPn>fGiZN?v#2NP$R=|Rik+!KW5ZapuWo~YzF|;$TD2jX&Z zqF50?jctH>^FnUSsG&f8vr`xh#VRzV4(ZI@0FbLUw?R`d2+IK|H^y9$8y1O-q=|$@ z>P8|W*HboUlGX}glL$yEbniqqY;vEg2sXLTB%h1w79-z*(qc8Ip=bD?Py?B?HYkfKg-vb)U}ztpNLUcBKCJ1c~owi)pgZ9yYp#PE^ z%>WN)E!SP$MQ3jtu0<8R>`GF$r%K3mmjfgd_~y1fd?wX5x9 zOKuhT*)AcMNI)>QX55-7o$!|yvE=S|lWbpku|w-fVzRs+ zMZ!P4y{X=&lumvGRZ7am{STP)^SJ?rZqX_Brusj^nE+6_aT}<(#in@{fW!X(kVPd} z_H1{h9@Brs*@qXlI<#7%-NDsTG(dXqe*gJszjo>NQ*IFpNX0+zO`z+2D4{AN2pZ2Br zkH_cE$OI%l3m~2KAF^qlVMq41L_YQ($^do*gTwRJX?brM28ZXL#1I^w`*H{zo`0Bn zy^_Jz^KW#$pGyq5dj3(0z}0gT^ME_Ie^7vaTl~ST zp?$|0xHa@gqaNHE0=I^C=3&tG{KM1>o_p?pE)CkAf3zCFbI-r=+4!jeg0|-$r3kb= zLEAGKRBl1#7HbTG2P@#g$`5BoaPw@Q= z`z}u4x#yo0WAIa8;HSWLzgG!bxHL46ZMeW- zG>eNi5J+P)a@A4j17<^Lvl6tF3^!-5LYH5{*BcP7-;jdXY~*V3J{Qp3J{QpHK9}xl z@je$~wRoRPXtnt7E-2>v1_uUdKO$5GAC|xFzdRhb!dm8sd?P!TweK}fe0}Y3kYIV7 z?A*WpZ5Axgm7SX=zP^6=-~J9VIv|NlmX8mvA4a;mFAJ7C!@iWt&SA4%z8@D{J51y1 z4m2wc`vSDw%D6I4yqyhmbq5+Vgna>;?qOV+CU#jmF1UVpJ6jd@B~5m&gK=e&*adaG zZ0)eFt9zDU`F8dI>M_GDAcbH(gEbL2? z?A&L@l?h@XdrjKqd*sSE&wQ)pa2%pi9PS$gA*Mky2>v6$24X};g>fqKMMv$VKGik# z==7~59%I@I6tWPTX`92hoeN|U0Kl}J+(D~tKquu^jj5y;wh;aw1-*V2`nKB)SOMe` zAVZ*N{2UwDkp&JQ?4$#VMh-YtZY?0-cmT(PzHJVmE`Z|!91oyY`BPm0#{)PX!0`Z% zhb>zjyFh~W1Gwt|+S5NL1aLfnJ8k6A%;Kx?MT;~dD4 zRpRsNE~JPmGzY;@gx@PtJX&uNu8nw)G285OF%#rL@Cb1W z@xZy^Jj;scK3SBdPzM~XgaP8E?~wq)w(oNRvD^2#_KOe?gpQ}#FG4&J?|r`r@j&SK z{UXEzq2u?95D$co|Jw-h0N{T^Xn30pI+h09+=}$K!K4p7)$b*c78rSks;C)n-Hbfh zH136xE-_+@h^cf-v!v%$Nd9u0Zow_q8KU2TM*vNjYXEJi{J7Z}d1`0PJ;%1ajfp$s zZ5uAjj~jnpMW(7l?Jp!m?qJ7~VC+eyaj%P|L?56{rTY`M*uPMLpYe8zR41n*{Su4W zcCo}?2mna&R_R9Jasc%sNV&I*eg1_2fD~btX(!Kcpnd}`CAL_>4(=UBbjOm~l~zar z^&fZ!V2kyEY}n!!$Ocdvz(E1d4WTOF6p39jK{kMF*w&r4Gzd@{KxqJ_0aT_zn*ubg zKnoKzw0Czs!2Jg74iLx&kPSb#0zqj2r2&)%aAz93j}Ni|WCM6y1D;xehj%+CssDeR zVQz9@M&al#%x0DYN%L^&3X`CJ)_rs|oMmF86~l_wbYc|<9}E`^6AUj4D+}+;y}tj| zm3#f~uaYdoJ-jCdyK;8`*)gMgcu%M`FKhz<2aP?vCu{`jw*k6S>Sh1#J&}cC-2r47 zuKv6CL|Ip^%Qhf4X4FuizS$`ZhGG?(QvcPh!eBF@tjreEvr)L(?P5`82{D6MK+GYQ zfSW=gY!U%Ug|4S;&g_|}fu!zpVZ2M>;(-PO6(~LtA64s~kmB6Os1fU0;ZGM)p{{q+ zL>_c_uignN^9mn1?M#23(Dw{dFRBKTw$Ig!R)MW&2rg^7&K9oqTcU~(lQ!^s?89M+V7svwA5TMi^2?PK^7Os^dCYK>;dnIxa zlg*Gcq4kW->B6-=5^w+lP*#kXL_*U3H37I^^dgo_p?z6sb2ymzuX&ISp9w;nL#Hj* z^`Lz;>wTNuh^3m%0-^s6?k)e6j18B*jNs*Fvw%D?4Lb2o3DbD4oIEjh4LT`Ped7Su zjNn)<>sAW&o%G3!VE@ifZ4|}uf--*E%KchiMzSUuE z6sv2*MZ0J|#r_cqRybTV=;(fS4$po)kHzNrnZgm%fE6+8ZCp}2ocWEIZRu&DC^Fg- zzs^rxuut^6Xz>4t1k3-gpDE64iP(1M6k+A~@5K_p4#?uVVZn|#Z^;|b43;y$6N7ET ztMilS*4W4sE87%d-$i4MrFLH=*j8bkpSDD7yK_EC?+miPuQ!+{HYk+4E6!Vw)V9N! z--y9V@s*u{8_%_XVzjQ^MI-!2Bv}5h=81{@>>P`qGr->vw~)xSu=x_8XlK-54y?-^m6S%;= zG;l8s+)D%Z(!k?^A3M;X;YkM`4`6r2xA(LE{b+1=83heb(C`EePtfoL4NuVU{Bax& z8lIrx2|96Xd4v3oE5f!`1v+s6emtNP2k4gu`lW$>X`o*k=$H0Gg$7-1clTFzy_)w_ zBtTbN(A5@nwFO;m!M6u?9n>YZT*tw;2SCH~4;%muPw<5(@P#Pwg(&caDDZ_S@EuR^ z9nY=Th{1O}u`l3)?|A-rm3+@lm)%V89Z&GJb?~)y@U?aDwRP}I96!D(0Dg(%PY$Et zmpH&LaV&hpj9}0kmeg5}E)64N*CCA~S&kb5L956Z*mvlv5XKktatyQJGP)W()_fg0 zx~duj9b1)+Sw!lr+GlMPt8NakU}i(1%XM()QAFv&PIk~n@je%9)m~^33HgRVH^A3l zLYJ>%W(_w7nm3Af0HX+W9ef>V6lfYi0HD!bwTCYtA=>~T7svwAn?R|(5{t;qCipr( zW)=w)+atkLxBcr;p=-PfI5xvbso$t0x0&ciT*^PCSpkRBc_ZdI{gPk=GV5q_58$zB^Ha^ zRftc0Y!?!p{!3epxxdm4)WAN-8st$<(=G%{_ikIS41c8?U4F?)Ou?z-!5c_2it9##_TZpSEk8yF2}vF-G%(tR_898!43dB04qu0 z2mq%ba0j%lo2 zvy|zC+T?6TzCaxqP&s1qCEe9 zJ7W}sfG7(JZgvG>=Aj!%BxVM>VTr)NFi2>X@^!!F;j|Uy4faivG4FNgAZ8q+wPrb? z;l%37?#hPNSS$T*Xk1#KKRBv^w9c?E>MYip(#}M&cR7Wd?qn~hA@{qA21jj5fsiEO z%_w%*l(t}3u}h}?supr#8vrzvg<{v8(k|;PcFC|`)j%!)$bh!D0r1Y^4Im3h1Euy# zIG5HV0Z3Qzh7NLJj|3EGKpnYYSXvK5vG0|zFRe!a5TF5V1oIxG@n zt`iy5*xZ=as2d6A!I%L-J1pTHP#}CqpCt+bNy98@q6-m|aI^{r2o+UptH+4}@70YG5f5-{)y`u~TxCI72}t_Up`qHUmk|1&>}V}0x< z{X)6Pv?e|jbn?ROgj|yHdh+c|q5%q9H@S8-5+EmT>qbYyMYfZz(0bQ{|RrIMDgTD#DR*mCQn5IEP==UDQ;Mq``gs?SkpRtI zgv-k+?cICJ_s=c_s{9mPY;R&aCGrOs{*nB8CC_gUFR?e(g}~$fp+L&j7-8XO>^&?{B&gpd2@w5r#@K(T zt?Z5y0CTn6k0G|txZG(E5TLLfksm>ql5+i&zrX21px)0}4J+}4TmX*}{}bLO02nv6 z`y@Ddo(&NGpMzq5ad6okCtI_^KOEE8>Cr3sp%hjK0EC-^TeI)(tod^k{?>&69X|&y zR^qp2_+O^4Kl2utR0+8t7q-SWAb~4nfC&Da&-Wi{g1d9c)~xVji0wBnciIzfe@DNA z&;e>G8t_y8evZQ5y71S9X=}pV8YscPPGA3Maq*$pSy3*SxcCE)yECutKR5v>&CXnc zovMG#l7FnWB|!b#OV|aI5_sXS^7nHT{?>&F$)|qIy*mpp&?*0~y{mz3>bk;OTeY3G zP-z|O8X%UIL8q+HwW~=}(OCOw+`^*HG^5K>pc*hLx5aH*6x#eeAtb6nlPIHsk+fJ4 zSPdbKNTddu;0NlUBq4YNl8o{5ASAd=AjUC{9CDC(n`P5|~Ts~F8UeSPX`AkK@RT+`Ed``7U(fZU=baMC(&_a-j28N7Y5=ZDQ|(N61TeJVS3NjA=K?^D-!z`akcolLYobr}ec4k-s+lTX@( z(V-;Uo^(?b_dazQ2=_j5?^8UXhSsOP@qj09HMUpK`qXD2v_8@L6uAUX-cCIxBKgy) zw;fO3;>lZJ5j;Ai>GP#WxAEeNa?L_HJdH<(^b`{H#WOrQq@mlwEW?W{x@XVu;)-%h zF;jgh_I~-kE8hFmxg&)4KDBmM_Brt0r#=JWy-($qqH=gT?$RJypJ;tjeFrbDXkG(G z>l3X{;s0~&If>3&bl#%#HqJ+z^jI`HZ_#;+&RcDdlBj>7^H$S&%d-n8K!4-e&DeZ_UFbC2S3PpIYImqYn;`499=ldz-6dGEU zzGJqLeDbQ&o4F!$Wj^Ur!#n4HG{^XJbLF$sph(5E@*L~yDc8TRVROUDqN;TA$uw6o zYUj5#pcStSyr8$1|{G}5v)(O ze&CX84)1mV0a|j(a@|heds1K?g9IJz#O@SwQWm}Dc&n4LFEFn+baegsztfS2&i7g} z-#P!=X;7qM3BkXlT0b!1Q`U}QiH9fM@a@o7)1O2q-VQy@6g=uctS(pv}L0-Dvxz{*oh2p5h{I_%mns8|6DL$`J!4 zN18pwE4g8(v%9=}M>w<~;9oulIcUWA5ofnM1V4@hzl;Pwi!_y32{BFZyGYLNfe`#u z(p2K8vpW!4z(Gv2XFLI68f}jp^o+MUyIr9LiHLS*w zZJ}1S&n`z@j4f-6HmwU6U7l$B{FZI~MQ-FXw(kw5QHU6Wh(O!t9@~138*#FI+(26*qB+{+gew2Rjl9M*CL*qIBc)8E2a-Vn2?%Iu1rz|S zhkhg?E^{L#Od|)$pnwDf3w?)R5A+=pw6lGXG&W}QLnes2#Z6p{y}{z^KLtS;(DiT= z{|~PmtD|OsEvzia>^oJHzCZ6k&A#*_j=b&G)%(dGN8SPwQb_(he4u742|iHcdZhSy zF-J~8<`QFz-XDW?^QM6L=`{@twud(h;&w*^G@^!i}z9;?NXgxG&Y2|F13+kj;#I=Ir zv|E60Z+fuo2RqJ-Iewv2J_T@mcU~SeXn$T6WGjAA6QZS+9ge&e{2!n}1({}=YrBYr zx)pJQxIZt~erm3mW9Zj9<5cMZ2auJJm6A+uWThm)#7RPwN^x)~ z;#&O;SqWK5TxM~BLtP1VrDWPAs@=Ml$r2-~-Dtr{cBI;NLJJO^0SN^wIs?!dkX!*r z3l1%~M9x8UQ4)u;;I36KvuMGg1&0<~LPZ0N7qsBeg2O#HVS5bs;BXI4y$ukjXQJ92 z2S;L@aN{Jo-KHRhtc0wD798aPJY<6Bm69spxN(9TC%ADU@Bkit!&8(=wI)=%QSHX_ zN&*ky*={`Bo%F&0db^V<+e!qg-Kch>+Kp;AUS86blRJ#@J zI_Wo5yLGsTT6M@uNf}6qKvqIlLJJNpxc_MjZjz01)h3^Jp~2(xzMWgq^Q9*^`BQ_B z4@8#mqkQB+zQ)Cj2e-QdWwF!l=Carsx4kUZ?YCN4>RO9L4q8d*<8_s3| zw%8aKxy%OJ8D9y1!xMuH5OL*hKFq|{MawoYa_x7r8WzRI3FXS@9gcl8DK zxV>VNDS9sxN{ii@75Q3<=(oK&ntj+m>ryCfUG(0zicLlA@h0x75FD6wDV#PIy*E&? zsgyl_l)HMx_NFKMFb&QPr)fOSP@2{gPID%IDne;mPdKe2`4gL%6}go?dC_*ejk{`N zk8>59Sm<;(4I=Jjd;7V+7BLUnqWK;E)QOKiUDHx`&@ivD)7moQSIf5btu_`u0B?Wv z0({FC0_dy!3nhT0kW>24uKw6X3#dCdZ*(IRB)sdS!285V@(zVwZ8@`+W`-#=j9wm!FBD6#IK(*M__ zKvi|~Mn@YupSDX-tNL%00+s3jGK8D(9>R^>jlx8hS(5BRVInUP(o%u4TV9c+l^K^x zI$zW)GioNHx`LXCEL2euoFYt7@17z|(af15Owr7t$_HANXvA+rBVP1uC{7IYnTVb> z*@-d9KVHa(d2j*SeBNAx$$fpGEV7Guh)Z&v_6|PyNG#LN5BcWXJ;BIM*UDhzW0xry zsduTIzlnUplJhr_PdL1j)p}~#u*UN-8`gNXv0;q|Ji8iCQg3iJQ&O>u_mx~XZ84o_ zI{c9R#7o}gk?*q4Ci4Qz?%{uN0LS}4GTq)B0Lb= zRdz?{#?0!)S1s?B6Dn8i3F&(9wh&#LO==0=q)mmUZ78^rxB*^A$2E)Gfbq?=l_Cw$ zY$!M*p(=D*LW!n)LIQX$>!Dp37NH`jsi1+_+Td3bY_-Q4#zTaXP$r`$50DyVXqs0U z*7ybtS^zt_0mEq&IFSZuypE3~RE6=9P@*Z2B2Xe)^}DO@r~wT zKcOU)3IE6gq((V@SmPT2eccQUD2_1Yuq_e|&8Tl*45DE>gO}wn=$$L&11> z4A6+15ef$nM9RCHYLw$dj3|Os!vrYHB8PIAOan9- zYPMCQq~=8w= new_date ~ (new_monthly_income - new_monthly_expenses)), -Points1 = rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500), -Savings1 = cumsum(Scenario1), -Savings1.5 = cumsum(Points1)) +# class(times$Date) +# which(is.na(mdy(times$Date))) +# times$Date[510] +# times$Date <- as_date(times$Date) +#min(times$Date) +#min(as.Date(times$Date)) +#sort(times$Date)[[1]] +#times$Date[[length(times$Date)]] +# Check function of work week start date first (examine parsing) +work_week_startdate <- seq((sort(times$Date)[[1]]), +times$Date[[length(times$Date)]], by = "7 days") +times$Start <- hms::as_hms(lubridate::parse_date_time(times$Start, "%I:%M %p")) +times$End <- hms::as_hms(lubridate::parse_date_time(times$End, "%I:%M %p")) +times$project_duration <- (times$End - times$Start) +work_duration_day <- 8 * 60 * 60 # h * m * s = s +work_duration_week <- work_duration_day * 5 # 5 days per work week (excluding holidays) +# data.frame(Date = seq(as_date(min(times$Date)), as_date(max(times$Date)), by="day")) +# seq(as_date(min(times$Date)), as_date(max(times$Date)), by = "day") +####################################################################### +# What to do about missing days or days when no project time is entered? +# Need an estimator or simulation with the expected normal work days +# From the start date when data was first entered (3/21) create a sequence of dates every 7 days +# work_week_startdate <- seq( +# as_date(min(times$Date)), as_date(max(times$Date)), by = "7 days" +# ) +# Create a df with the first work week +df_all <- data.frame(Date = seq(work_week_startdate[[1]], +work_week_startdate[[1]] + 4, by = "day")) +# add 5 days for every work week startdate based on start of data collection +# with times which occurred on a Monday +for (i in 2:length(work_week_startdate)){ +df <- data.frame(Date = seq(work_week_startdate[[i]], +work_week_startdate[[i]] + 4, by = "day")) +df_all <- rbind(df_all, df) +} +df_all <- df_all %>% +mutate(time_day = as.integer(work_duration_day)) +# Nth.delete<-function(dataframe, n)dataframe[-(seq(n,to=nrow(dataframe),by=n)),] +setDT(times) +# Nth.delete<-function(dataframe, n)dataframe[-(seq(n,to=nrow(dataframe),by=n)),] +setDT(times) +setDT(df_all) +df_all <- df_all %>% +mutate(time_day = as.integer(work_duration_day)) +# Nth.delete<-function(dataframe, n)dataframe[-(seq(n,to=nrow(dataframe),by=n)),] +setDT(times) +setDT(df_all) +df <- times[df_all, on = "Date"] # Merge to DF +df$project_duration[which(is.na(df$project_duration))] <- 0 # NA is equivalent to zero s +df.stats <- df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +non_prj_time = as.numeric(work_duration_day - prj_time), +tot_time = (prj_time + non_prj_time)) %>% +summarise(avg = mean(prj_time/3600), +med = median(prj_time/3600)) +# How much time have I had leftover each day? df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -ggplot(., aes(Date, Total_Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +# non_prj_time = as.numeric(work_duration_day - prj_time), +# tot_time = (prj_time + non_prj_time), # = work_duration_day +# project_time = work_duration_day - non_prj_time +) %>% # prj_time and project_time should overlay exactly on plot +filter(prj_time >= 0) %>% +gather(key, value, -day) %>% +ggplot(aes(day, (value/3600))) + +geom_col(position = "stack", fill = "light blue", col = "black", alpha = 0.75) + +geom_hline(yintercept = df.stats$med, lty = "dashed") + +geom_hline(yintercept = 8, lty = "solid") + +labs(x = "Day", y = "Hours", title = "Title", subtitle = "subtitle") + +theme_classic() + theme(plot.title = element_text(hjust = 0.5), +plot.subtitle = element_text(hjust = 0.5)) +# Locate overtime locations (where prj_time > work_duration_day) df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -filter(Date >= as.Date("2022-09-01")) %>% View() -library(shiny); runApp('app5.R') -# Packages -library(shinydashboard) -library(shiny) -# library(remotes) -# remotes::install_github("rstudio/shinyuieditor") -library(gridlayout) -library(tidyverse) +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(project_duration), +non_prj_time = work_duration_day - prj_time) %>% +filter(non_prj_time < 0) %>% View() +View(df) +# list.of.packages <- c("ggplot2", "dplyr", "lubridate", "data.table") +# new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] +# if(length(new.packages)) install.packages(new.packages) +# alternative? +# if (!require(devtools)) install.packages("devtools") +# devtools::install_github("yanlinlin82/ggvenn") +# link <- paste0("https://docs.google.com/spreadsheets/", +# "d/e/2PACX-1vRbI6ljkD0T2Mbf0_o0oTczrPm6d7fSQTiVNM", +# "-u2MPe56tQ-Ex92rUQbzaT3OPvJQ/pub?output=xlsx") +glink <- paste0("https://docs.google.com/spreadsheets/", +"d/e/2PACX-1vQrgIzP3_8Fbn7I7kiwKuH8aYPzIRYDXqMj", +"AIJo9ejpN902Yzv5Gqetbq3QX5DqjOddVT3caxxftuii/pub?", +"gid=343744476&single=true&output=csv") +times <- read.delim(glink, header = T, sep = ",") +times$Date <- mdy(times$Date) # Does not work if a single failure occurs +df_all <- df_all %>% +mutate(time_day = as.integer(work_duration_day)) +View(times) +# Nth.delete<-function(dataframe, n)dataframe[-(seq(n,to=nrow(dataframe),by=n)),] +setDT(times) +setDT(df_all) +df <- times[df_all, on = "Date"] # Merge to DF +df$project_duration[which(is.na(df$project_duration))] <- 0 # NA is equivalent to zero s +df.stats <- df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +non_prj_time = as.numeric(work_duration_day - prj_time), +tot_time = (prj_time + non_prj_time)) %>% +summarise(avg = mean(prj_time/3600), +med = median(prj_time/3600)) +# How much time have I had leftover each day? +df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +# non_prj_time = as.numeric(work_duration_day - prj_time), +# tot_time = (prj_time + non_prj_time), # = work_duration_day +# project_time = work_duration_day - non_prj_time +) %>% # prj_time and project_time should overlay exactly on plot +filter(prj_time >= 0) %>% +gather(key, value, -day) %>% +ggplot(aes(day, (value/3600))) + +geom_col(position = "stack", fill = "light blue", col = "black", alpha = 0.75) + +geom_hline(yintercept = df.stats$med, lty = "dashed") + +geom_hline(yintercept = 8, lty = "solid") + +labs(x = "Day", y = "Hours", title = "Title", subtitle = "subtitle") + +theme_classic() + theme(plot.title = element_text(hjust = 0.5), +plot.subtitle = element_text(hjust = 0.5)) +# list.of.packages <- c("ggplot2", "dplyr", "lubridate", "data.table") +# new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])] +# if(length(new.packages)) install.packages(new.packages) +# alternative? +# if (!require(devtools)) install.packages("devtools") +# devtools::install_github("yanlinlin82/ggvenn") +# link <- paste0("https://docs.google.com/spreadsheets/", +# "d/e/2PACX-1vRbI6ljkD0T2Mbf0_o0oTczrPm6d7fSQTiVNM", +# "-u2MPe56tQ-Ex92rUQbzaT3OPvJQ/pub?output=xlsx") +glink <- paste0("https://docs.google.com/spreadsheets/", +"d/e/2PACX-1vQrgIzP3_8Fbn7I7kiwKuH8aYPzIRYDXqMj", +"AIJo9ejpN902Yzv5Gqetbq3QX5DqjOddVT3caxxftuii/pub?", +"gid=343744476&single=true&output=csv") +times <- read.delim(glink, header = T, sep = ",") +require(data.table) library(lubridate) -library(scales) -library(flexdashboard) -library(shinythemes) -source("helper.R") -# --------- # -# Define UI # -# --------- # -header <- shinydashboard::dashboardHeader(title = "Home Savings") -sidebar <- shinydashboard::dashboardSidebar( -sidebarMenu( -menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), -menuItem("Widgets", tabName = "widgets", icon = icon("th")) -) -) -body <- shinydashboard::dashboardBody( -tabItems( -tabItem( -tabName = "dashboard", -fluidRow( -box( -valueBoxOutput(outputId = "homePrice", width = 3), -valueBoxOutput(outputId = "downPayment", width = 3), -valueBoxOutput(outputId = "mortgageAmount", width = 3), -valueBoxOutput(outputId = "monthlyPayment", width = 3), -width = 12 -) -), -fluidRow( -box( -title = "controls", -numericInput( -inputId = "init_savings", -label = "Current Savings", -value = 1000L -), -numericInput( -inputId = "monthly_income", -label = "Monthly Income (net)", -value = 4290L -), -numericInput( -inputId = "expenses", -label = "Monthly Expenses", -value = 3241L -), -dateRangeInput( -inputId = "dates", -label = "Date Range", -format = "mm-dd-yyyy", -start = "2022-01-01", -end = "2028-01-01" -), -numericInput( -inputId = "yearly_income", -label = "Yearly Income (gross)", -value = 60000L -), -sliderInput( -inputId = "percent", -label = "Down Payment %", -min = 0L, -max = 100L, -value = 20L, -width = "100%" -), -numericInput( -inputId = "term", -label = "Loan Term (years)", -value = 30L -), -numericInput( -inputId = "rate", -label = "Interest Rate (%)", -value = 4L -), -width = 3), -box(plotOutput(outputId = "linePlot", -height = 650), width = 9), -) -), -tabItem( -tabName = "widgets", -h2("Tab for Widgets") -) -) +require(dplyr) +require(ggplot2) +require(tidyr) +require(stringr) +library(ggvenn) +require(ggVennDiagram) +times$Date <- mdy(times$Date) # Does not work if a single failure occurs +# as.Date(times$Date) +# class(times$Date) +# which(is.na(mdy(times$Date))) +# times$Date[510] +# times$Date <- as_date(times$Date) +#min(times$Date) +#min(as.Date(times$Date)) +#sort(times$Date)[[1]] +#times$Date[[length(times$Date)]] +# Check function of work week start date first (examine parsing) +work_week_startdate <- seq((sort(times$Date)[[1]]), +times$Date[[length(times$Date)]], by = "7 days") +times$Start <- hms::as_hms(lubridate::parse_date_time(times$Start, "%I:%M %p")) +times$End <- hms::as_hms(lubridate::parse_date_time(times$End, "%I:%M %p")) +times$project_duration <- (times$End - times$Start) +work_duration_day <- 8 * 60 * 60 # h * m * s = s +work_duration_week <- work_duration_day * 5 # 5 days per work week (excluding holidays) +# data.frame(Date = seq(as_date(min(times$Date)), as_date(max(times$Date)), by="day")) +# seq(as_date(min(times$Date)), as_date(max(times$Date)), by = "day") +####################################################################### +# What to do about missing days or days when no project time is entered? +# Need an estimator or simulation with the expected normal work days +# From the start date when data was first entered (3/21) create a sequence of dates every 7 days +# work_week_startdate <- seq( +# as_date(min(times$Date)), as_date(max(times$Date)), by = "7 days" +# ) +# Create a df with the first work week +df_all <- data.frame(Date = seq(work_week_startdate[[1]], +work_week_startdate[[1]] + 4, by = "day")) +# add 5 days for every work week startdate based on start of data collection +# with times which occurred on a Monday +for (i in 2:length(work_week_startdate)){ +df <- data.frame(Date = seq(work_week_startdate[[i]], +work_week_startdate[[i]] + 4, by = "day")) +df_all <- rbind(df_all, df) +} +df_all <- df_all %>% +mutate(time_day = as.integer(work_duration_day)) +# Nth.delete<-function(dataframe, n)dataframe[-(seq(n,to=nrow(dataframe),by=n)),] +setDT(times) +setDT(df_all) +df <- times[df_all, on = "Date"] # Merge to DF +df$project_duration[which(is.na(df$project_duration))] <- 0 # NA is equivalent to zero s +df.stats <- df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +non_prj_time = as.numeric(work_duration_day - prj_time), +tot_time = (prj_time + non_prj_time)) %>% +summarise(avg = mean(prj_time/3600), +med = median(prj_time/3600)) +# How much time have I had leftover each day? +df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +# non_prj_time = as.numeric(work_duration_day - prj_time), +# tot_time = (prj_time + non_prj_time), # = work_duration_day +# project_time = work_duration_day - non_prj_time +) %>% # prj_time and project_time should overlay exactly on plot +filter(prj_time >= 0) %>% +gather(key, value, -day) %>% +ggplot(aes(day, (value/3600))) + +geom_col(position = "stack", fill = "light blue", col = "black", alpha = 0.75) + +geom_hline(yintercept = df.stats$med, lty = "dashed") + +geom_hline(yintercept = 8, lty = "solid") + +labs(x = "Day", y = "Hours", title = "Title", subtitle = "subtitle") + +theme_classic() + theme(plot.title = element_text(hjust = 0.5), +plot.subtitle = element_text(hjust = 0.5)) +# How much time have I had leftover each day? +df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(as.numeric(project_duration)), +# non_prj_time = as.numeric(work_duration_day - prj_time), +# tot_time = (prj_time + non_prj_time), # = work_duration_day +# project_time = work_duration_day - non_prj_time +) %>% # prj_time and project_time should overlay exactly on plot +filter(prj_time >= 0) %>% +gather(key, value, -day) %>% +ggplot(aes(day, (value/3600))) + +geom_col(position = "stack", fill = "light blue", col = "black", alpha = 0.75) + +geom_hline(yintercept = df.stats$med, lty = "dashed") + +geom_hline(yintercept = 8, lty = "solid") + +labs(x = "Day", y = "Hours", title = "Title", subtitle = "subtitle") + +theme_classic() + theme(plot.title = element_text(hjust = 0.5), +plot.subtitle = element_text(hjust = 0.5)) +# Locate overtime locations (where prj_time > work_duration_day) +df %>% +group_by(day = floor_date(Date, "day")) %>% +summarise(prj_time = sum(project_duration), +non_prj_time = work_duration_day - prj_time) %>% +filter(non_prj_time < 0) %>% View() +# What classifications do I spend most of my time on? +factors <- df %>% +dplyr::select(Primary_Venn_Class, Venn_Class_Heirarchy, +DataScience_Anaconda_Survey_TimeSpentOn_Area, +Job_Category) +factors <- data.frame(lapply(factors, as.factor)) +# Compare this to updated Primary_Venn_Class using Venn_Class_Heirarchy +factors %>% +transmute(Primary_Venn_Class = toupper(Primary_Venn_Class), +Venn_Class_Heirarchy = toupper(Venn_Class_Heirarchy), +DataScience_Anaconda_Survey_TimeSpentOn_Area = toupper(DataScience_Anaconda_Survey_TimeSpentOn_Area), +Job_Category = toupper(Job_Category)) %>% +na.omit() %>% +ggplot(aes(Primary_Venn_Class)) + geom_bar(aes(fill = Primary_Venn_Class)) +factors <- factors %>% +transmute(Primary_Venn_Class = toupper(Primary_Venn_Class), +Venn_Class_Heirarchy = toupper(Venn_Class_Heirarchy), +DataScience_Anaconda_Survey_TimeSpentOn_Area = toupper(DataScience_Anaconda_Survey_TimeSpentOn_Area), +Job_Category = toupper(Job_Category)) %>% na.omit() +# How much of each Secondary_Venn_Class accounts for each Primary_Venn_Class? +factors %>% +group_by(Primary_Venn_Class) %>% +summarise(CS = sum(str_count(Venn_Class_Heirarchy, "CS")), +BK = sum(str_count(Venn_Class_Heirarchy, "BK")), +MT = sum(str_count(Venn_Class_Heirarchy, "MT")), +) %>% +gather(key, value, -Primary_Venn_Class) %>% +ggplot(aes(key, value, col = Primary_Venn_Class)) + +geom_point(alpha = 0.95) + +geom_col(aes(fill = Primary_Venn_Class)) + theme_minimal() +# Based on Common Data Science Groupings +# What areas do I spend the most and least time? +factors %>% +group_by(DataScience_Anaconda_Survey_TimeSpentOn_Area) %>% +summarise(Freq = table(DataScience_Anaconda_Survey_TimeSpentOn_Area)) %>% +ggplot(aes(DataScience_Anaconda_Survey_TimeSpentOn_Area, Freq, +fill = DataScience_Anaconda_Survey_TimeSpentOn_Area)) + +geom_col() + coord_flip() +# Which Primary_Venn_Class are the most diverse and how do their proportions compare? +factors %>% +group_by(Primary_Venn_Class) %>% +summarise(CS = sum(str_count(Venn_Class_Heirarchy, "CS")), +BK = sum(str_count(Venn_Class_Heirarchy, "BK")), +MT = sum(str_count(Venn_Class_Heirarchy, "MT")), +CSMT = sum(str_count(Venn_Class_Heirarchy, "CSMT"), +str_count(Venn_Class_Heirarchy, "MTCS")), +BKMT = sum(str_count(Venn_Class_Heirarchy, "BKMT"), +str_count(Venn_Class_Heirarchy, "MTBK")), +CSBK = sum(str_count(Venn_Class_Heirarchy, "BKCS"), +str_count(Venn_Class_Heirarchy, "CSBK")), +DS = sum(str_count(str_length(Venn_Class_Heirarchy), "6")) +) %>% +gather(key, value, -Primary_Venn_Class) %>% +ggplot(aes(Primary_Venn_Class, value, fill = key)) + geom_col(col = "black") +# Summarize the matrix of factors and find ratios between the classes +factors_matrixsummary <- factors %>% +group_by(Primary_Venn_Class) %>% +summarise(CS = sum(str_count(Venn_Class_Heirarchy, "CS")), +BK = sum(str_count(Venn_Class_Heirarchy, "BK")), +MT = sum(str_count(Venn_Class_Heirarchy, "MT")), +CSMT = sum(str_count(Venn_Class_Heirarchy, "CSMT"), +str_count(Venn_Class_Heirarchy, "MTCS")), +BKMT = sum(str_count(Venn_Class_Heirarchy, "BKMT"), +str_count(Venn_Class_Heirarchy, "MTBK")), +CSBK = sum(str_count(Venn_Class_Heirarchy, "BKCS"), +str_count(Venn_Class_Heirarchy, "CSBK")), +DS = sum(str_count(str_length(Venn_Class_Heirarchy), "6")) +) %>% rowwise() %>% +mutate(total = sum(CS, BK, MT, CSMT, BKMT, CSBK, DS)) +# Compare total here to count of geom_bar() in raw primary_venn_class +factors_matrixsummary %>% +ggplot(aes(Primary_Venn_Class, total, fill = Primary_Venn_Class)) + geom_col() +# Determine the ratios between the factors that can be used for simulation +factors_matrixsummary %>% +gather(key, value, -Primary_Venn_Class) %>% +filter(key != "total", key != "BK") %>% +mutate(total = sum(value), +Ratio = value/ total) %>% View() +# How much of each primary class in percent of total class values? +factors_matrixsummary %>% +gather(key, value, -Primary_Venn_Class) %>% +filter(key == "total") %>% +mutate(total = sum(value), +percent = (value / total) * 100) +# Example VennDiagram +library(ggVennDiagram) +set.seed(20220519) +# Need 3 classes with overlap (duplication) in each while preserving ratios +# BK Primary Class (Areas 1, 2, 4, and 5) +BK_Primary_Class <- c(rep(1, (factors_matrixsummary[[6]][[3]] + +factors_matrixsummary[[3]][[3]] + +factors_matrixsummary[[6]][[1]] + +factors_matrixsummary[[4]][[1]])), # Area 1 +rep(2, (factors_matrixsummary[[3]][[2]] + +factors_matrixsummary[[7]][[2]] + +factors_matrixsummary[[2]][[1]] + +factors_matrixsummary[[7]][[1]])), # Area 2 +rep(4, (factors_matrixsummary[[5]][[1]] + +factors_matrixsummary[[6]][[2]] + +factors_matrixsummary[[7]][[3]] + +factors_matrixsummary[[8]][[1]] + +factors_matrixsummary[[8]][[2]] + +factors_matrixsummary[[8]][[3]])), # Area 4 +rep(5, factors_matrixsummary[[3]][[1]]) # BK only ) -ui <- shinydashboard::dashboardPage(header = header, sidebar = sidebar, body = body, -skin = c("black")) -# ------------------- # -# Define Server Logic # -# ------------------- # -server <- function(input, output, session) { -output$linePlot <- renderPlot({ -# calculate savings from income and expenses -savings <- monthly_savings(input$monthly_income, input$expenses) -# create df from init_savings, savings, start_date, and end_date -df <- create_savingsdf(init_savings = input$init_savings, -savings, -start_date = input$dates[1], -end_date = input$dates[2]) -# plot savings over date range -ggplot(df, aes(x = Date, y = Savings, group = 1)) + -geom_line(size = 2) + -scale_x_date(date_labels = "%b-%Y") + -scale_y_continuous(labels=scales::dollar_format()) + -theme_minimal() -}) -output$homePrice <- renderValueBox({ -loan <- calculate_loan(input$yearly_income, input$rate, input$term) -home_price <- calculate_home_price(loan) -valueBox( -paste(scales::dollar(home_price, largest_with_cents = 100)), -subtitle = "Home Price", -color = "blue" +CS_Primary_Class <- c(rep(1, (factors_matrixsummary[[6]][[3]] + +factors_matrixsummary[[3]][[3]] + +factors_matrixsummary[[6]][[1]] + +factors_matrixsummary[[4]][[1]])), # Area 1 +rep(3, (factors_matrixsummary[[4]][[2]] + +factors_matrixsummary[[5]][[2]] + +factors_matrixsummary[[2]][[3]] + +factors_matrixsummary[[5]][[3]])), # Area 3 +rep(4, (factors_matrixsummary[[5]][[1]] + +factors_matrixsummary[[6]][[2]] + +factors_matrixsummary[[7]][[3]] + +factors_matrixsummary[[8]][[1]] + +factors_matrixsummary[[8]][[2]] + +factors_matrixsummary[[8]][[3]])), # Area 4 +rep(6, factors_matrixsummary[[2]][[2]]) # CS only ) -}) -output$downPayment <- renderValueBox({ -loan <- calculate_loan(input$yearly_income, input$rate, input$term) -down_payment <- down_payment(loan, input$percent) -valueBox( -scales::dollar(down_payment), -subtitle = "Down Payment", -color = "yellow" +MT_Primary_Class <- c(rep(2, (factors_matrixsummary[[3]][[2]] + +factors_matrixsummary[[7]][[2]] + +factors_matrixsummary[[2]][[1]] + +factors_matrixsummary[[7]][[1]])), # Area 2 +rep(3, (factors_matrixsummary[[4]][[2]] + +factors_matrixsummary[[5]][[2]] + +factors_matrixsummary[[2]][[3]] + +factors_matrixsummary[[5]][[3]])), # Area 3 +rep(4, (factors_matrixsummary[[5]][[1]] + +factors_matrixsummary[[6]][[2]] + +factors_matrixsummary[[7]][[3]] + +factors_matrixsummary[[8]][[1]] + +factors_matrixsummary[[8]][[2]] + +factors_matrixsummary[[8]][[3]])), # Area 4 +rep(7, factors_matrixsummary[[4]][[3]]) # MT only ) -}) -output$mortgageAmount <- renderValueBox({ -loan <- calculate_loan(input$yearly_income, input$rate, input$term) -valueBox( -scales::dollar(loan), -subtitle = "Mortage Amount", -color = "orange" +z <- list( +BK_Primary_Class, +CS_Primary_Class, +MT_Primary_Class ) -}) -output$monthlyPayment <- renderValueBox({ -mortgage <- mortgage_payment(input$yearly_income) -valueBox( -scales::dollar(mortgage), -subtitle = "Monthly Payment", -color = "aqua" +ggVennDiagram(z, label_alpha = 0) +Area1 <- rep(paste0("BKCS", 1:(factors_matrixsummary[[6]][[3]] + # Specific to BKCS +factors_matrixsummary[[3]][[3]] + +factors_matrixsummary[[6]][[1]] + +factors_matrixsummary[[4]][[1]])), +(factors_matrixsummary[[6]][[3]] + +factors_matrixsummary[[3]][[3]] + +factors_matrixsummary[[6]][[1]] + +factors_matrixsummary[[4]][[1]])) # Area 1 +Area2 <- rep(paste0("BKMT", 1:(factors_matrixsummary[[3]][[2]] + # Specific to BKMT +factors_matrixsummary[[7]][[2]] + +factors_matrixsummary[[2]][[1]] + +factors_matrixsummary[[7]][[1]])), +(factors_matrixsummary[[3]][[2]] + +factors_matrixsummary[[7]][[2]] + +factors_matrixsummary[[2]][[1]] + +factors_matrixsummary[[7]][[1]])) # Area 2 +Area3 <- rep(paste0("CSMT", 1:(factors_matrixsummary[[4]][[2]] + # Specific to CSMT +factors_matrixsummary[[5]][[2]] + +factors_matrixsummary[[2]][[3]] + +factors_matrixsummary[[5]][[3]])), +(factors_matrixsummary[[4]][[2]] + +factors_matrixsummary[[5]][[2]] + +factors_matrixsummary[[2]][[3]] + +factors_matrixsummary[[5]][[3]])) # Area 3 +Area4 <- rep(paste0("DS", 1:(factors_matrixsummary[[5]][[1]] + # Specific to DS +factors_matrixsummary[[6]][[2]] + +factors_matrixsummary[[7]][[3]] + +factors_matrixsummary[[8]][[1]] + +factors_matrixsummary[[8]][[2]] + +factors_matrixsummary[[8]][[3]])), +(factors_matrixsummary[[5]][[1]] + +factors_matrixsummary[[6]][[2]] + +factors_matrixsummary[[7]][[3]] + +factors_matrixsummary[[8]][[1]] + +factors_matrixsummary[[8]][[2]] + +factors_matrixsummary[[8]][[3]])) # Area 4 +Area5 <- rep(paste0("BK", 1:factors_matrixsummary[[3]][[1]]), factors_matrixsummary[[3]][[1]]) # Area 5 (BK only) +Area6 <- rep(paste0("CS", 1:factors_matrixsummary[[2]][[2]]), factors_matrixsummary[[2]][[2]]) # Area 6 (CS only) +Area7 <- rep(paste0("MT", 1:factors_matrixsummary[[4]][[3]]), factors_matrixsummary[[4]][[3]]) # Area 7 (MT only) +w <- list( +BK = c(Area1, Area2, Area4, Area5), +CS = c(Area1, Area3, Area4, Area6), +MT = c(Area2, Area3, Area4, Area7) ) -}) -} -shinyApp(ui, server) -# Packages -library(shinydashboard) -library(shiny) -# library(remotes) -# remotes::install_github("rstudio/shinyuieditor") -library(gridlayout) +library(ggVennDiagram) +library(ggplot2) +ggVennDiagram(w, +category.names = c("Domain", "Science", "Math"), +show_intersect = F, +set_color = "black", +set_size = 4, +label = "both", +label_alpha = 0.00, +label_geom = "label", +label_color = "black", +label_size = 4, +label_percent_digit = 2, +label_txtWidth = 30, +edge_lty = "solid", +edge_size = 1) + +guides(fill = guide_legend(title = "Title", )) + +scale_color_manual(values = c("white", "white", "white")) + +scale_fill_gradient(low = "#c2fffc", high = "#00c4bb") + +labs(title = "Project Class Diagram", +subtitle = "What project areas do I spend time on?", +caption = Sys.Date()) + +theme(legend.position = "bottom", +plot.title = element_text(hjust = 0.5), +plot.subtitle = element_text(hjust = 0.5), +plot.caption = element_text(hjust = 0.5)) +df %>% +group_by(Job_Category) %>% +summarise(sum(project_duration)) +# df %>% +# group_by(DataScience_Anaconda_Survey_TimeSpentOn_Area) %>% +# summarise(t = sum(project_duration)) %>% +# na.exclude() %>% +# ggplot(aes(reorder(DataScience_Anaconda_Survey_TimeSpentOn_Area, t))) + +# geom_bar(stat = "identity", aes(y = t/360, col = DataScience_Anaconda_Survey_TimeSpentOn_Area), +# fill = "white") + theme(legend.position = "none")\ +df %>% +group_by(Primary_Venn_Class) %>% +summarise(t = sum(project_duration), +hours = as.numeric(t)/360) +library(shiny); runApp('app5.R') library(tidyverse) -library(lubridate) -library(scales) -library(flexdashboard) -library(shinythemes) -source("helper.R") -# --------- # -# Define UI # -# --------- # -header <- shinydashboard::dashboardHeader(title = "Home Savings") -sidebar <- shinydashboard::dashboardSidebar( -sidebarMenu( -menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), -menuItem("Widgets", tabName = "widgets", icon = icon("th")) -) -) +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() + geom_vline(x = "2022-10-01") +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() + geom_vline(xintercept = "2022-10-01") +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() + geom_vline(xintercept = 1) +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() + geom_hline(yintercept = 30000) runApp('app5.R') runApp('app5.R') +which(times$project_duration == 30000) +which(times$project_duration == 3000) +times$Date[which(times$project_duration == 3000)] +times %>% +group_by(Date, project_duration) %>% +summarise(Total = sum(project_duration)) %>% +ggplot(aes(Date, Total)) + +geom_line() + geom_vline(xintercept = c( +times$Date[which(times$project_duration == 3000)])) runApp('app5.R') runApp('app5.R') runApp('app5.R') -runApp('app5.R') -# Line Plot -# Using simulated data -library(dplyr) -library(ggplot2) -library(lubridate) -# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source("helper.R") -setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source("helper.R") -# Packages -library(dplyr) -library(ggplot2) -library(lubridate) -# Starting data -start_date <- as.Date("2022-09-15") -end_date <- as.Date("2025-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -# New data -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 1 -# The original data inputs: -# savings <- monthly_savings(input$monthly_income, input$expenses) -# # create df from init_savings, savings, start_date, and end_date -# df <- create_savingsdf(init_savings = input$init_savings, -# savings, -# start_date = input$dates[1], -# end_date = input$dates[2]) -# Recreate monthly savings given some number -start_date <- as.Date("2022-09-15") -end_date <- as.Date("2026-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -View(df) -# New data -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 1 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% -ggplot(., aes(Date, Total_Theory_Savings)) + -geom_smooth(method = "lm") + -geom_point() + geom_line(aes(Date, Savings)) + -geom_hline(yintercept = dp, lty = 3) + -geom_hline(yintercept = current_savings, lty = 3) + -geom_vline(xintercept = goal_purchase_date) + -scale_x_date(date_labels = "%b-%Y", breaks = goal_purchase_date) + -scale_y_continuous(labels=scales::dollar_format(), -breaks = c(10000, 80000)) + -theme_classic() -View(df) -# Packages -library(dplyr) -library(ggplot2) -library(lubridate) -# setwd("C:/Users/Zachary.Palmore/GitHub/Home/home_afford_app") -source("helper.R") -# Starting data -start_date <- as.Date("2022-09-15") -end_date <- as.Date("2025-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -View(df) -end_date <- as.Date("2023-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -# Starting data -start_date <- as.Date("2022-09-15") -end_date <- as.Date("2023-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -View(df) -# New data -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 1 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% View() -df -df[c(1,2),] -df[c(1,2)] -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date > new_date ~ as.numeric(0), -Date >= new_date ~ new_monthly_income - new_monthly_expenses -)) -# New data -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 1 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% View() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ new_monthly_income - new_monthly_expenses -)) -new_monthly_expenses <- 0 -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ new_monthly_income - new_monthly_expenses -)) -new_monthly_expenses <- 5 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% View() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ new_monthly_income - new_monthly_expenses -)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) + Savings -)) -Date < new_date ~ as.numeric(Savings), -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(Savings), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) + Savings -)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ cumsum((new_monthly_income - new_monthly_expenses) + Savings) -)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ cumsum((new_monthly_income - new_monthly_expenses)) -)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), cumsum(Scenario)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), new_savings = cumsum(Scenario)) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% -ggplot(aes(Date, total_saved)) + geom_line() -# Starting data -start_date <- as.Date("2020-09-15") -end_date <- as.Date("2023-12-31") -goal_purchase_date <- as.Date("2023-10-01") -monthly_income <- 4000 -monthly_expenses <- 2800 -current_savings <- 24000 -dp <- down_payment(calculate_loan(monthly_income * 12, .04, 30), 20) -# seq(from = start_date, to = end_date, by = ) -df <- "" -df$date <- seq.Date(from = start_date, to = end_date, by = 1) -df <- create_savingsdf(init_savings = current_savings, -savings = monthly_income - monthly_expenses, -start_date = start_date, end_date = end_date) -df$Points <- rnorm(length(df$Savings), mean = monthly_income - monthly_expenses, sd = 3000) # Insert realistic standard deviation -df <- df %>% mutate(Theory_Savings = cumsum(Points)) -# New data -new_date <- as.Date("2022-10-01") -new_monthly_income <- 4700 -new_monthly_expenses <- 5 -df %>% -mutate(Scenario1 = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ rnorm(length(Savings), mean = new_monthly_income - new_monthly_expenses, -sd = 500)), -Savings1 = cumsum(Scenario1), -Total_Theory_Savings = Theory_Savings + Savings1) %>% View() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% -ggplot(aes(Date, total_saved)) + geom_line() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% -ggplot(aes(Date, total_saved)) + geom_line() + geom_point() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% -ggplot(aes(Date, total_saved, color = Scenario)) + -geom_line() + geom_point() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% -ggplot(aes(Date, total_saved, color = Scenario)) + -geom_line() + geom_point() -df[c(1,2)] %>% -mutate(Scenario = case_when( -Date < new_date ~ as.numeric(0), -Date >= new_date ~ (new_monthly_income - new_monthly_expenses) -), -new_savings = cumsum(Scenario), -total_saved = new_savings + Savings) %>% View() +?guides() diff --git a/home_afford_app/app5.R b/home_afford_app/app5.R index 34b23921..962d22c9 100644 --- a/home_afford_app/app5.R +++ b/home_afford_app/app5.R @@ -116,11 +116,17 @@ server <- function(input, output, session) { savings, start_date = input$dates[1], end_date = input$dates[2]) + # calculate autopopulated values + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + down_payment <- down_payment(loan, input$percent) + dp_date <- df$Date[which[df$savings == down_payment]] # plot savings over date range ggplot(df, aes(x = Date, y = Savings, group = 1)) + geom_line(size = 2) + scale_x_date(date_labels = "%b-%Y") + scale_y_continuous(labels=scales::dollar_format()) + + geom_hline(yintercept = down_payment) + + geom_vline(xintercept = dp_date) + theme_minimal() }) From a859d8cd93271a19aa45145c09a7d34b8fad4f1b Mon Sep 17 00:00:00 2001 From: palmorezm Date: Sun, 11 Dec 2022 21:33:42 -0600 Subject: [PATCH 19/19] Clarity and Cleaning --- home_afford_app/.Rhistory | 26 +-- home_afford_app/app.R | 249 +++++++++++++++++------------ home_afford_app/app2.R | 146 ----------------- home_afford_app/app3.R | 108 ------------- home_afford_app/app4.R | 38 ----- home_afford_app/app5.R | 176 -------------------- home_afford_app/card_with_button.R | 37 ----- home_afford_app/notes | 22 ++- 8 files changed, 177 insertions(+), 625 deletions(-) delete mode 100644 home_afford_app/app2.R delete mode 100644 home_afford_app/app3.R delete mode 100644 home_afford_app/app4.R delete mode 100644 home_afford_app/app5.R delete mode 100644 home_afford_app/card_with_button.R diff --git a/home_afford_app/.Rhistory b/home_afford_app/.Rhistory index 458e8437..e5ca3070 100644 --- a/home_afford_app/.Rhistory +++ b/home_afford_app/.Rhistory @@ -1,16 +1,3 @@ -# class(times$Date) -# which(is.na(mdy(times$Date))) -# times$Date[510] -# times$Date <- as_date(times$Date) -#min(times$Date) -#min(as.Date(times$Date)) -#sort(times$Date)[[1]] -#times$Date[[length(times$Date)]] -# Check function of work week start date first (examine parsing) -work_week_startdate <- seq((sort(times$Date)[[1]]), -times$Date[[length(times$Date)]], by = "7 days") -times$Start <- hms::as_hms(lubridate::parse_date_time(times$Start, "%I:%M %p")) -times$End <- hms::as_hms(lubridate::parse_date_time(times$End, "%I:%M %p")) times$project_duration <- (times$End - times$Start) work_duration_day <- 8 * 60 * 60 # h * m * s = s work_duration_week <- work_duration_day * 5 # 5 days per work week (excluding holidays) @@ -510,3 +497,16 @@ runApp('app5.R') runApp('app5.R') runApp('app5.R') ?guides() +# Packages +library(shinydashboard) +library(shiny) +# library(remotes) +# remotes::install_github("rstudio/shinyuieditor") +library(gridlayout) +library(tidyverse) +library(lubridate) +library(scales) +library(flexdashboard) +library(shinythemes) +source("helper.R") +runApp('app5.R') diff --git a/home_afford_app/app.R b/home_afford_app/app.R index 567017ab..418b440a 100644 --- a/home_afford_app/app.R +++ b/home_afford_app/app.R @@ -1,4 +1,9 @@ -source("helper.R") + +# Shiny Dashboard (by shinydashboard) + + +# Packages +library(shinydashboard) library(shiny) # library(remotes) # remotes::install_github("rstudio/shinyuieditor") @@ -7,100 +12,111 @@ library(tidyverse) library(lubridate) library(scales) library(flexdashboard) -library(shinydashboard) +library(shinythemes) +source("helper.R") +# For simulations use standard inputs: +# 1000 current savings +# 4290 net monthly +# 3241 expenses monthly +# 01-01-2022 through 01-01-2028 +# 60000 gross +# 20% dp +# 30 yr +# 7% IR -# App template from the shinyuieditor -ui <- grid_page( - layout = c( - "header header", - "savings linePlot", - "home_input home_output" - ), - row_sizes = c( - "60px", - "400px", - "400px" - ), - col_sizes = c( - "260px", - "1fr" - ), - gap_size = "1rem", - grid_card( - area = "savings", - item_alignment = "top", - title = "Savings Estimator", - item_gap = "12px", - numericInput( - inputId = "init_savings", - label = "Current Savings", - value = 1000L - ), - numericInput( - inputId = "monthly_income", - label = "Monthly Income (net)", - value = 4290L - ), - numericInput( - inputId = "expenses", - label = "Monthly Expenses", - value = 3241L - ), - dateRangeInput( - inputId = "dates", - label = "Date Range", - format = "mm-dd-yyyy", - start = "2022-01-01", - end = "2028-01-01" - ) - ), - grid_card_text( - area = "header", - content = "Home Savings", - alignment = "start", - is_title = FALSE - ), - grid_card_plot(area = "linePlot"), - grid_card( - area = "home_input", - title = "Home Affordability", - item_gap = "12px", - numericInput( - inputId = "yearly_income", - label = "Yearly Income (gross)", - value = 60000L - ), - sliderInput( - inputId = "percent", - label = "Down Payment %", - min = 0L, - max = 100L, - value = 20L, - width = "100%" - ), - numericInput( - inputId = "term", - label = "Loan Term (years)", - value = 30L +# --------- # +# Define UI # +# --------- # +header <- shinydashboard::dashboardHeader(title = "Home Savings") + +sidebar <- shinydashboard::dashboardSidebar( + sidebarMenu( + menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), + menuItem("Widgets", tabName = "widgets", icon = icon("th")) + ) +) + +body <- shinydashboard::dashboardBody( + tabItems( + tabItem( + tabName = "dashboard", + fluidRow( + box( + shinydashboard::valueBoxOutput(outputId = "homePrice", width = 3), + shinydashboard::valueBoxOutput(outputId = "downPayment", width = 3), + shinydashboard::valueBoxOutput(outputId = "mortgageAmount", width = 3), + shinydashboard::valueBoxOutput(outputId = "monthlyPayment", width = 3), + width = 12 + ) + ), + fluidRow( + box( + title = "controls", + numericInput( + inputId = "init_savings", + label = "Current Savings", + value = 1000L + ), + numericInput( + inputId = "monthly_income", + label = "Monthly Income (net)", + value = 4290L + ), + numericInput( + inputId = "expenses", + label = "Monthly Expenses", + value = 3241L + ), + dateRangeInput( + inputId = "dates", + label = "Date Range", + format = "mm-dd-yyyy", + start = "2022-01-01", + end = "2028-01-01" + ), + numericInput( + inputId = "yearly_income", + label = "Yearly Income (gross)", + value = 60000L + ), + sliderInput( + inputId = "percent", + label = "Down Payment %", + min = 0L, + max = 100L, + value = 20L, + width = "100%" + ), + numericInput( + inputId = "term", + label = "Loan Term (years)", + value = 30L + ), + numericInput( + inputId = "rate", + label = "Interest Rate (%)", + value = 4L + ), + width = 3), + box(plotOutput(outputId = "linePlot", + height = 650), width = 9), + ) ), - numericInput( - inputId = "rate", - label = "Interest Rate (%)", - value = 4L - ) - ), - grid_card( - area = "home_output", - item_gap = "12px", - tagAppendAttributes(textOutput(outputId = "homeAmount"), - style = "white-space:pre-wrap;" + tabItem( + tabName = "widgets", + h2("Tab for Widgets") ) ) ) -# Define server logic required to draw a histogram -server <- function(input, output) { +ui <- shinydashboard::dashboardPage(header = header, sidebar = sidebar, body = body, + skin = c("black")) +# ------------------- # +# Define Server Logic # +# ------------------- # +server <- function(input, output, session) { + output$linePlot <- renderPlot({ # calculate savings from income and expenses savings <- monthly_savings(input$monthly_income, input$expenses) @@ -109,32 +125,61 @@ server <- function(input, output) { savings, start_date = input$dates[1], end_date = input$dates[2]) + # calculate autopopulated values + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + down_payment <- down_payment(loan, input$percent) + dp_date <- df$Date[which[df$savings == down_payment]] # plot savings over date range ggplot(df, aes(x = Date, y = Savings, group = 1)) + - geom_line() + + geom_line(size = 2) + scale_x_date(date_labels = "%b-%Y") + scale_y_continuous(labels=scales::dollar_format()) + + geom_hline(yintercept = down_payment) + + geom_vline(xintercept = dp_date) + theme_minimal() }) - output$homeAmount <- renderText({ - # calculate how much home you can afford based on inputs - mortgage <- mortgage_payment(input$yearly_income) + output$homePrice <- renderValueBox({ loan <- calculate_loan(input$yearly_income, input$rate, input$term) home_price <- calculate_home_price(loan) + shinydashboard::valueBox( + paste(scales::dollar(home_price, largest_with_cents = 100)), + subtitle = "Home Price", + color = "blue", + width = 12 + ) + }) + + output$downPayment <- renderValueBox({ + loan <- calculate_loan(input$yearly_income, input$rate, input$term) down_payment <- down_payment(loan, input$percent) - # display results - homePrice <- paste("Home Price: ", dollar(home_price, largest_with_cents = 100)) - downPayment <- paste("Down Payment: ", dollar(down_payment, largest_with_cents = 100)) - mortgageAmount <- paste("Mortgage Amount: ", dollar(loan, largest_with_cents = 100)) - monthlyPayment <- paste("Monthly Payment: ", dollar(mortgage, largest_with_cents = 100)) - paste(homePrice, downPayment, mortgageAmount, monthlyPayment, sep="\n") + shinydashboard::valueBox( + scales::dollar(down_payment), + subtitle = "Down Payment", + color = "yellow", + width = 12 + ) }) - - output$PriceofHome <- renderText(expr = "$367,924") + output$mortgageAmount <- renderValueBox({ + loan <- calculate_loan(input$yearly_income, input$rate, input$term) + shinydashboard::valueBox( + scales::dollar(loan), + subtitle = "Mortage Amount", + color = "orange", + width = 12 + ) + }) + + output$monthlyPayment <- renderValueBox({ + mortgage <- mortgage_payment(input$yearly_income) + shinydashboard::valueBox( + scales::dollar(mortgage), + subtitle = "Monthly Payment", + color = "aqua", + width = 12 + ) + }) } shinyApp(ui, server) - - diff --git a/home_afford_app/app2.R b/home_afford_app/app2.R deleted file mode 100644 index d32ff377..00000000 --- a/home_afford_app/app2.R +++ /dev/null @@ -1,146 +0,0 @@ - -source("helper.R") -library(shiny) -# library(remotes) -# remotes::install_github("rstudio/shinyuieditor") -library(gridlayout) -library(tidyverse) -library(lubridate) -library(scales) -library(flexdashboard) -library(shinydashboard) -library(shinythemes) - -ui <- navbarPage( - "Home Savings", - theme = shinytheme("cosmo"), - # header = "Header Section for all Tabs in Navbar", - tabPanel( - title = "Plot", - # column(c(4, 8), - # Title = "Selection Options"), - sidebarPanel( - h3("Heading 3"), - numericInput( - inputId = "init_savings", - label = "Current Savings", - value = 1000L - ), - numericInput( - inputId = "monthly_income", - label = "Monthly Income (net)", - value = 4290L - ), - numericInput( - inputId = "expenses", - label = "Monthly Expenses", - value = 3241L - ), - dateRangeInput( - inputId = "dates", - label = "Date Range", - format = "mm-dd-yyyy", - start = "2022-01-01", - end = "2028-01-01" - ) - ), - mainPanel("Main1", - plotOutput(outputId = "linePlot")) - ), # End Tab 1 - tabPanel( - title = "Key", - fluidPage( - sidebarPanel( - h3("Heading 3"), - numericInput( - inputId = "yearly_income", - label = "Yearly Income (gross)", - value = 60000L - ), - sliderInput( - inputId = "percent", - label = "Down Payment %", - min = 0L, - max = 100L, - value = 20L, - width = "100%" - ), - numericInput( - inputId = "term", - label = "Loan Term (years)", - value = 30L - ), - numericInput( - inputId = "rate", - label = "Interest Rate (%)", - value = 4L - ) - ), - mainPanel("Main2", - textOutput(outputId = "homeAmount")), - ) - ), - tabPanel( - "Name Card", - box(title = "Home Price", - footer = "Footer here", - background = "aqua", collapsible = FALSE) - ), - valueBox(value = "$367,900", subtitle = "subtitle", color="aqua") - ) - - - - - # Define server logic required to draw a histogram -server <- function(input, output, session) { - - output$linePlot <- renderPlot({ - # calculate savings from income and expenses - savings <- monthly_savings(input$monthly_income, input$expenses) - # create df from init_savings, savings, start_date, and end_date - df <- create_savingsdf(init_savings = input$init_savings, - savings, - start_date = input$dates[1], - end_date = input$dates[2]) - # plot savings over date range - ggplot(df, aes(x = Date, y = Savings, group = 1)) + - geom_line(size = 2) + - scale_x_date(date_labels = "%b-%Y") + - scale_y_continuous(labels=scales::dollar_format()) + - theme_minimal() - }) - - output$homeAmount <- renderText({ - # calculate how much home you can afford based on inputs - mortgage <- mortgage_payment(input$yearly_income) - loan <- calculate_loan(input$yearly_income, input$rate, input$term) - home_price <- calculate_home_price(loan) - down_payment <- down_payment(loan, input$percent) - # display results - homePrice <- paste("Home Price: ", dollar(home_price, largest_with_cents = 100)) - downPayment <- paste("Down Payment: ", dollar(down_payment, largest_with_cents = 100)) - mortgageAmount <- paste("Mortgage Amount: ", dollar(loan, largest_with_cents = 100)) - monthlyPayment <- paste("Monthly Payment: ", dollar(mortgage, largest_with_cents = 100)) - paste(homePrice, downPayment, mortgageAmount, monthlyPayment, sep="\n") - }) - - # output$PriceofHome <- renderText(expr = "$367,924") - output$PriceofHome <- shinydashboard::renderValueBox( - shinydashboard::valueBox(value = "$367,924", - title = "Title", - subtitle = "Home Price", - icon = NULL, - color = "aqua") - ) - - output$box1 <- renderValueBox( - expr = valueBox( - value = scales::number(x = 100*10000), - subtitle = "subtitle", - icon = NULL - ) - ) - } - -shinyApp(ui, server) diff --git a/home_afford_app/app3.R b/home_afford_app/app3.R deleted file mode 100644 index bc8890b8..00000000 --- a/home_afford_app/app3.R +++ /dev/null @@ -1,108 +0,0 @@ -library(shiny) -library(flexdashboard) -library(shinydashboard) -library(scales) -library(tibble) - -header <- dashboardHeader(title = "Home Savings") - -sidebar <- dashboardSidebar( - sidebarMenu( - - id = "tabs", width = 300, - - menuItem("Plot", tabName = "dashboard", icon = icon("list-ol")) - - ) -) - -body <- dashboardBody( - - tabItems( - - tabItem(tabName = "dashboard", titlePanel("Plot"), - - fluidPage( - - column(2, - - box(title = "Plot", width = 75, - sliderInput( - inputId = 'aa', label = 'AA', - value = 0.5 * 100, - min = 0 * 100, - max = 1 * 100, - step = 1 - ), - - sliderInput( - inputId = 'bb', label = 'BB', - value = 0.5 * 100, - min = 0 * 100, - max = 1 * 100, - step = 1 - ), - - sliderInput( - inputId = 'cc', label = 'CC', - value = 2.5, min = 1, max = 5, step = .15 - ), - - sliderInput( - inputId = 'dd', label = 'DD', - value = 2.5, min = 1, max = 5, step = .15 - ) - ) - ), - - column(8, - shinydashboard::valueBoxOutput(outputId = "box1", width = 3), title = "boxs") - ) - ) - ) -) - -ui <- dashboardPage(header, sidebar, body) - -server <- function(input, output, session) { - - ac <- function(aa, bb, cc, dd) { - (aa + cc) + (bb ^ dd) - } - - reac_1 <- reactive({ - tibble( - aa = input$aa, - bb = input$bb, - cc = input$cc, - dd = input$dd - ) - }) - - pred_1 <- reactive({ - temp <- reac_1() - ac( - aa = input$aa, - bb = input$bb, - cc = input$cc, - dd = input$dd - ) - }) - - output$box1 <- shinydashboard::renderValueBox( - shinydashboard::valueBox( - value = scales::number(x = pred_1() / 100, accuracy = 0.01), - subtitle =ifelse(test = pred_1() / 100 <= 2.33, yes = 'AAAAAAAAAA', - ifelse(test = pred_1() / 100 <= 3.67, yes = 'BBBBBBBBB', - no = 'CCCCCCCCCC')), - color = ifelse(test = pred_1() / 100 <= 2.33, yes = 'red', - ifelse(test = pred_1() / 100 <= 3.67, yes = 'green', - no = 'blue')), - icon = icon(ifelse(test = pred_1() / 100 <= 2.33, yes = 'fa-times-circle', - ifelse(test = pred_1() / 100 <= 3.67, yes = 'fa-exclamation-circle', - no = 'fa-check-circle'))) - ) - ) -} - -shinyApp(ui, server) \ No newline at end of file diff --git a/home_afford_app/app4.R b/home_afford_app/app4.R deleted file mode 100644 index d6585fd5..00000000 --- a/home_afford_app/app4.R +++ /dev/null @@ -1,38 +0,0 @@ - - -source("helper.R") -library(shiny) -# library(remotes) -# remotes::install_github("rstudio/shinyuieditor") -library(gridlayout) -library(tidyverse) -library(lubridate) -library(scales) -library(flexdashboard) -library(shinydashboard) -library(shinythemes) - -# Review -# https://rstudio.github.io/shinydashboard/structure.html#background-shiny-and-html - -ui <- dashboardPage( - dashboardHeader(title = "Home Savings"), - dashboardSidebar( - sidebarMenu( - menuItemOutput("menuitem"), - menuItemOutput("menuitem2") - ) - ), - dashboardBody() -) - -server <- function(input, output) { - output$menuitem <- renderMenu({ - menuItem("Menu item", icon = icon("calendar")) - }) - output$menuitem <- renderMenu({ - menuItem("Menu item", icon = icon("calendar")) - }) -} - -shinyApp(ui, server) \ No newline at end of file diff --git a/home_afford_app/app5.R b/home_afford_app/app5.R deleted file mode 100644 index 962d22c9..00000000 --- a/home_afford_app/app5.R +++ /dev/null @@ -1,176 +0,0 @@ - -# Shiny Dashboard (by shinydashboard) - - -# Packages -library(shinydashboard) -library(shiny) -# library(remotes) -# remotes::install_github("rstudio/shinyuieditor") -library(gridlayout) -library(tidyverse) -library(lubridate) -library(scales) -library(flexdashboard) -library(shinythemes) -source("helper.R") - -# --------- # -# Define UI # -# --------- # -header <- shinydashboard::dashboardHeader(title = "Home Savings") - -sidebar <- shinydashboard::dashboardSidebar( - sidebarMenu( - menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), - menuItem("Widgets", tabName = "widgets", icon = icon("th")) - ) -) - -body <- shinydashboard::dashboardBody( - tabItems( - tabItem( - tabName = "dashboard", - fluidRow( - box( - shinydashboard::valueBoxOutput(outputId = "homePrice", width = 3), - shinydashboard::valueBoxOutput(outputId = "downPayment", width = 3), - shinydashboard::valueBoxOutput(outputId = "mortgageAmount", width = 3), - shinydashboard::valueBoxOutput(outputId = "monthlyPayment", width = 3), - width = 12 - ) - ), - fluidRow( - box( - title = "controls", - numericInput( - inputId = "init_savings", - label = "Current Savings", - value = 1000L - ), - numericInput( - inputId = "monthly_income", - label = "Monthly Income (net)", - value = 4290L - ), - numericInput( - inputId = "expenses", - label = "Monthly Expenses", - value = 3241L - ), - dateRangeInput( - inputId = "dates", - label = "Date Range", - format = "mm-dd-yyyy", - start = "2022-01-01", - end = "2028-01-01" - ), - numericInput( - inputId = "yearly_income", - label = "Yearly Income (gross)", - value = 60000L - ), - sliderInput( - inputId = "percent", - label = "Down Payment %", - min = 0L, - max = 100L, - value = 20L, - width = "100%" - ), - numericInput( - inputId = "term", - label = "Loan Term (years)", - value = 30L - ), - numericInput( - inputId = "rate", - label = "Interest Rate (%)", - value = 4L - ), - width = 3), - box(plotOutput(outputId = "linePlot", - height = 650), width = 9), - ) - ), - tabItem( - tabName = "widgets", - h2("Tab for Widgets") - ) - ) -) - -ui <- shinydashboard::dashboardPage(header = header, sidebar = sidebar, body = body, - skin = c("black")) - -# ------------------- # -# Define Server Logic # -# ------------------- # -server <- function(input, output, session) { - - output$linePlot <- renderPlot({ - # calculate savings from income and expenses - savings <- monthly_savings(input$monthly_income, input$expenses) - # create df from init_savings, savings, start_date, and end_date - df <- create_savingsdf(init_savings = input$init_savings, - savings, - start_date = input$dates[1], - end_date = input$dates[2]) - # calculate autopopulated values - loan <- calculate_loan(input$yearly_income, input$rate, input$term) - down_payment <- down_payment(loan, input$percent) - dp_date <- df$Date[which[df$savings == down_payment]] - # plot savings over date range - ggplot(df, aes(x = Date, y = Savings, group = 1)) + - geom_line(size = 2) + - scale_x_date(date_labels = "%b-%Y") + - scale_y_continuous(labels=scales::dollar_format()) + - geom_hline(yintercept = down_payment) + - geom_vline(xintercept = dp_date) + - theme_minimal() - }) - - output$homePrice <- renderValueBox({ - loan <- calculate_loan(input$yearly_income, input$rate, input$term) - home_price <- calculate_home_price(loan) - shinydashboard::valueBox( - paste(scales::dollar(home_price, largest_with_cents = 100)), - subtitle = "Home Price", - color = "blue", - width = 12 - ) - }) - - output$downPayment <- renderValueBox({ - loan <- calculate_loan(input$yearly_income, input$rate, input$term) - down_payment <- down_payment(loan, input$percent) - shinydashboard::valueBox( - scales::dollar(down_payment), - subtitle = "Down Payment", - color = "yellow", - width = 12 - ) - }) - - output$mortgageAmount <- renderValueBox({ - loan <- calculate_loan(input$yearly_income, input$rate, input$term) - shinydashboard::valueBox( - scales::dollar(loan), - subtitle = "Mortage Amount", - color = "orange", - width = 12 - ) - }) - - output$monthlyPayment <- renderValueBox({ - mortgage <- mortgage_payment(input$yearly_income) - shinydashboard::valueBox( - scales::dollar(mortgage), - subtitle = "Monthly Payment", - color = "aqua", - width = 12 - ) - }) -} - -shinyApp(ui, server) diff --git a/home_afford_app/card_with_button.R b/home_afford_app/card_with_button.R deleted file mode 100644 index 58c80489..00000000 --- a/home_afford_app/card_with_button.R +++ /dev/null @@ -1,37 +0,0 @@ -library(shinydashboard) - -## Only run this example in interactive R sessions -if (interactive()) { - library(shiny) - - ui <- dashboardPage( - dashboardHeader(title = "Dynamic boxes"), - dashboardSidebar(), - dashboardBody( - fluidRow( - box(width = 2, actionButton("count", "Count")), - infoBoxOutput("ibox"), - valueBoxOutput("vbox") - ) - ) - ) - - server <- function(input, output) { - output$ibox <- renderInfoBox({ - infoBox( - "Title", - input$count, - icon = icon("credit-card") - ) - }) - output$vbox <- renderValueBox({ - valueBox( - "Title", - input$count, - icon = icon("credit-card") - ) - }) - } - - shinyApp(ui, server) -} diff --git a/home_afford_app/notes b/home_afford_app/notes index 2d80a25a..bfa87233 100644 --- a/home_afford_app/notes +++ b/home_afford_app/notes @@ -58,8 +58,20 @@ Comparing prices of goods (one store from another): Checklist: -Vertical line at Date when savings amount equals down payment -Horizontal line at at dollar amount that equals down payment -Autopopulate end year to be 1 year after the date when down payment amount is reached -Incorporate interest rate into monthly payment (monthly payment varies based on amount borrowed and rate) -Develop realistic simulation of natural 'normal' variation with user-controlled standard deviation from mean net monthly income. Greater variation should show greater uncertainty in savings growth. +A. Vertical line at Date when savings amount equals down payment +B. Horizontal line at at dollar amount that equals down payment +C. Autopopulate end year to be 1 year after the date when down payment amount is reached +D. Incorporate interest rate into monthly payment (monthly payment varies based on amount borrowed and rate) +E. Develop realistic simulation of natural 'normal' variation with user-controlled standard deviation from mean net monthly income. Greater variation should show greater uncertainty in savings growth. + +# For simulations use standard inputs: +# 1000 current savings +# 4290 net monthly +# 3241 expenses monthly +# 01-01-2022 through 01-01-2028 +# 60000 gross +# 20% dp +# 30 yr +# 7% IR +A_1. Create a data set using these inputs +