I have a data.frame df like this:
df <- data.frame (x=1:5,y=1:5)
I want to use an apply function row-wise to this data frame, where I check a condition that is dependent on both the x and y and then change the x and y elements until they meet my condition. In this example if x and y don't add up to 8 I keep picking new random numbers for them and try again.
I figured an apply function using a while loop would be best. So I tried the following:
checkchange <- function(x) while(x[1] + x[2] < 8)
{
x[1] <- sample(5,1)
x[2] <- sample(5,1)
return(cbind(x[1],x[2]))
}
I would then plan on doing this:
newdf <- apply(df,1,checkchange)
This doesn't work. Should I be using repeat and a break or do I need to specify a return value more clearly. while loop grammar help greatly appreciated.
You are missing the curly braces for your anonymous function
This works for me:
checkchange <- function(x)
{
while((x[1] + x[2]) < 8)
{
x[1] <- sample(5,1)
x[2] <- sample(5,1)
}
return(cbind(x[1],x[2]))
}
As #Nico pointed out, the function will work with additional braces.
checkchange <- function(x) {
while (sum(x) < 8) {
# no need to sample from 1:5 if the sum has to be at least 8
x <- sample(3:5, 2, TRUE)
}
return(x)
}
The output of the apply needs to transposed to match the original arrangement of the data.
t(apply(df, 1, checkchange))
By the way, you don't need a loop for the function:
checkchange <- function(x) {
if (sum(x) < 8) {
x[1] <- sample(3:5, 1)
x[2] <- ifelse(x[1] == 3, 5, sample(seq(8 - x[1], 5), 1))
}
return(x)
}
Related
I would like to smartly round my results so that it sums up to the same sum after rounding.
Can someone explain me why this is different when I do it with map or lapply?
v <- c(
0.9472164,
71.5330771,
27.5197066)
smart.round <- function(x, digits = 0) {
up <- 10 ^ digits
x <- x * up
y <- floor(x)
indices <- tail(order(x-y), round(sum(x)) - sum(y))
y[indices] <- y[indices] + 1
y / up
}
### works correctly
smart.round(v)
### lapply and map is wrong
lapply(v,smart.round)
map(v,smart.round)
( I think this is merely a comment, but I have not yet earned my right add comments )
lapply, purrr::map are processing your input sequentially. In your example, lapply takes the first value of v and calls smart.round then moves on to the second value of v and so on ...
in total smart.round is called three times, each time without any knowledge of the other two values in v.
I'm not entirely sure why you try to use lapply here, if this is part of a more complex situation you might want to expand your question.
I have written my own solution. Definitely a bit cumbersome but it works.. :) My initial goal was just to input a dataframe and output the rounded dataframe.
The whole example here:
v <- data.frame(a = c(0.9472164,
71.5330771,
27.5197066),
b = c(4.6472164,
5.6330771,
27.1197066))
smart.round <- function(x, digits = 0) {
up <- 10 ^ digits
x <- x * up
y <- floor(x)
indices <- tail(order(x-y), round(sum(x)) - sum(y))
y[indices] <- y[indices] + 1
y / up
}
rounding_function <- function(input_df) {
output_df <- data.frame(matrix(ncol = ncol(input_df), nrow = nrow(input_df)))
for (i in 1:nrow(input_df)) {
a = smart.round(as.numeric(input_df[i,]))
for (k in 1:ncol(input_df)) {
output_df[i,k]=a[k]
}
colnames(output_df) = colnames(input_df)
}
return(output_df)
}
v_rounded <- rounding_function(v)
I'm trying to do some conditional logic on my raster brick. In the code below myFun1 correctly generates raster.out1. But myFun2 generates an error when trying to produce raster.out2. The error message is
Error in which(test) : argument to 'which' is not logical
Other than the use of a variable with the value of 5, these two functions look identical. I'm missing something clearly.
library(raster)
raster.in <- raster(nrows=100, ncols=100)
raster.in[] <- runif(ncell(raster.in), min = -10, max = 10)
const1 <- 5
myFun1 <- function(x, ...) {
ifelse(x <= 5, 5, x )
}
raster.out1 <- calc(raster.in, fun = myFun1)
myFun2 <- function(x, tbase, ...) {
ifelse(x <= tbase, tbase, raster.in)
}
raster.out2 <- calc(raster.in, fun = myFun2(x = raster.in, tbase = const1))
Two issues, you should have x instead of raster.in in your function, and to put a function w multiple parameters you need some extra code:
myFun2 <- function(x, tbase, ...) {
ifelse(x <= tbase, tbase, x)
}
calc(raster.in, function(x){myFun2(x, tbase = const1)})
astrofunkswag's answer is correct but there are more direct ways to get what you want with clamp or reclassify
r1 <- clamp(raster.in, const1)
r2 <- reclassify(raster.in, cbind(-Inf, const1, const1))
There is also a hidden (and less efficient) ifel method
r3 <- raster:::.ifel(raster.in < const1, const1, raster.in)
I am writing a function that takes in some vector and checks if it is numeric. If it is false, it will replace the numeric values with NA in the else statement. I have tried using the is.numeric() function in many ways, without much luck. Any help would be appreciated!
test <- function(x){
if(is.numeric(x) == TRUE){
mean.x <- mean(x)
vectorlist <- list(mean.x)
}
else
return(vectorlist)
}
x <- c("a", 1, 2)
test(x)
It sounds like you're looking for a function roughly like this:
test <- function(x){
if(is.numeric(x)){
return(mean(x))
}
else{
x[!is.na(as.numeric(x))] <- NA
return(x)
}
}
x <- c("a", 1, 2)
test(x)
Note that if (is.numeric(x)) is sufficient, you don't need the == TRUE stuff in the if clause.
I am new to R and am trying to vectorize my codes below.
What is a better way to do this? Thanks so much!
*
l_mat <- data.frame(matrix(ncol = 4, nrow = 4))
datax <- data.frame("var1"= c(1,1,1,1), "Var2" = c(2,2,2,2), "Var3"=c(3,3,3,3), "Var4"=c(4,4,4,4))
for (i in 1:4) {
for (j in 1:4) {
if (datax[i, 2] == datax[j, 2]) {
l_mat[i, j] <- 100
} else {
l_mat[i, j] <- 1
}
}
}
*
It can be better done with outer. As we are checking if all the values in the second column against itself, create the logical expression with outer, convert it to a numeric index and then replace the values with 1 or 100
out <- 1 + (outer(datax[,2], datax[,2], `==`))
out[] <- c(1, 100)[out]
Or in a single line
ifelse(outer(datax[,2], datax[,2], `==`), 100, 1)
Or use a variation with pmax and outer
do.call(pmax, list(outer(datax[,2], datax[,2], `==`) * 100, 1))
I'd like to perform this function on a matrix 100 times. How can I do this?
v = 1
m <- matrix(0,10,10)
rad <- function(x) {
idx <- sample(length(x), size=1)
flip = sample(0:1,1,rep=T)
if(flip == 1) {
x[idx] <- x[idx] + v
} else if(flip == 0) {
x[idx] <- x[idx] - v
return(x)
}
}
This is what I have so far but doesn't work.
for (i in 1:100) {
rad(m)
}
I also tried this, which seemed to work, but gave me an output of like 5226 rows for some reason. The output should just be a 10X10 matrix with changed values depending on the conditions of the function.
reps <- unlist(lapply(seq_len(100), function(x) rad(m)))
Ok I think I got it.
The return statement in your function is only inside a branch of an if statement, so it returns a matrix with a probability of ~50% while in the other cases it does not return anything; you should change the code function into this:
rad <- function(x) {
idx <- sample(length(x), size=1)
flip = sample(0:1,1,rep=T)
if(flip == 1) {
x[idx] <- x[idx] + v
} else if(flip == 0) {
x[idx] <- x[idx] - v
}
return(x)
}
Then you can do:
for (i in 1:n) {
m <- rad(m)
}
Note that this is semantically equal to:
for (i in 1:n) {
tmp <- rad(m) # return a modified verion of m (m is not changed yet)
# and put it into tmp
m <- tmp # set m equal to tmp, then in the next iteration we will
# start from a modified m
}
When you run rad(m) is not do changes on m.
Why?
It do a local copy of m matrix and work on it in the function. When function end it disappear.
Then you need to save what function return.
As #digEmAll write the right code is:
for (i in 1:100) {
m <- rad(m)
}
You don't need a loop here. The whole operation can be vectorized.
v <- 1
m <- matrix(0,10,10)
n <- 100 # number of random replacements
idx <- sample(length(m), n, replace = TRUE) # indices
flip <- sample(c(-1, 1), n, replace = TRUE) # subtract or add
newVal <- aggregate(v * flip ~ idx, FUN = sum) # calculate new values for indices
m[newVal[[1]]] <- m[newVal[[1]]] + newVal[[2]] # add new values