如何在Shiny

时间:2017-05-15 14:49:47

标签: css r shiny textinput shinydashboard

Hello Stack Overflow,

在我最近的问题中,我已经解决了一些与动态呈现的UI元素相关的主要问题,并为那些在这里有一些了不起的人帮助的人动态创建了观察者。看到这里: Dynamically rendered UI: how to delete old reactive variables on second run

现在我正构建一部分动态渲染textInput字段。渲染和监视应该不是问题,因为我可以应用与我们已经制作的动作按钮相同的编码方式,但这些元素的样式证明是一个问题。

据我所知,有两种方式来设计元素: 添加tags$style(.....)就像, 1:

tags$style(type="text/css", "#BatchName { width: 520px; position: relative;left: 7%}") 
UI中的

或2:

actionButton(inputId= "Submit", label = icon("upload"),
                           style="color: blue; color: white; 
                           text-align:center; indent: -2px;
                           border-radius: 6px; width: 2px"),

第二个选项也适用于动态呈现,如上面的链接所示,如果我在下面的工作示例中的lapply循环中创建actionButtons而不是textInput,则也可以在下面的示例中使用。但是,textInput()中的style =“......”元素不起作用。

有没有人有解决方案还可以动态地为textinput添加样式?

解决方案我尝试但失败了:
动态制作标签$ head元素,但它不是可以用renderUI()制作的ui元素我认为

以某种方式使textinput接受style = " ")参数。

最后我看了一下textInput的功能代码,想知道计划A或B是否不起作用,是否可以更自由地将现有的textInput代码修改为我自己的函数? textinput在包中编码如下:

function (inputId, label, value = "", width = NULL, placeholder = NULL) 
{
  value <- restoreInput(id = inputId, default = value)
  div(class = "form-group shiny-input-container", style = if (!is.null(width)) 
    paste0("width: ", validateCssUnit(width), ";"), label %AND% 
    tags$label(label, `for` = inputId), tags$input(id = inputId, 
    type = "text", class = "form-control", value = value, 
    placeholder = placeholder))
}

工作示例:

   library(shiny)
library(shinydashboard)
library(shinyBS)


ui <- dashboardPage(
  dashboardHeader(title = "My Test App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs", menuItem("testpage", tabName = "testpage", icon = icon("book"))
    )
  ),

  dashboardBody(
    tags$head(tags$style(HTML('.skin-blue .content-wrapper, .right-side {background-color: #ffffff; }, '))),


    tabItems(

      ### test page ###_________
      tabItem(tabName = "testpage",  

              h5("Enter desired nr of elements here"),
              textInput(inputId ="NrOfClusters", label = NULL , placeholder = "NULL"),


              uiOutput("NameFields")
      ))))




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

  ################# start functionality HOME TAB #############################  

  ### create 2 reactive environment lists
  values <- reactiveValues(clickcount=0)
  DNL <- reactiveValues(el=NULL)

  ### set initial state of two buttons 
  values$HL_multi_switch_sf1 <- FALSE
  values$HL_all_switch_sf1 <- FALSE 

  ### if the user types in a value, then convert it to a reactive value of this nr
  observeEvent (input$NrOfClusters, {
    values$nrofelements <- input$NrOfClusters
    namelist <- as.character(unlist(DNL$el), use.names = FALSE)
  })

  AddNameField <- function(idx){
    sprintf("highlight_button_sf1-%s-%d",values$nrofelements,idx)
  }




  #### RENDER DYNAMIC UI and DYNAMIC OBSERVERS
  observeEvent(values$nrofelements, {
    req(input$NrOfClusters)
    nel <- values$nrofelements
    DNL$el <- rep(0,nel) 
    names(DNL$el) <- sapply(1:nel,AddNameField)

    output$NameFields <- renderUI({
         lapply(1:values$nrofelements, function(ab) {
          div(br(), textInput(inputId = AddNameField(ab), label = NULL))
      })
    })

    lapply(1:values$nrofelements,  function(ob) {
      textfieldname <- AddNameField(ob)
      print(textfieldname)
      observeEvent(input[[textfieldname]], {

        DNL$el[[ob]] <- input[[textfieldname]]
        namelist <- as.character(unlist(DNL$el), use.names = FALSE)
        print(namelist)
        })

    })
  })
  }
options(shiny.reactlog = TRUE)
shinyApp(ui,shinyServer)

0 个答案:

没有答案