I 'm trying to use else if within a function in R
new<-function(a,b,c,d){
if (a==1){
var1<-100+100+100
var2<-500+500+500
var3<-500-100
}else if (a==2){
var1<-100+100
var2<-500+500
var3<-500-10
} else if (a==3){
var1<-100
var2<-500
var3<-500
}
b<-var1-var2
c<- var2+var3
d<-var3-var1
if (b<100)
{print ("the value is good")
}else if (b>100)
{ print("check teh value")
}else
{print ("repeat")
}
}
output<-new(3,b,c,d)
I feel something fundamental is wrong with this which I m missing. I 'm trying to use else if to populate the values to be used as an input to call the same fucntion.
Help is greatly appreciated
You can simplify to:
new <- function(a) {
if (a == 1) {
b <- -1200
} else if (a == 2) {
b <- -800
} else if (a == 3) {
b <- -400
}
if (b < 100)
{
print ("the value is good")
} else if (b > 100)
{
print("check the value")
} else
{
print ("repeat")
}
return(b) # for fun return the value of b
}
output <- new(2)
But this function will always have the side effect of printing "the value is good" because b always evaluates to a negative number. What's the purpose?
If you would want to return values a to d, you could do the intermediate calculations as per your example and do: return(list(a = a, b = b, c = c, d = d)) instead of return(b).
Related
I am trying to create functions that evaluates numbers and adds them to a category dependent on set criteria.
I wrote a "stupid" function with a lot of repetitions and lines, that can solve the job in a simple case:
# Findgroup (Everything manually typed out)
# Purpose of function:
#If 1 or 2: output A
#If 3 or 4: output B
#If 5 or 6: output random A/B (bonus if this can be balanced equally over the dataset)
# Else output "error"
findGroup <- function(x){ if (x == 1) {
"A"
} else if (x == 2) {
"A"
} else if (x == 3) {
"B"
} else if (x == 4) {
"B"
}else if (x == 5) {
sample(c("sA","sB"),1)
}else if (x == 6) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All matches expectations
findGroup(1) # Returns A
findGroup(3) # Returns B
findGroup(5) # Samples
findGroup(7) # Returns Error
This is okay, if I had to evaluate a few numbers. But what should I do if the list of numbers is much more elaborate? I tried to write a function that solves this in fewer lines, but the result does not work:
# Findgroup new
# Purpose of function:
#If 2:8: output A
#If 10:16: output B
#If 1,9: output random A/B (bonus if this can be balanced equally)
findGroupNew <- function(x){ if (x == 2|3|4|5|6|7|8) {
"A"
} else if (x == 10|11|12|13|14|15|16) {
"B"
} else if (x == 1||9) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All return A!!!
findGroupNew(1) # Should sample
findGroupNew(3) # Should Return A
findGroupNew(11) # Should Return B
findGroupNew(17) # Should Return Error
It may be a stupid mistake such as not having used the right sign for OR, but having tried solutions such as using || and & has not been successful.
I hope there is a quick fix to this issue and will appreciate your feedback.
Use %in% to check for multiple values.
findGroupNew <- function(x) {
if (x %in% 2:6) {
return("A")
} else if (x %in% 10:16) {
return("B")
} else if (x %in% c(1, 9)) {
return(sample(c("sA","sB"),1))
} else {
return("Error")
}
}
findGroupNew(1)
#[1] "sB"
findGroupNew(3)
#[1] "A"
findGroupNew(11)
#[1] "B"
findGroupNew(7)
#[1] "Error"
I need to have a function where if a number entered is a prime number, it must round it up to the next prime number and if it is not to round it down to the previous prime number.
I have this code to identify whether it is a prime number:
prime <- function(x) {
if (x == 2) {
print(3)
} else if (any(x %% 2:(x-1) == 0)) {
FALSE
} else {
TRUE
}
}
I want to add a while loop to the true and false where if the function is false, it must minus one until it is true and if it is true, it must add one until it is true again but I am not sure how to do this.
Using your prime checker,
prime <- function(x) {
if (x == 2) {
print(3)
} else if (any(x %% 2:(x-1) == 0)) {
FALSE
} else {
TRUE
}
}
We build the new function, we first check if our number is a prime, if so, add 1 until we reach the next prime. If it is not a prime, we minus 1 until it is.
new <- function(x){
if (isTRUE(prime(x))){
x = x+1
while(prime(x) == FALSE){
x = x+1
}
return(x)
} else {
while(prime(x) == FALSE){
x = x-1
}
return(x)
}
}
we get
> new(7)
[1] 11
> new(10)
[1] 7
i <- 2
j <- 0
for (i in 2:1000) {
if(return.prime(i)){j = j + 1}
i = i + 1
}
I want to check how many prime numbers there are in 1 to 1000 using my own function return.prime which returns TRUE when the number input is a prime and FALSE when the number input is not prime. The return.prime function is the function below and it is correct.
return.prime <- function(d){
if(d ==1 ){print(FALSE)}
if (d == 2){
print(TRUE)
}
if(d !=2 && d!=1){
if(any(d %% (2:(d-1)) == rep(0,d-2))==TRUE){
print(FALSE)}
else
print(TRUE)
}
}
The problem is when I run my program it says:
[1] TRUE
Error in if (return.prime(i)) { : argument is of length zero
I do not know what causes the length zero.
R doesn't work that way. You're just having the function print the word "TRUE" or "FALSE". Instead, you need to ?return TRUE or FALSE. Consider:
return.prime <- function(d){
if(d==1){ return(FALSE) }
if(d==2){ return(TRUE) }
if(d !=2 && d!=1){
if(any(d %% (2:(d-1)) == rep(0,d-2))==TRUE){
return(FALSE)
} else{
return(TRUE)
}
}
}
i <- 2
j <- 0
for (i in 2:1000) {
if(return.prime(i)){j = j + 1}
i = i + 1
}
j # [1] 168
IS <- function(N,K,sigma,t,r,S_0,a,b,tol){
funct_1 <- function(x){
return((S_0*(exp(-0.5*(sigma^2)*t+sigma*sqrt(t)*x))*(sigma*sqrt(t)-x))+
(exp(-r*t))*K*x)
}
bisection_method <- function(a, b, tol, f = funct_1){
if (f(a)*f(b) > 0){
print("No root found.")
} else
while ((b - a)/2.0 > tol){
midpt= (a + b)/2.0
if (f(midpt) == 0){
return(midpt)
} else if (f(a)*f(midpt) < 0){
b = midpt
} else
a = midpt
}
return(midpt)
}
}
The above function will produce nothing for you. My goal that to input the values of "N,K,sigma,t,r,S_0, a,b" and somehow return "midpt" for me. I have searched a lot but could not come up with anything that makes sense. I have many problems, assume that I input everything things, then how the function "funct_1" will output expression, this expression needs to be recalled to the next function "bisection_method} along with the value of a and b then finally obtain the "midpt" value. Any suggestions are really appreciated. Please let me know if there is anything not clear to you at all.
Your main function doesn't return anything. It just creates the auxiliary functions and then do nothing. That's why you're getting no output.
Try returning the bisection method with appropriate parameters in your main function instead. I also edited so you get NULL output when no root is found.
IS <- function(N,K,sigma,t,r,S_0,a,b,tol){
funct_1 <- function(x){
return((S_0*(exp(-0.5*(sigma^2)*t+sigma*sqrt(t)*x))*(sigma*sqrt(t)-x))+
(exp(-r*t))*K*x)
}
bisection_method <- function(a, b, tol, f = funct_1){
if (f(a)*f(b) > 0){
print("No root found."); return(NULL)
} else
while ((b - a)/2.0 > tol){
midpt= (a + b)/2.0
if (f(midpt) == 0){
return(midpt)
} else if (f(a)*f(midpt) < 0){
b = midpt
} else
a = midpt
}
return(midpt)
}
return(bisection_method(a,b,tol,funct_1))
}
Figured out some parameter combination that makes sense:
IS(1,1,1,4,5,1,.1,9,10^-4)
[1] 2.000023
I was asked to implement function that calculates n-dimensional matrix determinant using Laplace expansion. This involves recursion. I developed this:
minor<-function(A,i,j) {
return(A[c(1:(i-1),(i+1):dim(A)[1]),c(1:(j-1),(j+1):dim(A)[2])])
}
determinantRec<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1) return(X[1][1])
else {
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k][i]*(-1)^(k+i)*determinantRec(minor(X,k,i),k)
}
return(s)
}
}
where k in determinantRec(X,k) function indicates which row I want to use Laplace expansion along of.
My problem is when I run determinantRec(matrix(c(1,2,3,4),nrow = 2,ncol = 2),1) this error appears:
C stack usage 7970628 is too close to the limit
What is wrong with my code?
#julia, there is one simple type in your code. Just remove the '*' at the end of the definition of 's'. And don't indent the recursion.
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)
determinantRek(X[-k,-i],k)
}
return(s)
}
I did this way and works just fine, although it is super slow, compared to the det function in base R
laplace_expansion <- function(mat){
det1 <- function(mat){
mat[1]*mat[4]-mat[2]*mat[3]
}
determinant <- 0
for(j in 1:ncol(mat)){
mat1 <- mat[-1,-j]
if(nrow(mat1) == 2){
determinant <- determinant+mat[1,j]*(-1)^(1+j)*det1(mat1)
}else{
val <- mat[1,j]*(-1)^(1+j)
if(val != 0){
determinant <- determinant+val*laplace_expansion(mat1)
}
}
}
return(determinant)
}
This is my approach, I think it's cleaner.
deter <- function(X) {
stopifnot(is.matrix(X))
stopifnot(identical(ncol(X), nrow(X)))
if (all(dim(X) == c(1, 1))) return(as.numeric(X))
i <- 1:nrow(X)
out <- purrr::map_dbl(i, function(i){
X[i, 1] * (-1)^(i + 1) * deter(X[-i, -1, drop = FALSE])
})
return(sum(out))
}
Thank you #ArtemSokolov and #MrFlick for pointing the problem cause, it was it. I also discovered that this code does not calculate properly the determinant of 2x2 matrix. After all it looks like that:
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)*
determinantRek(X[-k,-i],k)
}
return(s)
}
Debuging with browser() was also helpful :)