How to calculate a geometric mean based on cell values?

Question

There are the table 1 and table 2 as shown in the script below. I have the following task: (1) The 1st row of the table 2 should represent a geometric mean of the 1st and 3rd rows of the table 1; (2) The 2nd row of the table 2 = a geometric mean of the 2nd and 4th rows of the table 1.

I would be grateful if someone can help me.

    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

You asked about "geometry mean", the general function is

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

I tweaked the shiny a bit. Some pointers:

• not sure why you had quotes and backticks, not necessary
• as.numeric(c(0,0)) -> c(0,0), the 0 is already class numeric
• as.data.frame(df1) -> df1, since it's already class data.frame
• ignoring input$recalc, it's not defined, does/triggers nothing
• if (!is.null(..)) --> req(..), it handles more situations where you don't want the reactive block to fire, and it does it in a way that can cascade to dependent blocks (if (!..) does not and will needlessly cascade)
• it seems odd to predefine DF2; as soon as something is edited (or input$recalc, whatever that is) in DF1, then DF2 updates

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)