Question

我想根据输入来设置表达式的格式。例如。当它为负值时，我希望它为红色。可能有多种方法可以实现这一目标。我试图在UI部分中创建ifelse语句，然后根据条件将显示具有所需样式的值。但是，if条件不起作用，因为我似乎无法访问实际值（请参阅substr（kpiModuleUI_Test（“ knownedName”）[2]，1,25），这是我想查看内部的内容表达）。

如何在UI中访问反应值？您是否知道一种比在UI中进行逻辑操作更好的方法，以便对反应表达式进行条件格式化？

可复制的示例主文件：

packages <- c( "data.table","ggthemes","ggExtra","grid","gridExtra","extrafont","stringi","plyr","dplyr","reshape2","shiny","shinydashboard","shinythemes","shinyjs","stats","plotly","ggplot2","lattice","cowplot","lubridate","rstudioapi","zoo")
for (i in packages){
  if (!is.element(i,installed.packages()[,1])) {
    install.packages(i,dependencies = TRUE)
  }
}
lapply(packages, require, character.only = TRUE)

# Set directory to file location
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
getwd()

source("Modules_Test_1.R")

server <- function(input,output,session) {
  val1<-reactive({input$testinput})
  callModule(kpiModule_Test,"calledName",val1)
}



header<-dashboardHeader(title = "Module Test",titleWidth = 280)

sidebar<-dashboardSidebar(width = 280,sidebarMenu(id="sidebar_tabs",
                                                  menuItem("AAA", tabName = "AAA"),
                                                  menuItem("BBB", tabName = "BBB")))


body<-dashboardBody(title="Main",
                    tabItem(tabName = "Overview",h1("Overview"),
                      fluidPage(
                      box(sliderInput(inputId = "testinput",label="testinput",min=1,max=20,value=5)),
                      box(title="KPIs",tags$p(kpiModuleUI_Test("calledName")[2],style="color:#ff5733"),br(),
                          class(kpiModuleUI_Test("calledName")[2]),br(),
                          substr(kpiModuleUI_Test("calledName")[2],1,25))
                      # ,
                      # box(title="KPIs",if(kpiModuleUI_Test("calledName")[2]>20){tags$p(kpiModuleUI_Test("calledName")[2],style="color:#ff5733")}
                      # else{tags$p(kpiModuleUI_Test("calledName")[2],style="color:#1E90FF")})
                    )                  
                    )
                    )

sdb_ui <- dashboardPage(skin = "black",
                        header,
                        sidebar,
                        body
)

shinyApp(ui = sdb_ui, server = server)

带有模块（）的文件：

kpiModule_Test <- function(input, output, session,show1) {
  output$kpi1a <- renderText({show1()})
  output$kpi1b <- renderText({(show1()+20)})
}

kpiModuleUI_Test <- function(id) {
  # Create a namespace function using the provided id
  ns <- NS(id)

  tagList(
    textOutput(ns("kpi1a"),inline=TRUE),
    textOutput(ns("kpi1b"),inline=TRUE)
  )      
}

到目前为止，我在Stackoverflow上找不到此问题。最接近的线程涵盖表中的格式。在我真正的问题中，反应价值不再是简单的价值（-5 $）。这就是为什么我尝试使用substr（）提取第一个字符以创建条件的原因。

非常感谢您的帮助！

Answer 1

我想分享两种解决问题的方法。一个来自this thread，另一个来自rstudio社区：

在示例代码中，两种解决方案都起作用-一次用于testinput 1，一次用于testinput 2：

coloring <- function(x) {
  testinput <- x
  if(is.numeric(as.numeric(testinput)) & !is.na(as.numeric(testinput))) {
    ## Clean up any previously added color classes
    removeClass("elementcolor", "blue")
    removeClass("elementcolor", "red")
    ## Add the appropriate class
    cols <- c("red", "blue") # Order of colors according to intervals
    col <- cols[cut(testinput, breaks=c(-Inf, -0.00001, Inf))]
    addClass("elementcolor", col)
  } else  {}
  }

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

  output$testinput1<-renderText({input$testinput1})

  # observeEvent(input$testinput, setColor(id = "testinput", val = input$testinput))

  observeEvent(input$testinput1, {

    coloring(input$testinput1)

    output$testinput2<-renderUI({
      if(input$testinput2 >=0 ) { 
        a <- paste("<span style=color:#1E90FF>", input$testinput2, "-  my number is blue", "</span>")
      } else{
        a <- paste0("<span style=color:#ff5733>", input$testinput2, "-  my number is red", "</span>")
      }
      HTML(a)
    })


  })

}



header<-dashboardHeader(title = "Coloring_Test",titleWidth = 280)

sidebar<-dashboardSidebar(width = 280,sidebarMenu(id="sidebar_tabs",
                                                  menuItem("AAA", tabName = "AAA")
                                                  ))


body<-dashboardBody(title="Main",useShinyjs(),  ## Set up shinyjs
                    # extendShinyjs(text = jsCode),
                    ## Add CSS instructions for three color classes
                    inlineCSS(list(.blue   = "color: blue",
                                   .red  = "color: red")),
                      tabItem(tabName = "Overview",h1("Overview"),
                      fluidPage(
                      box(sliderInput(inputId = "testinput1",label="testinput1",min=-30,max=20,value=5)),
                      box(sliderInput(inputId = "testinput2",label="testinput2",min=-30,max=20,value=5)),
                      box(title="Output1",span(id="elementcolor",textOutput(outputId="testinput1", inline=TRUE))),
                      box(title="Output2",uiOutput("testinput2"))
{tags$p("IF",style="color:#1E90FF")}else{tags$p("ELSE",style="color:#ff5733")})  # does not work :
                    )                  
                    )
                    )

ui <- dashboardPage(skin = "black",
                        header,
                        sidebar,
                        body
)

shinyApp(ui = ui, server = server)

感谢所有尝试解决此问题的人。

闪亮：反应式表达式的条件格式（涉及模块）

1 个答案: