renderUI로 렌더링 할 때 반짝이는 로그 슬라이더

Question

반짝이는 로그 슬라이더의 유연한 번호를 원했지만 몇 가지 문제가있었습니다. 렌더링 슬라이더하기 전에 태그에 의해

sliderLogarithm <- "$(function() { 
setTimeout(function(){ 
var vals = [0]; 
var powStart = -2.0; 
var powStop = 0.01; 
for (i = powStart; i <= powStop; i=i+0.01) { 
var val = Math.pow(10, i); 
val = parseFloat(val.toFixed(3)); 
vals.push(val); 
} 
$('#range1').data('ionRangeSlider').update({'values':vals}) 
}, 5)})" 

그런 다음 ui.R에서 초기화 : tags$head(tags$script(HTML(sliderLogarithm))) 다음 슬라이더가 range1가 로그 불리는 인터넷을 통해 검색 할 때 나는 하나 개의 슬라이더는 다음과 같은 예를 들어 스크립트에 의해 로그로 변경 될 수 있음을 발견 하였다. 그러나 renderUI 함수에 의해 server.R에서 슬라이더가 초기화 될 때 작동하지 않습니다. 도움?

코드 :

library(shiny) 

server <- shinyServer(function(input, output, session) { 
    output$sliders <- renderUI({ 
    tags$head(tags$script(HTML(sliderLogarithm))) 
    lapply(seq(input$number), function(i) { 
     sliderInput(inputId = "range1", 
        label = paste('Some range', i), 
        min = 0, max = 1, value = 0.1) 
    }) 
    }) 
}) 

sliderLogarithm <- 
"$(function() { 
setTimeout(function(){ 
    var vals = [0]; 
    var powStart = -2.0; 
    var powStop = 0.01; 
    for (i = powStart; i <= powStop; i=i+0.01) { 
    var val = Math.pow(10, i); 
    val = parseFloat(val.toFixed(3)); 
    vals.push(val); 
    } 
    $('#range1').data('ionRangeSlider').update({'values':vals}) 
}, 5)})" 

ui <- fluidPage(
    numericInput('number', 'Number', 1), 
    tags$head(tags$script(HTML(sliderLogarithm))), 
    uiOutput('sliders') 
) 

shinyApp(ui = ui, server = server) 

Answer 1

나는 확실히 그것을 만들 수 있습니다.

library(shiny) 

sliderLogarithm <- 
    "$(function() { 
    setTimeout(function() { 
     var vals = [0]; 
     var powStart = 5; 
     var powStop = 2; 
     for (i = powStart; i >= powStop; i--) { 
     var val = Math.pow(10, -i); 
     val = parseFloat(val.toFixed(8)); 
     vals.push(val); 
     } 
     $('*[id^=range]').data('ionRangeSlider').update({'values':vals}) 
}, 5)})" 

ui <- fluidPage(
    numericInput('number', 'Number', 1), 
    # actionButton('insertBtn', 'Insert'), 
    # actionButton('removeBtn', 'Remove'), 
    tags$head(tags$script(HTML(sliderLogarithm))), 
    tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); });'))), 
    uiOutput('sliders') 
    # tags$div(id = 'placeholder') 
) 

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

    # observeEvent(input$insertBtn, { # Alternative I 
    # session$sendCustomMessage(type = 'jsCode', list(value = sliderLogarithm)) 
    # insertUI(
    #  selector = '#placeholder', 
    #  ui = sliderInput(
    #  inputId = 'range1', 
    #  label = 'Some range', 
    #  min = 0, 
    #  max = 1e-2, 
    #  value = c(0, 1e-2)) 
    # ) 
    # }) 
    # observeEvent(input$removeBtn, { 
    # removeUI(
    #  selector = 'div:has(> #range1)' 
    # ) 
    # }) 

    output$sliders <- renderUI({ # Alternative II 
    session$sendCustomMessage(type = 'jsCode', list(value = sliderLogarithm)) 
    lapply(1:input$number, function(i) { 
     print(i) 
     sliderInput(
     inputId = paste0('range', i), 
     label = paste('Some range', i), 
     min = 0, 
     max = 1e-2, 
     value = c(0, 1e-2) 
    ) 
    }) 
    }) 

}) 

shinyApp(ui = ui, server = server) 

내가 두 가지 방법으로 실험 : 이것은 내가 지금까지 가지고있는 첫 번째는 insertUI 및 removeUI과 함께 observeEvent()을 포함 renderUI() 두 번째를 포함. 그러나 Shiny와 JQuery가 함께 작동하는 데 문제가 있습니다. 아마도 @ dean-attali가 당신을 도울 수 있습니다.