对数刻度上的闪亮滑块
Shiny slider on logarithmic scale
我正在使用 Shiny 构建一个简单的 Web 应用程序，其中 slider 控制应在输出中显示哪些 p 值。
如何使滑块作用于对数而不是线性刻度？
目前我有：
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
),
谢谢！
这个问题没有得到更多关注的原因是它很难回答。要执行提问者想要的操作，您必须编写 javascript 并将其注入网页。下面是我改编的代码，用于将 shiny 滑块正确格式化为日期。我没有尝试将其修改为对数，因为我只学到了足够的 javascript 来修补这个脚本，然后迅速将其从内存中删除，以便为更重要的事情腾出空间，例如酒吧下方的季节性啤酒菜单块。
随便说：
output$selectUI <-
renderUI(
list(sliderInput(inputId = "target", label = "Date",
min = 0, max = diff_months(targetEnd(),targetStart()) - 1,
value = diff_months(targetEnd(),targetStart()) - 1,
animate = animationOptions( loop = T)),
singleton(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var endDate = new Date(',
year(Sys.Date()),',', month(Sys.Date())
,', 1);
var slider = $("#dates").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text("Jan., 1962");
labels.eq(1).text([monthNames[endDate.getUTCMonth() +1], endDate.getUTCFullYear()].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(1962, 1, 1);
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value));
return [monthNames[slider_date.getUTCMonth()], slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var slider = $("#target").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text([monthNames[', month(targetStart()) +1, '],', year(targetStart()), '].join(", "));
labels.eq(1).text([monthNames[', month(targetEnd()) + 1, '], ', year(targetEnd()), '].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(', year(targetStart()), ', ', month(targetStart()),',1 );
// each slider step is 4 weeks, translating to 24 * 3600 * 1000 milliseconds
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value - 1));
return [monthNames[slider_date.getUTCMonth()],
slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
</script>
')
)
)
)
我不确定你想要什么作为输出，但我所做的是让可能的 p 值为 [0, 0.00001, 0.0001, 0.001, 0.01]。如果你想要一些不同的东西，希望这个答案是一个足够好的起点。
基本上，首先我创建了一个数组来保存数字值 (0, 0.0000.1, ...)，然后我只使用滑块的 API 中的特殊更新函数来制作这些值粘在滑块上。一旦您弄清楚如何使用滑块的 API，这就非常简单了。此外，出于某种原因 运行 RStudio 中的这个看起来很奇怪，但在浏览器中它很好。另外，请注意我有 5 毫秒的延迟，因为我想确保它在滑块初始化后运行。不是最干净的解决方案，可能有更好的方法，但它有效。
library(shiny)
JScode <-
"$(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);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 5)})"
runApp(shinyApp(
ui = fluidPage(
tags$head(tags$script(HTML(JScode))),
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
)
),
server = function(input, output, session) {
}
))
我现在没有闪亮，我稍微扩大了范围，如果你尝试这样会发生什么：
sliderInput("pvalue",
"PValue:",
min = 1e-02,
max = 1e+02,
value = -10^seq(-2, 2)
),
你的post提到了1e-2，我用过1e-02，我查了下
> 1e-2==1e-02
[1] TRUE
不确定此线程是否仍处于活动状态，但以防万一想要使用 ionRangeSlider 的 prettify 函数属性添加更通用的 "logifying" inputSlider 方式，而不是覆盖值，优点是您可以像往常一样定义 inputSlider 的最小值、最大值、步长和默认值，然后在 Javascript 侧发生的所有事情都是显示值的变化（提供了两个选项，一个用于数字输出，一个用于科学记数法):
library(shiny)
# logifySlider javascript function
JS.logify <-
"
// function to logify a sliderInput
function logifySlider (sliderId, sci = false) {
if (sci) {
// scientific style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
})
} else {
// regular number style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return (Math.pow(10, num)); }
})
}
}"
# call logifySlider for each relevant sliderInput
JS.onload <-
"
// execute upon document loading
$(document).ready(function() {
// wait a few ms to allow other scripts to execute
setTimeout(function() {
// include call for each slider
logifySlider('log_slider', sci = false)
logifySlider('log_slider2', sci = true)
}, 5)})
"
ui <- fluidPage(
tags$head(tags$script(HTML(JS.logify))),
tags$head(tags$script(HTML(JS.onload))),
sliderInput("log_slider", "Log Slider (numbers):",
min = -5, max = 3, value = -4, step = 1),
sliderInput("log_slider2", "Log Slider (sci. notation):",
min = -5, max = 3, value = 1, step = 0.5),
br(),
textOutput("readout1"),
textOutput("readout2")
)
server <- function(input, output, session) {
output$readout1 <- reactive({
paste0("Selected value (numbers): ", input$log_slider, " = ", 10^input$log_slider)
})
output$readout2 <- reactive({
paste0("Selected value (sci. notation): ", input$log_slider2, " = ", 10^input$log_slider2)
})
}
shinyApp(ui, server)
更新（2018 年 5 月）：
现在可以通过 shinyWidgets::sliderTextInput() 控件实现。您可以指定自定义步骤（例如，对数间隔），然后滑块逐步执行这些步骤。缺点是您需要指定每个步骤，而不是最大和最小值，并让滑块计算步骤，但它适用于此类应用程序。
小例子：
library(shiny)
ui <- fluidPage(
shinyWidgets::sliderTextInput("pvalue2","PValue:",
choices=c(0, 0.0001, 0.001, 0.01),
selected=0, grid = T)
)
server <- function(input, output) {}
shinyApp(ui, server)
我正在使用 Shiny 构建一个简单的 Web 应用程序，其中 slider 控制应在输出中显示哪些 p 值。
如何使滑块作用于对数而不是线性刻度？
目前我有：
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
),
谢谢！
这个问题没有得到更多关注的原因是它很难回答。要执行提问者想要的操作，您必须编写 javascript 并将其注入网页。下面是我改编的代码，用于将 shiny 滑块正确格式化为日期。我没有尝试将其修改为对数，因为我只学到了足够的 javascript 来修补这个脚本，然后迅速将其从内存中删除，以便为更重要的事情腾出空间，例如酒吧下方的季节性啤酒菜单块。
随便说：
output$selectUI <-
renderUI(
list(sliderInput(inputId = "target", label = "Date",
min = 0, max = diff_months(targetEnd(),targetStart()) - 1,
value = diff_months(targetEnd(),targetStart()) - 1,
animate = animationOptions( loop = T)),
singleton(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var endDate = new Date(',
year(Sys.Date()),',', month(Sys.Date())
,', 1);
var slider = $("#dates").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text("Jan., 1962");
labels.eq(1).text([monthNames[endDate.getUTCMonth() +1], endDate.getUTCFullYear()].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(1962, 1, 1);
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value));
return [monthNames[slider_date.getUTCMonth()], slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
$(document).ready(function() {
var monthNames = [ "Jan.", "Feb.", "Mar.", "Apr.", "May", "June",
"July", "Aug.", "Sept.", "Oct.", "Nov.", "Dec." ];
var slider = $("#target").slider();
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text([monthNames[', month(targetStart()) +1, '],', year(targetStart()), '].join(", "));
labels.eq(1).text([monthNames[', month(targetEnd()) + 1, '], ', year(targetEnd()), '].join(", "));
// override the default "nice" function.
slider.nice = function(value) {
alert("hi")
var ref_date = new Date(', year(targetStart()), ', ', month(targetStart()),',1 );
// each slider step is 4 weeks, translating to 24 * 3600 * 1000 milliseconds
var slider_date = new Date(ref_date.setMonth(ref_date.getMonth() + value - 1));
return [monthNames[slider_date.getUTCMonth()],
slider_date.getUTCFullYear()].join(", ");
}
$(slider).trigger("slidechange");
})
</script>
')
)
)
)
我不确定你想要什么作为输出，但我所做的是让可能的 p 值为 [0, 0.00001, 0.0001, 0.001, 0.01]。如果你想要一些不同的东西，希望这个答案是一个足够好的起点。
基本上，首先我创建了一个数组来保存数字值 (0, 0.0000.1, ...)，然后我只使用滑块的 API 中的特殊更新函数来制作这些值粘在滑块上。一旦您弄清楚如何使用滑块的 API，这就非常简单了。此外，出于某种原因 运行 RStudio 中的这个看起来很奇怪，但在浏览器中它很好。另外，请注意我有 5 毫秒的延迟，因为我想确保它在滑块初始化后运行。不是最干净的解决方案，可能有更好的方法，但它有效。
library(shiny)
JScode <-
"$(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);
}
$('#pvalue').data('ionRangeSlider').update({'values':vals})
}, 5)})"
runApp(shinyApp(
ui = fluidPage(
tags$head(tags$script(HTML(JScode))),
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
)
),
server = function(input, output, session) {
}
))
我现在没有闪亮，我稍微扩大了范围，如果你尝试这样会发生什么：
sliderInput("pvalue",
"PValue:",
min = 1e-02,
max = 1e+02,
value = -10^seq(-2, 2)
),
你的post提到了1e-2，我用过1e-02，我查了下
> 1e-2==1e-02
[1] TRUE
不确定此线程是否仍处于活动状态，但以防万一想要使用 ionRangeSlider 的 prettify 函数属性添加更通用的 "logifying" inputSlider 方式，而不是覆盖值，优点是您可以像往常一样定义 inputSlider 的最小值、最大值、步长和默认值，然后在 Javascript 侧发生的所有事情都是显示值的变化（提供了两个选项，一个用于数字输出，一个用于科学记数法):
library(shiny)
# logifySlider javascript function
JS.logify <-
"
// function to logify a sliderInput
function logifySlider (sliderId, sci = false) {
if (sci) {
// scientific style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return ('10<sup>'+num+'</sup>'); }
})
} else {
// regular number style
$('#'+sliderId).data('ionRangeSlider').update({
'prettify': function (num) { return (Math.pow(10, num)); }
})
}
}"
# call logifySlider for each relevant sliderInput
JS.onload <-
"
// execute upon document loading
$(document).ready(function() {
// wait a few ms to allow other scripts to execute
setTimeout(function() {
// include call for each slider
logifySlider('log_slider', sci = false)
logifySlider('log_slider2', sci = true)
}, 5)})
"
ui <- fluidPage(
tags$head(tags$script(HTML(JS.logify))),
tags$head(tags$script(HTML(JS.onload))),
sliderInput("log_slider", "Log Slider (numbers):",
min = -5, max = 3, value = -4, step = 1),
sliderInput("log_slider2", "Log Slider (sci. notation):",
min = -5, max = 3, value = 1, step = 0.5),
br(),
textOutput("readout1"),
textOutput("readout2")
)
server <- function(input, output, session) {
output$readout1 <- reactive({
paste0("Selected value (numbers): ", input$log_slider, " = ", 10^input$log_slider)
})
output$readout2 <- reactive({
paste0("Selected value (sci. notation): ", input$log_slider2, " = ", 10^input$log_slider2)
})
}
shinyApp(ui, server)
更新（2018 年 5 月）：
现在可以通过 shinyWidgets::sliderTextInput() 控件实现。您可以指定自定义步骤（例如，对数间隔），然后滑块逐步执行这些步骤。缺点是您需要指定每个步骤，而不是最大和最小值，并让滑块计算步骤，但它适用于此类应用程序。
小例子：
library(shiny)
ui <- fluidPage(
shinyWidgets::sliderTextInput("pvalue2","PValue:",
choices=c(0, 0.0001, 0.001, 0.01),
selected=0, grid = T)
)
server <- function(input, output) {}
shinyApp(ui, server)