HW_10.RMD
Megan O’Connor
2024-04-10
Question 1. Using a for loop, write a function to calculate the number of zeroes in a numeric vector. Before entering the loop, set up a counter variable counter <- 0. Inside the loop, add 1 to counter each time you have a zero in the vector. Finally, use return(counter) for the output.
counter <- 0
vector <- c(0,1,2,0,7,8,0,9,9,4,5,0)
counting_zeroes <- function(vector) {
for (i in vector) {
if (i == 0) {
counter <- counter + 1
}
}
return(counter)
}
counting_zeroes(vector)## [1] 4Question 2. Use subsetting instead of a loop to rewrite the function as a single line of code.
zero_subset <- function(vector) {
return(sum(vector == 0))
}
zero_subset(vector)## [1] 4Question 3.
mtrx <- function(rows,cols) {
result <- matrix(nrow=rows,ncol=cols)
for (i in 1:rows) {
for (j in 1:cols) {
result[i,j] <- i*j
}
}
return(result)
}
rows <- 4
cols <- 5
final_matrix <- mtrx(rows,cols)
print(final_matrix)## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 2 3 4 5
## [2,] 2 4 6 8 10
## [3,] 3 6 9 12 15
## [4,] 4 8 12 16 20Question 4a.
n <- 100
means <- c(50,75,100)
group <- rep(1:3, each=n)
response <- c(rnorm(n,mean=means[1]),
rnorm(n,mean=means[2]),
rnorm(n,mean=means[3]))
# making a data fram!
MyData <- data.frame(group, response)
data## function (..., list = character(), package = NULL, lib.loc = NULL,
## verbose = getOption("verbose"), envir = .GlobalEnv, overwrite = TRUE)
## {
## fileExt <- function(x) {
## db <- grepl("\\.[^.]+\\.(gz|bz2|xz)$", x)
## ans <- sub(".*\\.", "", x)
## ans[db] <- sub(".*\\.([^.]+\\.)(gz|bz2|xz)$", "\\1\\2",
## x[db])
## ans
## }
## my_read_table <- function(...) {
## lcc <- Sys.getlocale("LC_COLLATE")
## on.exit(Sys.setlocale("LC_COLLATE", lcc))
## Sys.setlocale("LC_COLLATE", "C")
## read.table(...)
## }
## names <- c(as.character(substitute(list(...))[-1L]), list)
## if (!is.null(package)) {
## if (!is.character(package))
## stop("'package' must be a character string or NULL")
## if (FALSE) {
## if (any(package %in% "base"))
## warning("datasets have been moved from package 'base' to package 'datasets'")
## if (any(package %in% "stats"))
## warning("datasets have been moved from package 'stats' to package 'datasets'")
## package[package %in% c("base", "stats")] <- "datasets"
## }
## }
## paths <- find.package(package, lib.loc, verbose = verbose)
## if (is.null(lib.loc))
## paths <- c(path.package(package, TRUE), if (!length(package)) getwd(),
## paths)
## paths <- unique(normalizePath(paths[file.exists(paths)]))
## paths <- paths[dir.exists(file.path(paths, "data"))]
## dataExts <- tools:::.make_file_exts("data")
## if (length(names) == 0L) {
## db <- matrix(character(), nrow = 0L, ncol = 4L)
## for (path in paths) {
## entries <- NULL
## packageName <- if (file_test("-f", file.path(path,
## "DESCRIPTION")))
## basename(path)
## else "."
## if (file_test("-f", INDEX <- file.path(path, "Meta",
## "data.rds"))) {
## entries <- readRDS(INDEX)
## }
## else {
## dataDir <- file.path(path, "data")
## entries <- tools::list_files_with_type(dataDir,
## "data")
## if (length(entries)) {
## entries <- unique(tools::file_path_sans_ext(basename(entries)))
## entries <- cbind(entries, "")
## }
## }
## if (NROW(entries)) {
## if (is.matrix(entries) && ncol(entries) == 2L)
## db <- rbind(db, cbind(packageName, dirname(path),
## entries))
## else warning(gettextf("data index for package %s is invalid and will be ignored",
## sQuote(packageName)), domain = NA, call. = FALSE)
## }
## }
## colnames(db) <- c("Package", "LibPath", "Item", "Title")
## footer <- if (missing(package))
## paste0("Use ", sQuote(paste("data(package =", ".packages(all.available = TRUE))")),
## "\n", "to list the data sets in all *available* packages.")
## else NULL
## y <- list(title = "Data sets", header = NULL, results = db,
## footer = footer)
## class(y) <- "packageIQR"
## return(y)
## }
## paths <- file.path(paths, "data")
## for (name in names) {
## found <- FALSE
## for (p in paths) {
## tmp_env <- if (overwrite)
## envir
## else new.env()
## if (file_test("-f", file.path(p, "Rdata.rds"))) {
## rds <- readRDS(file.path(p, "Rdata.rds"))
## if (name %in% names(rds)) {
## found <- TRUE
## if (verbose)
## message(sprintf("name=%s:\t found in Rdata.rds",
## name), domain = NA)
## thispkg <- sub(".*/([^/]*)/data$", "\\1", p)
## thispkg <- sub("_.*$", "", thispkg)
## thispkg <- paste0("package:", thispkg)
## objs <- rds[[name]]
## lazyLoad(file.path(p, "Rdata"), envir = tmp_env,
## filter = function(x) x %in% objs)
## break
## }
## else if (verbose)
## message(sprintf("name=%s:\t NOT found in names() of Rdata.rds, i.e.,\n\t%s\n",
## name, paste(names(rds), collapse = ",")),
## domain = NA)
## }
## if (file_test("-f", file.path(p, "Rdata.zip"))) {
## warning("zipped data found for package ", sQuote(basename(dirname(p))),
## ".\nThat is defunct, so please re-install the package.",
## domain = NA)
## if (file_test("-f", fp <- file.path(p, "filelist")))
## files <- file.path(p, scan(fp, what = "", quiet = TRUE))
## else {
## warning(gettextf("file 'filelist' is missing for directory %s",
## sQuote(p)), domain = NA)
## next
## }
## }
## else {
## files <- list.files(p, full.names = TRUE)
## }
## files <- files[grep(name, files, fixed = TRUE)]
## if (length(files) > 1L) {
## o <- match(fileExt(files), dataExts, nomatch = 100L)
## paths0 <- dirname(files)
## paths0 <- factor(paths0, levels = unique(paths0))
## files <- files[order(paths0, o)]
## }
## if (length(files)) {
## for (file in files) {
## if (verbose)
## message("name=", name, ":\t file= ...", .Platform$file.sep,
## basename(file), "::\t", appendLF = FALSE,
## domain = NA)
## ext <- fileExt(file)
## if (basename(file) != paste0(name, ".", ext))
## found <- FALSE
## else {
## found <- TRUE
## zfile <- file
## zipname <- file.path(dirname(file), "Rdata.zip")
## if (file.exists(zipname)) {
## Rdatadir <- tempfile("Rdata")
## dir.create(Rdatadir, showWarnings = FALSE)
## topic <- basename(file)
## rc <- .External(C_unzip, zipname, topic,
## Rdatadir, FALSE, TRUE, FALSE, FALSE)
## if (rc == 0L)
## zfile <- file.path(Rdatadir, topic)
## }
## if (zfile != file)
## on.exit(unlink(zfile))
## switch(ext, R = , r = {
## library("utils")
## sys.source(zfile, chdir = TRUE, envir = tmp_env)
## }, RData = , rdata = , rda = load(zfile,
## envir = tmp_env), TXT = , txt = , tab = ,
## tab.gz = , tab.bz2 = , tab.xz = , txt.gz = ,
## txt.bz2 = , txt.xz = assign(name, my_read_table(zfile,
## header = TRUE, as.is = FALSE), envir = tmp_env),
## CSV = , csv = , csv.gz = , csv.bz2 = ,
## csv.xz = assign(name, my_read_table(zfile,
## header = TRUE, sep = ";", as.is = FALSE),
## envir = tmp_env), found <- FALSE)
## }
## if (found)
## break
## }
## if (verbose)
## message(if (!found)
## "*NOT* ", "found", domain = NA)
## }
## if (found)
## break
## }
## if (!found) {
## warning(gettextf("data set %s not found", sQuote(name)),
## domain = NA)
## }
## else if (!overwrite) {
## for (o in ls(envir = tmp_env, all.names = TRUE)) {
## if (exists(o, envir = envir, inherits = FALSE))
## warning(gettextf("an object named %s already exists and will not be overwritten",
## sQuote(o)))
## else assign(o, get(o, envir = tmp_env, inherits = FALSE),
## envir = envir)
## }
## rm(tmp_env)
## }
## }
## invisible(names)
## }
## <bytecode: 0x7fb8a4c1dd90>
## <environment: namespace:utils>Question 4b.
# first I need to reshuffle the data and THEN get the means again
reshuffle_time <- function(MyData){
for (i in MyData) {
shuffleresponse <- sample(MyData[,2])
shuffleresponse
# then I make a new frame
data_2 <- data.frame(group,shuffleresponse)
data_2
# NOW i get the means
group_1mean <- mean(data_2[1:n,2])
group_2mean <- mean(data_2[n:(2*n),2])
group_3mean <- mean(data_2[(2*n):(3*n),2])
}
new_means <- data.frame(group_1mean, group_2mean, group_3mean)
return(new_means)
}
reshuffle_time(MyData)## group_1mean group_2mean group_3mean
## 1 74.09539 77.13599 73.53254# YAY MY NEW MEANS ARE REALQuestion 4c.
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.1.2## Warning: package 'tibble' was built under R version 4.1.2## Warning: package 'tidyr' was built under R version 4.1.2## Warning: package 'readr' was built under R version 4.1.2## Warning: package 'stringr' was built under R version 4.1.2## Warning: package 'forcats' was built under R version 4.1.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## âś” dplyr 1.1.3 âś” readr 2.1.4
## âś” forcats 1.0.0 âś” stringr 1.5.0
## âś” ggplot2 3.4.4 âś” tibble 3.2.1
## âś” lubridate 1.9.3 âś” tidyr 1.3.0
## âś” purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## âś– dplyr::filter() masks stats::filter()
## âś– dplyr::lag() masks stats::lag()
## â„ą Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors# using a for loop to replicate these 100 times :)
loopy <- function(MyData) {
MyResults <- data.frame(matrix(nrow=n,ncol=4))
colnames(MyResults) <- c("replicate", "group_1mean", "group_2mean", "group_3mean")
# n = 100 in this case
for (i in 1:n) {
new_means <- reshuffle_time(MyData) # bringing back this function
MyResults[i,1:4] <- c(i,new_means)
}
# what are we returning???? RESULTS
return(MyResults)
}
n = 100 # like i said before
answer <- loopy(MyData)
answer## replicate group_1mean group_2mean group_3mean
## 1 1 73.03579 78.27858 73.93989
## 2 2 73.31962 73.74516 77.65652
## 3 3 74.72534 75.62119 74.64805
## 4 4 74.24647 75.24336 75.26631
## 5 5 74.24632 75.12712 75.39177
## 6 6 74.24422 73.16636 77.57096
## 7 7 74.22138 75.36772 75.41047
## 8 8 75.99062 75.24609 74.01975
## 9 9 73.79588 76.55190 74.64275
## 10 10 75.23301 75.02481 74.76623
## 11 11 71.26861 79.19517 75.01353
## 12 12 72.71910 77.00207 75.75260
## 13 13 74.91605 74.90706 75.43609
## 14 14 75.94677 76.20286 72.89015
## 15 15 77.20937 72.04018 76.00809
## 16 16 72.19455 77.75893 75.03619
## 17 17 76.76948 76.45579 72.05889
## 18 18 75.28018 74.23868 75.75242
## 19 19 71.94252 79.55517 73.73177
## 20 20 76.67572 73.27983 75.07275
## 21 21 75.48562 73.05360 76.73477
## 22 22 73.97177 76.58468 74.69191
## 23 23 75.60126 75.14381 73.77726
## 24 24 72.99169 75.33177 76.67847
## 25 25 72.02563 75.99832 77.20503
## 26 26 72.34015 75.62186 77.50801
## 27 27 76.28498 74.78733 74.18611
## 28 28 74.01963 78.17370 73.04016
## 29 29 76.48359 75.52728 73.02490
## 30 30 75.38845 74.70979 75.18597
## 31 31 74.47664 74.36040 75.94702
## 32 32 74.31417 74.76252 75.92916
## 33 33 76.73764 73.47091 74.84206
## 34 34 75.01884 74.01227 75.49204
## 35 35 76.55690 74.45869 74.25036
## 36 36 73.24272 74.87953 76.86857
## 37 37 72.37760 74.27080 77.83824
## 38 38 75.28253 71.84985 77.86397
## 39 39 75.51594 72.69426 76.57909
## 40 40 73.89660 74.61655 76.73209
## 41 41 73.47252 76.05850 75.20858
## 42 42 74.23773 73.38606 77.63742
## 43 43 73.24160 74.44604 77.30885
## 44 44 74.32227 76.70038 73.74904
## 45 45 77.65596 74.61641 73.04446
## 46 46 73.62802 75.71158 76.14214
## 47 47 77.37765 72.38110 75.31055
## 48 48 71.26674 78.70318 74.99209
## 49 49 75.15302 74.00704 75.84121
## 50 50 75.97539 72.52280 76.77211
## 51 51 73.78495 73.46497 77.99244
## 52 52 74.84510 73.84327 76.54843
## 53 53 73.80573 75.47857 76.18067
## 54 54 75.77924 75.02350 74.69911
## 55 55 75.37601 73.81581 76.29940
## 56 56 77.80022 72.79944 74.68316
## 57 57 74.61080 75.40034 75.01093
## 58 58 74.06123 75.68152 75.50049
## 59 59 78.14745 71.48720 75.15814
## 60 60 74.36578 71.77031 78.38867
## 61 61 73.83909 75.30956 76.33568
## 62 62 73.68212 74.74963 77.04984
## 63 63 75.93036 74.75924 74.09020
## 64 64 77.37170 75.84883 71.58910
## 65 65 75.64885 75.70930 74.14621
## 66 66 76.88513 76.61649 71.52817
## 67 67 74.52163 75.61303 74.87636
## 68 68 76.60692 76.99509 71.65767
## 69 69 74.87275 74.71218 75.91618
## 70 70 73.13549 77.91079 74.43465
## 71 71 76.07187 75.15046 73.56037
## 72 72 76.32747 73.03994 76.14031
## 73 73 72.70055 76.69327 76.08018
## 74 74 77.25663 73.48390 73.80977
## 75 75 76.10849 75.17359 73.97368
## 76 76 75.74900 72.29862 76.71627
## 77 77 78.12120 75.88196 71.04105
## 78 78 76.17532 78.11187 70.99145
## 79 79 72.54799 78.13577 74.03450
## 80 80 72.33178 76.16852 76.73985
## 81 81 74.25001 74.47743 76.03520
## 82 82 76.82076 72.18028 75.54255
## 83 83 79.71106 75.73811 69.83519
## 84 84 74.11315 75.78415 75.12748
## 85 85 75.33965 72.64756 77.01908
## 86 86 76.89028 73.52794 74.85080
## 87 87 74.24863 74.72997 76.27284
## 88 88 75.36040 74.42311 74.98939
## 89 89 76.19982 73.00493 75.55743
## 90 90 75.96966 76.09004 72.98997
## 91 91 76.22718 76.21414 72.35597
## 92 92 73.42373 75.13126 76.43760
## 93 93 74.47383 76.12477 74.42984
## 94 94 76.54490 75.90451 72.79999
## 95 95 78.69900 74.28508 72.06729
## 96 96 76.44119 75.20503 73.37100
## 97 97 72.18978 77.00957 75.80420
## 98 98 78.43106 75.05458 71.79408
## 99 99 70.73027 77.36763 76.39787
## 100 100 76.07574 72.81155 76.12664Question 4d.
# time to make a nice looking plot that you can fill with whatever group you want to look at
library(ggplot2)
answer## replicate group_1mean group_2mean group_3mean
## 1 1 73.03579 78.27858 73.93989
## 2 2 73.31962 73.74516 77.65652
## 3 3 74.72534 75.62119 74.64805
## 4 4 74.24647 75.24336 75.26631
## 5 5 74.24632 75.12712 75.39177
## 6 6 74.24422 73.16636 77.57096
## 7 7 74.22138 75.36772 75.41047
## 8 8 75.99062 75.24609 74.01975
## 9 9 73.79588 76.55190 74.64275
## 10 10 75.23301 75.02481 74.76623
## 11 11 71.26861 79.19517 75.01353
## 12 12 72.71910 77.00207 75.75260
## 13 13 74.91605 74.90706 75.43609
## 14 14 75.94677 76.20286 72.89015
## 15 15 77.20937 72.04018 76.00809
## 16 16 72.19455 77.75893 75.03619
## 17 17 76.76948 76.45579 72.05889
## 18 18 75.28018 74.23868 75.75242
## 19 19 71.94252 79.55517 73.73177
## 20 20 76.67572 73.27983 75.07275
## 21 21 75.48562 73.05360 76.73477
## 22 22 73.97177 76.58468 74.69191
## 23 23 75.60126 75.14381 73.77726
## 24 24 72.99169 75.33177 76.67847
## 25 25 72.02563 75.99832 77.20503
## 26 26 72.34015 75.62186 77.50801
## 27 27 76.28498 74.78733 74.18611
## 28 28 74.01963 78.17370 73.04016
## 29 29 76.48359 75.52728 73.02490
## 30 30 75.38845 74.70979 75.18597
## 31 31 74.47664 74.36040 75.94702
## 32 32 74.31417 74.76252 75.92916
## 33 33 76.73764 73.47091 74.84206
## 34 34 75.01884 74.01227 75.49204
## 35 35 76.55690 74.45869 74.25036
## 36 36 73.24272 74.87953 76.86857
## 37 37 72.37760 74.27080 77.83824
## 38 38 75.28253 71.84985 77.86397
## 39 39 75.51594 72.69426 76.57909
## 40 40 73.89660 74.61655 76.73209
## 41 41 73.47252 76.05850 75.20858
## 42 42 74.23773 73.38606 77.63742
## 43 43 73.24160 74.44604 77.30885
## 44 44 74.32227 76.70038 73.74904
## 45 45 77.65596 74.61641 73.04446
## 46 46 73.62802 75.71158 76.14214
## 47 47 77.37765 72.38110 75.31055
## 48 48 71.26674 78.70318 74.99209
## 49 49 75.15302 74.00704 75.84121
## 50 50 75.97539 72.52280 76.77211
## 51 51 73.78495 73.46497 77.99244
## 52 52 74.84510 73.84327 76.54843
## 53 53 73.80573 75.47857 76.18067
## 54 54 75.77924 75.02350 74.69911
## 55 55 75.37601 73.81581 76.29940
## 56 56 77.80022 72.79944 74.68316
## 57 57 74.61080 75.40034 75.01093
## 58 58 74.06123 75.68152 75.50049
## 59 59 78.14745 71.48720 75.15814
## 60 60 74.36578 71.77031 78.38867
## 61 61 73.83909 75.30956 76.33568
## 62 62 73.68212 74.74963 77.04984
## 63 63 75.93036 74.75924 74.09020
## 64 64 77.37170 75.84883 71.58910
## 65 65 75.64885 75.70930 74.14621
## 66 66 76.88513 76.61649 71.52817
## 67 67 74.52163 75.61303 74.87636
## 68 68 76.60692 76.99509 71.65767
## 69 69 74.87275 74.71218 75.91618
## 70 70 73.13549 77.91079 74.43465
## 71 71 76.07187 75.15046 73.56037
## 72 72 76.32747 73.03994 76.14031
## 73 73 72.70055 76.69327 76.08018
## 74 74 77.25663 73.48390 73.80977
## 75 75 76.10849 75.17359 73.97368
## 76 76 75.74900 72.29862 76.71627
## 77 77 78.12120 75.88196 71.04105
## 78 78 76.17532 78.11187 70.99145
## 79 79 72.54799 78.13577 74.03450
## 80 80 72.33178 76.16852 76.73985
## 81 81 74.25001 74.47743 76.03520
## 82 82 76.82076 72.18028 75.54255
## 83 83 79.71106 75.73811 69.83519
## 84 84 74.11315 75.78415 75.12748
## 85 85 75.33965 72.64756 77.01908
## 86 86 76.89028 73.52794 74.85080
## 87 87 74.24863 74.72997 76.27284
## 88 88 75.36040 74.42311 74.98939
## 89 89 76.19982 73.00493 75.55743
## 90 90 75.96966 76.09004 72.98997
## 91 91 76.22718 76.21414 72.35597
## 92 92 73.42373 75.13126 76.43760
## 93 93 74.47383 76.12477 74.42984
## 94 94 76.54490 75.90451 72.79999
## 95 95 78.69900 74.28508 72.06729
## 96 96 76.44119 75.20503 73.37100
## 97 97 72.18978 77.00957 75.80420
## 98 98 78.43106 75.05458 71.79408
## 99 99 70.73027 77.36763 76.39787
## 100 100 76.07574 72.81155 76.12664answer_plot <- qplot(data=answer,
y=answer[,2],
geom="histogram",
fill=I("purple"),
main="Group Means",
xlim=c(0,100), # repeats 100x
ylim=c(0,100), # my means go up to 100
xlab="Replicate",
# now we let ppl know which group we're looking at
ylab="Group 1 Mean Value")## Warning: `qplot()` was deprecated in ggplot2 3.4.0.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.answer_plot## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 2 rows containing missing values (`geom_bar()`).