R- Assignment 1

PHOTO

Thu Sep 19 2024 22:09:36 GMT+0000 (Coordinated Universal Time)

set.seed(28092024) 
n <- 3 
sample_norm <- rnorm(3,0,sqrt(5)) 
unb_estim <- var(sample_norm) 
max_estim <- var(sample_norm) * ((n-1)/n) 
mse_estim <- var(sample_norm) * ((n-1)/(n+1)) 
popul_var <- 5



estimates <- c(max_estim , unb_estim , mse_estim ) 
differences <- estimates - popul_var 
result <- data.frame( Estimator = c("MLE", "Unbiased", "MinMSE"), Estimate = estimates, Difference = differences ) 
print(result)
barplot(result$Difference, names.arg = result$Estimator, main = "Difference of Estimator values fromTrue Population Variance", ylab = "Difference", col = c("red", "green", "blue"), ylim = c(min(result$Difference) - 1, max(result$Difference) + 1))



calculate_estimators <- function(n, S, mean, popul_var) { 
unbiased_vals <- numeric(S) 
mle_vals <- numeric(S) 
mse_vals <- numeric(S) 
for (i in 1:S) { 
sample <- rnorm(n, mean, sqrt(popul_var)) 
unbiased <- var(sample) 
mle <- unbiased * ((n - 1) / n) 
minmse <- unbiased * ((n - 1) / (n + 1)) 
unbiased_vals[i] <- unbiased 
mle_vals[i] <- mle 
mse_vals[i] <- minmse } 
return(list( unbiased_var = unbiased_vals, mle_var = mle_vals, mse_var = mse_vals )) } 



stats_calc <- function(estimate_vals, popul_var) { 
avg_val <- mean(estimate_vals) 
bias <- avg_val - popul_var 
variance <- var(estimate_vals) 
mse <- mean((estimate_vals - popul_var)^2) 
return(c(Average = avg_val, Bias = bias, Variance = variance, MSE = mse)) } 
exp_n3 = calculate_estimators(3,10000,0,sqrt(5))
exp_n20 = calculate_estimators(20,10000,0,sqrt(5))
exp_n200 = calculate_estimators(200,10000,0,sqrt(5))



results_n3 <- data.frame( Estimator = c("Unbiased", "MLE", "MinMSE"), Average = c(n3_unbiased_stats["Average"], n3_mle_stats["Average"], n3_minmse_stats["Average"]), Bias = c(n3_unbiased_stats["Bias"], n3_mle_stats["Bias"], n3_minmse_stats["Bias"]), Variance = c(n3_unbiased_stats["Variance"], n3_mle_stats["Variance"], n3_minmse_stats["Variance"]), MSE = c(n3_unbiased_stats["MSE"], n3_mle_stats["MSE"], n3_minmse_stats["MSE"]) )

results_n20 <- data.frame( Estimator = c("Unbiased", "MLE", "MinMSE"), Average = c(n20_unbiased_stats["Average"], n20_mle_stats["Average"], n20_minmse_stats["Average"]), Bias = c(n20_unbiased_stats["Bias"], n20_mle_stats["Bias"], n20_minmse_stats["Bias"]), Variance = c(n20_unbiased_stats["Variance"], n20_mle_stats["Variance"], n20_minmse_stats["Variance"]), MSE = c(n20_unbiased_stats["MSE"], n20_mle_stats["MSE"], n20_minmse_stats["MSE"]) )


results_n200 <- data.frame( Estimator = c("Unbiased", "MLE", "MinMSE"), Average = c(n200_unbiased_stats["Average"], n200_mle_stats["Average"], n200_minmse_stats["Average"]), Bias = c(n200_unbiased_stats["Bias"], n200_mle_stats["Bias"], n200_minmse_stats["Bias"]), Variance = c(n200_unbiased_stats["Variance"], n200_mle_stats["Variance"], n200_minmse_stats["Variance"]), MSE = c(n200_unbiased_stats["MSE"], n200_mle_stats["MSE"], n200_minmse_stats["MSE"]) )

COPY

Save snippets that work from anywhere online with our extensions

Comments

Statistical computing - R

@madgakantara

R- Assignment 1

How to Combine Multiple GGPlots into a Figure - Datanovia

library(ggplot2)
library("ggpubr")
theme_set(
  theme_bw() +
    theme(legend.position = "top")
  )

Dynamically select dataframe column in R

var <- "mpg"
#Doesn't work
mtcars$var
#These both work, but note that what they return is different
# the first is a vector, the second is a data.frame
mtcars[[var]]
mtcars[var]

multiple correspondence analysis in R

# load packages
require(FactoMineR)
require(ggplot2)
# load data tea
data(tea)
# select these columns
newtea = tea[, c("Tea", "How", "how", "sugar", "where", "always")]
# take a look
head(newtea)


# number of categories per variable
cats = apply(newtea, 2, function(x) nlevels(as.factor(x)))
cats

# apply MCA
mca1 = MCA(newtea, graph = FALSE)

# table of eigenvalues
mca1$eig


# data frames for ggplot
mca1_vars_df = data.frame(mca1$var$coord, Variable = rep(names(cats), 
                                                         cats))
mca1_obs_df = data.frame(mca1$ind$coord)

# plot of variable categories
ggplot(data = mca1_vars_df,
       aes(x = Dim.1, y = Dim.2, label = rownames(mca1_vars_df))) + 
  geom_hline(yintercept = 0, colour = "gray70") + geom_vline(xintercept = 0, 
                                              colour = "gray70") +
  geom_text(aes(colour = Variable)) + 
  ggtitle("MCA plot of variables using R package FactoMineR")


# XXX ---------------------------------------------------------------------

Base_acm <- Base %>% select(P1_1, P3_1, P3_2, P3_3)
Base_acm$P1_1 <- as.factor(Base_acm$P1_1)
Base_acm$P3_1 <- as.factor(Base_acm$P3_1)
Base_acm$P3_2 <- as.factor(Base_acm$P3_2)
Base_acm$P3_3 <- as.factor(Base_acm$P3_3)

cats=apply(Base_acm, 2, function(x) nlevels(as.factor(x)))

mca2 = MCA(Base_acm, graph = FALSE)

# data frames for ggplot
mca2_vars_df = data.frame(mca2$var$coord, Variable = rep(names(cats), 
                                                         cats))
mca2_obs_df = data.frame(mca2$ind$coord)

# plot of variable categories
ggplot(data = mca2_vars_df,
       aes(x = Dim.1, y = Dim.2, label = rownames(mca2_vars_df))) + 
  geom_hline(yintercept = 0, colour = "gray70") + geom_vline(xintercept = 0, 
                                                        colour = "gray70") +
  geom_text(aes(colour = Variable)) + 
  ggtitle("MCA plot of variables using R package FactoMineR")

factoextra::fviz_screeplot(mca2, addlabels = TRUE, ylim = c(0, 45))

Basic Scatter Plot

x <- data$variable_xaxis
y <- data$variable_yaxis

plot(x, y, main = "Main title",
     xlab = "X axis title", ylab = "Y axis title",
     pch = 19, frame = FALSE)
abline(lm(y ~ x, data = mtcars), col = "blue")

Basic Plot with Geom

qplot(x-coordinate, y-coordinate, data=data_frame, geom = c("point", "smooth")

Basic Plot with Point Layer (ggplot2)

g <- ggplot(data_set, aes(x-variable, y-variable) 

g + geom_point()

basic scatter plot

x <- data$variable_xaxis
y <- data$variable_yaxis

plot(x, y, main = "Main title",
     xlab = "X axis title", ylab = "Y axis title",
     pch = 19, frame = FALSE)
abline(lm(y ~ x, data = mtcars), col = "blue")

Fix Misspellings in a Data frame

library(tidyverse)

df$column <- df$column str_to_title(df$column) #Standardize caps

#Two options 
df$column <- str_replace(df$column, "old", "new") #Option 1, uses str_replace
df$column <- gsub("old", "new", df$column) #Option 2, uses str_replace

Select Rows in a Data Frame that do not match

# make data frame 
a <- data.frame( x =  c(1,2,3,4)) 
b <- data.frame( y =  c(1,2,3,4,5,6))
subset(b, !(y %in% a$x)) #Pulls values from frame b that are not in frame a

Importa vários arquivos iguais da mesma pasta

dir <- "directory of archives"

directories <- as.list(file.path(dir, list.files(dir, pattern = ".*.csv")))

dataframes <- map(directories , rio::import)

dataset <- plyr::ldply(dataframes, data.frame)

Order or sort a character vector


str_order(
  x,
  decreasing = FALSE,
  na_last = TRUE,
  locale = "en",
  numeric = FALSE,
  ...
)
  
# Examples 
  
  str_order(letters)
#>  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
#> [26] 26
str_sort(letters)
#>  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s"
#> [20] "t" "u" "v" "w" "x" "y" "z"

str_order(letters, locale = "haw")
#>  [1]  1  5  9 15 21  2  3  4  6  7  8 10 11 12 13 14 16 17 18 19 20 22 23 24 25
#> [26] 26
str_sort(letters, locale = "haw")
#>  [1] "a" "e" "i" "o" "u" "b" "c" "d" "f" "g" "h" "j" "k" "l" "m" "n" "p" "q" "r"
#> [20] "s" "t" "v" "w" "x" "y" "z"

x <- c("100a10", "100a5", "2b", "2a")
str_sort(x)
#> [1] "100a10" "100a5"  "2a"     "2b"    
str_sort(x, numeric = TRUE)
#> [1] "2a"     "2b"     "100a5"  "100a10"

Turns Swedbank Estonia financial statement csv file to cashflow dataframe

# Account
statement <- read.csv("statement.csv", stringsAsFactors = F, sep = ";")

# Get rid of irrelevant columns
statement <- statement[2:13]

# Statement money flows
rahavoog <- statement[statement$Reatüüp == 20,]
rahavoog$Summa <- as.numeric(gsub(",", ".", rahavoog$Summa))

Removes outliers in dataframe column by looking at quartiles

#Outlier Removal Function
remove_outliers <- function(dataframe, column, na.rm = TRUE) {
  Q1 <- quantile(column, .25)
  Q3 <- quantile(column, .75)
  IQR <- IQR(column)
  dataframe <- subset(dataframe, column> (Q1 - 1.5*IQR) & column< (Q3 + 1.5*IQR))
}

#Not looping
df_1 <-remove_outliers(df_1,df_1$Column1)

#Loop through a list of column names
for(i in Column_List){
  df_1 <- remove_outliers(df_1, df_1[[i]])
}

Stopping an R Script running upon a certain condition

if (1 != 2)
  stop("something is wrong")

Try function & Continue the execution

try(log("not a number"), silent = TRUE)
print("errors can't stop me")

R- Assignment 1

Save snippets that work from anywhere online with our extensions

Comments

More like this

Statistical computing - R

Browse more snippets >>

R- Assignment 1

Save snippets that work from anywhere online with our extensions

Comments

More like this

Statistical computing - R

Browse more snippets >>

Embed code snippet