function ifelse calculation - r

Question

I am trying to write the function in R, but keep getting an error. Within 1 simulation run I generate random values from 2 intevals - in order to generate 2 different output values.
se.m if the input parameter lies within [0, 1]
se.st if the input parameter lies wiothin [1, 5]
(floating point in neglegible)
Then, these randomly generated values are used as input in the following function:
This is the code I have used:
fuchs08 <- function(n){
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 0.33, 0, 0.12 * (x.m[i]^2) - 0.04 * x.m[i])
se.st[i] <- ifelse (runif(n = 1, min = 1, max = 5) < 3.06, 0.12 * (x.m[i]^2) - 0.04 * x.m[i], 1)
}
return(cbind(se.m, se.st))
}
I dont get any results. I believe the error is in the ifelse statement, but cannot find a solution to it.
> fuchs08(5)
se.m se.st
[1,] 0 NA
[2,] NA 1
[3,] NA 1
[4,] NA NA
[5,] 0 1
The overall idea is add this function to a list of functions called funktionen. Then I run a simulation 100 times. Simulation 1 randomly chooses a function from the list funktionen and executes it. (Function creates two outputs for the aforementioned intevals: se.m and se.st which are combined with the outputs from simulation 2:99) Therefore the function needs to be in the format: function(n) in order to run the random function selection. Here is my code for that part:
funktionen <- list(akbas, bell.glade, borter, fell.hartford, fuchs07, fuchs08)
fxn_list_sample <- sample(1:5, 100, replace=T)
fxn_list_result <- unlist(sapply(fxn_list_sample, function(x) do.call(funktionen[[x]], args=list(n=1))))
results <- as.data.frame(t(fxn_list_result))
colnames(results) <- c("se.m", "se.st")
results <- melt(results)
results$value <-round(results$value, 4)
separate(results, variable, into = c("Parameter", "Intensitaet")) %>%
mutate(Intensitaet = c(3, 2) [(Intensitaet == "m")+1])
Any suggestions how to fix this?

Answer 1

To answer your trouble with ifelse():
ifelse() needs three arguments to make sense (condition, yes, no). it works with only the condition if the condition evaluates to NA, hence the NA's in your results and works with two arguments if the condition evalutates to TRUE, hence the 1 in your resutls. As Konrad says in the comment, the use of ifelse seems redundant. For illustration:
> ifelse(1==1)
Error in ifelse(1 == 1) : argument "yes" is missing, with no default
> ifelse(NA)
[1] NA
> ifelse(1==1, 4)
[1] 4
> ifelse(1!=1, 4)
Error in ifelse(1 != 1, 4) : argument "no" is missing, with no default
> ifelse(1!=1, 4, 10)
[1] 10
Regarding your original problem, I am not sure if I understand you question correctly, but maybe this does what you want:
fuchs08 <- function(x){
ifelse(x<1/3, 0,
ifelse(x<=3.06, 0.12*x^2-0.04*x, 1))
}
fuchs08_with_n_inputs_two_outputcols <- function(n) {
df <- data.frame(input=runif(n, 0, 5))
df$se.m <- ifelse(df$input<1, fuchs08(df$input), NA)
df$se.st <- ifelse(df$input>1 & df$input<5, fuchs08(df$input), NA)
return(df)
}
fuchs08_with_n_inputs_two_outputcols(10)
Edit: replaced n by x to avoid confusion and added a second function after having read your answer (the name is long for the sake of clarity...). It is not the output in your answer but may easily be transformed to that. I think it would be helpfull to give an example of the output you want and which format it should have (data.frame, named vector...?)

Answer 2

I think ifelse & if-and-else are both awkward. You could try something like:
fuchs08<-function(n,min,max) {
x<-runif(n,min,max)
y<-x
y[x<1/3]<-0
y[x>=1/3 & x<=3.06]<-0.12*y[x>=1/3 & x<=3.06]^2-0.04*y[x>=1/3 & x<=3.06]
y[x>3.06]<-1
return(y)
}
(want<-cbind(fuchs08(100,0,1),fuchs08(100,1,5)))

Answer 3

This seems to work. However, not very elegant answer. Feel free to give me tipps to improve it, reduce rebundant elements, etc.
fuchs08 <- function(n) {
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
print(x.m[i] <- runif(n = 1, min = 0, max = 1))
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 0.33, 0, 0.12 * x.m[i]^2 - 0.04* x.m[i])
print(x.st[i] <- runif(n = 1, min = 1, max = 5))
se.st[i] <- ifelse (runif(n = 1, min = 1, max = 5) < 3.06, 0.12 * x.st[i]^2 - 0.04* x.st[i], 1)
}
return(cbind(se.m, se.st))
}
fuchs08(10)
The whole code is:
library(reshape2)
library(stringr)
install.packages("dplyr")
install.packages("tidyr")
library(dplyr)
library(tidyr)
install.packages("data.table")
library(data.table)
# AKBAS u.a. (2009)
akbas <- function(n){
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
print(x.m[i] <- runif(n = 1, min = 0, max = 1))
se.m[i] <- 0.17 * (x.m[i]^2) - 0.03 * x.m[i]
print(x.st[i] <- runif(n = 1, min = 1, max = 5))
se.st[i] <- 0.17 * (x.st[i]^2) - 0.03 * x.st[i]
}
akbasr<-return(cbind(se.m, se.st))
}
# FUCHS u.a.(2007)
fuchs07 <- function(n){
x.m=se.m=x.st=se.st=NULL #solves indexing problem
for(i in 1:n){
print(x.m[i] <- runif(n = 1, min = 0, max = 1))
se.m[i] <- 0.11 * (x.m[i]^2) - 0.02 * x.m[i]
print(x.st[i] <- runif(n = 1, min = 1, max = 5))
se.st[i] <- 0.11 * (x.st[i]^2) - 0.02 * x.st[i]
}
return(cbind(se.m, se.st))
}
# BELL AND GLADE (2004)
bell.glade <- function(n){
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 1, 0.2, 0.2)
se.st[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 1, 0.5, 0.5)
}
return(cbind(se.m, se.st))
}
# BORTER (1999b,a)
borter <- function(n){
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 1, 0.1, 0.1)
se.st[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 1, 0.5, 0.5)
}
return(cbind(se.m, se.st))
}
# FELL UND HARTFORD (1997)
fell.hartford <- function(n){
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 0.25, 0.1, 0.4)
se.st[i] <- ifelse (runif(n = 1, min = 1, max = 5) < 1.5, 0.4, 0.7)
}
return(cbind(se.m, se.st))
}
# FUCH (2008, 2009)
fuchs08 <- function(n) {
x.m=se.m=x.st=se.st=NULL
for(i in 1:n){
print(x.m[i] <- runif(n = 1, min = 0, max = 1))
se.m[i] <- ifelse (runif(n = 1, min = 0, max = 1) < 0.33, 0, 0.12 * x.m[i]^2 - 0.04* x.m[i])
print(x.st[i] <- runif(n = 1, min = 1, max = 5))
se.st[i] <- ifelse (runif(n = 1, min = 1, max = 5) < 3.06, 0.12 * x.st[i]^2 - 0.04* x.st[i], 1)
}
return(cbind(se.m, se.st))
}
funktionen <- list(akbas, bell.glade, borter, fell.hartford, fuchs07, fuchs08)
fxn_list_sample <- sample(1:5, 100, replace=T)
fxn_list_result <- unlist(sapply(fxn_list_sample, function(x) do.call(funktionen[[x]], args=list(n=1))))
results <- as.data.frame(t(fxn_list_result))
colnames(results) <- c("se.m", "se.st")
results <- melt(results)
results$value <-round(results$value, 4)
separate(results, variable, into = c("Parameter", "Intensitaet")) %>%
mutate(Intensitaet = c(3, 2) [(Intensitaet == "m")+1])
write.csv(results, "murgang-test.csv")