r 闪亮的自定义 css javascript 滑块 - 如何从中获取值？

Question

对于我的应用，我需要总和为 100% 的比例滑块（多拇指滑块）。据我所知，rShiny 中没有类似的东西，但我在这里找到了我想要的东西：https://codepen.io/sim04ful/pen/QWjpLJm

这是在 truescript 和 React 中准备的。我下载了 zip，并使用 script.js、style.css 和 index.html 将其放入我闪亮的应用程序中。我对代码进行了一些小改动以进行自定义，然后在闪亮中使用 iframe 和 html 输出。

效果很好：https://tomaszwojtas.pl/shiny/slider_demo/（我的个人 vps）

代码如下：

library(shiny)
library(htmltools)
options(shiny.sanitize.errors = F)
 
ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(width = 12,
            fluidRow(width = 12, 
                tags$head(includeScript('script.js', 'type' = 'text/javascript', 'data-unique-tag' = 'unique')),
                tags$head(includeCSS('style.css')),
                htmlOutput('prop_slider')
            ),
           
        ),

        # main panel ----
        mainPanel(width = 12, 
                  h3("I need values of the slider above to interact with :)")
        )
))
    
server <- function(input, output, session) {
    output$prop_slider <-  renderUI({
        tags$iframe(src = './index.html', width = '100%', height = 120, frameBorder="0")
    })
    
    
    
}

# Run the application 
shinyApp(ui = ui, server = server)

但是我不知道如何从此滑块中获取值。我通过 Chrome 确定了 html 的范围，它可以从 html 代码中获取：

但是我不知道如何让它活着并且可用于进一步的计算。如果有任何帮助，我将不胜感激......

Answer 1

我使用了 Stéphane Laurent 的建议。我使用 noUiSlider 和 ggplot 和 ggraph 来可视化它。 我在加载时添加了一些额外的东西，例如微调器。

library(shiny)
library(htmltools)
library(ggplot2)
library(ggiraph)
library(shinyWidgets)
library(tidyr)
library(dplyr)
library(shinycssloaders)
library(ggmap)

options(shiny.sanitize.errors = F)


ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(width = 12,

            noUiSliderInput("prop_slider2", label = "Set the structure:", min = 0, max = 100, value = c(25,50,75), step = 1, connect = c(T, T, T, T), color = "darkred", tooltips = T, width = "100%"),
            ggiraphOutput("profile_percentage", height = 150,width = "100%") %>% withSpinner(),
            
        ),

        mainPanel(width = 12, 
                  ""
        )
))


server <- function(input, output, session) {
   
    output$prop_slider <-  renderUI({
        tags$iframe(src = './index.html', width = '100%', height = 120, frameBorder="0")
    })
    
    profile_df <- reactive({
        profile_df <- data.frame(Home = 100 - input$prop_slider2[3], 
                                 Nomad = input$prop_slider2[3] - input$prop_slider2[2],
                                 Blended = input$prop_slider2[2] - input$prop_slider2[1],
                                 Office = input$prop_slider2[1])
        profile_df
    })
    
    output$profile_percentage <- renderggiraph({
        

        profile_df <- profile_df()

        
        profile_df_gather <- gather(profile_df, "Profile", "Value") %>% mutate(
            Value = Value/sum(Value, na.rm = T),
            Value = round(Value, 2), 
            Profile = factor(Profile, levels=c("Home", "Nomad", "Blended", "Office"),ordered=T),
            Definition = rep("Some info", 4))
      
        
        p1 <- profile_df_gather %>%
            ggplot(., aes(1, Value, fill = Profile)) + 
            geom_bar_interactive(aes(tooltip = Definition), stat = "identity") +
            coord_flip() + 
            theme_nothing() +
            theme(plot.margin = unit(-c(1,2,1,1.6), "cm")) +
            scale_fill_brewer(palette = "Reds") +
            geom_text_interactive(aes(label = paste0(Profile,": ", Value*100, "%")), position = position_stack(vjust = .5))
        gp1 <- girafe(ggobj = p1, width_svg = 15, height_svg = 0.5)
        
        
        ggp1<- girafe_options(gp1,
                              
                              fonts = list(sans = "Helvetica"), opts_sizing(rescale = T, width = 1),
                              opts_toolbar(saveaspng = F))
        ggp1
    })
    
    
}

shinyApp(ui = ui, server = server)

这是现场版：https://tomaszwojtas.pl/shiny/slider_demo_2/