I am running a simulation that I need to keep track of number of occurrences in a function call of a particular condition. I attempted to accomplish this with an assignment to a global object. It works if you run the function but if you try to lapply the function as I'm doing then you get a single count of all the times the condition happened rather than a count for every time it happened for each element in the list fed to lapply.
Here's a dummy situation where the occurrence is evenness of a number:
FUN <- function(x){
lapply(1:length(x), function(i) {
y <- x[i]
if (y %% 2 == 0){
assign("count.occurrences", count.occurrences + 1, env=.GlobalEnv)
}
print("do something")
})
list(guy="x", count=count.occurrences)
}
#works as expected
count.occurrences <- 0
FUN(1:10)
count.occurrences <- 0
lapply(list(1:10, 1:3, 11:16, 9), FUN)
#gives me...
#> count.occurrences
#[1] 9
#I want...
#> count.occurrences
#[1] 5 1 3 0
It's in a simulation so speed is an issue. I want this to be as fast as possible so I'm not married to the global assignment idea.
Rather than assign to the global environment, why not just assign to inside FUN's environment?
FUN <- function(x){
count.occurances <- 0
lapply(1:length(x), function(i) {
y <- x[i]
if (y %% 2 == 0){
count.occurances <<- count.occurances + 1
}
print("do something")
})
list(guy="x", count=count.occurances)
}
Z <- lapply(list(1:10, 1:3, 11:16, 9), FUN)
Then you can just pull the counts out.
> sapply(Z, `[[`, "count")
[1] 5 1 3 0
I haven't done any benchmarking on this, but have you tried just using a for loop? I know that loops aren't generally encouraged in R, but they're also not always slower.
FUN <- function(x) {
count.occurrences = 0
for (i in 1:length(x)) {
y = x[i]
if (y %% 2 == 0) {
count.occurrences = count.occurrences + 1
}
print("do something")
}
list(guy="x", count=count.occurrences)
}
lapply(list(1:10, 1:3, 11:16, 9), FUN)
I can get it like this:
count.occurances <- 0
Z <-lapply(list(1:10, 1:3, 11:16, 9), FUN)
diff(c(0, sapply(1:length(Z), function(x) Z[[x]]$count)))
I'm open to better ideas (faster).
Related
I already tried max(seq_along(x)) but I need it to also return 0 if we, let's say, inputted numeric(0).
So yeah, it works for anything else other than numeric(0). This is what I have so far:
my_length <- function(x){
max(seq_along(x))
}
You can just include a 0 to the max() call in your attempt:
my_length <- function(x) max(0, seq_along(x))
my_length(10:1)
[1] 10
my_length(NULL)
[1] 0
my_length(numeric())
[1] 0
Using forloop:
my_length <- function(x){
l = 0
for(i in x) l <- l + 1
return(l)
}
x <- numeric(0)
my_length(x)
# [1] 0
x <- 1:10
my_length(x)
# [1] 10
Another option:
my_length <- function(x) nrow(matrix(x))
You can use NROW():
len <- \(x) NROW(x)
Examples:
len(numeric(0))
#> [1] 0
len(letters)
#> [1] 26
len(c(3, 0, 9, 1))
#> [1] 4
From the documentation:
nrow and ncol return the number of rows or columns present in x. NCOL and NROW do the same treating a vector as 1-column matrix, even a 0-length vector ...
Here are a few more functional programming approaches:
Using mapping and summation:
length = function (x) {
sum(vapply(x, \(.) 1L, integer(1L)))
}
Using reduction:
length = function (x) {
Reduce(\(x, .) x + 1L, x, 0L)
}
Using recursion:
length = function (x, len = 0L) {
if (is_empty(x)) len else Recall(x[-1L], len + 1L)
}
Alas, the last one needs to define the helper function and that is unfortunately not trivial without using length():
is_empty = function (x) {
is.null(x) || identical(x, vector(typeof(x), 0L))
}
I'm trying to convert a while loop to a recursion.
I know the while loop is more efficient, but I'm trying to understand how to convert a for/while loop to recursion, and recursion to a for/while/if loop.
my function as I'm using a while loop:
harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
n <- (n +1)
}
return(n)
}
This function takes some numeric value, suppose x=2, and returns the number of objects for the harmonic sum that you need to sum up in order to create a greater number then x. (for x=2, you'd need to sum up the first 5 objects of the harmonic sum)
[![harmonic sum][1]][1]
**example**: `harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
print(sum)
n <- (n +1)
print(n)
}
return(n)
}
> harmon_sum(x =2)
[1] 1
[1] 2
[1] 1.5
[1] 3
[1] 1.833333
[1] 4
[1] 2.083333
[1] 5
[1] 5`
my version for the recursive function:
harmon_sum2 <- function(x, n =1){
if( x<= 0){
return(n-1)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
which returns me the wrong answer.
I'd rather find a solution with just one variable (x), instead of using two variables (x, n), but I couldn't figure a way to do that.
It seems to me that if you change return(n-1) to return(n) you do get the right results.
harmon_sum2 <- function(x, n=1){
if( x <= 0){
return(n)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
harmon_sum(2)
[1] 5
harmon_sum2(2)
[1] 5
harmon_sum(4)
[1] 32
harmon_sum2(4)
[1] 32
Your function needs to know n. If you don't want to pass it, you need to store it somewhere where all functions on the call stack can access it. For your specific case you can use sys.nframe instead:
harmon_sum2 <- function(x){
if( x<= 0){
return(sys.nframe())
}
else {
x <- (x- (1/(sys.nframe())))
harmon_sum2(x)
}
}
harmon_sum(8)
#[1] 1675
harmon_sum2(8)
#[1] 1675
However, this doesn't work if you call your function from within another function:
print(harmon_sum2(8))
#[1] 4551
Another alternative is the approach I demonstrate in this answer.
Write a function which takes a matrix that can be coerces into a matrix; the function should return a matrix which is the same as the function argument, but every even number is not changed and odd number is doubled.
I'm very new to R. Can someone help me complete my codes:
mx = matrix(c(1,1,3,5,2,6,-2,-1,-3), nrow = 3, byrow = TRUE)
fun = function(mx){
for(i in mx){
if(i %% 2 == 0){
return(i)
}
else if(i %% 2 > 0){
return(2*i)
}
}
}
Don't need a function, just use the built-in function ifelse:
mx <- ifelse(mx %% 2 == 0, mx, 2*mx)
Or, if you prefer to encapsulate it into a function:
fun = function(mx) {
ifelse(mx %% 2 == 0, mx, 2*mx)
}
res <- fun(mx)
## [,1] [,2] [,3]
##[1,] 2 2 6
##[2,] 10 2 6
##[3,] -2 -2 -6
Explanation:
ifelse performs a vectorized comparison over all elements of the matrix mx to see if each element is even (i.e., mx %% 2 == 0). For each element if this comparison condition is TRUE, the next argument is returned, which in this case is just the value from that element in mx. Otherwise, the last argument is returned, which is 2 times the value from that element in mx as you wish.
That's easy using indices :)
double_odd <- function(mx){
odds_idx <- (mx %% 2 != 0)
mx[odds_idx] <- 2 * mx[odds_idx]
mx # If it is the last statement, you don't need return
}
Cheers
Using your try:
fun = function(mx){
res <- matrix(data = NA, ncol = ncol(mx), nrow = nrow(mx))
for(i in 1:ncol(mx)){
for(j in 1:nrow(mx))
if(mx[j, i] %% 2 == 0){
res[j, i] <- mx[j, i]
}else{
res[j, i] <- 2 * mx[j, i]
}
}
return(res)
}
of course not the most elegant solution :)
x <- c(1,2,3,2,1)
table(x)
# x
# 1 2 3
# 2 2 1
Outputs how many times each element occur in the vector.
I am trying to imitate the above function using function()
Below is my code:
TotalTimes = function(x){
times = 0
y = unique(x)
for (i in 1:length(y)) {
for (i in 1:length(x)) {
if(y[i] == x[i])
times = times + 1
}
return(times)
}
}
What would be the right approach?
Here's a one-liner, using rle():
f <- function(x) {
with(rle(sort(x)), setNames(lengths, values))
}
f(c(1,2,3,2,1))
# 1 2 3
# 2 2 1
Alternatively, here's an option that's less "tricky", and is probably a better model for learning to code in an R-ish way:
f2 <- function(x) {
ss <- sort(x)
uu <- unique(ss)
names(uu) <- uu
sapply(uu, function(u) sum(ss == u))
}
f2(c(1,2,3,2,1))
# 1 2 3
# 2 2 1
function(x) {
q = sapply(unique(x), function(i) sum(x == i))
names(q) = unique(x)
return(q)
}
Here is one method using base R:
# data
x <- c(1,2,3,2,1)
# set up
y <- sort(unique(x))
counts <- rep_len(0, length.out=length(y))
names(counts) <- y
for(i in seq_along(x)) {
counts[x[i] == y] <- counts[x[i] == y] + 1
}
Wrapping it in a function:
table2 <- function(x) {
# transform x into character vector to reduce search cost in loop
x <- as.character(x)
y <- sort(unique(x))
counts <- rep_len(0, length.out=length(y))
names(counts) <- y
for(i in seq_along(x)) {
counts[x[i]] <- counts[x[i]] + 1L
}
return(counts)
}
This version only accepts a single vector, of course. At #Frank's suggestion, the function version is slightly different, and possibly faster, in that it transforms the input x into a character. The potential speed up is in the search in counts[x[i]] where the name in counts is referred to (as x[i]), rather than performing a search using "==."
I would like to hide printed output when saving output of my own function.
f2 <- function(x) {
cat("x + 5 = ", x + 5)
invisible(x + 5)
}
f2(1) # prints
a <- f2(1) # also prints
In other words I would like to make my function print
x + 5 = 6
when calling f2(1) but in case of calling a <- f2(1) I dont want to show any printed output. Is there any easy way how to do that?
You can use a class system for this. Here's a simple S3 example:
f2 <- function(x) {
names(x) <- paste(x, "+ 5")
class(x) <- c(class(x), 'foo')
x + 5
}
print.foo <- function(x) { cat(names(x), "=", x)}
In practice:
> x <- 3
> f2(x)
3 + 5 = 8
> y <- f2(x)
>
Note that the print.foo function does not handle vectors of length > 1 gracefully. That could be fixed, if desired.