【问题标题】:Linking two functions连接两个函数
【发布时间】:2015-08-14 11:25:23
【问题描述】:

我不得不承认我是编码函数的新手,因此我需要你的帮助。

此代码应在 ANOVA 之后提供贝叶斯标准 (pBIC),并自动从 ANOVA 表中读取必要信息。

我有两个功能

## This is function 1

test_pBIC1 <- function(name,c){  ## name is the name of the ANOVA table, e.g. "ANOVA_ALL_wake" and c is the number of conditions
  c = c
  data = get(name)
  i = length(data$ANOVA$Effect)
  result1 = data.frame(name,c,i)
  return(result1)
}
## ----------------------------------------------------
## I now run and save the result of Function 1

result1 <- test_pBIC1("ANOVA_ALL_wake",3) ## for test

## ----------------------------------------------------
## This is function 2

test_pBIC2 <- function(result1){ 
  name1 <- as.character(result1$name)
  data = get(name1)
  count <- as.vector(result1$i)
  for (i in 1:count){
    s = (data$ANOVA$DFd[i]/data$ANOVA$DFn[i])+1
    n = s*(result1[2]-1)
    SSE1 = data$ANOVA$SSd[i]
    SSE0 = data$ANOVA$SSd[i]+data$ANOVA$SSn[i]
    deltaBIC = (n * log(SSE1/SSE0))+(data$ANOVA$DFn[i]*log(n))
    BF01 = exp(deltaBIC/2)
    pH0_D = (BF01/(1+BF01))
    pH1_D = (1-pH0_D)
    result = data.frame(pH0_D, pH1_D)
    colnames(result) <- c("pH0_D", "pH1_D")
    rownames(result) <- c(data$ANOVA$Effect[i]) 
    if (i == 1){
      result_all <- result
    } else {
      result_all <- rbind (result_all, result)
    }
  }
  return(result_all)
}
## ------------------------------------------------------
Now I run function 2 and receive the result

test_pBIC2(result1)

现在虽然这样做了,但我想链接这两个函数,所以我只需要给出名称和参数 c 并且最后仍然会得到 result_all,即不必一个接一个地运行这两个函数。

我试图想出这个解决方案:

test_pBIC <- function(name,c){   ## pass arguments as: test_pBIC(name = "ANOVA_all_wake", c = 3)
  c = c
  name = name
  result1 = data.frame(name,c)
  # return(result1)

  test_pBIC1 <- function(result1){
    c = as.vector(result1$c)
    name1 <- as.character(result1$name)
    data = get(name)
    i = length(data$ANOVA$Effect)
    result2 = data.frame(name,c,i)
  # return(result2)

    test_pBIC2 <- function(result2){ 
      name1 <- as.character(result2$name)
      data = get(name1)
      count <- as.numeric(integer$i)

      for (i in 1:count){
        s = (data$ANOVA$DFd[i]/data$ANOVA$DFn[i])+1
        n = s*(result1[2]-1)
        SSE1 = data$ANOVA$SSd[i]
        SSE0 = data$ANOVA$SSd[i]+data$ANOVA$SSn[i]
        deltaBIC = (n * log(SSE1/SSE0))+(data$ANOVA$DFn[i]*log(n))
        BF01 = exp(deltaBIC/2)
        pH0_D = (BF01/(1+BF01))
        pH1_D = (1-pH0_D)
        result = data.frame(pH0_D, pH1_D)
        colnames(result) <- c("pH0_D", "pH1_D")
        rownames(result) <- c(data$ANOVA$Effect[i]) 
        if (i == 1){
          result_all <- result
        } else {
          result_all <- rbind (result_all, result)
        }
      }
      return(result_all)
    }
  }
}


test_pBIC("ANOVA_all_wake", 3)

但是,我什么都没有……而且我找不到错误:(。

谢谢!!

【问题讨论】:

  • 您是否通过示例输入逐步完成了更大的流程并查看了失败的地方?

标签: r function user-defined-functions


【解决方案1】:

不完全确定问题出在哪里,一个可重现的例子会有很大帮助。如果您只想将其组合成一个功能,您可以这样做...

test_overall <- function(name,c) {
  c = c
  data = get(name)
  i = length(data$ANOVA$Effect)
  result1 = data.frame(name,c,i)
  name1 <- as.character(result1$name)
  data = get(name1)
  count <- as.vector(result1$i)
  for (i in 1:count){
    s = (data$ANOVA$DFd[i]/data$ANOVA$DFn[i])+1
    n = s*(result1[2]-1)
    SSE1 = data$ANOVA$SSd[i]
    SSE0 = data$ANOVA$SSd[i]+data$ANOVA$SSn[i]
    deltaBIC = (n * log(SSE1/SSE0))+(data$ANOVA$DFn[i]*log(n))
    BF01 = exp(deltaBIC/2)
    pH0_D = (BF01/(1+BF01))
    pH1_D = (1-pH0_D)
    result = data.frame(pH0_D, pH1_D)
    colnames(result) <- c("pH0_D", "pH1_D")
    rownames(result) <- c(data$ANOVA$Effect[i]) 
    if (i == 1){
      result_all <- result
    } else {
      result_all <- rbind (result_all, result)
    }
  }
  return(result_all)
}

【讨论】:

    【解决方案2】:

    在您的第一个代码示例中,您创建了函数test_pBIC1test_pBIC2。如果你想创建一个调用两者的函数test_pBIC,你可以定义一个调用两者的函数:

    test_pBIC <- function(name, c) test_pBIC2(test_pBIC1(name, c))
    

    【讨论】:

      猜你喜欢
      • 2015-04-06
      • 2022-11-02
      • 1970-01-01
      • 1970-01-01
      • 2023-03-07
      • 2012-12-15
      • 2018-10-17
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多