I want to reproduce the default tooltip with some additions. However, when I try to do so, it left-aligns both serie and group names, and I am not sure how to fix it.
Some sample data and what I tried to do:
library(dplyr)
library(echarts4r)
library(htmlwidgets)
set.seed(10)
data <- data.frame(name = rep(c("Bob", "Michael"), each = 10),
x = rep(0:9, 2),
y = sample(0:5, 20, replace = TRUE),
add = sample(1:100, 20, replace = TRUE))
# Default tooltip
data %>%
group_by(name) %>%
e_chart(x = x) %>%
e_line(serie = y) %>%
e_tooltip(trigger = "axis")
# My attempt to recreate the formatting while adding new things
data %>%
group_by(name) %>%
e_chart(x = x) %>%
e_line(serie = y, bind = add) %>%
e_tooltip(trigger = "axis",
formatter = JS("
function(params){
var colorSpan = color => `<span style='display:inline-block;margin-right:5px;border-radius:10px;width:9px;height:9px;background-color:` + color + `'></span>`;
let rez = '<strong>Day ' + params[0].value[0] + '</strong>';
params.forEach(item => {
var xx = '<br />' + colorSpan(item.color) + ' ' + item.seriesName +
' <strong>' + item.value[1] + '</strong> (' + item.name + ')'
rez += xx;
});
return (rez)}"))
So, the default tooltip looks like this (values are right aligned):
And my tooltip looks something like this, which is not very readable:
I want to add things to the tooltip while keeping the formatting mostly untouched, but do not know how to do so with right alignment. I am not very familiar with echarts and JS in general though, so I have some troubles with it.
EDIT
So, thanks to #Russ we now have a workaround, which is not exactly what I was hoping to get, but a solution nonetheless. Does not look as pretty as the default tooltip, but for now we have what we have.
Still, #Russ's solution does have some issues, so I post my edited version of his answer here. Not sure how to apply css to echarts' tooltip to remove margins caused by <pre> tag, but that does not matter too much right now
# Adding whitespaces after the name
data <- data %>%
mutate(nameAlt = stringr::str_pad(name, max(nchar(name)), "right"))
data %>%
group_by(nameAlt) %>%
e_chart(x = x) %>%
e_line(serie = y, bind = add) %>%
e_tooltip(trigger = "axis",
formatter = JS("
function(params){
var colorSpan = color => `<span style='display:inline-block;margin-right:5px;border-radius:10px;width:9px;height:9px;background-color:` + color + `'></span>`;
let rez = '<strong>Day ' + params[0].value[0] + '</strong><pre>';
params.forEach(item => {
var xx = colorSpan(item.color) + item.seriesName +
'<span style=`float:right;margin-left:20px;`><strong>' + item.value[1] + '</strong> (' + item.name + ')</span></br>'
rez += xx;
});
rez += '</pre>'
return (rez)}")) %>%
# Removing whitespaces from the legend
e_legend(formatter = JS("function(name){return(name.trim())}"))
Result:
Overview
The way to solve this is with a combination of html tags with css styles that you can specify inside of the javascript. I tried playing around with it and came up a solution that does what you want at the cost of changing the font and probably not being best practice html/css. So my solution isn't a great one, but it does fix the spacing and keep most of your original formatting.
What I did was use R to add white space to the end of Bob's name so that his name has the same number of characters as Michael's name. So like "Bob" becomes "Bob ". I wrote the code so that it finds the longest name in the data and then adds a variable amount of white space to all the other names so that they're all the same length. It should work with an arbitrary number of names.
Then I added a <pre></pre> html tag around the rows in the tool tip. I put <span></span> tags around the numbers in each row and then defined a style that included a bit of a left side margin to separate Bob and Michael from the numbers.
Code
Add white space to names in R
# Find the longest name in the data
longest_name_length <- data$name %>% # names column
unique() %>% # unique values in the name column
nchar() %>% # number of characters in each unique name
max(na.rm = TRUE) # longest name
# add a new column with the length of the name
data$name_length <- data$name %>%
nchar()
# add a characters to add column
data$characters_to_add <- longest_name_length - data$name_length
# add white space to the shorter characters so that all names are the same length
# add a variable amount of white space to each name using a loop
for (row in 1:nrow(data)){
# Rep " " by the number of characters to add and then collapse
# that vector into a single string using paste
white_spaces <- rep(" ", times=data$characters_to_add[row]) %>%
paste(collapse = "")
# paste the name to the white spaces string
data$name[row] <- paste0(data$name[row], white_spaces)
}
update html tags in the code for the chart
data %>%
group_by(name) %>%
e_chart(x = x) %>%
e_line(serie = y, bind = add) %>%
e_tooltip(trigger = "axis",
formatter = JS("
function(params){
var colorSpan = color => `<span style='display:inline-block;margin-right:5px;border-radius:10px;width:9px;height:9px;background-color:` + color + `'></span>`;
let rez = '<strong>Day ' + params[0].value[0] + '</strong>';
params.forEach(item => {
var xx = '<pre>' + colorSpan(item.color) + item.seriesName +
'<span style=`float:right;margin-left:15px;`> <strong>' + item.value[1] + '</strong> (' + item.name + ')</span></pre>'
rez += xx;
});
return (rez)}"))
In this part var xx = '<br />' + I replaced a </br> tag with a <pre> and then in this part
'</strong> (' + item.name + ')' I added ended a </pre> to close the tag. Around this part
<strong>' + item.value[1] + '</strong> (' + item.name + ') I added tags to group these items into an inline html element and then inside I specified a left margin using css to add space between Bob/Michael and their numbers with this style=`float:right;margin-left:15px;`
Result
Other thoughts
This is a javascript question, but it's also an html/css question. It might be worth it to add those tags and hope for a less hacky solution than mine :D
Related
I'm trying append some daily values to a sheet but can't quite figure out how to capture the current cell in a variable and then reuse it to generate the formula.
This is the code that I'm using
var emptyA = sheet.getRange(sheet.getLastRow()+1,1,1)
var emptyB = sheet.getRange(sheet.getLastRow()+1,2,1)
var emptyC = sheet.getRange(sheet.getLastRow()+1,3,1)
I'd like multiply the daily value in the A column with the value in cell F5 which also updates daily, because this changes it should be a formula so I figure it's something along the lines of
var dailyValue = sheet.getRange('F5')
var lastA = sheet.getRange(sheet.getLastRow(),2,1)
var formula = "=" + lastA + "*" + dailyValue
emptyB.setFormula([formula])
The problem that I'm having is lastA gives me "RANGE" rather than the cell ID
Does anyone have any thoughts?
Cheers, Rich
I guess you need to change
var formula = "=" + lastA + "*" + dailyValue
to
var formula = "=" + "F5" + "*" + dailyValue.getA1Notation();
Use getA1Notation() to return cell address like A500.
Use getValue() if you need the value to be hardcoded instead of a link to cell.
Change the following lines:
var dailyValue = sheet.getRange('F5').getValue
var lastA = sheet.getRange(sheet.getLastRow(),2).getValue
emptyB.setFormula(formula)
I am in the circuit board manufacturing industry, and we measure the temperature at a variety of locations on our circuit boards in an effort to identify if certain components are exceeding their required temperatures.
I have some exposure to .js visualization libraries, RStudio and Shiny. I would like to implement this application into an existing R or ShinyDashboard that I am developing.
What I would like to accomplish is to have a 2d or 3d image of my circuit board, and a heatmap that takes the maximum temperature and shows it on that image. My data sets have columns of temperatures over time for up to 20 different locations.
I know this is a crude description, but I was wondering if anyone has any initial suggestions to accomplish this?
Update1
This is the result of running the first code:
Update2
Here is the sample dataset that I would like to base this heatmap off of.
https://docs.google.com/spreadsheets/d/11I19uQyND7YehKrYd-NPiib4bQSHmHmWENFvausigvU/edit?usp=sharing
You could use ggplot for something like this, for example:
library(grid)
library(ggplot2)
# Download image
library(jpeg)
download.file("http://www.expresspcb.com/wp-content/uploads/2015/06/PhotoProductionPCB_TL_800.jpg","pcb.jpg")
img <- readJPEG("/home/oskar/pcb.jpg")
## Load image, use this if you can't download image
#library(png)
#img <- readPNG(system.file("img", "Rlogo.png", package="png"))
g <- rasterGrob(img, interpolate=TRUE,width=1,height=1)
coords <- data.frame("x"=c(0,1),"y"=c(0,1))
# Simulate data
df <- data.frame("x.pos" = c(runif(200),runif(20,min=0.5,max=0.8)),
"y.pos" = c(runif(200),runif(20,min=0.5,max=0.8)),
"heat" = c(runif(200),runif(20,min=0.7,max=1)))
# Show overlay of image and heatmap
ggplot(data=df,aes(x=x.pos,y=y.pos,fill=heat)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
stat_density2d( alpha=0.2,aes(fill = ..level..), geom="polygon" ) +
scale_fill_gradientn(colours = rev( rainbow(3) )) +
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0))
# Show where max temperature is
dat.max = df[which.max(df$heat),]
ggplot(data=coords,aes(x=x,y=y)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
geom_point(data=dat.max,aes(x=x.pos,y=y.pos), shape=21,size=5,color="black",fill="red") +
geom_text(data=dat.max,aes(x=x.pos,y=y.pos,label=round(heat,3)),vjust=-1,color="red",size=10)
The ggplot image part is from here
You can also bin the data manually and overlay it on the image like this (run this part after the script above):
# bin data manually
# Manually set number of rows and columns in the matrix containing sums of heat for each square in grid
nrows <- 30
ncols <- 30
# Define image coordinate ranges
x.range <- c(0,1) # x-coord range
y.range <- c(0,1) # x-coord range
# Create matrix and set all entries to 0
heat.density.dat <- matrix(nrow=nrows,ncol=ncols)
heat.density.dat[is.na(heat.density.dat)] <- 0
# Subdivide the coordinate ranges to n+1 values so that i-1,i gives a segments start and stop coordinates
x.seg <- seq(from=min(x.range),to=max(x.range),length.out=ncols+1)
y.seg <- seq(from=min(y.range),to=max(y.range),length.out=nrows+1)
# List to hold found values
a <- list()
cnt <- 1
for( ri in 2:(nrows+1)){
for ( ci in 2:(ncols+1)){
# Get current segments, for example x.vals = [0.2, 0.3]
x.vals <- x.seg [c(ri-1,ri)]
y.vals <- y.seg [c(ci-1,ci)]
# Find which of the entries in the data.frame that has x or y coordinates in the current grid
x.inds <- which( ((df$x.pos >= min(x.vals)) & (df$x.pos <= max(x.vals)))==T )
y.inds <- which( ((df$y.pos >= min(y.vals)) & (df$y.pos <= max(y.vals)))==T )
# Find which entries has both x and y in current grid
inds <- which( x.inds %in% y.inds )
# If there's any such coordinates
if (length(inds) > 0){
# Append to list
a[[cnt]] <- data.frame("x.start"=min(x.vals), "x.stop"=max(x.vals),
"y.start"=min(y.vals), "y.stop"=max(y.vals),
"acc.heat"=sum(df$heat[inds],na.rm = T) )
# Increment counter variable
cnt <- cnt + 1
}
}
}
# Construct data.frame from list
heat.dens.df <- do.call(rbind,a)
# Plot again
ggplot(data=heat.dens.df,aes(x=x.start,y=y.start)) +
annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
geom_rect(data=heat.dens.df, aes(xmin=x.start, xmax=x.stop, ymin=y.start, ymax=y.stop, fill=acc.heat), alpha=0.5) +
scale_fill_gradientn(colours = rev( rainbow(3) )) +
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0))
Coordinate conversion from your data to my format can be done like:
sensor.data <- read.csv("~/Sample_Dataset.csv - Sample_Dataset.csv.csv")
# Create position -> coord conversion
pos.names <- names(sensor.data)[ grep("*Pos",names(sensor.data)) ] # Get column names with "Pos" in them
mock.coords <<- list()
lapply(pos.names, function(name){
# Create mocup coords between 0-1
mock.coords[[name]] <<- data.frame("x"=runif(1),"y"=runif(1))
})
# Change format of your data matrix
df.l <- list()
cnt <- 1
for (i in 1:nrow(sensor.data)){
for (j in 1:length(pos.names)){
name <- pos.names[j]
curr.coords <- mock.coords[[name]]
df.l[[cnt]] <- data.frame("x.pos"=curr.coords$x,
"y.pos"=curr.coords$x,
"heat" =sensor.data[i,j])
cnt <- cnt + 1
}
}
# Create matrix
df <- do.call(rbind, df.l)
I was making a survey in Qualtrics, and needed to have my items show different values of the slider depending on a variable, in my case, the value from a loop and merge. That didn't seem like a thing that you could do with piped text, so I had to figure out how to do it in Javascript.
I'm just posting this as an opportunity to provide the answer I found on my own. As usual with Qualtrics, your mileage may vary, and this may need to be modified for your specific situation. In particular, the question IDs and postTags change depending on whether it is in a loop/merge, and perhaps on other factors.
Put the following code into the javascript section of the question:
// Set the slider range
// First define the function to do it
setSliderRange = function (theQuestionInfo, maxValue) {
var postTag = theQuestionInfo.postTag
var QID=theQuestionInfo.QuestionID
// QID should be like "QID421"
// but postTag might be something like "5_QID421" sometimes
// or, it might not exist, so play around a bit.
var sliderName='CS_' + postTag
window[sliderName].maxValue=maxValue
// now do the ticks. first get the number of ticks by counting the table that contains them
var numTicks = document.getElementsByClassName('LabelDescriptionsContainer')[0].colSpan
// do the ticks one at a time
for (var i=1; i<=numTicks; i++) {
var tickHeader='header~' + QID + '~G' + i
// the first item of the table contains the minimum value, and also the first tick.
// so we do some tricks to separate them out in that case.
var tickSpanArray = $(tickHeader).down("span.TickContainer").children
var tickSpanArrayLength=tickSpanArray.length
var lastTickIndex=tickSpanArrayLength - 1
var currentTickValue = tickSpanArray[lastTickIndex].innerHTML
currentTickValue=currentTickValue.replace(/^\s+|\s+$/g,'')
console.log('Tick value ' + i + ' is ' + currentTickValue)
// now get the new value for the tick
console.log('maxValue: ' + maxValue + ' numTicks: ' + numTicks + ' i: ' + i)
var newTickValue = maxValue * i / numTicks //the total number of ticks
tickSpanArray[lastTickIndex].innerHTML=newTickValue.toString()
console.log('Changed tick value to ' + newTickValue)
}
}
var currentQuestionInfo = this.getQuestionInfo()
var currentQuestionID = currentQuestionInfo.QuestionID
// Now call the function
setSliderRange(currentQuestionInfo, theMaxValueYouWant)
If you find my answers helpful, help raise my reputation enough to add "qualtrics" as a valid tag!! Or, if someone else with reputation over 1500 is willing to do it that would be very helpful!
In rCharts, one can set JS callbacks of DataTables using a special string notation: #! function(par) {...} !#. For example, let's look into the following R code:
#JS callback to truncate long strings in table cells and add a tooltip
callback = "#!
function (nRow) {
$('td', nRow).each(function (index) {
var maxChars = 80;
var unfilteredText = $(this).text();
if (unfilteredText.length > maxChars && maxChars > 3) {
$(this).attr('title', unfilteredText);
$(this).html(unfilteredText.substring(0, maxChars-4) + '...');
}
});
return nRow;
} !#"
result <- dTable(df, aaSorting = list(c(5, "desc")), sPaginationType="full_numbers",
fnRowCallback=callback)
Is this possible in Shiny DataTables?
I just stumbled across this question and was able to use the information here, along with help from section 4.5 of this post to solve this problem. In order to get this to work, you would simply do the following:
library(DT)
long_strings = replicate(10, paste(sample(c(0:9, letters, LETTERS), 135, replace = TRUE), collapse = ""))
dat <- data.frame(x = 1:10,
y = month.abb[1:10],
z = long_strings,
stringsAsFactors = FALSE)
DT::datatable(dat,
options = list(
rowCallback = JS("function(row, data) {",
" var max_chars = 80, full_text = data[3];",
" if (full_text.length > max_chars) {",
" $('td:eq(3)', row).attr('title', full_text);",
" $('td:eq(3)', row).html(full_text.substring(0, max_chars - 4) + '...');",
" }",
"}")))
It's important to note that since we want this to operate on a per row basis, we use the rowCallback function inside of the options parameter. This is in contrast to the callback function that can be used on the entire table, which is its own parameter for DT::datatable.
Also take note of the fact that you don't have to call .text() or .innerHTML or anything of that sort on data[3]. The value that is returned is the text value of that cell.
Hopefully someone in the future stumbles across this and finds it beneficial.
I'm trying to render a Google Charts BarChart with the value labels on, or next to the bars. By default, the values are being shown when the user hovers over a bar. I would like to show these values permanently in the graph.
As far as I can see, this was possible using the Image Charts API, but not with the JavaScript API. I am missing something?
Why not add the values in the legend (its how i got around the same problem)
Where you are setting the name of each column add the value next to it.
For example keeping track of stock in a warehouse:
var sold = 300;
var missing = 7;
var reserved = 5;
var available = 143;
var data = google.visualization.arrayToDataTable([
[' Available (' + available + ')', 'Missing (' + missing+ ')', 'Reserved (' + reserved+ ')', 'Sold (' + sold+ ')'],
[available, missing, reserved, sold]
]);
Output:
Available (143)
Missing (7)
Reserved (5)
Sold (300)