rShiny自定义css javascript滑块-如何从中获取值？

对于我的应用程序，我需要的比例滑块（多拇指滑块）的总和为100%。我知道在rShiny没有这样的事，但我在这里找到了我想要的：

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

它工作得很好：（我的个人副总裁）

代码如下：

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)

库（闪亮）
图书馆（htmltools）
选项（shinny.sanitize.errors=F）
ui我使用了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)

库（闪亮）
图书馆（htmltools）
图书馆（GG2）
图书馆（ggiraph）
图书馆（shinyWidgets）
图书馆（tidyr）
图书馆（dplyr）
图书馆（shinycssloaders）
图书馆（ggmap）
选项（shinny.sanitize.errors=F）
ui%withSpinner（），
),
主面板（宽度=12，
""
)
))
服务器使用
iframe
，恐怕这是不可能的。“shinyWidgets”包提供了noUiSlider，它允许多个拇指。但是结果并没有那么漂亮。斯泰芬·洛朗，谢谢你，这真的帮了我的忙。我用它和堆叠的酒吧来想象它。我很快就会把它寄出去。然而。。。我们真的不能让它工作吗？也许有一些变通方法来生成xml文件，并以某种方式对其进行解析？