How to change the axis title with rCharts, dPlot and dimple - r

How can I change the axis titles of a plot generated with rCharts and the dimple.js library? For example:
library(rCharts)
data(mtcars)
mtcars.df <- data.frame( car = rownames(mtcars), mtcars )
d1 <- dPlot(x ="disp", y="mpg", groups=c("car", "cyl"), type ="point", data=mtcars.df)
d1$xAxis( type = "addMeasureAxis")
d1
The desired effect is to replace the variable name "disp" with a more complete piece of text as the axis title. I've tried adding arguments to the d1$xAxis() line like title="Displacement" and label="Displacement: but without success.

Sorry I just saw this. Thanks John for answering.
With rCharts, we can take advantage of the afterScript template to add this. If there is only one chart in the DOM, we can use John's example unmodified.
d1$setTemplate(
afterScript =
'
d3.selectAll(".axis.title")
.text(function () {
var t = d3.select(this).text();
if (t === "disp") {
return "Displacement";
} else if (t === "mpg") {
return "Miles Per Gallon";
} else {
return t;
}
});
'
)
Please let me know if this you would like an example with multiple charts in the DOM or this does not work for you. Thanks.

Dimple doesn't currently expose the titles, however it's coming in the next release. Once it does I'm sure the great guys behind the dimple implementation in rcharts will add them into the library. I'm not quite sure how this works with an R implementation but if you can run some Javascript once the chart is rendered you can modify the titles using some raw d3:
d3.selectAll(".axis.title")
.text(function () {
var t = d3.select(this).text();
return (t === "disp" ? "Displacement" : t);
});
If you want to extend this to replace a couple of titles you can do it with:
d3.selectAll(".axis.title")
.text(function () {
var t = d3.select(this).text();
if (t === "disp") {
return "Displacement";
} else if (t === "mpg") {
return "Miles Per Gallon";
} else {
return t;
}
});
I hope this helps.

Here is another way:
# devtools::install_github("rCharts", "ramnathv", ref = "dev")
library(rCharts)
data(mtcars)
mtcars.df <- data.frame( car = rownames(mtcars), mtcars )
d1 <- dPlot(x ="disp", y="mpg", groups=c("car", "cyl"), type ="point", data=mtcars.df)
d1$xAxis( type = "addMeasureAxis")
d1
d1$setTemplate(afterScript = "
<script>
myChart.draw()
myChart.axes[0].titleShape.text('Displacement')
myChart.axes[1].titleShape.text('Miles Per Gallon')
myChart.svg.append('text')
.attr('x', 40)
.attr('y', 20)
.text('Plot of Miles Per Gallon / Displacement')
.style('text-anchor','beginning')
.style('font-size', '100%')
.style('font-family','sans-serif')
</script>
")
d1
Screenshot:
Hat tip to Ramnath: R: interactive plots (tooltips): rCharts dimple plot: formatting axis

Related

Sift through each row in a dataframe and manually classify it

Can someone recommend an efficient way to sift through each row in a dataframe and manually classify it? For example I might be wanting to separate spam from e-mail, or shortlist job adverts, job applicants, or dating agency profiles (I understand Tinder does this by getting you to swipe left or right).
My dataset is small enough to classify manually. I suppose if it was larger I might only want to manually classify a portion of it in order to train a machine-learning algorithm such as Naive Bayes to finish the task for me.
I'll show you what I've got at the moment, but this isn't a particularly original task, so there must be a less crude way to do this that someone has already thought of! (As a newcomer, I'm impressed by the power of R, but also nonplussed when little tasks like clearing the screen or capturing a keystroke turn out to be non-trivial)
# Let us suppose I am using this built-in dataset to draw up a
# shortlist of where I might wish to go on holiday
df <- data.frame(state.x77);
# pp - define a task-specific pretty print function
pp <- function(row) {
print(row); # Example dataset is simple enough to just print the entire row
}
# cls - clear the screen (this hack works on Windows but I've commented it for now)
cls <- function() {
#system("powershell -ExecutionPolicy Bypass -command (New-Object -ComObject Wscript.Shell).SendKeys([string][char]12)");
}
# It would halve the number of keystrokes needed if I knew a way to read
# a single character
readcharacter <- readline;
sift <- function(df, pp)
{
classification = rep('', nrow(df));
for (nRow in 1:nrow(df))
{
cls();
pp(df[nRow,]);
cat("\nEnter 'a' to discard, 'd' to keep, 'q' to quit\n");
char <- '';
while (char != 'a' && char != 'd' && char != 'q') {
char <- readcharacter();
}
if (char == 'q')
break;
classification[nRow] = char;
}
return(cbind(df,classification=classification));
}
result = sift(df, pp);
cls();
cat("Shortlist:\n");
print(row.names(result[result$classification=='d',]));
So how does the StackOverflow community feel about me using this Shiny app to solve my problem? I wouldn't expect to see Shiny used in this early part of data analysis - normally it only comes into play once we have some results we'd like to explore or present dynamically.
Learning Shiny was fun and useful, but I'd much prefer it if a less complicated answer could be found.
library(shiny);
#
# shortlist - function that allows us to shortlist through the rows in a data frame efficiently
#
shortlist <- function(df, sTitle, sRowName) {
createUI <- function() {
listHeading <- list(
textOutput(outputId = "Progress"),
tags$br(),
fluidRow(
column(width=1, sRowName),
column(width=9, textOutput(outputId = "RowName"))));
listFields <- lapply(names(df), function(sFieldname) {
return(fluidRow(
column(width=1, sFieldname),
column(width=9, textOutput(outputId = sFieldname))));
});
listInputs <- list(
tags$br(),
tags$table(
tags$tr(
tags$td(" "),
tags$td(actionButton(inputId="Up", label="W", disabled=TRUE, width="100%"))),
tags$tr(
tags$td(width="100px", actionButton(inputId="Discard", label="Discard, A", width="100%")),
tags$td(width="100px", actionButton(inputId="Down", label="S", disabled=TRUE, width="100%")),
tags$td(width="100px", actionButton(inputId="Keep", label="Keep, D", width="100%")))),
tags$script("
// JavaScript implemented keyboard shortcuts, including lots of conditions to
// ensure we're finished processing one keystroke before we start the next.
var bReady = false;
$(document).on('shiny:recalculating', function(event) {
bReady = false;
});
$(document).on('shiny:recalculated', function(event) {
setTimeout(function() {bReady = true;}, 500);
});
$(document).on('keypress', function(event) {
if (bReady) {
switch(event.key.toLowerCase()) {
case 'a':
document.getElementById('Discard').click();
bReady = false;
break;
case 'd':
document.getElementById('Keep').click();
bReady = false;
break;
}
}
});
// End of JavaScript
"));
listPanel <- list(
title = sTitle,
tags$br(),
conditionalPanel(
condition = paste("input.Keep + input.Discard <", nrow(df)),
append(append(listHeading, listFields), listInputs)));
listShortlist <- list(
tags$hr(),
tags$h4("Shortlist:"),
dataTableOutput(outputId="Shortlist"));
ui <- do.call(fluidPage, append(listPanel, listShortlist));
return(ui);
}
app <- shinyApp(ui = createUI(), server = function(input, output) {
classification <- rep('', nrow(df));
getRow <- reactive({
return (input$Keep + input$Discard + 1);
});
classifyRow <- function(nRow, char) {
if (nRow <= nrow(df)) {
classification[nRow] <<- char;
}
# In interactive mode, automatically stop the app when we're finished
if ( interactive() && nRow >= nrow(df) ) {
stopApp(classification);
}
}
observeEvent(input$Discard, {classifyRow(getRow() - 1, 'a')});
observeEvent(input$Keep, {classifyRow(getRow() - 1, 'd')});
output$Progress = renderText({paste("Showing record", getRow(), "of", nrow(df))});
output$RowName = renderText({row.names(df)[getRow()]});
lapply(names(df), function(sFieldname) {
output[[sFieldname]] <- renderText({df[getRow(), sFieldname]});
});
output$Shortlist <- renderDataTable(options = list(paging = FALSE, searching = FALSE), {
# Mention the 'keep' input to ensure this code is called when the 'keep' button
# is pressed. That way the shortlist gets updated when an item to be added to it.
dummy <- input$Keep;
# Construct the shortlist
shortlist <- data.frame(row.names(df[classification == 'd',]));
colnames(shortlist) <- sRowName;
return(shortlist);
});
});
if (interactive()) {
classification <- runApp(app);
return(cbind(df, classification = classification));
} else {
return(app);
}
}
#
# And now some example code.
# Shortlist the built in state.x77 data set (let us suppose I am drawing up
# a shortlist of where I might wish to go on holiday)
#
df <- data.frame(state.x77);
result <- shortlist(df = df, "Choose states", "State");
if (interactive()) {
cat("Shortlist:\n");
print(row.names(result[result$classification == 'd',]));
} else {
return (result);
}

chart_Series does not plot when called in function with condition that evaluates to FALSE

I am begginer with R so maybe I am missing some concept about functions. But here is my example and I am interested why it works like that?
require(quantmod);
myPlot = function(ts, addAdx = TRUE) {
chart_Series(ts);
if (addAdx) {
add_TA(ADX(HLC(ts))$ADX)
}
}
getSymbols("DIA", src='yahoo');
myPlot(DIA, addAdx = FALSE)
If I set addAdx parameter to false then my function does not plot the chart (otherwise its fine). Why is that?
If you don't use return the R functions return the latest computed value.
If addAdx is set to FALSE the function returns a void.
This code solve your problem:
myPlot = function(ts, addAdx = TRUE) {
p <- chart_Series(ts);
if (addAdx) {
p <- add_TA(ADX(HLC(ts))$ADX)
}
p #return(p)
}
I'm not sure why this happens, but here's the fix. Put chart_Series twice in the function, when addAdx is TRUE and FALSE.
myPlot = function(ts, addAdx = TRUE) {
if (addAdx) {
chart_Series(ts)
add_TA(ADX(HLC(ts))$ADX)
} else {
chart_Series(ts)
}
}
getSymbols("DIA", src='yahoo');
myPlot(DIA, addAdx = FALSE)
myPlot(DIA, addAdx = TRUE)

Define function in leaflet cluster options

How do I custom the cluster options so that the markers aren't clustered by the default Leaflet markerOptions(count of markers), but by a function (mean, maximum or whatelse) that I choose?
For Java i could find tons of examples, but for R I couldn't find anything.
Only thing I could find is something that has to do with
"iconCreateFunction" and "JS()", but I don't know if it's right and how it works..
leaflet(data) %>%
addTiles() %>%
addMarkers(lng=data$lon, lat=data$lat, clusterOptions = list(iconCreateFunction = JS(...
Can somebody help me? Thanks in advance
Replying to old question however some users still may find this useful.
You need to pass custom iconCreateFunction javascript formula to markerClusterOptions()
The main challenge is how you pass data to the markers so that you can apply a formula to data which are in the cluster of markers. I have tried to read the javascript code which is on the example website, but since I don't know js I could only find a workaround.
Example website: http://leaflet.github.io/Leaflet.markercluster/example/marker-clustering-custom.html
The user is adding data into marker[i].number in populate() function.
If anyone knows how this work please add your solution which I assume will be better than what I currently use.
My workaround is to store data into addMarkers(... , title=myData, ...) or addCircleMarkers(... , weight=myData , ...)
library(leaflet)
# sample data to pass to markers
myData <- sample(x=1:1000, size=1000, replace=TRUE)
# add some NaN which may occur in real data
myData[sample(x=1:1000, size=100, replace=FALSE)] <- NaN
circle.colors <- sample(x=c("red","green","gold"),size=1000,replace=TRUE)
avg.formula =
"function (cluster) {
var markers = cluster.getAllChildMarkers();
var sum = 0;
var count = 0;
var avg = 0;
var mFormat = ' marker-cluster-';
for (var i = 0; i < markers.length; i++) {
if(markers[i].options.weight != undefined){
sum += markers[i].options.weight;
count += 1;
}
}
avg = Math.round(sum/count);
if(avg<333) {mFormat+='small'} else if (avg>667){mFormat+='large'}else{mFormat+='medium'};
return L.divIcon({ html: '<div><span>' + avg + '</span></div>', className: 'marker-cluster'+mFormat, iconSize: L.point(40, 40) });
}"
# in the above we loop through every marker in cluster access the options.weight
# which is our data, if data is not undefined (not NA or NaN) then we sum data
# and count occurrence
# at the end of code we check if average is more/less to assign default
# marker icons marker-cluster-small marker-cluster-medium marker-cluster-large
# for green yellow red respectively
# stroke = FALSE is a must if you store data in weights !!!
leaflet(quakes) %>% addTiles() %>%
addCircleMarkers(lng=~long,lat=~lat,radius=10,stroke=FALSE,fillOpacity=0.9,
fillColor = circle.colors,weight=myData,
popup=as.character(myData),
clusterOptions = markerClusterOptions(iconCreateFunction=JS(avg.formula)))
for any other custom formula you need to adjust
for (var i = 0; i < markers.length; i++) {
if(markers[i].options.weight != undefined){
sum += markers[i].options.weight;
count += 1;
}
}
Kind regards,
Peter

Change line type in rCharts NVD3 (nPlot)

I would like to have both solid and dashed lines for different levels of a factor (grouping variable) in a plot created with nPlot. Any suggestions?
library(reshape2)
library(ggplot2)
library(rCharts)
ecm <- reshape2::melt(economics[,c('date', 'uempmed', 'psavert')], id = 'date')
p7 <- nPlot(value ~ date, group = 'variable', data = ecm, type = 'lineWithFocusChart')
Final result:
uempmed (solid line) and psavert (dashed line)
Another option could be to change the thickness of the lines instead.
Unfortunately nvd3 has stagnated. This is a great example where a pull request that would allow the ability to specify thickness and dashed styling for lines sits unpulled.
Here is the difficult way to potentially solve your problem. We will need to modify the standard rCharts script template to add a callback function for the line styling. See here for a rCharts demo and a live code example.
options(viewer=NULL)
library(reshape2)
library(ggplot2)
library(rCharts)
ecm <- reshape2::melt(economics[,c('date', 'uempmed', 'psavert')], id = 'date')
p7 <- nPlot(value ~ date, group = 'variable', data = ecm, type = 'lineWithFocusChart')
#grab template from
#https://github.com/ramnathv/rCharts/blob/master/inst/libraries/nvd3/layouts/chart.html
#modify to add callback on graph render
p7$setTemplate(script = sprintf("
<script type='text/javascript'>
$(document).ready(function(){
draw{{chartId}}()
});
function draw{{chartId}}(){
var opts = {{{ opts }}},
data = {{{ data }}}
if(!(opts.type==='pieChart' || opts.type==='sparklinePlus' || opts.type==='bulletChart')) {
var data = d3.nest()
.key(function(d){
//return opts.group === undefined ? 'main' : d[opts.group]
//instead of main would think a better default is opts.x
return opts.group === undefined ? opts.y : d[opts.group];
})
.entries(data);
}
if (opts.disabled != undefined){
data.map(function(d, i){
d.disabled = opts.disabled[i]
})
}
nv.addGraph(function() {
var chart = nv.models[opts.type]()
.width(opts.width)
.height(opts.height)
if (opts.type != 'bulletChart'){
chart
.x(function(d) { return d[opts.x] })
.y(function(d) { return d[opts.y] })
}
{{{ chart }}}
{{{ xAxis }}}
{{{ x2Axis }}}
{{{ yAxis }}}
//on legend click, line might be deleted
//when redrawn we need to make dashed again
chart.legend.dispatch.on('legendClick', dashedAfterLegend )
function dashedAfterLegend(){
//to make dashed we need to make sure it is drawn first
//not a js expert so might not be best way to handle
window.setTimeout(function dashedDelay(){
makeDashed(opts)
} , 400)
}
d3.select('#' + opts.id)
.append('svg')
.datum(data)
.transition().duration(500)
.call(chart);
nv.utils.windowResize(chart.update);
return chart;
},%s);
};
%s
</script>
"
,
#here is where you can type your line styling function
"function(){ makeDashed( opts ) } "
# here is the part that was in afterScript but moved to work with shiny
#see this article for help on dashed d3 lines
#http://www.d3noob.org/2013/01/making-dashed-line-in-d3js.html
,"
function makeDashed( opts ){
// select all the lines with d3 both main plot and focus
// see this article for help on dashed d3 lines
// http://www.d3noob.org/2013/01/making-dashed-line-in-d3js.html
d3.select('#' + opts.id).selectAll('.nv-linesWrap .nv-group')
.filter(function(g){return g.key== 'psavert'})
.selectAll('.nv-line')
.style('stroke-dasharray', ('3, 3'))
}
"
))
p7
I understand that this is a lot of Javascript to ask of a R user, so please let me know if any of this does not make sense.
var dasheddesign=['10,20','5,5' ,'30,30','20,10,5,5,5,10'];
d3.select('#chart1 svg')
.datum(data)
.call(chart)
.call(function(){
d3.select('#chart1')
.selectAll('.nv-line').each(function( d,i ){
d3.select(this).attr("stroke-dasharray",dasheddesign[i]);
});
});
No delay required
This works fine, but thy to Hide and then Unhide series from legend. dash style is gone :(

Simple flot graph not updating

I'm trying to create a simple flot line graph and update it on a timer and I only want to display the last 10 points of data. But I only ever see the axis and not the graph plot. Also, I see the x axis change with the extra data but the y axis remain the same and do not correspond to the additional data. My code is as following:
var dataSet = [];
var PlotData;
var x = 0;
var y = 0;
var plot = null;
function EveryOneSec()
{
if (dataSet.length == 10)
{
dataSet.shift();
}
x++;
y += 2;
dataSet("[" + x + ", " + y + "]");
PlotData = { label: "line 1", data: [ dataSet ], color: "green" };
if (plot == null)
{
plot = $.plot($("#placeholder"), [ PlotData ], { lines: {show: true}, points: {show: true}});
}
else
{
plot.setData([ PlotData ]);
plot.setupGrid();
plot.draw();
}
setTimeout(EveryOneSec, 1000);
}
I have tried with and without the call to setupGrid() but this makes no difference to the axis display or graph plot. The x axis stop changing when I get the ticks 0 to 9 plotted even though x is incrementing past that, and the y axis remains static. I believe the code is correct above in terms of passing arrays of data, so why is the graph not appearing?
OK, you have two problems here.
First, you're not appending to your dataSet correctly. I'm not sure what the syntax you've got is doing, but what you need in each slot of the array is [x,y], which you can achieve with Array.push.
This:
dataSet("[" + x + ", " + y + "]");
Should look like this:
dataSet.push([x , y]);
And when you create your series object PlotData, you don't need to store your data inside of another array, so instead of this:
PlotData = { label: "line 1", data: [ dataSet ], color: "green" };
You need this:
PlotData = { label: "line 1", data: dataSet , color: "green" };
See it working here: http://jsfiddle.net/ryleyb/qJEXH/

Resources