Add Unique Links to all Data Points in Graph with rCharts - r

I'm using rCharts to create a scatterplot that displays ratings that I have calculated over time. I have more information for each individual data point (rating) and would like to have each data point on the graph link to a unique page with more information about that specific data point.
For example: I would like to be able to hover over the first data point on the graph and click on it to go to a specific page (http://www.example.com/info?id=1) that provides more information about that rating or data point. Each data point has a unique id and unique url that I would like to link to.
Here is the code that I am using to generate the graph
library(rCharts)
age <- c(1:20)
tall <- seq(0.5, 1.90, length = 20)
name <- paste(letters[1:20], 1:20, sep = "")
df <- data.frame(age = age, tall = tall, name = name)
n1 <- nPlot(age ~ tall ,data = df, type = "scatterChart")
n1$xAxis(axisLabel = "the age")
n1$yAxis(axisLabel = "the tall", width = 50)
n1$chart(tooltipContent = "#! function(key, x, y, e ){
var d = e.series.values[e.pointIndex];
return 'x: ' + x + ' y: ' + y + ' name: ' + d.name
} !#")
n1

This should definitely be considered a hack for now, but it works. Issues that we face here that cause us to require this hack are the draw function in the standard rCharts template does not offer us a place to add bits of code for nvd3, and the afterScript for nvd3 falls outside of our draw so is called before the chart is rendered. Also, the nvd3 tooltip is just html, but the problem with providing a link here to click is that mouseover is triggered and the tooltip disappears before we can click on it (fun trick but not useful). So, in this hack we will hijack the tooltip content function to also specify a click event function.
I tried to be clear with comments, but please let me know if none of this makes sense. I certainly do not make a career out of support :), so I have not built up that skill set.
library(rCharts)
age <- c(1:20)
tall <- seq(0.5, 1.90, length = 20)
name <- paste(letters[1:20], 1:20, sep = "")
#this next line is not entirely necessary if other data
#provides the part of the link address
#will also comment in the js piece below to show
#how to handle that
links <- paste0("http://example.com/",name)
df <- data.frame(age = age, tall = tall, name = name, links = links)
n1 <- nPlot(age ~ tall ,data = df, type = "scatterChart")
n1$xAxis(axisLabel = "the age")
n1$yAxis(axisLabel = "the tall", width = 50)
n1$chart(tooltipContent = "#! function(key, x, y, e ){
d3.selectAll('[class*=\"nv-path\"]').on('click',function(){
//uncomment debugger if you want to see what you have
//debugger;
window.open(d3.select(this).datum().data['point'][4].links,'_blank');
//as stated in the r code generating this
//the link address might be in the data that we already have
//window.open(
// 'http://example.com/' + d3.select(this).datum().data['point'][4].name,
// '_blank'
//);
})
//looks like the actual point is below the hover tooltip path
//if tooltips disabled we could do click on the actual points
//d3.selectAll('.nv-group circle').on('click',function(){
// debugger;
//})
var d = e.series.values[e.pointIndex];
return 'x: ' + x + ' y: ' + y + ' name: ' + d.name
} !#")
n1
I hope it helps.

Related

diagrammeR/GraphViz - justify node text if node text is multi-line substitution label

I am using substitution labels (##) with diagrammeR and Graphviz syntax. I have seen previous questions about justification of node labels such as this one when the labels are in-line text, but I am wondering how to justify node text generated from a multi-row substitution label. More specifically, for the label in the reproducible example below, I want the ‘main’ column, meaning the first and third rectangle labels, to remain centered, but multi-line node labels such as the rightmost rectangle to be left justified (the value as well as the subvalues). Since I specify line breaks in the substitution labels, I tried using double backslash \l instead of \n without success.
Additionally, I would like to bold the headers (in the reproducible example, the first value, second value, and third value rows), but not bold any subvalues.
Any help would be greatly appreciated. Thank you!
library(DiagrammeR)
library(DiagrammeRsvg)
a <- 100
x <- 50
b <- 30
d <- 20
grViz("
digraph a_nice_graph {
node[fontname = Helvetica, shape = box, width = 4, fontcolor = darkslategray]
firstvalue[label = '##1']
secondvalue[label = '##2']
thirdvalue[label = '##3']
blank[label = '', width = 0.01, height = 0.01]
{ rank = same; blank secondvalue }
firstvalue -> blank [dir = none]
blank -> secondvalue[minlen = 9]
blank -> thirdvalue
}
[1]: paste0('First value (n = ', a, ')')
[2]: paste0('Second value (n = ', a-x, ')\\nSubvalue = ', b, '\\nSubvalue = ', d, '')
[3]: paste0('Third value (n = ', x, ')')
")

Issue with the robin projection and contourf data with Basemap

I'm using the basemap library to display spatial information from Copernicus program.
The issue is i can not figure out how to project the data on the robin projection, but I do it correctly with the orthogonal projection.
So currently, I tried this :
plt.ioff()
# adapt for location of datasources
filePath = '../data/grib/download.grib'
# load data
grbs = grb.open(filePath)
grbs.seek(0)
data, lats, lons = (None, None, None)
dataUnit = None
title = None
for g in grbs:
data, lats, lons = g.data()
name = g.name
level = g.level
pressureUnit = g.pressureUnits
date = g.validDate
dataUnit = g.units
title = name + ' at ' + str(level) + ' ' + str(pressureUnit) + ' [' + str(date) + ']'
print(title)
break
# mapPlot = Basemap(projection='ortho', lat_0=0, lon_0=0)
mapPlot = Basemap(projection='robin', lat_0=0, lon_0=0, resolution='l')
mapPlot.drawcoastlines(linewidth=0.25)
x, y = mapPlot(lons, lats)
mapPlot.contourf(x, y, data)
mapPlot.colorbar(location='bottom', format='%.1f', label=dataUnit)
plt.title(title)
plt.show()
The orthogonal projection works correctly. But for the robin projection, I have an ... interesting pattern.
What I'm doing wrong ?
So i figure out how to do. I was misled but the first examples I saw.
Here is a my code:
import matplotlib
from mpl_toolkits.basemap import Basemap, shiftgrid
import matplotlib.pyplot as plt
import numpy as np
import pygrib as grb
# Get data
data = g['values']
lats = g['distinctLatitudes'] # 1D vector
lons = g['distinctLongitudes'] # 1D vector
# Useful information for late
name = g.name
level = str(g.level) + g.pressureUnits
date = g.validDate
dataUnit = g.units
# Parse the data
# Shit the data to start à -180. This is important to mark the data to start at -180°
data, lons = shiftgrid(180., data, lons, start=False) # shiftgrid
# Choose a representation (works with both)
# mapPlot = Basemap(projection='ortho', lat_0=0, lon_0=0)
mapPlot = Basemap(projection='robin', lat_0=0, lon_0=0)
mapPlot.drawcoastlines(linewidth=0.25)
# Convert the coordinates into the map projection
x, y = mapPlot(*np.meshgrid(lons, lats))
# Display data
map = mapPlot.contourf(x, y, data, levels=boundaries, cmap=plt.get_cmap('coolwarm'))
# Add what ever you want to your map.
mapPlot.nightshade(date, alpha=0.1)
# Legend
mapPlot.colorbar(map, label=dataUnit)
# Title
plt.title(name + ' at ' + str(level) + ' [' + str(date) + ']')
plt.show()
So it returns what I'm expecting.

Storing information during optim()

I have a general function I have provided an example below if simple linear regression:
x = 1:30
y = 0.7 * x + 32
Data = rnorm(30, mean = y, sd = 2.5);
lin = function(pars = c(grad,cons)) {
expec = pars[1] * x + pars[2];
SSE = sum((Data - expec)^2)
return(SSE)
}
start_vals = c(0.2,10)
lin(start_vals)
estimates = optim(par = start_vals, fn = lin);
## plot the data
Fit = estimates$par[1] * x + estimates$par[2]
plot(x,Data)
lines(x, Fit, col = "red")
So that's straight forward. What I want is to store the expectation for the last set of parameters, so that once I have finished optimizing I can view them. I have tried using a global container and trying to populating it if the function is executed but it doesn't work, e.g
Expectation = c();
lin = function(pars = c(grad,cons)) {
expec = pars[1] * x + pars[2];
Expectation = expec;
SSE = sum((Data - expec)^2)
return(SSE)
}
start_vals = c(0.2,10)
estimates = optim(par = start_vals, fn = lin);
Expectation ## print the expectation that would relate to estimates$par
I know that this is trivial to do outside of the function, but my actual problem (which is analogous to this) is much more complex. Basically I need to return internal information that can't be retrospectively calculated. Any help is much appreciated.
you should use <<- instead of = in your lin function, Expectation <<- expec,The operators <<- and ->> are normally only used in functions, and cause a search to be made through parent environments for an existing definition of the variable being assigned.

Legends on R Leaflet Maps

While I realize that putting legends on maps using the Rstudio leaflet package is still a work in progress, I've been trying to add a legend post-hoc to the HTML that R generates.
library("leaflet")
set.seed(100)
pdf <- data.frame(Latitude = runif(100, -90,90), Longitude = runif(100, -180,180),
col=rep(c("red", "blue"), 50 ))
#just red
leaflet(pdf) %>% addTiles() %>%
addCircleMarkers(lat = ~ Latitude, lng = ~ Longitude, color= ~col)
I've been trying to adapt the code from http://leafletjs.com/examples/choropleth.html and figure out where to add it to the output from running the above code in R and turning it into HTML.
So something like putting the following in the body of the html:
<script>
var legend = L.control({position: 'bottomright'});
legend.onAdd = function (map) {
var div = L.DomUtil.create('div', 'info legend'),
grades = [red, blue],
labels = [];
// loop through our density intervals and generate a label with a colored square for each label
for (var i = 0; i < grades.length; i++) {
div.innerHTML +=
'<i style="background:' + getColor(grades[i] + 1) + '"></i> ' +
grades[i] + (grades[i + 1] ? '–' + grades[i + 1] + '<br>' : '+');
}
return div;
};
legend.addTo(map);
<script>
This doesn't seem to work, however. Nothing pops up. Nor is it clear how I would use names other than 'red', and 'blue' for the grades, as it were. I've also added in CSS as shown in the choropleth example as well, but no dice.
Has anyone done this - manually added a legend to their R output (say, grabbing the source from Rpubs after publishing) to add a legend?
While this is not quite what I was looking for, it appears that an addLegend function is on its way, and is in one branch of the package. See some documentation and and an example here:
http://smartinsightsfromdata.github.io//2015/04/25/choropleths.html

R - upload current ggplot2 to imgur

The imguR package seems to be exactly what I want, but a scan of the docs makes it seem like it only uploads files. Can I upload the current plot device without outputting to a file? Specifically I'm interested in uploading plots created with ggplot2. Here is what I tried:
> token = imgur_login()
> ggplot(dstat, aes(x=obs,y=tcp)) + geom_line() + theme_bw()
> upload_image(token=token)
Error in file.exists(file) : argument "file" is missing, with no default
EDIT: I should add, I'm comfortable with a method that invisibly creates a file in the background then uploads it, this is just for quick showcasing of plots not for perfect presentation
EDIT: Here is the code I have created so far. It does not work well because there seems to be a cache used inside of account_albums that is not easily disabled. Any help finalizing this would be appreciated
get_or_create_album = function(token) {
# I can find no way to disable the cache inside
# account_albums - it always returns the first
# result unless you login again.
# So if this function creates the album, then
# the user must manually log out and log back in
# or this function will happily continue creating the album
albums = account_albums(ids=F,token=token)
albums = data.frame(t(sapply(albums,c)))
album = albums$id[albums$title == "R ggplot2"]
if (length(album) >= 1)
return(album[[1]])
album = create_album(title='R ggplot2',description='Automatic uploads from ggplot2',privacy='public', token=token)
return(album$id)
}
ggupload = function(token) {
albumID = get_or_create_album(token)
x = tempfile(fileext = '.pdf')
ggsave(filename=x)
p = last_plot()
title = ""
desc = ""
labels = names(p$labels)
if ("x" %in% labels && "y" %in% labels)
title = paste(p$labels$x,"vs",p$labels$y)
desc = title
if ("title" %in% labels)
title = p$labels$title
imgur_upload(file = x, album = albumID, title=title, description = desc, token = token)
}
This works as follows
> token = imgur_login()
> ggplot(dstat, aes(x=obs,y=tcp)) + geom_line() + theme_bw()
> ggupload(token)

Resources