I have a function with three variables
fcalc <- function(n1,n2,n3){
calc1 <- n1*5+n2*10-n3*2
)
I want to pass the values:
1:2 to n1
3:5 to n2
and
6:9 to n3
However when I try
list1 <-lapply(1:2,3:5,6:9,fcalc)
liat1
I get an error.
eg when n1=1 and n2=3 and n3=6
the function would give
calc1 <- 1*5+3*10-6*2
23
I would be grateful for your help.
An option with pmap
library(purrr)
library(tidyr)
fcalc <- function(n1, n2, n3) n1 * 5 + n2 * 10 - n3 * 2
pmap_dbl(crossing(n1 = 1:2, n2 = 3:5, n3 = 6:9), fcalc)
If what you actually want to do is to get calc1 for each combination of the values then this could be your solution:
fcalc <- function(x) {
x[1]*5+x[2]*10-x[3]*2
}
(df <- expand.grid(x1=1:2,x2=3:5,x3=6:9))
(df$calc1 <- apply(df,1,fcalc))
You can also use outer():
fcalc <- function(x, y, z) {
c(outer(outer(x * 5, y * 10, FUN = "+"), z * 2, FUN = "-"))
}
fcalc(1:2, 3:5, 6:9)
[1] 23 28 33 38 43 48 21 26 31 36 41 46 19 24 29 34 39 44 17 22 27 32 37 42
Related
I want to calculate an equation in R. I don't want to use the function sum because it's returning 1 value. I want the full vector of values.
x = 1:10
y = c(21:29,NA)
x+y
[1] 22 24 26 28 30 32 34 36 38 NA
x = 1:10
y = c(21:30)
x+y
[1] 22 24 26 28 30 32 34 36 38 40
I don't want:
sum(x,y, na.rm = TRUE)
[1] 280
Which does not return a vector.
This is a toy example but I have a more complex equation using multiple vector of length 84647 elements.
Here is another example of what I mean:
x = 1:10
y = c(21:29,NA)
z = 11:20
a = c(NA,NA,NA,30:36)
5 +2*(x+y-50)/(x+y+z+a)
[1] NA NA NA 4.388889 4.473684 4.550000 4.619048 4.681818 4.739130 NA
1) %+% Define a custom + operator:
`%+%` <- function(x, y) mapply(sum, x, y, MoreArgs = list(na.rm = TRUE))
5 + 2 * (x %+% y - 50) / (x %+% y %+% z %+% a)
giving:
[1] 3.303030 3.555556 3.769231 4.388889 4.473684 4.550000 4.619048 4.681818
[9] 4.739130 3.787879
Here are some simple examples:
1 %+% 2
## [1] 3
NA %+% 2
## [1] 2
2 %+% NA
## [1] 2
NA %+% NA
## [1] 0
2) na2zero Another possibility is to define a function which maps NA to 0 like this:
na2zero <- function(x) ifelse(is.na(x), 0, x)
X <- na2zero(x)
Y <- na2zero(y)
Z <- na2zero(z)
A <- na2zero(a)
5 + 2 * (X + Y - 50) / (X + Y + Z + A)
giving:
[1] 3.303030 3.555556 3.769231 4.388889 4.473684 4.550000 4.619048 4.681818
[9] 4.739130 3.787879
3) combine above A variation combining (1) with the idea in (2) is:
X <- x %+% 0
Y <- y %+% 0
Z <- z %+% 0
A <- a %+% 0
5 + 2 * (X + Y - 50) / (X + Y + Z + A)
4) numeric0 class We can define a custom class "numeric0" with its own + operator:
as.numeric0 <- function(x) structure(x, class = "numeric0")
`+.numeric0` <- `%+%`
X <- as.numeric0(x)
Y <- as.numeric0(y)
Z <- as.numeric0(z)
A <- as.numeric0(a)
5 + 2 * (X + Y - 50) / (X + Y + Z + A)
Note: The inputs used were those in the question, namely:
x = 1:10
y = c(21:29,NA)
z = 11:20
a = c(NA,NA,NA,30:36)
Using rowSums:
To elaborate on my comment, you can concatenate the vectors and then apply your calculations on the resulted matrix. This is the solution for the example that you provided at the end of your question;
5 + 2 * (rowSums(cbind(x,y), na.rm = T)-50)/(rowSums(cbind(x,y,z,a), na.rm = T))
# [1] 3.303030 3.555556 3.769231 4.388889 4.473684 4.550000 4.619048 4.681818
# [9] 4.739130 3.787879
Repalcing NA:
I have seen solutions here with the idea of replacing NA in the vectors; I think this would be helpful too:
y[is.na(y)] <- 0 #indexing NA values and replacing with zero
you can use ifelse()
x = 1:10
y = c(21:29,NA)
x+y
[1] 22 24 26 28 30 32 34 36 38 NA
x + ifelse(is.na(y), 0, y)
[1] 22 24 26 28 30 32 34 36 38 10
DATA
x = 1:10
y = c(21:29,NA)
x+y
# [1] 22 24 26 28 30 32 34 36 38 NA
1
foo1 = function(...){
return(rowSums(cbind(...), na.rm = TRUE))
}
foo1(x, y)
# [1] 22 24 26 28 30 32 34 36 38 10
2
foo2 = function(...){
Reduce('+', lapply(list(...), function(x) replace(x, is.na(x), 0)))
}
foo2(x, y)
# [1] 22 24 26 28 30 32 34 36 38 10
Just for laffs:
x=1:10
y=c(21:29, NA)
"[<-"(x, is.na(x), 0) + "[<-"(y, is.na(y), 0)
# [1] 22 24 26 28 30 32 34 36 38 10
which again illustrates the fact that everything in R is a function (and also shows that the R interpreter is smart enough to turn a string into a function when required).
Syntactically sweetened:
na.zero <- function(x)
{
"[<-"(x, is.na(x), 0)
}
na.zero(x) + na.zero(y)
# [1] 22 24 26 28 30 32 34 36 38 10
More broadly applicable version:
na.replace <- function(x, value)
{
"[<-"(x, is.na(x), value)
}
na.replace(x, 1) * na.replace(x, 1)
# [1] 1 4 9 16 25 36 49 64 81 100
I have a two value
3 and 5
and I make vector
num1 <- 3
num2 <- 12
a <- c(num1, num2)
I want add number(12) to vector "a" and
also I want to make new vector with repeat and append
like this:
3,12, 15,24, 27,36, 39,48 ....
repeat number "n" is 6
I don't have any idea.
Here are two methods in base R.
with outer, you could do
c(outer(c(3, 12), (12 * 0:4), "+"))
[1] 3 12 15 24 27 36 39 48 51 60
or with sapply, you can explicitly loop through and calculate the pairs of sums.
c(sapply(0:4, function(i) c(3, 12) + (12 * i)))
[1] 3 12 15 24 27 36 39 48 51 60
outer returns a matrix where every pair of elements of the two vectors have been added together. c is used to return a vector. sapply loops through 0:4 and then calculates the element-wise sum. It also returns a matrix in this instance, so c is used to return a vector.
Here is a somewhat generic function that takes as input your original vector a, the number to add 12, and n,
f1 <- function(vec, x, n){
len1 <- length(vec)
v1 <- sapply(seq(n/len1), function(i) x*i)
v2 <- rep(v1, each = n/length(v1))
v3 <- rep(vec, n/len1)
return(c(vec, v3 + v2))
}
f1(a, 12, 6)
#[1] 3 12 15 24 27 36 39 48
f1(a, 11, 12)
#[1] 3 12 14 23 25 34 36 45 47 56 58 67 69 78
f1(a, 3, 2)
#[1] 3 12 6 15
EDIT
If by n=6 you mean 6 times the whole vector then,
f1 <- function(vec, x, n){
len1 <- length(vec)
v1 <- sapply(seq(n), function(i) x*i)
v2 <- rep(v1, each = len1)
v3 <- rep(vec, n)
return(c(vec, v3 + v2))
}
f1(a, 12, 6)
#[1] 3 12 15 24 27 36 39 48 51 60 63 72 75 84
Using rep for repeating and cumsum for the addition:
n = 6
rep(a, n) + cumsum(rep(c(12, 0), n))
# [1] 15 24 27 36 39 48 51 60 63 72 75 84
The seq function in R would give me a sequence from x to y with a constant step m:
seq(x, y, m)
E.g. seq(1,9,2) = c(1,3,5,7,9).
What would be the most elegant way to get a sequence from x to y with alternating steps m1 and m2, such that something like "seq(x, y, c(m1, m2))" would give me c(x, x + m1, (x + m1) + m2, (x + m1 + m2) + m1, ..., y), each time adding one of the steps (not necessarily reaching up to y, of course, as in seq)?
Example: x = 1; y = 19; m1 = 2; m2 = 4 and I get c(1,3,7,9,13,15,19).
I arrived the solution by:
1. Use cumsum with a vector c(from,rep(by,times),...), with by repeated times = ceiling((to-from)/sum(by)) times.
2. Truncate the sequence by !(seq > to).
seq_alt <- function(from, to, by) {
seq <- cumsum(c(from,rep(by,ceiling((to-from)/sum(by)))))
return(seq[! seq > to])
}
First n terms of this sequence you can generate with
x = 1; m1 = 2; m2 = 4
n <- 0:10 # first 11 terms
x + ceiling(n/2)*m1 + ceiling((n-1)/2)*m2
# [1] 1 3 7 9 13 15 19 21 25 27 31
Here is another idea,
fun1 <- function(x, y, j, z){
if(j >= y) {return(x)}else{
s1 <- seq(x, y, j+z)
s2 <- seq(x+j, y, j+z)
return(sort(c(s1, s2)))
}
}
fun1(1, 19, 2, 4)
#[1] 1 3 7 9 13 15 19
fun1(1, 40, 4, 3)
#[1] 1 5 8 12 15 19 22 26 29 33 36 40
fun1(3, 56, 7, 10)
#[1] 3 10 20 27 37 44 54
fun1(1, 2, 2, 4)
#[1] 1
Here is an alternative that uses diffinv This method over allocates the values, so as a stopping rule, I get the elements that are less than or equal to the stopping value.
seqAlt <- function(start, stop, by1, by2) {
out <- diffinv(rep(c(by1, by2), ceiling(stop / (by1 + by2))), xi=start)
return(out[out <= stop])
}
seqAlt(1, 19, 2, 4)
[1] 1 3 7 9 13 15 19
You could use Reduce with accumulate = TRUE to iteratively add either 2 or 4:
Reduce(`+`, rep(c(2,4), 10), init = 1, accumulate = TRUE)
# [1] 1 3 7 9 13 15 19 21 25 27 31 33 37 39 43 45 49 51 55 57 61
The number of times you repeat c(2,4) will determine sequence length; since it is 10 above, the sequence is length 20.
The purrr package has an accumulate wrapper, if you prefer the syntax:
purrr::accumulate(rep(c(2,4), 10), `+`, .init = 1)
## [1] 1 3 7 9 13 15 19 21 25 27 31 33 37 39 43 45 49 51 55 57 61
perfect example of recycling vectors in R
# 1.
x = 1; y = 19; m1 = 2; m2 = 4
(x:y)[c(TRUE, rep(FALSE, m1-1), TRUE, rep(FALSE,m2-1))]
# [1] 1 3 7 9 13 15 19
# 2.
x = 3; y = 56; m1 = 7; m2 = 10
(x:y)[c(TRUE, rep(FALSE, m1-1), TRUE, rep(FALSE,m2-1))]
# [1] 3 10 20 27 37 44 54
My R code is as follows. The main task is to calculate the row number of repetitions.
library(plyr)
data<-data.frame(1,2,3);
x <- read.table(text = "ID1 ID2 n m
13 156 12 15
94 187 14 16
66 297 41 48
29 89 42 49
78 79 51 79", header= TRUE)
distfunc <- function(data,ID1,ID2,n,m){
X1<-ID1; ################
X2<-ID2; ################
X3<-unlist(mapply(':', n, m));
data<-rbind(data,data.frame(X1,X2,X3));
return(data);
}
data<-distfunc(data,x$ID1, x$ID2,x$n, x$m)
data<-data[-1,]
plyr::count(data, names(data)); ## Calculates the row number of repetitions
The error message I get:
Error in data.frame(X1, X2, X3) :
arguments imply differing number of rows: 5, 52
I try to fix it by R Error: “In numerical expression has 19 elements: only the first used”, but it failed and the result is wrong. This probelm is not the same as that probelm.
I suppose you want to do:
# library(plyr)
# data<-data.frame(1,2,3);
x <- read.table(header=TRUE, text =
"ID1 ID2 n m
13 156 12 15
94 187 14 16
66 297 41 48
29 89 42 49
78 79 51 79")
#distfunc <- function(data, ID1, ID2, n, m) {
# X1 <- ID1 ################
# X2 <- ID2 ################
# X3 <- unlist(mapply(':', n, m))
# data <- rbind(data, data.frame(X1,X2,X3))
#}
#data <- distfunc(data, x$ID1, x$ID2, x$n, x$m)
L <- apply(x, 1, function(x) data.frame(X1=x[1], X2=x[2], X3=x[3]:x[4], row.names=NULL))
data <- L[[1]]
for (i in 2:length(L)) data <- rbind(data, L[[i]])
or with a better readable function in apply():
L <- apply(x, 1, function(r) data.frame(X1=r["ID1"], X2=r["ID2"], X3=r["n"]:r["m"], row.names=NULL))
data <- L[[1]]; for (i in 2:length(L)) data <- rbind(data, L[[i]])
Here is a simpler variant:
data <- data.frame(X1=x$ID1[1], X2=x$ID2[1], X3=x$n[1]:x$m[1])
for (i in 2:nrow(x)) data <- rbind(data, data.frame(X1=x$ID1[i], X2=x$ID2[i], X3=x$n[i]:x$m[i]))
I just fixed it.
distfunc <- function(data, ID1, ID2, n, m) {
X1 <- ID1
X2 <- ID2
X3 <- unlist(mapply(':', n, m))
data <- rbind(data,data.frame(X1, X2, X3))
return(data)
}
Please, input the following code:
A <- matrix(11, nrow = 4, ncol = 3)
A[,2] <- seq(119, 122, 1)
A[,3] <- seq(45, 42)
B <- matrix(39, nrow = 4, ncol = 3)
B[,2] <- seq(119, 122, 1)
B[,3] <- seq(35, 32)
C <- matrix(67, nrow = 4, ncol = 3)
C[,2] <- seq(119, 122, 1)
C[,3] <- seq(27, 24)
D <- rbind(A, B, C)
You will get D which is a 12 x 3 matrix; I would like to know the most efficient way to obtain Mat starting from D.
> Mat
11 39 67
119 45 35 27
120 44 34 26
121 43 33 25
122 42 32 24
In fact, Mat is the last column of D indexed by the first and the second column of D; e.g. consider Mat[1,1] which is equal to 45: it comes from the only row of D which is identified by 11 and 119.
How may I obatin it?
Thanks,
You can use xtabs:
xtabs(D[,3]~D[,2]+D[,1])
D[, 1]
D[, 2] 11 39 67
119 45 35 27
120 44 34 26
121 43 33 25
122 42 32 24
library(reshape2)
dcast(data.frame(D), X2 ~ X1)