PLEASE IGNORE
this is the past exam from february with its solutions, for the two time slots, its oop, tabular data, tryCatch and regex, and simple functions and OOP in R. all the types of assert functions
Slot 1
# # Question 01: `consecutiveDups` [10 pts]
#
# consecutiveDups(v: character) -> logical(1)
#
# Write a function `consecutiveDups` that, given a character vector, returns
# `TRUE` if the vector contains any consecutive duplicate values (i.e. two
# adjacent elements that are equal), and `FALSE` otherwise.
#
# ## Input
#
# - `v`: A `character` vector containing no missing values.
#
# ## Output
#
# A scalar `logical` value: `TRUE` if there are any consecutive duplicates,
# `FALSE` otherwise.
#
# ## Examples
#
# consecutiveDups(c("a", "a", "b"))
# #> [1] TRUE
# consecutiveDups(c("a", "b", "a"))
# #> [1] FALSE
# consecutiveDups(c("a", "b", "c"))
# #> [1] FALSE
# consecutiveDups(character(0))
# #> [1] FALSE
#
consecutiveDups <- function(v) {
# your code
assertCharacter(v, any.missing = FALSE)
if (length(v) <= 1) return(FALSE)
any(v[-length(v)] == v[-1])
}
# # Question 02: `reverseCase` [10 pts]
#
# reverseCase(text: character(1)) -> character(1)
#
# Write a function `reverseCase` that takes a single string `text` and swaps the
# case of all Latin letters (A-Z and a-z). All upper case letters should become
# lower case and all lower case letters should become upper case. Non-letter
# characters (digits, spaces, punctuation etc.) should remain unchanged.
#
# ## Input
#
# - `text`: A scalar `character` string.
#
# ## Output
#
# A scalar `character` string with all letter cases swapped.
#
# ## Examples
#
# reverseCase("Hello World")
# #> [1] "hELLO wORLD"
# reverseCase("abc")
# #> [1] "ABC"
# reverseCase("ABC")
# #> [1] "abc"
# reverseCase("Hello 123!")
# #> [1] "hELLO 123!"
# reverseCase("")
# #> [1] ""
#
reverseCase <- function(text) {
# your code
assertString(text)
# disassemble
text.chars <- strsplit(text, "")[[1]]
text.chars.lower <- tolower(text.chars)
text.chars.upper <- toupper(text.chars)
# if text.charsis the same as its lowercase version, then it
# was either lowercase to begin with, or tolower/toupper does not change it.
# In the former case, we want 'upper'; in the latter, we don't care which one
# so we might just as well take 'upper' as well.
text.chars.translated <- ifelse(
text.chars == text.chars.lower,
text.chars.upper, # letter was either lower, or does not get changed
text.chars.lower # letter was an uppercase letter before
)
paste(text.chars.translated, collapse = "")
# other solutions may use the builtin variables `letters`, `LETTERS`,
# and the function `chartr` can be useful.
}
# # Question 03: `findFixedPoint` [10 pts]
#
# findFixedPoint(fn: function, x0: numeric(1),
# tol: numeric(1), max.tries: integer(1)) -> numeric(1)
#
# Write a function `findFixedPoint` that attempts to find a fixed point of a
# function `fn`, starting from an initial value `x0`. A fixed point of `fn` is a
# value `x` such that `fn(x) = x`.
#
# The function should repeatedly apply `fn`, starting from `x0`: compute
# `x1 = fn(x0)`, `x2 = fn(x1)`, and so on. After each application, check whether
# the current value is approximately a fixed point: if `|fn(x) - x| < tol`,
# return `x`. If no fixed point is found within `max.tries` applications of
# `fn`, return `NA`.
#
# Your function should never call `fn` more than `max.tries` times.
#
# ## Input
#
# - `fn`: A function that takes a single numeric argument and returns a single
# numeric value.
# - `x0`: A scalar `numeric` starting value.
# - `tol`: A positive scalar `numeric` tolerance.
# - `max.tries`: A non-negative scalar integer-valued `numeric`, indicating
# the maximum number of times `fn` is applied.
#
# ## Output
#
# A scalar `numeric` value that is an approximate fixed point of `fn`, or `NA`
# if none is found within `max.tries` steps.
#
# ## Examples
#
# ## cos has a fixed point near 0.7391
# findFixedPoint(cos, 0, 0.001, 100)
# #> [1] 0.7395672
#
# ## fn(x) = x/2 converges to 0
# findFixedPoint(function(x) x / 2, 10, 0.01, 100)
# #> [1] 0.01953125
#
# ## fn(x) = 2x diverges -> NA
# findFixedPoint(function(x) 2 * x, 1, 0.001, 5)
# #> [1] NA
#
# ## max.tries = 0 -> NA immediately
# findFixedPoint(cos, 0, 0.001, 0)
# #> [1] NA
#
findFixedPoint <- function(fn, x0, tol, max.tries) {
# your code
assertFunction(fn)
assertNumber(x0)
assertNumber(tol, lower = 0)
assertCount(max.tries)
x <- x0
for (i in seq_len(max.tries)) {
fx <- fn(x)
if (abs(fx - x) < tol) return(x)
x <- fx
}
NA_real_
}
# # Question 04: `clipOutput` [10 pts]
#
# clipOutput(f: function, lower: numeric(1), upper: numeric(1)) -> function
#
# Write a function `clipOutput` that takes three arguments: a function `f`, a
# numeric scalar `lower`, and a numeric scalar `upper` (with `lower <= upper`).
# It should return a new function that behaves like `f`, but whose numeric
# return value is clipped to the interval `[lower, upper]`: values below `lower`
# are replaced by `lower`, values above `upper` are replaced by `upper`.
#
# ## Input
#
# - `f`: A function that returns a scalar `numeric` value.
# - `lower`: A scalar `numeric` value representing the lower bound.
# - `upper`: A scalar `numeric` value representing the upper bound, with
# `upper >= lower`.
#
# ## Output
#
# A new `function` that accepts the same arguments as `f`, calls `f`, and clips
# the result to `[lower, upper]`.
#
# ## Examples
#
# clipped.sqrt <- clipOutput(sqrt, 0, 2)
# clipped.sqrt(1) # sqrt(1) = 1, within [0, 2]
# #> [1] 1
# clipped.sqrt(9) # sqrt(9) = 3, clipped to 2
# #> [1] 2
# clipped.sqrt(0) # sqrt(0) = 0, at lower bound
# #> [1] 0
#
# neg.clip <- clipOutput(function(x) -x, -5, 5)
# neg.clip(3) # -3, within [-5, 5]
# #> [1] -3
# neg.clip(10) # -10, clipped to -5
# #> [1] -5
#
clipOutput <- function(f, lower, upper) {
# your code
assertFunction(f)
assertNumber(lower)
assertNumber(upper, lower = lower)
function(...) {
pmin(pmax(f(...), lower), upper)
}
}
# # Question 05: `Operation` Arithmetic Operations [10 pts]
#
# ## Intro
#
# The following is an example that you may use to inspire your solution for this
# question. It implements an S3 class for a mathematical set, as well as a union
# of sets. The actual exam question follows below.
#
# ## Constructor for an S3 representation of a "discrete set" (of real numbers),
# ## representing a set of numbers.
# SetDiscrete <- function(content) {
# structure(
# list(content = unique(content)),
# class = c("SetDiscrete", "Set")
# )
# }
#
# ## `SetUnion()` with inputs set1, set2 returns an object representing the union
# ## of these sets.
# SetUnion <- function(set1, set2) {
# structure(
# list(set1 = set1, set2 = set2),
# class = c("SetUnion", "Set")
# )
# }
#
# ## `format()` creates a string representation of a Set.
# format.SetDiscrete <- function(x, ...) {
# paste0("{", paste(x$content, collapse = ", "), "}")
# }
#
# format.SetUnion <- function(x, ...) {
# paste(format(x$set1), "U", format(x$set2))
# }
#
# ## `print()` method shared by all Set subclasses.
# print.Set <- function(x, ...) {
# cat(paste0(format(x), "\n"))
# invisible(x)
# }
#
# ## Determine if `object` is a member of `set`.
# ## Returns: `logical(1)`: `TRUE` if `object` is in `set`, `FALSE` otherwise.
# isElement <- function(set, object) {
# UseMethod("isElement")
# }
#
# isElement.SetDiscrete <- function(set, object) {
# object %in% set$content
# }
#
# isElement.SetUnion <- function(set, object) {
# isElement(set$set1, object) || isElement(set$set2, object)
# }
#
# ## Usage:
#
# set1 <- SetDiscrete(c(1, 2))
# set2 <- SetDiscrete(c(9, 10))
#
# union <- SetUnion(set1, set2)
#
# isElement(set1, 1)
# #> [1] TRUE
# isElement(union, 1)
# #> [1] TRUE
# isElement(union, 3)
# #> [1] FALSE
#
# ## Task
#
# Implement a set of S3 classes to represent arithmetic operations:
# `OperationAdd`, `OperationMultiply`, as well as a chained operation
# `OperationChain`. All operations should inherit from a base class `Operation`.
#
# The constructors should be:
#
# - `OperationAdd(val: numeric(1))`: Creates an operation that adds a scalar
# `numeric` value `val`.
# - `OperationMultiply(val: numeric(1))`: Creates an operation that multiplies
# by a scalar `numeric` value `val`.
# - `OperationChain(op1: Operation, op2: Operation)`: Creates a chained
# operation that applies `op1` first, then `op2` to the result.
#
# Implement a generic method `describe(op)` that returns a human-readable string
# describing the operation:
#
# - For `OperationAdd`: `"add "` (e.g. `"add 5"`).
# - For `OperationMultiply`: `"multiply by "` (e.g. `"multiply by 3"`).
# - For `OperationChain`: `" then "`
# (e.g. `"add 5 then multiply by 3"`).
#
# Implement a `print` method for the `Operation` class that prints
# `Operation: ` followed by a newline.
#
# Implement a generic method `applyOp(op, input)` that applies the operation to
# a scalar `numeric` `input` and returns the result:
#
# - For `OperationAdd`: Returns `input + val`.
# - For `OperationMultiply`: Returns `input * val`.
# - For `OperationChain`: Applies `op1` first, then applies `op2` to the
# result of `op1`.
#
# This question does not have a dedicated ``assert’’-block; asserts are tested
# in the appropriate test blocks.
#
# Hint: If tests show an “unused argument” error, this means you likely have an
# argument name wrong. Argument names must match the description above.
#
# ## Input / Output
#
# See descriptions above for constructors and the `describe`, `print`, and
# `applyOp` methods. All `val` and `input` values are scalar `numeric`.
# `describe` returns a scalar `character`. `applyOp` returns a scalar `numeric`.
#
# ## Examples
#
# add5 <- OperationAdd(5)
# mul3 <- OperationMultiply(3)
# chain <- OperationChain(add5, mul3)
#
# describe(add5)
# #> [1] "add 5"
# describe(chain)
# #> [1] "add 5 then multiply by 3"
#
# add5
# #> Operation: add 5
#
# applyOp(add5, 10) # 10 + 5
# #> [1] 15
# applyOp(mul3, 10) # 10 * 3
# #> [1] 30
# applyOp(chain, 10) # (10 + 5) * 3
# #> [1] 45
#
OperationAdd <- function(val) {
assertNumber(val)
structure(list(val = val), class = c("OperationAdd", "Operation"))
}
OperationMultiply <- function(val) {
assertNumber(val)
structure(list(val = val), class = c("OperationMultiply", "Operation"))
}
OperationChain <- function(op1, op2) {
assertClass(op1, "Operation")
assertClass(op2, "Operation")
structure(
list(op1 = op1, op2 = op2),
class = c("OperationChain", "Operation")
)
}
describe <- function(op) {
UseMethod("describe")
}
describe.OperationAdd <- function(op) paste("add", op$val)
describe.OperationMultiply <- function(op) paste("multiply by", op$val)
describe.OperationChain <- function(op) paste(describe(op$op1), "then", describe(op$op2))
print.Operation <- function(x, ...) {
cat(sprintf("Operation: %s\n", describe(x)))
invisible(x)
}
applyOp <- function(op, input) {
assertNumber(input)
UseMethod("applyOp")
}
applyOp.OperationAdd <- function(op, input) {
assertNumber(input)
op$val + input
}
applyOp.OperationMultiply <- function(op, input) {
assertNumber(input)
op$val * input
}
applyOp.OperationChain <- function(op, input) {
applyOp(op$op2, applyOp(op$op1, input))
}
# # Question 06: `mergeIntervals` [10 pts]
#
# mergeIntervals(
# intervals: data.table(start: numeric, end: numeric)
# ) -> data.table(start: numeric, end: numeric)
#
# Given a `data.table` with numeric columns `start` and `end` representing
# intervals, merge all overlapping or touching intervals and return a
# `data.table` of the merged intervals, sorted by their `start`. Two intervals
# overlap if one starts before the other ends; they touch if one ends exactly
# where the other starts. For example, intervals `(1, 3)`, `(2, 5)`, `(7, 9)`
# merge to `(1, 5)`, `(7, 9)`.
#
# You should not assume that the input is sorted.
#
# ## Input
#
# - `intervals`: A `data.table` with two `numeric` columns:
# - `start`: The start of each interval.
# - `end`: The end of each interval.
#
# (You need to assert the `data.table`, but you do not need to assert column
# names or types.)
#
# ## Output
#
# A `data.table` with two `numeric` columns `start` and `end`, containing the
# merged intervals sorted by `start`.
#
# ## Examples
#
# mergeIntervals(data.table(start = c(1, 2, 7), end = c(3, 5, 9)))
# #> start end
# #>
# #> 1: 1 5
# #> 2: 7 9
# mergeIntervals(data.table(start = c(6, 1), end = c(8, 3)))
# #> start end
# #>
# #> 1: 1 3
# #> 2: 6 8
# mergeIntervals(data.table(start = numeric(0), end = numeric(0)))
# #> Empty data.table (0 rows and 2 cols): start,end
#
mergeIntervals <- function(intervals) {
# your code
assertDataTable(intervals)
if (!nrow(intervals)) return(intervals)
setorder(intervals, start)
lastint <- intervals[1, ]
outints <- list(lastint)
for (r in seq_len(nrow(intervals))[-1]) {
if (intervals[r, start] <= lastint[, end]) {
newend <- intervals[r, end]
lastint[, end := max(end, newend)]
} else {
lastint <- intervals[r, ]
outints[[length(outints) + 1]] <- lastint
}
}
rbindlist(outints)
}
Slot 2
this was my own, check for oop, implementing a method and assigning it to classes and arguments and
medianMeanRelationship <- function(v) {
# your code
assertNumeric(v, any.missing = FALSE, min.len = 1)
if (mean(v) < median(v)) return("negative skew")
if (mean(v) > median(v)) return("positive skew")
return("symmetric")
}
# # Question 02: `doubleVowel` [10 pts]
#
# doubleVowel(text: character(1)) -> character(1)
#
# Write a function `doubleVowel` that takes a single string `text` and doubles
# every vowel (`a`, `e`, `i`, `o`, `u`, both lower and upper case) that is not
# immediately preceded or followed by another vowel. A vowel that is part of a
# consecutive group of vowels should not be doubled. You may assume that the
# input contains only letters and spaces.
#
# ## Input
#
# - `text`: A scalar `character` string containing only letters and spaces.
#
# ## Output
#
# A scalar `character` string with isolated vowels doubled.
#
# ## Examples
#
# doubleVowel("hello")
# #> [1] "heelloo"
# doubleVowel("beautiful")
# #> [1] "beautiifuul"
# doubleVowel("cat")
# #> [1] "caat"
# doubleVowel("boat")
# #> [1] "boat"
# doubleVowel("")
# #> [1] ""
#
doubleVowel <- function(text) {
# your code
assertString(text)
# You DID learn about negative lookbehinds / lookaheads, right?
gsub("(? numeric(1)
#
# Write a function `functionErrorProportion` that, given a function `f` that
# takes a single integer numeric argument, calculates the proportion of inputs
# from 1 to 10 (inclusive) for which `f` throws an error. The return value
# should be a numeric scalar between 0 and 1.
#
# ## Input
#
# - `f`: A function that takes a single numeric argument and may throw an
# error for certain inputs.
#
# ## Output
#
# A scalar `numeric` value between 0 and 1, representing the proportion of
# inputs in `1:10` for which `f` throws an error.
#
# ## Examples
#
# functionErrorProportion(function(x) x^2)
# #> [1] 0
# functionErrorProportion(function(x) stop("Error"))
# #> [1] 1
# functionErrorProportion(function(x) if (x > 5) stop("Error") else x)
# #> [1] 0.5
#
functionErrorProportion <- function(f) {
# your code
assertFunction(f)
mean(vapply(1:10, function(x) {
tryCatch({
f(x)
0 # if f returns successfully, tryCatch() "returns" the 0 here
}, error = function(e) 1) # otherwise, on error, it returns 1
}, numeric(1)))
}
# # Question 04: `reverseArguments` [10 pts]
#
# reverseArguments(f: function) -> function
#
# Write a function `reverseArguments` that takes a function `f` as input and
# returns a new function that behaves like `f` but with the order of its
# arguments reversed. For example, if `f(a, b, c)` computes something, then
# `reverseArguments(f)` should return a function `g` such that `g(c, b, a)`
# gives the same result as `f(a, b, c)`. This should work for any number of
# arguments. All arguments are passed unnamed (positionally).
#
# ## Input
#
# - `f`: A function.
#
# ## Output
#
# A new `function` that calls `f` with its arguments in reversed order.
#
# ## Examples
#
# g <- reverseArguments(paste)
# g("a", "b", "c")
# #> [1] "c b a"
#
# h <- reverseArguments(function(x, y) x - y)
# h(1, 10) # equivalent to (function(x, y) x - y)(10, 1) = 9
# #> [1] 9
#
# reverseArguments(function() 42)()
# #> [1] 42
#
reverseArguments <- function(f) {
# your code
assertFunction(f)
function(...) {
args <- rev(list(...))
do.call(f, args)
}
}
# # Question 05: `Distribution` Probability Distributions [10 pts]
#
# ## Intro
#
# The following is an example that you may use to inspire your solution for this
# question. It implements an S3 class for a mathematical set, as well as a union
# of sets, including `format()`, `print()`, and a custom generic. The actual
# exam question follows below.
#
# ## Constructor for an S3 representation of a "discrete set" (of real numbers),
# ## representing a set of numbers.
# SetDiscrete <- function(content) {
# structure(
# list(content = unique(content)),
# class = c("SetDiscrete", "Set")
# )
# }
#
# ## `SetUnion()` with inputs set1, set2 returns an object representing the union
# ## of these sets.
# SetUnion <- function(set1, set2) {
# structure(
# list(set1 = set1, set2 = set2),
# class = c("SetUnion", "Set")
# )
# }
#
# ## `format()` creates a string representation of a Set.
# format.SetDiscrete <- function(x, ...) {
# paste0("{", paste(x$content, collapse = ", "), "}")
# }
#
# format.SetUnion <- function(x, ...) {
# paste(format(x$set1), "U", format(x$set2))
# }
#
# ## `print()` method shared by all Set subclasses.
# print.Set <- function(x, ...) {
# cat(paste0(format(x), "\n"))
# invisible(x)
# }
#
# ## Determine the number of elements in `set`.
# ## Returns: `numeric(1)`: the number of elements.
# setSize <- function(set) {
# UseMethod("setSize")
# }
#
# setSize.SetDiscrete <- function(set) {
# length(set$content)
# }
#
# setSize.SetUnion <- function(set) {
# setSize(set$set1) + setSize(set$set2)
# }
#
# ## Usage:
#
# set1 <- SetDiscrete(c(1, 2))
# set2 <- SetDiscrete(c(9, 10))
#
# union <- SetUnion(set1, set2)
#
# print(set1)
# #> {1, 2}
# print(union)
# #> {1, 2} U {9, 10}
# setSize(set1)
# #> [1] 2
# setSize(union)
# #> [1] 4
#
# ## Task
#
# Implement a set of S3 classes to represent probability distributions:
# `DNormal`, `DBernoulli`, as well as a sum of independent distributions `DSum`.
# All distributions should inherit from a base class `Distribution`.
#
# The constructors should be:
#
# - `DNormal(mu: numeric(1), sigma: numeric(1))`: Creates a normal
# distribution with mean `mu` and standard deviation `sigma` (must be
# non-negative).
# - `DBernoulli(p: numeric(1))`: Creates a Bernoulli distribution with success
# probability `p` (must be between 0 and 1, inclusive).
# - `DSum(d1: Distribution, d2: Distribution)`: Creates a distribution
# representing the sum of two independent distributions.
#
# Implement `format()` methods that return a string representation:
#
# - For `DNormal`: `"DNormal(, )"` (e.g. `"DNormal(3, 2)"`).
# - For `DBernoulli`: `"DBernoulli()"` (e.g. `"DBernoulli(0.7)"`).
# - For `DSum`: `" + "`
# (e.g. `"DNormal(0, 1) + DBernoulli(0.5)"`).
#
# Implement a `print` method for the `Distribution` class that outputs the
# `format()` string followed by a newline.
#
# Implement the following generic methods:
#
# - `distEV(dist)`: Returns the expected value of the distribution.
# - `DNormal`: `mu`. `DBernoulli`: `p`. `DSum`: sum of component expected
# values.
# - `distVar(dist)`: Returns the variance of the distribution.
# - `DNormal`: `sigma^2`. `DBernoulli`: `p * (1 - p)`. `DSum`: sum of
# component variances (since they are independent).
# - `distSample(dist)`: Returns a single random draw from the distribution.
# - `DNormal`: a draw from `N(mu, sigma)`. `DBernoulli`: a draw from
# `Bernoulli(p)` (i.e. 0 or 1). `DSum`: sum of independent draws from
# the components.
#
# This question does not have a dedicated ``assert’’-block; asserts are tested
# in the appropriate test blocks.
#
# Hint: If tests show an “unused argument” error, this means you likely have an
# argument name wrong. Argument names must match the description above.
#
# ## Input / Output
#
# See descriptions above for constructors and methods. All parameters are scalar
# `numeric`. `format` returns scalar `character`. `distEV` and `distVar` return
# scalar `numeric`. `distSample` returns a scalar `numeric` random draw.
#
# ## Examples
#
# d1 <- DNormal(0, 1)
# d2 <- DBernoulli(0.7)
# dsum <- DSum(d1, d2)
#
# distEV(d1)
# #> [1] 0
# distVar(d1)
# #> [1] 1
# format(d1)
# #> [1] "DNormal(0, 1)"
#
# print(dsum)
# #> DNormal(0, 1) + DBernoulli(0.7)
# distEV(dsum)
# #> [1] 0.7
# distVar(dsum)
# #> [1] 1.21
#
# set.seed(42)
# distSample(d1)
# #> [1] 1.370958
# distSample(dsum)
# #> [1] 0.4353018
#
DNormal <- function(mu, sigma) {
assertNumber(mu)
assertNumber(sigma, lower = 0)
structure(list(mu = mu, sigma = sigma), class = c("DNormal", "Distribution"))
}
DBernoulli <- function(p) {
assertNumber(p, lower = 0, upper = 1)
structure(list(p = p), class = c("DBernoulli", "Distribution"))
}
distEV <- function(dist) UseMethod("distEV")
distVar <- function(dist) UseMethod("distVar")
distEV.DNormal <- function(dist) dist$mu
distEV.DBernoulli <- function(dist) dist$p
distVar.DNormal <- function(dist) dist$sigma^2
distVar.DBernoulli <- function(dist) dist$p * (1 - dist$p)
DSum <- function(d1, d2) {
assertClass(d1, "Distribution")
assertClass(d2, "Distribution")
structure(list(d1 = d1, d2 = d2), class = c("DSum", "Distribution"))
}
format.DNormal <- function(x, ...) sprintf("DNormal(%s, %s)", x$mu, x$sigma)
format.DBernoulli <- function(x, ...) sprintf("DBernoulli(%s)", x$p)
format.DSum <- function(x, ...) sprintf("%s + %s", format(x$d1), format(x$d2))
print.Distribution <- function(x, ...) {
cat(format(x), "\n", sep = "")
invisible(x)
}
distEV.DSum <- function(dist) distEV(dist$d1) + distEV(dist$d2)
distVar.DSum <- function(dist) distVar(dist$d1) + distVar(dist$d2)
distSample <- function(dist) UseMethod("distSample")
distSample.DNormal <- function(dist) rnorm(1, dist$mu, dist$sigma)
distSample.DBernoulli <- function(dist) as.numeric(runif(1) < dist$p)
distSample.DSum <- function(dist) distSample(dist$d1) + distSample(dist$d2)
# # Question 06: `followersFromFollowing` [10 pts]
#
# followersFromFollowing(
# following.dt: data.table(name: character, following: list of character)
# ) -> data.table(name: character, followers: list of character)
#
# Given a `data.table` with a `name` column and a `following` column (a list
# column, where each element is a `character` vector of account names that
# `name` follows), return a `data.table` with columns `name` and `followers` (a
# list column, where each element is a `character` vector of accounts that
# follow `name`).
#
# Only include rows for accounts that have at least one follower. Not all
# accounts in `following` need to appear in `name`: some accounts that are
# followed may not be in the input table themselves. The accounts in the
# `followers` vectors should come from the `name` column of the input.
#
# ## Input
#
# - `following.dt`: A `data.table` with two columns:
# - `name`: A `character` column of account names.
# - `following`: A `list` column, where each element is a `character`
# vector of account names that `name` follows. May be `character(0)` if
# the account does not follow anyone.
#
# (You need to assert the `data.table`, but you do not need to assert column
# names or types.)
#
# ## Output
#
# A `data.table` with two columns:
#
# - `name`: `character` column of account names (any account that has at least
# one follower).
# - `followers`: `list` column, where each element is a `character` vector of
# accounts from the input `name` column that follow this account.
#
# ## Examples
#
# following.dt <- data.table(
# name = c("Alice", "Bob", "Charlie"),
# following = list(c("Bob", "Charlie"), c("Charlie"), character(0))
# )
# followersFromFollowing(following.dt)
# #> name followers
# #>
# #> 1: Bob Alice
# #> 2: Charlie Alice,Bob
#
# following.dt2 <- data.table(name = character(0), following = list())
# followersFromFollowing(following.dt2)
# #> Empty data.table (0 rows and 2 cols): name,followers
#
followersFromFollowing <- function(following.dt) {
# your code
assertDataTable(following.dt)
# Need to 'as.character()' to tell data.table that the column is character, even when
# the list is empty.
# Alternative solution would be to `if (sum(lengths(following.dt$following)) == 0) return()`
unnested <- following.dt[, .(followed = as.character(unlist(following))), by = "name"]
if (nrow(unnested) == 0) {
return(data.table(name = character(0), followers = list()))
}
result <- unnested[, .(followers = list(name)), by = "followed"]
setnames(result, c("name", "followers"))[]
}