对数刻度上的闪亮滑块
Posted
技术标签:
【中文标题】对数刻度上的闪亮滑块【英文标题】：Shiny slider on logarithmic scale 【发布时间】：2015-08-10 17:50:45 【问题描述】：我正在使用 Shiny 构建一个简单的 Web 应用程序，该应用程序带有 slider，用于控制应在输出中显示哪些 p 值。
如何使滑块作用于对数而不是线性比例？
目前我有：
sliderInput("pvalue",
"PValue:",
min = 0,
max = 1e-2,
value = c(0, 1e-2)
),
谢谢！
【问题讨论】：
input_slider from ggvis 有一个 map 参数。可以直接使用ggivs，或者查看map参数的实现。
我想我可以得到一个非常简单的 javascript 来解决这个问题，不应该超过几行，你能告诉我们你想要什么吗？
【参考方案1】：
这个问题没有得到更多关注的原因是它很难回答。要满足提问者的要求，您必须编写 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>
')
)
)
)
【讨论】：
好吧，我想说它是问题的答案，它确实需要解决对数方面的问题！ 我不这么认为。定义映射很简单（如果您知道 javascript）。困难的部分是弄清楚如何变得闪亮来做到这一点。上面的代码花了大约 4 天的时间才开始工作，其中大约 10 分钟用于创建日期格式的代码。如果那样的话。 太棒了！因此，进行这些更改以回答问题应该很容易......！ 哇，我想我应该更加小心地选择我想帮助的人。祝你好运！ 非常感谢您的帮助，但是如果它实际上是针对不同的问题（即使您相信差异是微妙的）。这可能是让某人兴奋的必要条件，但这不是问题的答案。如果您对其进行编辑以便可以接受/授予它，那就太棒了【参考方案2】：我不确定你想要什么作为输出，但我所做的是让可能的 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)
))
【讨论】：
OP/赏金提问者：这是你想要的吗？ 这看起来很不错，但是标签发生了一些奇怪的事情，就像它们都被连接在一起 - 有什么想法吗？ 嗯，在我的浏览器上它们看起来不错（在 RStudio 中它们都聚集在一起）。在实际浏览器中对您来说看起来很奇怪？我认为这可能是因为浮点问题（如果您查看数字，它们就像“.00010000000000002”），因此解决方案是将它们四舍五入到 5 位数字或将数字构造为字符串为 10^-n 我更新了我的答案，我只是使用parseFloat(...toFixed()) 来确保它只显示前 8 个小数点。请注意，ionrangeslider 似乎确实有一个奇怪的错误，它甚至在小数点右侧插入逗号作为千位分隔符（10000 正确显示为 10,000，但 0.0001 错误显示为 0.0,001）。这是一个单独的问题，我认为这不是这个答案的责任
你是对的，但无论如何，这种变化已经对其进行了排序。这正是我所追求的，很高兴得到这个答案 - 如果现在满意，由 OP 接受【参考方案3】：
我现在没有闪亮的，我已经扩大了一点范围，如果你尝试这样会发生什么：
sliderInput("pvalue",
"PValue:",
min = 1e-02,
max = 1e+02,
value = -10^seq(-2, 2)
),
你的帖子提到1e-2，我用过1e-02，我检查如下
> 1e-2==1e-02
[1] TRUE
【讨论】：
这不起作用。 value 参数只接受一个或两个值（请参阅shiny.rstudio.com/reference/shiny/latest/sliderInput.html）。这样做的唯一方法是在比例尺上显示log(pValue) 或其他人发布的相当简洁的 JavaScript 解决方案。【参考方案4】：
不确定该线程是否仍然处于活动状态，但以防万一想要使用 ionRangeSlider 的美化函数属性添加更通用的“记录” inputSlider 方法，而不是覆盖值，其优点是您可以定义最小值, max, step 和 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)
【讨论】：
这不适用于 RStudio 浏览器，但在 chrome 和 FF 中可以 这很好用，但在 renderUI 中的服务器端创建滑块输入时效果不佳。问题是脚本在创建对象之前触发（如果我将等待时间设置得足够长，它就可以工作）。有什么好的解决办法吗？ 我找到了方法。将对 JS.onload 的调用插入到渲染 UI 中就可以了。session$sendCustomMessage(type='jsCode', list(value = JS.onload))。你在 ui 中也需要这个：tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) eval(message.value); );')))
我还必须在 .update( ) 调用中设置 'prettify_enabled' : true【参考方案5】：
更新（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)
【讨论】：
一个小例子会很棒！ @agenis 已编辑以包含示例。感谢更正函数名称！以上是关于对数刻度上的闪亮滑块的主要内容，如果未能解决你的问题，请参考以下文章
在 iOS 滑块上，我可以单击刻度上的任意位置还是必须拖动滑块旋钮？