char <- c("4", "2", "1", "0")
num <- 0:3
charnum <- data.frame(char, num, stringsAsFactors = TRUE)
as.numeric(as.character(charnum$char))## [1] 4 2 1 0Explanation:
The difference in results arises because of how R handles character vectors and factors:
Character vectors: When you apply as.numeric() to a character vector, R directly converts each element to its numeric equivalent if possible.
Factors: When you apply as.numeric() to a factor, R converts the factor to its underlying integer codes rather than the character values. This is because factors are internally stored as integers with corresponding levels.
char <- c("4", "2", "1", "0")
num <- 0:3
charnum <- data.frame(char, num, stringsAsFactors = TRUE)
# Convert charnum$char to numeric vector identical to as.numeric(char)
numeric_char_from_charnum <- as.numeric(as.character(charnum$char))
# Verify the result
numeric_char_from_charnum## [1] 4 2 1 0simple_list <- list("vector" = 1:10, "matrix" = matrix(6:1, nrow = 3, ncol = 2))
# simple_list$NULL <- NULL : cannot be used to add a named component to simple_list that contains the NULL object.The command simple_list$NULL <- NULL cannot be used to add a named component containing the NULL object to simple_list for two reasons:
NULL is a reserved word in R, representing an empty or non-existent value, and using it as a name for a list component causes ambiguity and potential errors.
Assigning NULL to a list component effectively removes that component from the list, rather than adding a new one with NULL as its value, as demonstrated by the fact that simple_list$NULL <- NULL would result in the component being omitted from the list.
# Existing simple_list
simple_list <- list("vector" = 1:10, "matrix" = matrix(6:1, nrow = 3, ncol = 2))
# Add a component that contains the NULL object
simple_list <- c(simple_list, list(null_component = NULL))
# Verify the length of the list
length(simple_list) == 3## [1] TRUE# Re-add the vector component to ensure it is not removed
simple_list <- c(simple_list, list(vector = NULL))
# Verify the structure of the updated list
str(simple_list)## List of 4
## $ vector : int [1:10] 1 2 3 4 5 6 7 8 9 10
## $ matrix : int [1:3, 1:2] 6 5 4 3 2 1
## $ null_component: NULL
## $ vector : NULL# Verify the length of the list
length(simple_list) == 3## [1] FALSEmy_scale <- function(x) {
# Check if the input has attributes a and b
if (!is.null(attr(x, "a")) && !is.null(attr(x, "b"))) {
a <- attr(x, "a")
b <- attr(x, "b")
} else {
a <- 0
b <- 1
}
# Compute the minimum and maximum of the input vector
min_x <- min(x, na.rm = TRUE)
max_x <- max(x, na.rm = TRUE)
# Apply min-max scaling
z <- a + (x - min_x) * (b - a) / (max_x - min_x)
# Add attributes to the output vector
attr(z, "a") <- min_x
attr(z, "b") <- max_x
return(z)
}
# Test the function with a numeric vector
x <- c(2, 4, 6, 8, 10)
# Apply the scaling function
scaled_x <- my_scale(x)
print(scaled_x)## [1] 0.00 0.25 0.50 0.75 1.00
## attr(,"a")
## [1] 2
## attr(,"b")
## [1] 10# Check attributes
print(attr(scaled_x, "a"))## [1] 2print(attr(scaled_x, "b"))## [1] 10# Apply the scaling function again
rescaled_x <- my_scale(scaled_x)
print(rescaled_x)## [1] 2 4 6 8 10
## attr(,"a")
## [1] 0
## attr(,"b")
## [1] 1Question:
Write a function called na_replace_mean that takes a numeric vector as input and replaces any NA values with the mean of the non-NA values in the vector. If the vector is entirely composed of NAs, return the original vector.
Requirements:
The function should take one argument: x: A numeric vector which may contain NA values.
The function should return a numeric vector where all NA values have been replaced by the mean of the non-NA values.
If the input vector is entirely composed of NAs, return the original vector.
he function should handle edge cases, such as: An empty vector. A vector without any NA values. A vector where all values are NA.
na_replace_mean <- function(x) {
if (all(is.na(x))) {
return(x)
}
mean_value <- mean(x, na.rm = TRUE)
x[is.na(x)] <- mean_value
return(x)
}
# Test cases
print(na_replace_mean(c(1, 2, 3, NA, 5))) # Expected: c(1, 2, 3, 2.75, 5)## [1] 1.00 2.00 3.00 2.75 5.00print(na_replace_mean(c(NA, NA, NA))) # Expected: c(NA, NA, NA)## [1] NA NA NAprint(na_replace_mean(c())) # Expected: c()## NULLQuestion:
The function sum_positive is designed to take a numeric vector as input and return the sum of all positive numbers in the vector. However, the function has some errors that cause it to produce incorrect results or errors for certain inputs. Identify and fix the errors in the function.
sum_positive <- function(x) {
if (length(x) == 0) {
return(0)
}
sum_pos <- 0
for (i in 1:length(x)) {
if (x[i] > 0) {
sum_pos <- sum_pos + x[i]
}
}
return(sum_pos)
}
# Test cases
print(sum_positive(c(1, 2, -3, 4, -5))) # Expected: 7## [1] 7print(sum_positive(c(-1, -2, -3, -4, -5))) # Expected: 0## [1] 0print(sum_positive(c())) # Expected: 0## [1] 0# print(sum_positive(NA)) # Expected: 0Errors:
Error with Empty Vector:
Issue: The condition if (length(x) == 0) correctly checks for an empty vector, but the test case sum_positive(NA) will not be caught by this condition.
Fix: Add a check for NA values at the start of the function.
Error with Single NA Value:
Issue: The function does not handle cases where the input vector contains only NA values. This will cause the function to return NA instead of 0.
Fix: Add a condition to check if all values are NA and return 0 in that case.Off-by-One Error in Loop:
Issue: The loop uses 1:length(x), which works for non-empty vectors but fails for an empty vector, potentially causing unexpected behavior.
Fix: Use seq_along(x) to correctly handle empty vectors.
sum_positive <- function(x) {
if (length(x) == 0 || all(is.na(x))) {
return(0)
}
sum_pos <- 0
for (i in seq_along(x)) {
if (!is.na(x[i]) && x[i] > 0) {
sum_pos <- sum_pos + x[i]
}
}
return(sum_pos)
}
# Test cases
print(sum_positive(c(1, 2, -3, 4, -5))) # Expected: 7## [1] 7print(sum_positive(c(-1, -2, -3, -4, -5))) # Expected: 0## [1] 0print(sum_positive(c())) # Expected: 0## [1] 0print(sum_positive(NA)) # Expected: 0## [1] 0Multiple Choice Question 1: Data Frames and Functions
Which of the following statements about the apply() function when used with data frames is TRUE?
A apply(data_frame, 1, mean) returns a data frame of row means.
B apply(data_frame, 2, mean) will always produce the same result as sapply(data_frame, mean).
C apply(data_frame, 1, sum) will sum the values in each column of the data frame.
D apply(data_frame, 2, summary) will produce a summary for each column, but the result will be a list, not a matrix.
E apply(data_frame, 2, sum) will coerce the data frame to a matrix and then sum the values in each column, producing a numeric vector.
Correct Answer: E. apply(data_frame, 2, sum) will coerce the data frame to a matrix and then sum the values in each column, producing a numeric vector.
Multiple Choice Question 2: List
Given the following list in R, which command will correctly extract the second row and second column of the matrix component?
A simple_list$matrix[2,2]
B simple_list[[2]][2,2]
C simple_list[“matrix”][2,2]
D simple_list[2][2,2]
E simple_list[[matrix]][2,2]
Answer: B) simple_list[[2]][2,2]
my_unlist <- function(x) {
result <- NULL # Initialize the result vector
for (element in x) {
if (is.list(element)) {
# Recursively unlist if the element is a list
element <- my_unlist(element)
}
if (is.null(result)) {
result <- element
} else if (is.factor(result) || is.factor(element)) {
# Coerce factors to integer if mixed with other types
result <- as.integer(result)
element <- as.integer(element)
result <- c(result, element)
} else {
result <- c(result, element)
}
}
# If all elements are factors, create a factor with combined levels
if (is.factor(result)) {
all_levels <- unique(unlist(lapply(x, levels)))
result <- factor(result, levels = all_levels)
}
return(result)
}
# Test cases
print(my_unlist(list(c(2, 1, 1), c(3, 2, 1), 2)))## [1] 2 1 1 3 2 1 2print(my_unlist(list(factor(c("a", "a", "b", "c")),
factor(c("b", "c", "e")),
factor(c("a", "d", "b")))))## [1] 1 1 2 3 1 2 3 1 3 2print(my_unlist(list(factor(c("a", "b")), c(1, 2))))## [1] 1 2 1 2print(my_unlist(list(factor(c("a", "b")), factor(c("b", "c")), c("a", "b"))))## [1] "1" "2" "1" "2" "a" "b"print(my_unlist(list(list(1:3, 1:4), list(list(1:3, 1:3, list(1:4, 1:5))))))## [1] 1 2 3 1 2 3 4 1 2 3 1 2 3 1 2 3 4 1 2 3 4 5my_unlist <- function(x) {
result <- c() # Initialize the result vector
for (element in x) {
if (class(element) == "list") {
# Recursively unlist if the element is a list
element <- my_unlist(element)
}
if (class(element) == "factor") {
# Handle factors by converting to character
element <- as.character(element)
}
result <- c(result, element)
}
# Determine the final mode of the result vector
if (any(sapply(x, class) == "factor")) {
# If there are factors, combine their levels
all_levels <- unique(unlist(lapply(x, function(y) {
if (class(y) == "factor") {
levels(y)
} else {
NULL
}
})))
result <- factor(result, levels = all_levels)
} else {
if (any(sapply(result, class) == "character")) {
result <- as.character(result)
} else {
if (any(sapply(result, class) == "numeric")) {
result <- as.numeric(result)
} else {
if (any(sapply(result, class) == "logical")) {
result <- as.logical(result)
}
}
}
}
return(result)
}
# Function to find the statistical mode
stat_mode <- function(x, first = FALSE) {
# Unlist the input using my_unlist
unlisted <- my_unlist(x)
# Get the frequency of each element
freq_table <- table(unlisted)
max_freq <- max(freq_table)
# Find the mode(s)
modes <- names(freq_table[freq_table == max_freq])
# If first is TRUE, return only the first mode
if (first) {
modes <- modes[1]
}
# Convert the mode(s) back to the original type/class
if (class(unlisted) == "factor") {
result <- factor(modes, levels = levels(unlisted))
} else {
if (class(unlisted) == "numeric") {
result <- as.numeric(modes)
} else {
if (class(unlisted) == "character") {
result <- modes
} else {
if (class(unlisted) == "logical") {
result <- as.logical(modes)
}
}
}
}
return(result)
}
# Test cases
print(stat_mode(c(FALSE, FALSE, TRUE, TRUE, FALSE)))## [1] FALSE# Expected output: [1] FALSE
print(stat_mode(list(c(2, 1, 1), c(3, 2, 1), 2)))## [1] 1 2# Expected output: [1] 2 1
print(stat_mode(list(c(2, 1, 1), c(3, 2, 1), 2), first = TRUE))## [1] 1# Expected output: [1] 2 ??????? (I dont get it)
print(stat_mode(list(factor(c("control", "treatment1", "control")),
factor(c("control", "treatment2")))))## [1] control
## Levels: control treatment1 treatment2# Expected output: [1] control
# Levels: control treatment1 treatment2# Function to summarize a data frame
df_summary <- function(df) {
n_obs <- nrow(df)
n_var <- ncol(df)
var_names <- colnames(df)
column_data <- list()
for (var in var_names) {
column <- df[[var]]
column_summary <- list(class = class(column)[1]) # Get the class of the column
if (is.numeric(column)) {
column_summary$min <- min(column, na.rm = TRUE)
column_summary$mean <- mean(column, na.rm = TRUE)
column_summary$max <- max(column, na.rm = TRUE)
column_summary$na_count <- sum(is.na(column))
} else {
modes <- stat_mode(column)
column_summary$modes <- modes
column_summary$mode_count <- sum(column == modes[1], na.rm = TRUE)
}
column_data[[var]] <- column_summary
}
summary_list <- list(
n_obs = n_obs,
n_var = n_var,
var_names = var_names,
column_data = column_data
)
return(summary_list)
}
# Test case
df <- data.frame(
Homework_One = c(88, 84, 93, NA),
Homework_Two = c(95, 90, 99, 60),
Homework_Three = c(NA, NA, 88, 23),
Lecture = c("Lecture 1", "Lecture 1", "Lecture 1", "Lecture 2")
)
# Call the df_summary function and print the structure of the result
result <- df_summary(df)
str(result)## List of 4
## $ n_obs : int 4
## $ n_var : int 4
## $ var_names : chr [1:4] "Homework_One" "Homework_Two" "Homework_Three" "Lecture"
## $ column_data:List of 4
## ..$ Homework_One :List of 5
## .. ..$ class : chr "numeric"
## .. ..$ min : num 84
## .. ..$ mean : num 88.3
## .. ..$ max : num 93
## .. ..$ na_count: int 1
## ..$ Homework_Two :List of 5
## .. ..$ class : chr "numeric"
## .. ..$ min : num 60
## .. ..$ mean : num 86
## .. ..$ max : num 99
## .. ..$ na_count: int 0
## ..$ Homework_Three:List of 5
## .. ..$ class : chr "numeric"
## .. ..$ min : num 23
## .. ..$ mean : num 55.5
## .. ..$ max : num 88
## .. ..$ na_count: int 2
## ..$ Lecture :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "Lecture 1"
## .. ..$ mode_count: int 3#getwd()
# Load the starwars data from the .RData file
load("/Users/isaiahmireles/Downloads/starwars.RData") # Replace "path_to" with the actual path to the file
# Assuming df_summary function is already defined
# Call the df_summary function on the starwars data
starwars_summary <- df_summary(starwars)
# Print the structure of the summary to verify
str(starwars_summary)## List of 4
## $ n_obs : int 87
## $ n_var : int 13
## $ var_names : chr [1:13] "name" "height" "mass" "hair_color" ...
## $ column_data:List of 13
## ..$ name :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr [1:87] "Ackbar" "Adi Gallia" "Anakin Skywalker" "Arvel Crynyd" ...
## .. ..$ mode_count: int 1
## ..$ height :List of 5
## .. ..$ class : chr "integer"
## .. ..$ min : int 66
## .. ..$ mean : num 174
## .. ..$ max : int 264
## .. ..$ na_count: int 6
## ..$ mass :List of 5
## .. ..$ class : chr "numeric"
## .. ..$ min : num 15
## .. ..$ mean : num 97.3
## .. ..$ max : num 1358
## .. ..$ na_count: int 28
## ..$ hair_color:List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "none"
## .. ..$ mode_count: int 37
## ..$ skin_color:List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "fair"
## .. ..$ mode_count: int 17
## ..$ eye_color :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "brown"
## .. ..$ mode_count: int 21
## ..$ birth_year:List of 5
## .. ..$ class : chr "numeric"
## .. ..$ min : num 8
## .. ..$ mean : num 87.6
## .. ..$ max : num 896
## .. ..$ na_count: int 44
## ..$ gender :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "male"
## .. ..$ mode_count: int 62
## ..$ homeworld :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "Naboo"
## .. ..$ mode_count: int 11
## ..$ species :List of 3
## .. ..$ class : chr "character"
## .. ..$ modes : chr "Human"
## .. ..$ mode_count: int 35
## ..$ films :List of 3
## .. ..$ class : chr "list"
## .. ..$ modes : chr "Attack of the Clones"
## .. ..$ mode_count: int 13
## ..$ vehicles :List of 3
## .. ..$ class : chr "list"
## .. ..$ modes : chr [1:3] "Imperial Speeder Bike" "Snowspeeder" "Tribubble bongo"
## .. ..$ mode_count: int 1
## ..$ starships :List of 3
## .. ..$ class : chr "list"
## .. ..$ modes : chr [1:2] "Millennium Falcon" "X-wing"
## .. ..$ mode_count: int 2# Extract the starships data from the summary
starships_data <- starwars_summary$column_data$starships
# Check the structure of the starships data
str(starships_data)## List of 3
## $ class : chr "list"
## $ modes : chr [1:2] "Millennium Falcon" "X-wing"
## $ mode_count: int 2# Extract the modes and mode_count
most_common_starships <- starships_data$modes
mode_count <- starships_data$mode_count
# Print the most common starships and their counts
most_common_starships## [1] "Millennium Falcon" "X-wing"mode_count## [1] 2# Define the impute function
impute <- function(x, col = NULL, center = mean, margin = 2) {
# Check if the input is a matrix or data frame
if (!is.matrix(x) && !is.data.frame(x)) {
stop("Input x must be a matrix or data frame.")
}
# If col is NULL, select all numeric columns
if (is.null(col)) {
col <- which(sapply(x, is.numeric))
}
# Function to impute missing values based on the margin
impute_col <- function(x_col, center_fun) {
if (margin == 2) {
# Impute based on column values
center_val <- center_fun(x_col, na.rm = TRUE)
x_col[is.na(x_col)] <- center_val
} else if (margin == 1) {
# Impute based on row values
for (i in seq_along(x_col)) {
if (is.na(x_col[i])) {
center_val <- center_fun(x[-i, col], na.rm = TRUE)
x_col[i] <- center_val
}
}
} else {
stop("Invalid margin. Use 1 for row and 2 for column.")
}
return(x_col)
}
# Apply the imputation function to the specified columns
for (j in col) {
x[, j] <- impute_col(x[, j], center)
}
return(x)
}
# Test cases
x_mat <- matrix(c(NA, 7, NA, 1, NA, 10, 6, 3, 7, NA, 5, 7, 6, 3, 2), nrow = 5, byrow = TRUE)
print(impute(x_mat, col = 1, center = mean, margin = 2))## [,1] [,2] [,3]
## [1,] 4.333333 7 NA
## [2,] 1.000000 NA 10
## [3,] 6.000000 3 7
## [4,] 4.333333 5 7
## [5,] 6.000000 3 2print(impute(x_mat, col = 2, center = median, margin = 1))## [,1] [,2] [,3]
## [1,] NA 7 NA
## [2,] 1 4 10
## [3,] 6 3 7
## [4,] NA 5 7
## [5,] 6 3 2print(impute(x_mat, col = c(1, 2), center = median, margin = 1))## [,1] [,2] [,3]
## [1,] 4.0 7.00 NA
## [2,] 1.0 4.75 10
## [3,] 6.0 3.00 7
## [4,] 4.5 5.00 7
## [5,] 6.0 3.00 2