FINALGROUP

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 http://rmarkdown.rstudio.com.

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:

library("readxl")
library(lattice)

if (!require(pacman)) install.packages("pacman")

## Loading required package: pacman

pacman::p_load(here,
               tidyverse,
               ggplot2,
               ggforce,
               here,
               GGally, #creates a matrix of plots 
               cowplot, #creates multiplots and has some nice complete 
               ggthemes, # has nice complete themes
               ggdark, # creates dark versions of all themes from 
               viridis, # a set of color palettes I like
               update = FALSE) 

Including Plots

reading in data and saving as tible

my_data <- read_excel("Copyofsurvey_data.xlsx")
new_my_data <- as_tibble(my_data)

Cleaning the data

new_my_data<- new_my_data %>% 
  dplyr::mutate(new_date_signed = case_when(date_signed_lease ==     "April 2023" ~ "April",
                          date_signed_lease == "December 2022" ~ "December",
                          date_signed_lease == "September 2023"~"September",
                          date_signed_lease == "September 2022"~"September",
                          date_signed_lease == "October 2023"~"October",
                          date_signed_lease == "October 2022"~"October",
                          date_signed_lease == "November 2022"~"November",
                          date_signed_lease == "May 2023"~"May",
                          date_signed_lease == "May 2022"~"May",
                          date_signed_lease == "March 2023"~"March",
                          date_signed_lease == "June 2023"~"June",
                          date_signed_lease == "July 2023"~"July",
                          date_signed_lease == "January 2023"~"January",
                          date_signed_lease == "January 2021"~"January",
                          date_signed_lease ==  "February 2023"~"February",
                         
                          .default = "other"
    )
  )%>%
  dplyr::relocate(new_date_signed, .after = date_signed_lease)


new_my_data <- new_my_data %>% mutate(new_my_data, pay_for_rent = as.numeric(pay_for_rent))

## How  many people occupy each complex
occupents_neigh<-new_my_data %>% count(live, sort = TRUE)

## How many people signed each month and ordering months
num_ppl_sign<-new_my_data %>% count(new_date_signed, sort = TRUE) %>%
  mutate(
    Month = factor(new_date_signed, levels = month.name)
  ) %>%
  arrange(Month)
#Lmanda is the expected number of events in the given time period or #interval. 
# So on average we could expect 
# (52 people signning/12) months*1month = about 4 signing a lease a month
lambda<-52/12

#|
# We will simulate random samples from a uniform distribution and #transform them 
#to create samples from an exponential distribution, we can use the #inverse #transform method. 
#The idea is to use the cumulative distribution function (CDF) of the #target #distribution to transform the uniform samples into samples #from the desired #distribution.
## Recall The inverse of CDF of exponential CDF #is:F^−1((u;λ)=−ln(1−u)/λ)

# Define a function to generate uniform samples for a given lambda
generate_exponential_samples <- function(num_samples, lambda) {
  uniform_samples <- runif(num_samples)
  exponential_samples <- -log(1 - uniform_samples) / lambda
  return(exponential_samples)
}

#|echo: false
# Set a seed for randomness
set.seed(123)
# Number of samples to be simulated
num_samples <- 1000
#Sample size total number of people who signed is 52
num_events <- 52
# Different lambda values for each distribution
numppl<-num_ppl_sign$n
lambda_values <- c(num_events/numppl)
# Create an empty list to store samples
exponential_samples_list <- list()

# Generate samples for each lambda
for (i in lambda_values) {
  # Generate uniform samples
  uniform_samples <- runif(1000)
  
# Transform uniform samples to exponential samples
exponential_samples <- -log(1 - uniform_samples) / lambda
 # Store the samples in the list
  exponential_samples_list[[as.character(lambda)]] <- exponential_samples
}

#|echo: true
# Plot the results

par(mfrow = c(1, 2))
hist(uniform_samples, main = "Uniform Distribution", col = "lightblue", xlim = c(0, 1))
hist(exponential_samples, main = "Transformed Exponential Distribution", col = "lightgreen", xlim = c(0, 2))

# The for loop iterates over each lambda, generating uniform samples #and transforming
# them into exponential samples for each lambda.The transformed samples #are stored in #a list (exponential_samples_list), with each entry #corresponding to a different #lambda. 
#The histogram shows the distributions of the transformed exponential #samples for each lambda. It provides a visual representation of the #probability density of the #samples. We can see its approximately #unirofrm and exponential but considering 
#our data set we might be over fitting. Now lets plot all all our #lamdas.

# Set a seed for 
set.seed(123)

# Number of samples
num_samples <- 1000

# Different lambda values for different time intervals
lambda_values <- c(num_events/numppl)

# Create an empty list to store samples
exponential_samples_list <- list()

# Generate samples for each lambda

for (lambda in lambda_values) {
  samples <- generate_exponential_samples(num_samples, lambda)
  # Store the samples in the list
  exponential_samples_list[[as.character(lambda)]] <- samples
}

# Plot the results
par(mar = c(1, 1, 1, 1))
## NOTE IF YOUU RUN THIS CODE YOU HAVE TO TRY TO RUN FIRST THEN YPU GET ERROR
## THEN HIGHLIGHT JUST THE FOR LOOP BELOW AND GRAPHS GENERATE


histogram_list <- list()

for (i in seq_along(lambda_values)){
  histogram<-hist(
    exponential_samples_list[[as.character(lambda_values[i])]],
    main = paste("Transformed Exponential (lambda =", lambda_values[i], ")"),
    col = "lightgreen",
    xlim = c(0, 2)
  )
  # Save the histogram to the list
  histogram_list[[as.character(lambda)]]<-histogram
}

# Plotting multiple exponential distributions
# Set a seed for 
set.seed(123)

# Number of points to plot
num_points <- 1000

# Exponential distribution parameters
lambda_values3 <- c(num_events/numppl)

# Plot multiple exponential distributions using curve
par(mfrow = c(1, 1))  # Set up a single plot
colors <- rainbow(length(lambda_values3))

for (i in seq_along(lambda_values3)) {
  curve(dexp(x, rate = lambda_values3[i]), from = 0, to = 10, col = colors[i],
        main = 'Multiple Exponential Distributions', xlab = 'x', ylab = 'Density',
        add = i > 1)  # Add to the existing plot after the first curve
}

# Add a legend
legend('topright', legend = paste('Lambda =', lambda_values3), fill = colors)

# Set a seed for reproducibility
set.seed(123)

# Number of months we only had 11 of the months
num_months <- 11

# Mean rates for each month
mean_rates <- c(num_events/numppl)

# Generate monthly data from different exponential distributions given # we had 52
# samples
monthly_data <- lapply(mean_rates, function(mean_rate) {
  rexp(52, rate = mean_rate)
})

# Combine the monthly data into a data frame
monthly_data_frame <- data.frame(
  month = rep(1:num_months, each = 52),
  values = unlist(monthly_data)
)

# Plot the monthly exponential distributions
library(ggplot2)

ggplot(monthly_data_frame, aes(x = values, fill = as.factor(month))) +
  geom_histogram(binwidth = 0.2, position = "identity", alpha = 0.5) +
  labs(title = 'Monthly Exponential Distributions',
       x = 'Values', y = 'Frequency') +
  theme_minimal()

# Set a seed 
set.seed(123)

# Number of samples
num_samples <- 52
samplemeans<-list()
# Different lambda values for different time intervals
lambda_values <-c(num_events/numppl)

# Create a PDF file to save the plots


# Generate samples for each lambda and record the mean
##ALSO RUN THIS BLOCK THEN GET ERROR COME BACK RUN JUS THIS FOR LOOP TO SEE PLOTS
for (lambda in lambda_values) {
 
  samples <- generate_exponential_samples(num_samples, lambda)
  
  # Calculate the mean of the samples
  mean_value <- mean(samples)
   samplemeans<- c(mean(samples[i]))
  # Plot and save the histogram with the mean
  hist(
    samples, mean(samples),
    main = paste("Transformed Exponential (lambda =", lambda, ")\nMean =", round(mean_value, 2)),
    col = "lightgreen",
    xlim = c(0, 20),
    breaks = 50
  )
 
}

## The process of simulating from a uniform distribution for our data 
## and model was a very tedious process. After looking at all the sample 
## fromeansm teh previious histograms it appears as though this was a good 
## fit for sampling but I do not have anyone to check the work I did here there could ## also be user error of how how I drew samples.
##
##  If we had a larger data set and if we
## we had been able to tailor our questions a bit differently then the approach
## for applying this model could  have produced  more significant results. 
## Below is the actual mean for each month
actualmean<-c(numppl/num_events)