滑块故障中的按钮

Question

我的滑块有问题。它不会显示为13号的划分，并且按下我按下按钮检查不起作用。我该怎么办？请帮忙。

这是我写的代码：

library(shiny)
library(readr)

# GiuseppeData <- read_csv("Classes_with_Giuseppe.csv")
GiuseppeData <- structure(list(number_of_classes = c("1_class", "2_class", "3_class",
                                                     "4_class", "5_class", "6_class", "7_class", "8_class", "9_class", "10_class",
                                                     "11_class", "12_class", "13_class", "14_class", "15_class", "16_class",
                                                     "17_class", "18_class"), 
                               length_of_classes = c(2.24, 2.37, 2.14, 2.18, 2.28,
                                                     2.3, 2.32, 2.24, 2.36, 2.38, 2.21, 2.25, 2.17, 2.17, 2, 2.1, 2.05, 2.2)),
                               row.names = c(NA, -18L),
                               class = "data.frame")

ui <- fluidPage(
  titlePanel("Hello Giuseppe!"),
  sidebarLayout(
    sidebarPanel(
      sliderInput(inputId = "rows",
                  label = "Amount of Classes",
                  min = 1,
                  max = nrow(GiuseppeData),
                  value = 7, step = 1,
                  animate = animationOptions(interval = 600, loop = TRUE)),
      actionButton(
        inputId = "check",
        label = "Check"
      )
    ),
    mainPanel(
      plotOutput(outputId = "distPie")
    )
  )
)

server <- function(input, output) {
  output$distPie <- renderPlot({
    x <- GiuseppeData[1:input$rows,]$length_of_classes
    pie(x, col = "76776", border = "pink",
        xlab = "Pie of Length of Each Class (in hours)",
        main = "Pie of Classes")
  })
}

shinyApp(ui = ui, server = server)

Answer 1

要显示一个自定义按钮，我们可以使用AnimationOptions，然后将ActionButton传递到其Playbutton参数。

可以开箱即用自定义滑块tick-但是，我们可以使用htmltools :: tagquery。 在这里可以找到一个相关的线程。

library(shiny)
library(readr)
library(plotly)
library(htmltools)

# GiuseppeData <- read_csv("Classes_with_Giuseppe.csv")
GiuseppeData <- structure(list(number_of_classes = c("1_class", "2_class", "3_class",
                                                     "4_class", "5_class", "6_class", "7_class", "8_class", "9_class", "10_class",
                                                     "11_class", "12_class", "13_class", "14_class", "15_class", "16_class",
                                                     "17_class", "18_class"), 
                               length_of_classes = c(2.24, 2.37, 2.14, 2.18, 2.28,
                                                     2.3, 2.32, 2.24, 2.36, 2.38, 2.21, 2.25, 2.17, 2.17, 2, 2.1, 2.05, 2.2)),
                               row.names = c(NA, -18L),
                               class = "data.frame")


ui <- fluidPage(titlePanel("Hello Giuseppe!"),
                sidebarLayout(sidebarPanel(
                  {
                    customSlider <- sliderInput(
                    inputId = "rows",
                    label = "Amount of Classes",
                    min = 1,
                    max = nrow(GiuseppeData),
                    value = 7,
                    step = 1,
                    animate = animationOptions(
                      interval = 600,
                      loop = TRUE,
                      playButton = actionButton(
                        inputId = "play",
                        label = "Play",
                        style = "margin-top: 20px; margin-bottom: -15px; width: 160px;"
                      ),
                      pauseButton = actionButton(
                        inputId = "pause",
                        label = "Pause",
                        style = "margin-top: 20px; margin-bottom: -15px; width: 160px;"
                      )
                    ),
                    ticks = TRUE
                    )
                    tagQuery(customSlider)$find("input")$addAttrs("data-values" = paste0(seq_len(nrow(GiuseppeData)), collapse = ", "))$allTags()
                    }
                ),
                mainPanel(
                  plotlyOutput(outputId = "distPie", height = "60vh")
                )))

server <- function(input, output) {
  output$distPie <- renderPlotly({
    x <- GiuseppeData[1:input$rows, ]
    fig <- plot_ly(
        data = x,
        labels = ~ number_of_classes,
        values = ~ length_of_classes,
        type = 'pie',
        textposition = 'inside',
        textinfo = 'label+value+percent',
        direction ='clockwise', 
        sort = FALSE
      )
    fig <- fig %>% layout(
      title = "Pie of Classes",
      xaxis = list(
        title = "Pie of Length of Each Class (in hours)",
        showgrid = FALSE,
        zeroline = FALSE,
        showticklabels = FALSE
      ),
      yaxis = list(
        showgrid = FALSE,
        zeroline = FALSE,
        showticklabels = FALSE
      )
    )
  })
}

shinyApp(ui = ui, server = server)

ps：我一直在使用 plotly ciptly pifly 而不是基础R图。随意恢复这一步骤。