如何根据单元格值计算几何平均值？

Question

有

table 1

和

table 2

，如下面的脚本所示。我有以下任务： (1)

table 2

的第1行应代表

table 1

的第1行和第3行的几何平均值； (2) 第 2 行

table 2

= 第 2 行和第 4 行

table 1

的几何平均值。

如果有人能帮助我，我将不胜感激。

    library(shiny)
    library(shinydashboard)
    library(rhandsontable)
    library(data.table)
    library(dplyr)

    "df1" <- data.table(column1 = as.numeric(c(3,8,3,8)))
    "df2" <- data.table(column2 = as.numeric(c(0,0)))

   ui <- dashboardPage(
    dashboardHeader(title = "Geometric Mean Calculation"),
    dashboardSidebar(
        menuItem("Calculation", tabName = "calculation",
                               menuSubItem("Gmean", tabName = "table1"))),
      dashboardBody(
        tabItems(
          tabItem(
        tabName = "table1",
            column(
              "table 1",
          width=6,
              rHandsontableOutput("Table1")
            ),
            column(
              "table 2",
          width=6,
              rHandsontableOutput("Table2")
            )
          )
        )
      )
    )

   server = function(input, output) {

    data <- reactiveValues()

    observe({input$recalc
            data$`DF1`<- as.data.frame(`df1`)
            data$`DF2`<- as.data.frame(`df2`)
    })
    observe({if(!is.null(input$Table1))
        data$`DF1` <- hot_to_r(input$Table1)
    })
    observe({if(!is.null(input$Table2))
        data$`DF2` <- hot_to_r(input$Table2)
    })

    geometric_mean1<- reactive({with(data$`DF1`, 
                              (column1[1]*column1[3])**(1/2))})
    
    observe({
        if(!is.null(geometric_mean1())){
        data$`DF2`$column2[1] <- geometric_mean1()[[1]]}
    })

    geometric_mean2<- reactive({with(data$`DF1`, 
                               (column1[2]*column1[4])**(1/2))})
    
    observe({
        if(!is.null(geometric_mean2())){
        data$`DF2`$column2[2] <- geometric_mean2()[[1]]}
    })

    output$Table1 <- renderRHandsontable({
        rhandsontable(data$`DF1`)
    })
    output$Table2 <- renderRHandsontable({
        rhandsontable(data$`DF2`)
    })

    }
   
   shinyApp(ui, server)

Answer 1

你问的是“几何均值”，一般函数是

gmean <- function(x, na.rm = FALSE) {
  n <- if (na.rm) sum(!is.na(x)) else length(x)
  prod(x, na.rm = na.rm)^(1/n)
}

我稍微调整了一下光泽。一些提示：

• 不确定为什么你有引号和反引号，没有必要

• as.numeric(c(0,0))

  ->

  c(0,0)

  ，

  0

  已经上课了

  numeric

• as.data.frame(df1)

  ->

  df1

  ，因为已经上课了

  data.frame

• 忽略

  input$recalc

  ，它没有定义，不会/触发任何事情

• if (!is.null(..))

  -->

  req(..)

  ，它可以处理更多您不希望反应性块触发的情况，并且它以可以级联到依赖块的方式执行此操作（

  if (!..)

  不会并且将不必要地级联） )
• 预定义

  DF2

  似乎很奇怪；一旦在

  input$recalc

  中编辑了某些内容（或

  DF1

  ，无论是什么），然后

  DF2

  就会更新

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(dplyr)

gmean <- function(x, na.rm = FALSE) {
  n <- if (na.rm) sum(!is.na(x)) else length(x)
  prod(x, na.rm = na.rm)^(1/n)
}

df1 <- data.table(column1 = c(3,8,3,8))
df2 <- data.table(column2 = c(0,0))

ui <- dashboardPage(
  dashboardHeader(title = "Geometric Mean Calculation"),
  dashboardSidebar(
    menuItem("Calculation", tabName = "calculation",
             menuSubItem("Gmean", tabName = "table1"))),
  dashboardBody(
    actionButton("button", label = "Debug!"),
    tabItems(
      tabItem(
        tabName = "table1",
        column(
          "table 1",
          width=6,
          rHandsontableOutput("Table1")
        ),
        column(
          "table 2",
          width=6,
          rHandsontableOutput("Table2")
        )
      )
    )
  )
)


server = function(input, output) {
  data <- reactiveValues()

  observe({
    req(input$Table1)
    data$DF1 <- hot_to_r(input$Table1)
  })
  observe({
    req(input$Table2)
    data$DF2 <- hot_to_r(input$Table2)
  })

  observe({
    # input$recalc # ??? no idea
    data$DF1 <- df1
    # data$DF2 <- df2
  })

  output$Table1 <- renderRHandsontable({
    req(data$DF1)
    rhandsontable(data$DF1)
  })
  output$Table2 <- renderRHandsontable({
    req(input$Table1, data$DF1)
    data.frame(column2 = c(
      gmean(data$DF1$column1[c(1,3)]),
      gmean(data$DF1$column1[c(2,4)])
    )) |>
      rhandsontable()
  })
  observeEvent(input$button, { browser();1;})

}

shinyApp(ui, server)