関数ifelse計算

Question

私はこの関数をRで書こうとしていますが、エラーは継続しています。 1回のシミュレーション実行で、2つの異なる出力値を生成するために、2つのintevalsからランダムな値を生成します。

• se.m入力パラメータが範囲内にある場合は[0、1]
• se.st入力パラメータは[1,5]

（neglegibleにおける浮動小数点）wiothinにある場合

：その後、これらのランダムに生成された値は、次の関数に入力として使用される

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から関数をランダムに選択して実行します。 （ファンクションは前述のintevalsの2つの出力を作成します：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()には3つの引数が必要です（条件、はい、いいえ）。条件がNAであると評価された場合は条件のみで処理され、結果にNAがあり、条件がTRUEに評価された場合は2つの引数で処理されます。コナートがコメントで述べたように、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) 

編集：混乱を避けるためにxでnを置き換えあなたの答えを読んだ後に2番目の機能を追加しました（名前は分かりやすくするために長いです...）。それはあなたの答えの出力ではありませんが、簡単にそれに変換することができます。私はそれがあなたが望む出力の例を与えるのに役立つだろうと思います（データフレーム、名前付きベクトル...？）

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

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