时间戳

首页 > 解决方案 > 闪亮的自定义按钮

r - 闪亮的自定义按钮

问题描述

我想构建一个按钮，每次点击都会改变其属性。具体来说，我想要一个以数学符号“>”开头的按钮，然后在您点击后它会变为“<”，如果再次点击它会变为“=”。是否可以在 Shiny 中构建它？

我已经建立了这样的界面：

library(shiny)
library(ggplot2)
library(plotly)
library(DT)
library(shinyWidgets)
library(semantic.dashboard)

ui <- dashboardPage(
  dashboardHeader(color = "blue",title = "Dashboard Demo", inverted = TRUE),
  dashboardSidebar(visible= FALSE,
                   size = 'very thin', color = "teal",
                   sidebarMenu(
                     menuItem(tabName = "main", "Main", icon = icon("car"))    )
  ),
  dashboardBody(
    tabItems(
      selected = 1,
      tabItem(
        tabName = "main",
        fluidRow(
          box(width = 7,
              title = "Produto A",
              color = "green", ribbon = TRUE, title_side = "top right",
              column(width = 7,
                     plotOutput("boxplot1")
              )
          ),
          box(width = 7,
              title = "Produto B",
              color = "red", ribbon = TRUE, title_side = "top right",
              column(width = 7,
                     plotOutput("dotplot1")
              )
          )

      )) 


  ), theme = "cerulean"

))

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

  colscale <- c(semantic_palette[["red"]], semantic_palette[["green"]], semantic_palette[["blue"]])

  number <- reactiveVal(1)



  output$boxplot1 <- renderPlot({
    plot(eval(parse(text=as.character(random[number(),1]))), axes = FALSE)
  })

  output$dotplot1 <- renderPlot({
    plot(eval(parse(text=as.character(random[number(),2]))), axes = FALSE)

  })

})

shinyApp(ui, server)

我想把这个按钮放在这两个框之间，这样用户就可以在照片之间进行比较。

标签： rbuttonshiny

解决方案

我没有深入阅读您的代码，但试图从您的问题中理解

我想要一个以数学符号“>”开头的按钮，然后在您点击后它会变为“<”，如果再次点击它会变为“=”。是否可以在 Shiny 中构建它？

以下代码可以做到这一点..

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Dashboard Demo"),
  dashboardSidebar(
        sidebarMenu(
                     menuItem(tabName = "main", "Main", icon = icon("car"))
                     )
  ),
  dashboardBody(
    tabItems(
      tabItem(
        tabName = "main",
        fluidRow(
          box(width = 7,
              title = "Produto A",
              color = "green", ribbon = TRUE, title_side = "top right",
              uiOutput("action_button")
          )
        )) 
    )
  ))

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

  output$action_button<-renderUI({
    actionButton("button",">")
  })

  observeEvent(input$button,{
   if(input$button==1)
   {
     updateActionButton(session,"button","<")
   }
    else if(input$button>1)
    {
      updateActionButton(session,"button","=")
    }
  })
})

shinyApp(ui, server)

请告诉我...

推荐阅读