レンダリングUIで光沢のある対数スライダ

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呼ばスライダーが対数であるインターネットを検索すると私は1つのスライダーは、このような例のためにスクリプトによって対数に変更することができることを見出しました。しかし、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

私はかなりそれを作ることができます。これは私がこれまで持っているものです：renderUI()を含む第一およびinsertUIとremoveUIと一緒observeEvent()を含む第二：

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) 

私は2つのアプローチで実験しました。しかし、私はShinyとJQueryが一緒に働くことに問題があります。多分@ dean-attaliはあなたを助けることができます。