在 RShiny 服务器调用中调用函数并将结果呈现为打印输出

Invoke function within RShiny server call and render result as print output

我编写了一个脚本,该脚本使用 2 个函数来计算 运行 测试所需的持续时间,例如功率分析。

输入和代码如下;

## RUN POWER CALCULATION
average_daily_traffic <-  3515/30
control <- 0.47
uplift <- 0.02
num_vars <- 2 

sample_size_calculator <- function(control, uplift){
  variant <- (uplift + 1) * control
  baseline <- ES.h(control, variant)
  sample_size_output <- pwr.p.test(h = baseline,
                                   n = ,
                                   sig.level = 0.05,
                                   power = 0.8)
  if(variant >= 0)
  {return(sample_size_output)}
  else
  {paste("N/A")}
}


## RUN DAYS CALCULATOR FUNCTION 
days_calculator <- function(sample_size_output, average_daily_traffic){
  days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
  if(days_required >= 0)
  {paste0("It will take ", round(days_required, digits = 0)*num_vars, " days for this test to reach significance, with a daily average of " , round(average_daily_traffic, digits = 0), " visitors to this page over a 30 day period.")}
  else
  {paste("N/A")}
}


## RUN FUNCTIONS AND OUTPUT ANSWER
sample_size_calculator <- sample_size_calculator(control, uplift)
sample_size_output <-   sample_size_calculator$n

answer <- days_calculator(sample_size_output, average_daily_traffic)
answer

此代码性能良好,适合我在独立 R 脚本中的目的。

但是,我需要在 Shiny 应用程序中使这些功能可执行。我的尝试如下;

library(shiny)

ui <- fluidPage(

  actionButton("exe", "Run", 
               style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),



  mainPanel(

    textOutput("answer")

  ))


server <- function(input, output, session) {

  sample_size_calculator <- eventReactive(input$exe,{

    average_daily_traffic <-  3515/30
    control <- 0.47
    uplift <- 0.02
    num_vars <- 2 

    variant <- (uplift + 1) * control
    baseline <- ES.h(control, variant)
    sample_size_output <- pwr.p.test(h = baseline,
                                     n = ,
                                     sig.level = 0.05,
                                     power = 0.8)
    if(variant >= 0)
    {return(sample_size_output)}
    else
    {paste("N/A")}

  })

  days_calculator <- eventReactive  (input$exe,{
    days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
    if(days_required >= 0)
    {paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
    else
    {paste("N/A")}
  })

  outputs_ <- eventReactive( input$exe, {
    req(sample_size_calculator())
    req(days_calculator())
  sample_size_calculator <- sample_size_calculator(control, uplift)
  sample_size_output <-   sample_size_calculator$n


  answer <- days_calculator(sample_size_output, average_daily_traffic)

  output$answer <- renderText(outputs_$answer) 

})

}


shinyApp(ui = ui, server = server)

当我 运行 这段代码时,我看到了执行按钮,但没有显示任何输出。 这很可能是由于我对 Shiny 调用函数的理解有限,所以如果有更好的方法,我将不胜感激。

提前致谢。

* 编辑以包含完整功能代码 *

代码的 objective 是使用 Mark Edmonson 的 googleAnalyticsR 和 googleAuthR 来启用从 Google Analytics 帐户检索特定 URL/page 最近 30 天的网络访问数据和显示此数据的趋势。这工作正常,一旦用户输入 URL 并点击 'Run'。

还有一个额外的 GA 调用可以检索特定转化操作的额外数据(请参阅 other_data)。这是为了推导稍后在功率计算中使用的转换率所必需的。

计算是cvr <- aeng$users/totalusers

#options(shiny.port = 1221)


## REQUIRED LIBS 
library(shiny)
library(googleAnalyticsR)
library(plotly)
library(googleAuthR)
library(markdown)
library(pwr)

gar_set_client(scopes = c("https://www.googleapis.com/auth/analytics.readonly"))

daterange <- function(x) {
  as.Date(format(x, "%Y-%m-01"))
}

## DATE PARAMETERS 
date_start <- as.Date(Sys.Date(),format='%d-%B-%Y')-31
date_end <- as.Date(Sys.Date(),format='%d-%B-%Y')-1
date_range <- c(date_start, date_end) 



## UI SECTION
ui <- fluidPage(
  googleAuth_jsUI("auth"),

  tags$head(
    tags$link(rel = "stylesheet", type = "text/css", href = "dur_calc.css")
  ),




  tags$br(),
  sidebarLayout(
    sidebarPanel(
      code("To begin, select from 'Accounts' and enter URL of page to be tested:"),
      tags$p(),

      column(width = 12, authDropdownUI("auth_dropdown", 
                                        inColumns = FALSE)),



            textInput("url", label = h5(strong("Page to be tested")), value = "Enter full page URL..."),

      hr(),
      fluidRow(column(3, verbatimTextOutput("value")
      )


      ),


      actionButton("exe", "Run Calculator", 
                   style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),


    ),



    mainPanel(
      plotlyOutput("trend_plot"),

      textOutput("page"),

      textOutput("answer")

    )


  )
)




## SERVER SECTION

server <- function(input, output, session) {

  auth <- callModule(googleAuth_js, "auth")



  ## GET GA ACCOUNTS 
  ga_accounts <- reactive({
    req(auth()
    )

    with_shiny(
      ga_account_list,
      shiny_access_token = auth()
    )

  })



  view_id <- callModule(authDropdown, "auth_dropdown", 
                        ga.table = ga_accounts)



  ga_data <- eventReactive( input$exe, {
    x <- input$url

    #reactive expression

    output$page <- renderText({ 
      paste("You have selected the page:", input$url) })



    filterPageurl <- dim_filter("dimension97" , "REGEX", x ,not = FALSE)
    filts <- filter_clause_ga4(list( filterPageurl))

    req(view_id())
    req(date_range)

    with_shiny(
      google_analytics,
      view_id(),
      date_range = date_range, 
      dimensions = "date",
      metrics = "users",
      dim_filters = filts,
      max = -1,
      shiny_access_token = auth()
    )



  })

  other_data <- eventReactive( input$exe, {
    x <- input$url


    filterPageurl <- dim_filter("dimension97" , "REGEX", x ,not = FALSE)
    filts <- filter_clause_ga4(list( filterPageurl))

    seg_id <- "gaid::uzKGvjpFS_Oa2IRh6m3ACg" #AEUs
    seg_obj <- segment_ga4("AEUs", segment_id = seg_id)

    req(view_id())
    req(date_range)
    #req(filts)

    with_shiny(
      google_analytics,
      view_id(),
      date_range = date_range, 
      dimensions = "date",
      metrics = "users",
      dim_filters = filts,
      segments = seg_obj, 
      max = -1,
      shiny_access_token = auth()
    )



})


  outputly <- eventReactive( input$exe, {

  req(other_data())
  req(ga_data())

  aeng <- other_data()
  ga_data <- ga_data()


  totalusers <<- sum(ga_data$users)
  cvr <- aeng$users/totalusers


  average_daily_traffic <-  totalusers/30
  control <- cvr
  uplift <- 0.02
  num_vars <- 2 
  })


  sample_size_calculator <- eventReactive(input$exe,{
    variant <- (uplift + 1) * control
    baseline <- ES.h(control, variant)
    sample_size_output <- pwr.p.test(h = baseline,
                                     n = ,
                                     sig.level = 0.05,
                                     power = 0.8)
    if(variant >= 0)
    {return(sample_size_output)}
    else
    {paste("N/A")}

  })


  days_calculator <- eventReactive  (input$exe,{
    days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
    if(days_required >= 0)
    {paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
    else
    {paste("N/A")}
  })


  output$trend_plot <- renderPlotly({
    req(ga_data())
    ga_data <- ga_data()

    plot_ly(
      x = ga_data$date,
      y = ga_data$users, 
      type = 'scatter',
      mode = 'lines') %>%

      layout(title = "Page Visitors by Day (last 30 days)",
             xaxis=list(title="Date", tickformat='%Y-%m-%d', showgrid=FALSE, showline=TRUE),
             yaxis=list(title = "Users", showgrid=FALSE, showline=TRUE)

      )


  })



  calc_answer <- eventReactive(input$exe, {

    req(outputly)
    outputly <- outputly()

    sample_size_calculator <- sample_size_calculator()
    sample_size_output <- sample_size_calculator$n
    days_calculator(sample_size_output, average_daily_traffic)
  })

  output$answer <- renderText(calc_answer()) 




}

shinyApp(ui = ui, server = server)

一些可能有用的建议。

  • 在添加所有计算之前会从一个简化的 shiny 应用程序开始,现在可能更容易使用
  • 会避免将 output 语句放在 eventReactive 中。例如,请参见下文。
  • 考虑只有一个 observeEventeventReactive 按钮按下而不是多个,特别是因为某些功能结果取决于其他功能。
  • 目前没有输入,因此不需要额外的 reactive 表达式。但是,当您添加输入时,您可能会。

如果您还没有,请查看 Action Buttons and Reactivity 上的 R Studio Shiny 教程。

希望这对前进有所帮助。

library(shiny)
library(pwr)

ui <- fluidPage(
  actionButton("exe", "Run", style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
  mainPanel(
    textOutput("answer")
  )
)

server <- function(input, output, session) {

  average_daily_traffic <-  3515/30
  control <- 0.47
  uplift <- 0.02
  num_vars <- 2 

  sample_size_calculator <- function() {
    variant <- (uplift + 1) * control
    baseline <- ES.h(control, variant)
    sample_size_output <- pwr.p.test(h = baseline,
                                     n = ,
                                     sig.level = 0.05,
                                     power = 0.8)
    if(variant >= 0)
      {return(sample_size_output)}
    else
      {return(NA)}
  }

  days_calculator <- function (sample_size_output, average_daily_traffic) {
    days_required <- c((sample_size_output)*num_vars)/(average_daily_traffic)
    if(days_required >= 0)
      {paste0("It will take approximately ", round(days_required, digits = 0)*num_vars, " days or ", round((round(days_required, digits = 0)*num_vars)/365, digits = 1) ," years for this test to reach significance, based on a daily average of " , round(average_daily_traffic, digits = 0), " users to this page in the last 30 days.")}
    else
      {paste("N/A")}
  }

  calc_answer <- eventReactive(input$exe, {
    sample_size_calculator <- sample_size_calculator()
    sample_size_output <- sample_size_calculator$n
    days_calculator(sample_size_output, average_daily_traffic)
  })

  output$answer <- renderText(calc_answer()) 

}

shinyApp(ui = ui, server = server)