I want to recursively count the log cylces in my function
logCounter <- function(number) {
k <- 0
if(k>=0){
k = k+1
}
result <- log(number)
if (result > 1) {
logCounter(result)
} else {
return(k)
}
}
logCounter(123)#returns 3 because log(log(log(123))) < 1
However, my counter k does not work as I would have inspected. Therefore I really would appreciate your answer!!!
You don't need to use Recall. Try this:
logCounter <- function(number) {
if (number <1) return(0) # A minor edit.
result <- log(number)
if (result > 1) return(logCounter(result)+1)
return(1)
}
The key is to try to compose your function in a way that doesn't require storing intermediate results.
You could do this much more easily without calling the function recursively with a while loop:
logCounter <- function(number) {
k <- 0
result <- number
while(result>1){
k <- k + 1
result <- log(result)
}
return(k)
}
> logCounter(123)
[1] 3
EDIT: If you need to use recursion, consider the Recall function:
logCounter <- function(number, iter=1) {
if(log(number)>1)
out <- Recall(log(number), iter+1)
else
out <- list(log(number),iter)
return(out)
}
> logCounter(123)
[[1]]
[1] 0.4518085
[[2]]
[1] 3
Related
I was working on a binomial expansion in R, I came across some issues and I feel the values do not make sense. Here is my code, I used factorial and combination from "scratch" to compute. I tried x=6, y=2 and n=4 I got 2784 as an answer. If I try 1 it gives 0. If n=i I get infinity because the denominator would equal zero
fact=1
for(i in 1:n){
fact=fact*i
}
return(fact)
}
Combi<-function(n,r){
result=f(n)/(f(r)*f(n-r))
return(result)
}
Combi(6,4)
expand.binomial<-function(x,y,n){
sumz=0
for(i in 1:n){
if(i==n){
break
}
sumz=sumz+Combi(n,i)*(x**i)*(y**(n-i))
}
return(sumz)
}
You should be aware of that, 0! is 1. In this case, f should be defined like below
f <- function(n) {
if (n == 0) {
return(1)
}
fact <- 1
for (i in 1:n) {
fact <- fact * i
}
return(fact)
}
Also, in expand.binomial, the exponents should start from 0 to n, i.e.,
expand.binomial <- function(x, y, n) {
sumz <- 0
for (i in 0:n) {
sumz <- sumz + Combi(n, i) * (x**i) * (y**(n - i))
}
return(sumz)
}
Test
> expand.binomial(6, 2, 4)
[1] 4096
> expand.binomial(6, 2, 1)
[1] 8
> expand.binomial(6, 2, 0)
[1] 1
I'm making a function that categorize the customers based on there sales into 3 classes A,B and C, but the function give me wired results i don't know why
f <- function(x)
{
for(j in 1:length(x))
{
if(x[j] > 0 & x[j] < 501 )
{
x[j] = "C"
}
else if(x[j] > 500 & x[j] < 1001 )
{
x[j] = "B"
}
else if(x[j] > 1000 )
{
x[j] = "A"
}
}
return(x)
}
This is the function.
print(f(c(2000,2000,2000)))
when i run this for example it gave me A,C,C where is should be all A
print(f(c(600,600)))
this gave B which is right but then A !
As noted by #shwan you were rewriting the x vector as character values. To avoid defining an other vector for result and also avoid the loop structure you could just use the vectorized ifelse command and write your function as:
f=function(x){ifelse(x>0 & x<501,"A",ifelse(x>500 & x <1001,"B","C"))}
By using x[j] = "C", you are coercing x to class 'character', which then returns unexpected logical comparisons.
You need to save the result in some other, character vector ('ret' below).
f <- function(x) {
ret <- NA_character_
for(j in 1:length(x)) {
if(x[j] > 0 & x[j] < 501 ) {
ret <- c(ret,"C")
} else if(x[j] > 500 & x[j] < 1001 ) {
ret <- c(ret,"B")
} else if(x[j] > 1000 ) {
ret <- c(ret,"A")
}
}
ret <- ret[2:length(ret)] # remove the first element
return(ret)
}
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
}
I have this piece of code:
library("GO.db")
lookParents <- function(x) {
parents <- subset(yy[x][[1]], labels(yy[x][[1]])=="is_a")
for (parent in parents) {
m[index,1] <<- Term(x)
m[index,2] <<- Term(parent)
m[index,3] <<- -log2(go_freq[x,1]/go_freq_all)
m[index,4] <<- log2(go1_freq2[x])
m[index,5] <<- x
m[index,6] <<- parent
index <<- index + 1
}
if (is.null(parents)) {
return(c())
} else {
return(parents)
}
}
getTreeMap <- function(GOlist, xx, m) {
print(paste("Input list has",length(GOlist), "terms", sep=" "))
count <- 1
for (go in GOlist) {
parents <- lookParents(go)
if (count %% 100 == 0) {
print(count)
}
while (length(parents) != 0) {
x <- parents[1]
parents <- parents[-1]
parents <- c(lookParents(x), parents)
}
count <- count + 1
}
}
xx <- c(as.list(GOBPANCESTOR), as.list(GOCCANCESTOR), as.list(GOMFANCESTOR))
go1_freq2 <- table(as.character(unlist(xx[go1])))
xx <- c(as.list(GOBPPARENTS), as.list(GOCCPARENTS), as.list(GOMFPARENTS))
m <- as.data.frame(matrix(nrow=1,ncol=6))
m[1,] <- c("all", "null", 0, 0, "null","null")
##biological processes
index <- 2
getTreeMap(BP, xx, m)
but it is really slow. BP is simply a vector. Do you have performance suggestions to apply? I would like to make it run faster, but that's all I can do at the moment.
I suggest following improvements:
add your functions into RProfile.site and compile them using cmpfun
use foreach and dopar instead of normal for
always delete the variables you don't need anymore and then call the garbage collector
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