这是对此问题的跟进:SO Q
上述问题的答案使用JavaScript代码将轴刻度变为指数。它适用于单个图上的单个轴。
在subplot()结构中运行时,只有在我将其应用于最终绘图时,它才适用于第一个绘图。
我正在寻找的修改是:
1:如何使其在子图上工作。我尝试在每个子图的构建中调用JavaScript,但是所有图都没有指数地出现。
2:让它适用于x和y轴(我试过,失败并且哭了一点)
3:当轴变成不是数字时,让它不破坏宇宙(我的应用程序也可以绘制日期列,所以需要检查它是否实际上是数字输入)
4:如果可能,打印为1.23E + 1而不是1E + 1
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
mainPanel(
plotlyOutput('myplotly')
)
)
server <- function(input, output, session) {
javascript <- "
function(el, x)
{
function fix_ticks()
{
ticks = Plotly.d3.selectAll('g.ytick').selectAll('text');
ticks.forEach(function(tick)
{
var num = parseInt(tick[0].innerHTML);
tick[0].innerHTML = num.toExponential();
})
}
el.on('plotly_afterplot', fix_ticks);
}"
output$myplotly <- renderPlotly({
myplots <- lapply(unique(mtcars$cyl), function(v) {
data <- mtcars[which(mtcars$cyl == v), ]
subp <- plot_ly(data = data,
x = rownames(data),
y = ~mpg,
type = "bar")
subp
})
p <- subplot(myplots, margin = 0.08)
p$elementId <- NULL ## to surpress warning of widgetid
p <- onRender(p, javascript)
p <- p %>% layout(margin =list(l = 60, r = 20, b = 160, t = 70) )
p
})
}
shinyApp(ui = ui, server = server)
更新 在这里给出的答案建议我现在运行以下代码来检查数字然后适用于每个轴。我还没有能够得到最后一个处理负值的建议,即使用tick [0] .innerHTML。我最终在第1点的答案下使用了建议,因为我无法得到tick [0] .innerHTML方法在forEach循环中工作。然而,回应早期评论的建议是回到tick [0]方法,我无法完全采用一种方法。
这是我在运行到负面之前最终使用的代码 - &gt; NaN问题
javascriptMPP <- "
function(el, x)
{
function isNumber(n) {
return (Object.prototype.toString.call(n) === '[object Number]' || Object.prototype.toString.call(n) === '[object String]') &&!isNaN(parseFloat(n)) && isFinite(n.toString().replace(/^-/, ''));
}
function fixTicks()
{
ticks = Plotly.d3.selectAll('g.yaxislayer-above,g.xaxislayer-above').selectAll('text');
ticks.each(function(d)
{
if(parseInt(d.text) !== 0 )
{
var num = parseInt(d.text).toExponential(2);
Plotly.d3.select(this).text(num);
}
})
}
el.on('plotly_afterplot', fixTicks);
}"
答案 0 :(得分:1)
1:如何使其在子图上工作。我试着在构建中调用java 每个子情节,但所有的情节都是没有指数的。
第二/第三/等的刻度。 subplot具有类y2tick
/ y3tick
/等类名。我们可以使我们的d3选择器不那么具体,然后使用each
来更改所有刻度。
ticks = Plotly.d3.selectAll('g.yaxislayer-above').selectAll('text');
ticks.each(function(d, i)
{
var num = parseInt(d.text).toExponential();
Plotly.d3.select(this).text(num);
})
2:让它适用于x和y轴(我试过,失败了,哭了 小)
只需将selectAll语句更改为Plotly.d3.selectAll('g.xaxislayer-above').selectAll('text')
3:当轴变为不是时,不要破坏宇宙 一个数字(我的应用程序也可以绘制日期列,所以它需要检查 是否实际上是数字输入)
您可以更改fixTicks
功能,以检查输入值是否为数字,例如使用typeof
或正则表达式。使用像1999年,2000年等的值,它可能会很棘手,你需要手动解决它。
4:如果可能,打印为1.23E + 1而不是1E + 1
toExponential
需要一个parameter,这是“小数点后面的符号中的位数”,即num.toExponential(3)
可以解决您的问题。
从评论中:当滴答的值为负值时,我似乎得到NaN
Plotly使用Unicode minus sign代替常规短划线。您可以使用以下JavaScript代码替换它:
var num = parseInt(tick[0].innerHTML.replace(/\\u2013|\\u2014|\\u2212/g, '-'));
注意:R中需要双反斜杠\\
,纯JavaScript只需要一个\
。
答案 1 :(得分:0)
由于这里发布了其他答案,我终于设法解决了所有问题。
javascript:
替换符号,使其也适用于负值
var num1 = parseInt(d.text.replace(/\\u2013|\\u2014|\\u2212/g, '-'));
如果value为0则跳过,因为不必将其更改为exp格式
if(parseInt(d.text) !== 0 )
如果值是文本,则跳过(将负号更改为符号后,否则将被视为文本
if(isNaN(num1)){
还向打印代码添加了布局命令,并将标签以45度角放置在x轴上,否则它们将相互重叠。 对mtcars df进行了一些更改,以便我们在数据中得到负数和大数字。
要在x轴上绘制文本值,可以使用此方法:
x = rownames(data),
代替数字x参数
x = ~disp,
这是工作代码:
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
mainPanel(
plotlyOutput('myplotly')
)
)
server <- function(input, output, session) {
javascriptMPP <- "
function(el, x)
{
function isNumber(n) {
return (Object.prototype.toString.call(n) === '[object Number]' || Object.prototype.toString.call(n) === '[object String]') &&!isNaN(parseFloat(n)) && isFinite(n.toString().replace(/^-/, ''));
}
function fixTicks()
{
ticks = Plotly.d3.selectAll('g.yaxislayer-above,g.xaxislayer-above').selectAll('text');
ticks.each(function(d)
{
if(parseInt(d.text) !== 0 )
{
var num1 = parseInt(d.text.replace(/\\u2013|\\u2014|\\u2212/g, '-'));
if(isNaN(num1)){
} else {
var num = parseInt(num1).toExponential(2);
Plotly.d3.select(this).text(num);
}
}
})
}
el.on('plotly_afterplot', fixTicks);
}"
output$myplotly <- renderPlotly({
mtcars2 <- mtcars
mtcars2$mpg <- mtcars2$mpg*-1
mtcars <- rbind(mtcars, mtcars2)
mtcars3 <- mtcars
mtcars3$mpg <- mtcars3$mpg*1000000
mtcars <- rbind(mtcars, mtcars3)
myplots <- lapply(unique(mtcars$cyl), function(v) {
data <- mtcars[which(mtcars$cyl == v), ]
subp <- plot_ly(data = data,
x = ~disp,
y = ~mpg,
type = "bar")
subp <- layout(subp, xaxis = list(tickangle = 45))
subp
})
p <- subplot(myplots, margin = 0.08)
p$elementId <- NULL ## to surpress warning of widgetid
p <- onRender(p, javascriptMPP)
p <- p %>% layout(margin =list(l = 60, r = 20, b = 160, t = 70) )
p
})
}
shinyApp(ui = ui, server = server)