I'm trying to loop through integers 1:1000 comparing the result of a function I've created with an R function. Specifically, I have:
floor.log2 = function(n) {
x = 1
i = 0
while (x <= n) {
x = 2*x
i = i + 1
}
print(i-1)
}
And I want to compare with:
floor(log(n, base = 2))
Every comparison loop I've created ends up printing each index 1:1000 - what is a succinct way to compare results for 1:1000 in these functions without R printing the indices?
I would modify the existing function you wrote to:
floor.log2 = function(n) {
x = 1
i = 0
while (x <= n) {
x = 2*x
i = i + 1
}
return(i-1)
}
To test:
iter <- 100 # How long you would like to test for
vec1 <- c() # Container of your custom function
vec2 <- c() # Container for the comparison function
for(i in 1:iter) {
vec1[i] <- floor.log2(i)
vec2[i] <- floor(log(i, base = 2))
}
Finally:
all(vec1 == vec2)
Related
Is it possible to evaluate a function argument in a subsequent function call multiple times, when the value that I try to capture may change inside the mother function?
The problem I have is similar to the example below.
I have a mother function f1() with a child function rnorm() inside a for loop.
The child function should receive a different argument in each iteration of the loop (i.e., rnorm(n = ii), but I want to control this at the level of the mother function.
f1 <- function(I, n = 1) {
res <- vector("list", length = I)
for (ii in seq_len(I)) {
res[[ii]] <- rnorm(n = n)
}
return(res)
}
f1(I = 2, n = 1)
f1(I = 2, n = ii) # desired, but obviously doesn't work
I tried to play around with eval(), quote(), get(), etc. but to no avail.
You want non-standard evaluation, which means you need to modify the expression based on a function parameter (typically using substitute) before it is evaluated.
f1 <- function(I, n = 1) {
nval <- substitute(n)
res <- vector("list", length = I)
if (is.numeric(nval)) {
for (ii in seq_len(I)) {
res[[ii]] <- rnorm(n = n)
}
}
if (is.name(nval)) {
for (ii in seq_len(I)) {
res[[ii]] <- eval(substitute(rnorm(n = nval), list(nval = nval)))
}
}
return(res)
}
f1(I = 2, n = 1)
#[[1]]
#[1] 0.4600974
#
#[[2]]
#[1] -0.6399949
f1(I = 2, n = ii)
#[[1]]
#[1] 0.4554501
#
#[[2]]
#[1] 0.7048373 1.0351035
I think your example is just poor software design. I strongly advise against doing it.
A much better approach would be this:
f1 <- function(I, n) {
res <- vector("list", length = I)
if (missing(n)) {
for (ii in seq_len(I)) {
res[[ii]] <- rnorm(n = ii)
}
} else {
for (ii in seq_len(I)) {
res[[ii]] <- rnorm(n = n)
}
}
return(res)
}
f1(I = 2, n = 1)
f1(I = 2)
I want to create a function that returns its result as a vector. More specifically, a function that returns the divisors of an input value and places them inside a vector.
divisors<-function(n){
i <- 2
c<-1
x<-c()
while(i <= n) {
if(n%%i==0) {
x[c]<-i
}
i <- i + 1
c<-c+1
x
}
}
I edited a bit your code in order to return a vector and avoid NA values.
divisors <- function(n){
i <- 2
x<-vector("integer")
while(i <= n) {
if(n%%i == 0) {
x <- c(x, i)
}
i <- i + 1
}
x
}
Hi so I have the following function:
kde.cv = function(X,s) {
l = length(X)
log.fhat.vector = c()
for (i in 1:l) {
current.log.fhat = log ( kde(X[i],X[-i],s) )
log.fhat.vector[i] = current.log.fhat
}
CV.score = sum(log.fhat.vector)
return(CV.score)
}
I'd like to vectorize this without using any for loops or apply statements, can't seem to get around doing so. Help would be appreciated. Thanks.
EDIT: Given the responses, here are my answers to the questions posed.
Given requests for clarification, I will elaborate on the function inputs and on the user defined function inside the function given. So X here is a dataset in the form of a vector, specifically, a vector of length 7 in the dataset I used as an input to this function. The X I used this function for is c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041). s is a single scalar point set at 0.2 for the use of this function. kde is a user - defined function that I wrote. Here is the implementation:
kde = function(x,X,s){
l = length(x)
b = matrix(X,l,length(X),byrow = TRUE)
c = x - b
phi.matrix = dnorm(c,0,s)
d = rowMeans(phi.matrix)
return(d)
}
in this function, X is the same vector of data points used in kde.cv. s is also the same scalar value of 0.2 used in kde.cv. x is a vector of evaluation points for the function, I used seq(-2.5, -0.5, by = 0.1).
Here is an option using sapply
kde.cv = function(X,s)
sum(sapply(1:length(X), function(i) log(kde(X[i], X[-i], s))))
For convenience, please provide a more complete example. For example, the kde() function. Is that a customized function?
Alternative to sapply, you can try Vectorize(). There are some examples you can find on stack overflow.
Vectorize() vs apply()
Here is an example
f1 <- function(x,y) return(x+y)
f2 <- Vectorize(f1)
f1(1:3, 2:4)
[1] 3 5 7
f2(1:3, 2:4)
[1] 3 5 7
and the second example
f1 <- function(x)
{
new.vector<-c()
for (i in 1:length(x))
{
new.vector[i]<-sum(x[i] + x[-i])
}
return(sum(new.vector))
}
f2<-function(x)
{
f3<-function(y, i)
{
u<-sum(y[i]+y[-i])
return(u)
}
f3.v<-Vectorize(function(i) f3(y = x, i=i))
new.value<-f3.v(1:length(x))
return(sum(new.value))
}
f1(1:3)
[1] 24
f2(1:3)
[1] 24
Note: Vectorize is a wrapper for mapply
EDIT 1
According to the response, I edited your kde.cv function.
kde.cv = function(X,s) {
l = length(X)
log.fhat.vector = c()
for (i in 1:l) {
current.log.fhat = log ( kde(X[i],X[-i],s) )
log.fhat.vector[i] = current.log.fhat
}
CV.score = sum(log.fhat.vector)
return(CV.score)
}
kde = function(x,X,s){
l = length(x)
b = matrix(X,l,length(X),byrow = TRUE)
c = x - b
phi.matrix = dnorm(c,0,s)
d = rowMeans(phi.matrix)
return(d)
}
##### Vectorize kde.cv ######
kde.cv.v = function(X,s)
{
log.fhat.vector = c()
kde.v<-Vectorize(function(i) kde(X[i], X[-i], s))
CV.score <- sum(log(kde.v(1:length(X))))
return(CV.score)
}
X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2
x<-seq(-2.5, -0.5, by = 0.1)
kde.cv(X, s)
[1] -10.18278
kde.cv.v(X, s)
[1] -10.18278
EDIT 2
Well, I think the following function may match your requirement. BTW, since the little x is not used in your kde.cv, I just edited both two functions
kde.cv.2 <- function(X,s)
{
log.fhat.vector<-log(kde.2(X, s))
CV.score = sum(log.fhat.vector)
return(CV.score)
}
kde.2<-function(X, s)
{
l <- length(X)
b <- matrix(rep(X, l), l, l, byrow = T)
c <- X - b
diag(c) <- NA
phi.matrix <- dnorm(c, 0, s)
d <- rowMeans(phi.matrix, na.rm = T)
return(d)
}
X<-c(-1.1653, -0.7538, -1.3218, -2.3394, -1.9766, -1.8718, -1.5041)
s<-0.2
kde.cv(X,s)
[1] -10.18278
kde.cv.2(X, s)
[1] -10.18278
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
I am trying to create a function to calculate the Box-Cox transformation in R, where you iterate values of lambda (lambdas) in a formula to maximize L. What I ultimately want is a vector of L, such that for all i in lambda, there is a corresponding L value.
y <- c(256,256,231,101,256,213,241,246,207,143,287,240,262,234,146,255,184,161,252,229,283,132,218,113,194,237,181,262,104)
df <- 28
n=29
lambdas <- seq(-3,3,0.001)
L <- c(rep(NA,length(lambdas)))
for(i in lambdas) {
if(i != 0) {
yprime <- (((y^i)-1)/i)
} else
{ yprime <- log(y)
}
st2 <- var(yprime)
L <- (((-df/2)*(log(st2))) + ((i-1)*(df/n)*(sum(log(y)))))
}
What I typically end up with L as a vector of 1, with the final iteration calculated.
Use seq_along to generate an index for lambdas[] and L[]
for(i in seq_along(lambdas)) {
if(i != 0) {
yprime <- (((y^lambdas[i])-1)/lambdas[i])
} else {
yprime <- log(y)
}
st2 <- var(yprime)
L[i] <- (((-df/2)*(log(st2))) + ((lambdas[i]-1)*(df/n)*(sum(log(y)))))
}
plot(L)