函数 ifelse 计算答案

【问题标题】：function ifelse calculation函数 ifelse 计算
【发布时间】：2017-03-20 13:17:44
【问题描述】：

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

se.m 如果输入参数在 [0, 1] 范围内
se.st 如果输入参数位于 [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])

有什么建议可以解决这个问题吗？

【问题讨论】：

我并不感到惊讶——你的x.m 是空的，当然访问它不会产生适当的值。我也不确定你为什么在循环中使用已经矢量化的ifelse。这感觉多余，但我可能只是误解了您的要求。
@Konrad 感谢您的意见。事实上，我不确定我是否已经很好地解释了自己。因此我编辑了这个问题。对于你的问题，为什么我使用了一个看起来很重的循环？我对列表funktionen 中的其他函数（此处未显示）使用了相同的过程。我基本上不知道更好......

标签： r function

【解决方案1】：

用ifelse()回答你的问题： ifelse() 需要三个参数才有意义（条件，是，否）。如果条件评估为 NA，它仅适用于条件，因此结果中的 NA 并且如果条件评估为 TRUE，则使用两个参数，因此结果中的 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，命名向量......？）

【讨论】：

谢谢@yoland，这行得通。但是我运行它并且只获得 se.m 的 NA 值？
如果您删除 NA，它应该与您发布的相同。根据您的问题，我得出结论，如果输入大于 1，则不应定义 se.m，因此不应定义 NA。

【解决方案2】：

我认为 ifelse 和 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)))

【讨论】：

不幸的是，这在我的问题的上下文中不起作用，你不可能知道。此功能是描述相同过程的众多功能之一。从我所有的函数列表中，我随机选择一个并运行它。我这样做x次。我所有的函数都是function(n)的格式，随机选择的命令是：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)))) 。不幸的是，该命令无法在您的函数 function(n,min,max) 上运行

【解决方案3】：

这似乎有效。但是，答案不是很优雅。随时给我提示以改进它，减少重复元素等。

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

【讨论】：