0

我正在尝试使用 UI 函数中的 uiOutput 在 RShiny 仪表板中创建用户框(包:ShinyDashboardPlus)。我的主要问题是我希望用户框根据在 selectInput 中选择的运动员进行更新。因此,我也希望他们的照片能够更新。

这是我的数据框的简要示例:

'''

 PlayerName <- c("Alexander Ovechkin", "Sidney Crosby")
 Position <- c("Forward", "Forward")
 ImageURL <- c("https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471214.jpg", "https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471675.jpg")

    DF <- data.frame (PlayerName, Position, ImageURL)

'''

以下是我的代码示例:

用户界面

'''

  ui <-navbarPage(title=title, 

    tabPanel(title = "HOME",icon= icon("Home"),
      fluidPage(
      fluidRow(column(3,
                h4("Filter Data", align = "center"),
                    box(collapsible = FALSE,
                        width= 12,
                        selectInput( "Playernameinput", "Select Player", choices = DF$PlayerName)
),
              column(3, 
                h4("Selected Athlete", align = "center"),
                uiOutput("SelectedAthletePlaceHolder")

 )))

'''

下面是服务器:

'''

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

output$SelectedAthletePlaceHolder <- renderUI({
                                              req(input$Playernameinput)
  
                                              req(PlayerPositionFilter <- DF %>% 
                                                                          filter(`PlayerName` %in% input$Playernameinput),
                                                  PlayerPosition <- PlayerPositionFilter$Position)
                                              
                                              req(PlayerImageFilter <- DF %>%
                                                                       filter(`Playername` %in% input$Playernameinput),
                                                  PlayerImage <- PlayerImageFilter$ImageURL)
                                                
                                              userBox(title = userDescription(title=input$Playernameinput,
                                                                              subtitle = PlayerPosition,
                                                                              type=2, 
                                                                              background = "Red", 
                                                                              image= PlayerImage), 
                                                      width = 12)


 }

'''

到目前为止,这个用户框可以正常工作,根据Playernameinput. 但是,图像方面没有正确更新。我没有注意到错误消息,但出现了一个小问号,而不是图像本身。请注意,如果我将 URL 硬编码到图像函数中,则可以正常工作。

我确信我错过了一个小因素。

非常感谢在我的代码的一般输入领域提供任何帮助!感谢您的时间和精力。

4

1 回答 1

0

以下对我有用。

PlayerName <- c("Alexander Ovechkin", "Sidney Crosby")
Position <- c("Forward", "Forward")
ImageURL <- c("https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471214.jpg", "https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471675.jpg")

DF <- data.frame(PlayerName, Position, ImageURL)

library(shinydashboardPlus)

ui <-navbarPage(title="My Title", 
                
                tabPanel(title = "HOME",icon= icon("Home"),
                         fluidPage(
                           fluidRow(column(3,
                                           h4("Filter Data", align = "center"),
                                           box(collapsible = FALSE,
                                               width= 12,
                                               selectInput( "Playernameinput", "Select Player", choices = DF$PlayerName)
                                           )),
                                           column(4, 
                                                  h4("Selected Athlete", align = "center"),
                                                  uiOutput("SelectedAthlete")
                                           ))
                         )
                )
)

server <- function(input, output, session) {
  
  output$SelectedAthlete <- renderUI({
    req(input$Playernameinput)

    df1 <- DF  %>% dplyr::filter(PlayerName %in% input$Playernameinput)
    PlayerPosition <- df1$Position
    PlayerImage <- df1$ImageURL

    userBox(title = userDescription(title=input$Playernameinput,
                                    subtitle = PlayerPosition,
                                    type=2,
                                    # background = "Red",
                                    image= PlayerImage
                                    ),
            status="info",
            width = 12)
  })
}

shinyApp(ui, server)

输出

于 2021-09-19T02:07:41.827 回答