假设我在R中的amChart之下
library(pipeR)
library(rAmCharts)
library(purrr)
set.seed(1)
Dat = data.frame(x = paste(as.character(-10:10), "%", sep = ""), y = -10:10, z=rnorm(21))
balloonFunction <- htmlwidgets::JS(
'function(item) {',
'if (item.category!="0%") { return \'X: \' + item.category +
\'<br>Y: \' + item.values.value +
\'<br>Z: \' + item.dataContext[\'z\'];}',
'}')
p <- amSerialChart(categoryField = "x", precision = 2) %>%
setDataProvider(dataProvider = Dat, keepNA = TRUE) %>%
addGraph(valueField = "y", lineColor = "gray", fillAlphas=0.5,
bullet="round", lineThickness=4) %>%
setChartCursor() %>%
setBalloon(cornerRadius=10, color="white", fillColor="red", textAlign="left")
p@graphs[[1]]$balloonFunction <- balloonFunction
p@valueAxes <- list(list(title='y-axis name', position='left', axisAlpha=0.5))
p@categoryAxis <- list(title='x-axis name', axisAlpha=0.5)
p
现在,我想在图表上修复气球位置。我希望气球应该在中心垂直对齐,在左边水平对齐。
如何在amChart的R实现中实现这一点的任何指针都将受到高度赞赏。
谢谢,
基于xorspark反馈的实施
下面是一个Shiny应用程序,用于演示如何修复气球的位置。
ui.R
library(rAmCharts)
library(pipeR)
library(purrr)
fluidPage(
tagList(tags$head(includeCSS("CSS.css"))),
selectInput("Dummy", "Some Dummy number:",c(1,2,3)),
div(id = "balloon"),
div(amChartsOutput("Plot", height = "400px"))
)
server.R
server <- function(input, output) {
set.seed(1)
balloonFunction <- htmlwidgets::JS(
"function(item) {",
"document.getElementById('balloon').innerHTML = item.dataContext.z;",
"}")
labFunx <- htmlwidgets::JS(
'function(value) {',
'return value+\'%\';',
'}')
dat = structure(list(x = c(-100, -99.61, -99.22, -98.83, -98.43, -98.04,
-97.65, -97.26, -96.87, -96.48, -96.09, -95.69, -95.3, -94.91,
-94.52, -94.13, -93.74, -93.35, -92.95, -92.56, -92.17, -91.78,
-91.39, -90, -90.61, -90.22, -89.82, -89.43, -89.04, -88.65),
y = c(1.7597036882208e-16, 3.74523809420545e-16, 6.79924138728896e-16,
5.49147548890779e-16, 2.8444302872708e-16, 2.01730936037434e-16,
4.72623693209037e-16, 5.25606872427607e-16, 5.75755789341732e-19,
2.74318552000638e-17, 7.41872388571549e-17, 1.16379243552747e-16,
1.30330176931005e-17, 1.44493324181405e-16, 1.48200512266161e-16,
2.12152823477696e-16, 1.23512766683157e-16, 1.32574841143743e-16,
4.4989064700399e-17, 1.34533164086192e-16, 1.9006081627268e-16,
2.39080196757097e-16, 1.19793582322272e-16, 9.50635502478515e-17,
8.85078754774532e-17, 4.07507372548731e-17, 4.87962996842999e-17,
0, 0, 0), z = c("Balloon -100", "Balloon -99.61", "Balloon -99.22",
"Balloon -98.83", "Balloon -98.43", "Balloon -98.04", "Balloon -97.65",
"Balloon -97.26", "Balloon -96.87", "Balloon -96.48", "Balloon -96.09",
"Balloon -95.69", "Balloon -95.3", "Balloon -94.91", "Balloon -94.52",
"Balloon -94.13", "Balloon -93.74", "Balloon -93.35", "Balloon -92.95",
"Balloon -92.56", "Balloon -92.17", "Balloon -91.78", "Balloon -91.39",
"Balloon -90", "Balloon -90.61", "Balloon -90.22", "Balloon -89.82",
"Balloon -89.43", "Balloon -89.04", "Balloon -88.65")), .Names = c("x",
"y", "z"), row.names = c(NA, 30L), class = "data.frame")
dat <- dat[order(dat$x),]
nr <- nrow(dat)
last.row <- dat[nr,]
last.row$y <- 0
dat <- rbind(dat, last.row)
p <- amXYChart(x=dat$x, y=dat$y) %>%
setDataProvider(dataProvider = dat, keepNA = TRUE) %>%
addGraph(xField = "x", yField = "y", lineColor = "gray", fillAlphas=0.5,
bullet="round", lineThickness=2, bulletColor="transparent") %>%
setChartCursor() %>%
setBalloon(cornerRadius=10, color="black", textAlign="left", maxWidth = 1300)
p@graphs[[1]]$balloonFunction <- balloonFunction
p@valueAxes <- list(list(title='x-axis name', position='bottom',axisAlpha=0.5,
labelFunction=labFunx),
list(title='y-axis name', position='left',axisAlpha=0.5))
output$Plot = renderAmCharts(p)
}
CSS
#balloon {
position: absolute;
width: 100px;
height: 100px;
top: 70px;
left: 30px;
background: #FFA500;
border: 1px solid #ccc;
opacity: 0.8;
padding: 5px;
font-size: 15px;
}
虽然,我原来的问题现在已经解决,我观察到的是,即使我将鼠标指针从图表容器中移除,我仍然会看到气球值。这个我不想要。只有当我将鼠标悬停在图表
上时,我才能看到气球值任何想法如何解决这个问题都将受到高度赞赏。
谢谢,
答案 0 :(得分:0)
在我看来,给定here的解决方案只适用于amCharts
时间序列图(type = "serial"
)。
使用amCharts
散点图(type = "xy"
)的解决方案为here。
您可以在下面找到一些可以帮助您的建议。
library(rAmCharts)
library(purrr)
library(shiny)
dat <- structure(list(x = c(-100, -99.61, -99.22, -98.83, -98.43, -98.04,
-97.65, -97.26, -96.87, -96.48, -96.09, -95.69, -95.3, -94.91,
-94.52, -94.13, -93.74, -93.35, -92.95, -92.56, -92.17, -91.78,
-91.39, -90, -90.61, -90.22, -89.82, -89.43, -89.04, -88.65),
y = c(1.7597036882208e-16, 3.74523809420545e-16, 6.79924138728896e-16,
5.49147548890779e-16, 2.8444302872708e-16, 2.01730936037434e-16,
4.72623693209037e-16, 5.25606872427607e-16, 5.75755789341732e-19,
2.74318552000638e-17, 7.41872388571549e-17, 1.16379243552747e-16,
1.30330176931005e-17, 1.44493324181405e-16, 1.48200512266161e-16,
2.12152823477696e-16, 1.23512766683157e-16, 1.32574841143743e-16,
4.4989064700399e-17, 1.34533164086192e-16, 1.9006081627268e-16,
2.39080196757097e-16, 1.19793582322272e-16, 9.50635502478515e-17,
8.85078754774532e-17, 4.07507372548731e-17, 4.87962996842999e-17,
0, 0, 0), z = c("Balloon -100", "Balloon -99.61", "Balloon -99.22",
"Balloon -98.83", "Balloon -98.43", "Balloon -98.04", "Balloon -97.65",
"Balloon -97.26", "Balloon -96.87", "Balloon -96.48", "Balloon -96.09",
"Balloon -95.69", "Balloon -95.3", "Balloon -94.91", "Balloon -94.52",
"Balloon -94.13", "Balloon -93.74", "Balloon -93.35", "Balloon -92.95",
"Balloon -92.56", "Balloon -92.17", "Balloon -91.78", "Balloon -91.39",
"Balloon -90", "Balloon -90.61", "Balloon -90.22", "Balloon -89.82",
"Balloon -89.43", "Balloon -89.04", "Balloon -88.65")), .Names = c("x",
"y", "z"), row.names = c(NA, 30L), class = "data.frame")
ui <- fluidPage(
tagList(tags$head(includeCSS("CSS.css"))),
selectInput("Dummy", "Some Dummy number:",c(1,2,3)),
div(id = "balloon"),
div(amChartsOutput("Plot", height = "800px", width="1600px"))
)
server <- function(input, output) {
balloonFunction <- htmlwidgets::JS(
'function(item) {',
'if (item.dataContext[\'x\']!=0) {
return \'X: \' + item.dataContext.x +
\'<br>Y: \' + item.dataContext.y +
\'<br>Z: \' + item.dataContext.z;}',
'}')
labFunx <- htmlwidgets::JS(
'function(value) {',
'return value+\'%\';',
'}')
# Add two points to the series in order to plot correctly the
# area below the line
dat <- dat[order(dat$x),]
nr <- nrow(dat)
first.row <- dat[1,]
first.row$y <- 0
last.row <- dat[nr,]
last.row$y <- 0
dat <- rbind(first.row, dat, last.row)
# Define Javascript function for plotting x-y values
# inside the fixed-position balloon
prt.balloon <- paste(
"function(event) {",
"var xValue = AmCharts.charts[0].graphs[0].xAxis.coordinateToValue(event.x);",
"var yValue = AmCharts.charts[0].graphs[0].yAxis.coordinateToValue(event.y);",
"document.getElementById('balloon').innerHTML='x:' + xValue + '<br>y:' + yValue;",
"}", sep="\n")
# Create chart cursor
chrCur <- chartCursor(cursorPosition="mouse") %>%
addListener(name="moved", expression=prt.balloon)
p <- new("AmChart", type="xy", chartCursor=chrCur) %>%
setDataProvider(dataProvider=dat, keepNA=TRUE) %>%
addGraph(balloonText="", balloonFunction=balloonFunction,
xField = "x", yField = "y", lineColor = "gray", fillAlphas=0.5,
bullet="round", lineThickness=2, bulletColor="transparent")
p@valueAxes <- list(list(title='x-axis name', position='bottom',axisAlpha=0.5,
labelFunction=labFunx),
list(title='y-axis name', position='left',axisAlpha=0.5))
output$Plot = renderAmCharts(p)
}
shinyApp(ui,server)
<强> CSS.css 强>
#balloon {
position: absolute;
width: 300px;
height: 100px;
top: 100px;
left: 1200px;
background: #FFA500;
border: 1px solid #ccc;
opacity: 0.8;
padding: 15px;
font-size: 20px;
font-weight: bold;
}