Question

我正在尝试在R中编写函数，但一直收到错误。在1次模拟运行中，我从2个间隔生成随机值 - 以生成2个不同的输出值。

se.m，如果输入参数位于[0,1]
se.st如果输入参数是wiothin [1,5]

（浮点数可忽略不计）

然后，这些随机生成的值将用作以下函数的输入：

这是我用过的代码：

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))
}

我没有得到任何结果。我相信错误是在ifelse语句中，但无法找到解决方案。

> fuchs08(5)
     se.m se.st
[1,]    0    NA
[2,]   NA     1
[3,]   NA     1
[4,]   NA    NA
[5,]    0     1

总体思路是将此函数添加到名为funktionen的函数列表中。然后我运行了100次模拟。模拟1从列表funktionen中随机选择一个函数并执行它。（函数为上述间隔创建两个输出：se.m和se.st，它们与模拟2:99的输出结合使用。因此，函数需要采用以下格式：function(n)运行随机函数选择。这是我的部分代码：

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])

有任何建议如何解决这个问题？

Answer 1

使用ifelse()解决您的问题： ifelse()需要三个有意义的参数（条件，是，否）。如果条件的计算结果为NA，则它只适用于条件，因此结果中包含NA，如果条件evalutates为TRUE，则使用两个参数，因此在您的resutls中为1。正如康拉德在评论中所说，使用ifelse似乎是多余的。例如：

> 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

关于你原来的问题，我不确定我是否理解你的问题，但也许这就是你想要的：

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)

编辑：将n替换为x以避免混淆，并在阅读完答案后添加了第二个功能（为了清晰起见，名称很长......）。它不是你答案中的输出，但很容易转化为它。我认为给出一个你想要的输出示例和它应该具有的格式（data.frame，命名为vector？？）

是有帮助的。

Answer 2

我认为ifelse＆amp; if-and-else都很尴尬。你可以尝试类似的东西：

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

这似乎有效。但是，回答不是很优雅。随意给我tipps来改善它，减少重复元素等。

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)

整个代码是：

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")

函数ifelse计算

3 个答案: