Nothing
#' Class providing object with methods for communication with lightning-viz server
#'
#' @docType class
#' @importFrom R6 R6Class
#' @importFrom RCurl postForm
#' @importFrom RJSONIO fromJSON toJSON
#' @importFrom httr POST
#' @export
#' @keywords data
#' @return Object of \code{\link{R6Class}} with methods for communication with lightning-viz server.
#' @format \code{\link{R6Class}} object.
#' @examples
#' Lightning$new("http://localhost:3000/")
#' Lightning$new("http://your-lightning.herokuapp.com/")
#' @field serveraddress Stores address of your lightning server.
#' @field sessionid Stores id of your current session on the server.
#' @field url Stores url of the last visualization created by this object.
#' @field autoopen Checks if the server is automatically opening the visualizations.
#' @field notebook Checks if the server is in the jupyter notebook mode.
#' #' @section Methods:
#' \describe{
#' \item{Documentation}{For full documentation of each method go to https://github.com/lightning-viz/lightining-r/}
#' \item{\code{new(serveraddress)}}{This method is used to create object of this class with \code{serveraddress} as address of the server object is connecting to.}
#'
#' \item{\code{sethost(serveraddress)}}{This method changes server that you are contacting with to \code{serveraddress}.}
#' \item{\code{createsession(sessionname = "")}}{This method creates new session on the server with optionally given name in \code{sessionname}.}
#' \item{\code{usesession(sessionid)}}{This method changes currently used session on the server to the one with id given in \code{sessionid} parameter.}
#' \item{\code{openviz(vizid = NA)}}{This method by default opens most recently created by this object visualization. If \code{vizid} parameter is given, it opens a visualization with given id instead.}
#' \item{\code{enableautoopening()}}{This method enables auto opening of every visualisation that you create since that moment. Disabled by default.}
#' \item{\code{disableautoopening()}}{This method disables auto opening of every visualisation that you create since that moment. Disabled by default.}
#' \item{\code{line(series, index = NA, color = NA, label = NA, size = NA, xaxis = NA, yaxis = NA, logScaleX = "false", logScaleY = "false")}}{This method creates a line visualization for vector/matrix with each row representing a line, given in \code{series}.}
#' \item{\code{scatter(x, y, color = NA, label = NA, size = NA, alpha = NA, xaxis = NA, yaxis = NA)}}{This method creates a scatterplot for points with coordinates given in vectors \code{x, y}.}
#' \item{\code{linestacked(series, color = NA, label = NA, size = NA)}}{This method creates a plot of multiple lines given in matrix \code{series}, with an ability to hide and show every one of them.}
#' \item{\code{force(matrix, color = NA, label = NA, size = NA)}}{This method creates a force plot for matrix given in \code{matrix}.}
#' \item{\code{graph(x, y, matrix, color = NA, label = NA, size = NA)}}{This method creates a graph of points with coordinates given in \code{x, y} vectors, with connection given in \code{matrix} connectivity matrix.}
#' \item{\code{map(regions, weights, colormap)}}{This method creates a world (or USA) map, marking regions given as a vector of abbreviations (3-char for countries, 2-char for states) in \code{regions} with weights given in \code{weights} vector and with \code{colormap} color (string from colorbrewer).}
#' \item{\code{graphbundled(x, y, matrix, color = NA, label = NA, size = NA)}}{This method creates a bundled graph of points with coordinates given in \code{x, y} vectors, with connection given in \code{matrix} connectivity matrix. Lines on this graph are stacked a bit more than in the \code{graph} function.}
#' \item{\code{matrix(matrix, colormap)}}{This method creates a visualization of matrix given in \code{matrix} parameter, with its contents used as weights for the colormap given in \code{colormap} (string from colorbrewer).}
#' \item{\code{adjacency(matrix, label = NA)}}{This method creates a visualization for adjacency matrix given in \code{matrix} parameter.}
#' \item{\code{scatterline(x, y, t, color = NA, label = NA, size = NA)}}{This method creates a scatterplot for coordinates in vectors \code{x, y} and assignes a line plot to every point on that plot. Each line is given as a row in \code{t} matrix.}
#' \item{\code{scatter3(x, y, z, color = NA, label = NA, size = NA, alpha = NA)}}{This method creates a 3D scatterplot for coordinates given in vectors \code{x, y, z}.}
#' \item{\code{image(imgpath)}}{This method uploads image from file \code{imgpath} to the server and creates a visualisation of it.}
#' \item{\code{gallery(imgpathvector)}}{This method uploads images from vector of file paths \code{imgpathvector} to the server and creates a gallery of these images.}}
Lightning <- R6Class("Lightning",
public = list(
serveraddress = NA,
sessionid = NA,
notebook = NA,
url = NA,
autoopen = FALSE,
initialize = function(serveraddress, notebook = F) {
if(!missing(serveraddress)){
self$serveraddress <- serveraddress
}
self$notebook = notebook
},
line = function(series, index = NA, color = NA, label = NA, size = NA, xaxis = NA, yaxis = NA, logScaleX = "false", logScaleY = "false") {
listbuilder <- list(type = "line", options = list(logScaleX = logScaleX, logScaleY = logScaleY))
features <- list(series = series)
if (!is.na(index)) {
features$index <- index
}
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
if (!is.na(xaxis)) {
features$xaxis <- xaxis
}
if (!is.na(yaxis)) {
features$yaxis <- yaxis
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "")
oldbody = "placeholder"
while (!(jsonbody == oldbody)) {
oldbody <- jsonbody
jsonbody <- gsub(", ,", ",", jsonbody)
}
jsonbody <- gsub(", ]", " ]", jsonbody)
jsonbody <- gsub('[ ,', '[', jsonbody, fixed = TRUE)
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
scatter = function(x, y, color = NA, label = NA, size = NA, alpha = NA, xaxis = NA, yaxis = NA){
listbuilder <- list(type = "scatter", options = list())
points <- matrix(ncol = 2, nrow = length(x))
points[,1] <- x
points[,2] <- y
features <- list(points = points)
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
if (!is.na(alpha)) {
features$alpha <- alpha
}
if (!is.na(xaxis)) {
features$xaxis <- xaxis
}
if (!is.na(yaxis)) {
features$yaxis <- yaxis
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
if (self$autoopen) {
browseURL(url)
}
self$url <- url
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
linestacked = function(series, color = NA, label = NA, size = NA){
listbuilder <- list(type = "line-stacked", options = list())
features <- list(series = series)
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "")
oldbody = "placeholder"
while (!(jsonbody == oldbody)) {
oldbody <- jsonbody
jsonbody <- gsub(", ,", ",", jsonbody)
}
jsonbody <- gsub(", ]", " ]", jsonbody)
jsonbody <- gsub('[ ,', '[', jsonbody, fixed = TRUE)
jsonbody <- gsub('"options"', "{}", jsonbody)
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
force = function(matrix, color = NA, label = NA, size = NA){
##matrix- connectivity matrix n by n, where value is the weight of the edge
listbuilder <- list(type = "force", options = list())
nodes <- vector(mode = "numeric", length = nrow(matrix))
for (i in 0:(length(nodes)-1)) {
nodes[i] <- i
}
features <- list(nodes = nodes)
##convert matrix to links
links <- matrix(ncol = 3, byrow = TRUE)
for (i in 1:ncol(matrix)) {
for (j in 1:nrow(matrix)) {
if (!(matrix[i,j] == 0)) {
links <- rbind(links, c((i-1), (j-1), (matrix[i,j])))
}
}
}
links <- links[-1,]
features$links <- links
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
graph = function(x, y, matrix, color = NA, label = NA, size = NA) {
listbuilder <- list(type = "graph", options = list())
points <- matrix(ncol = 2, nrow = length(x))
points[,1] <- x
points[,2] <- y
features <- list(nodes = points)
links <- matrix(ncol = 3, byrow = TRUE)
for (i in 1:ncol(matrix)) {
for (j in 1:nrow(matrix)) {
if (!(matrix[i,j] == 0)) {
links <- rbind(links, c((i-1), (j-1), (matrix[i,j])))
}
}
}
links <- links[-1,]
features$links <- links
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
map = function(regions, weights, colormap) {
listbuilder <- list(type = "map", options = list())
features = list(regions = regions, values = weights, colormap = colormap)
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
graphbundled = function(x, y, matrix, color = NA, label = NA, size = NA){
listbuilder <- list(type = "graph-bundled", options = list())
points <- matrix(ncol = 2, nrow = length(x))
points[,1] <- x
points[,2] <- y
features <- list(nodes = points)
links <- matrix(ncol = 3, byrow = TRUE)
for (i in 1:ncol(matrix)) {
for (j in 1:nrow(matrix)) {
if (!(matrix[i,j] == 0)) {
links <- rbind(links, c((i-1), (j-1), (matrix[i,j])))
}
}
}
links <- links[-1,]
features$links <- links
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
matrix = function(matrix, colormap){
listbuilder <- list(type = "matrix", options = list())
features = list(matrix = matrix, colormap = colormap)
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
return(list(url = url, id = response$id))
},
adjacency = function (matrix, label = NA) {
listbuilder <- list(type = "adjacency", options = list())
nodes <- c(0:(nrow(matrix) - 1))
links <- matrix(ncol = 3, byrow = TRUE)
for (i in 1:ncol(matrix)) {
for (j in 1:nrow(matrix)) {
if (!(matrix[i,j] == 0)) {
links <- rbind(links, c((i-1), (j-1), (matrix[i,j])))
}
}
}
links <- links[-1,]
features <- list(links = links, nodes = nodes)
if (!is.na(label)) {
features$label <- label
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
scatterline = function(x, y, t, color = NA, label = NA, size = NA){
listbuilder <- list(type = "scatter-line", options=list())
points <- matrix(ncol = 2, nrow = length(x))
points[,1] <- x
points[,2] <- y
features <- list(points = points, series = t)
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "")
oldbody = "placeholder"
while (!(jsonbody == oldbody)) {
oldbody <- jsonbody
jsonbody <- gsub(", ,", ",", jsonbody)
}
jsonbody <- gsub(", ]", " ]", jsonbody)
jsonbody <- gsub('[ ,', '[', jsonbody, fixed = TRUE)
jsonbody <- gsub('"options"', "{}", jsonbody)
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
scatter3 = function(x, y, z, color = NA, label = NA, size = NA, alpha = NA) {
listbuilder <- list(type = "scatter-3", options=list())
points <- matrix(ncol = 3, nrow = length(x))
points[,1] <- x
points[,2] <- y
points[,3] <- z
features <- list(points = points)
if (!is.na(color)) {
features$color <- color
}
if (!is.na(label)) {
features$label <- label
}
if (!is.na(size)) {
features$size <- size
}
if (!is.na(alpha)) {
features$alpha <- alpha
}
listbuilder$data <- features
if(self$notebook) {
listbuilder$options$width = 600
}
jsonbody <- toJSON(listbuilder, .na = "{}")
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
image = function(imgpath) {
body = list(file = upload_file(imgpath), type = "image", options = list())
if(self$notebook) {
body$options$width = 600
}
rawresponse <- POST(url = paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""), encode = 'multipart', body = body)
jsonstring <- rawToChar(rawresponse$content)
response <- fromJSON(jsonstring)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
gallery = function(imgpathvector) {
firstpath <- imgpathvector[1]
otherpaths <- imgpathvector[-1]
body = list(file = upload_file(firstpath), type = "gallery", options = list())
if(self$notebook) {
body$options$width = 600
}
rawresponse <- POST(url = paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", sep=""), encode = 'multipart', body = body)
jsonstring <- rawToChar(rawresponse$content)
response <- fromJSON(jsonstring)
url <- paste(self$serveraddress, "visualizations/", response$id, "/", sep="")
self$url <- url
for (var in otherpaths) {
POST(url = paste(self$serveraddress, "sessions/", self$sessionid, "/visualizations/", response$id, "/data/images/", sep=""), encode = 'multipart', body = list(file = upload_file(var), type = "image"))
}
if (self$autoopen) {
browseURL(url)
}
if(self$notebook) {
return(display_html(getURLContent(paste(url, "embed/", sep=""))))
}
return(list(url = url, id = response$id))
},
createsession = function(sessionname = ""){
jsonbody <- toJSON(list(name=sessionname))
httpheader<- c(Accept = "text/plain", "Content-Type" = "application/json")
response = postForm(paste(self$serveraddress, "sessions/", sep=""),
.opts = list(httpheader = httpheader, postfields=jsonbody))
response = fromJSON(response)
self$sessionid <- response["id"]
return(response)
},
usesession = function(sessionid){
self$sessionid <- sessionid
},
sethost = function(serveraddress){
self$url <- NA
self$sessionid <- NA
self$serveraddress <- serveraddress
},
enableautoopening = function(){
self$autoopen <- TRUE
},
disableautoopening = function(){
self$autoopen <- FALSE
},
openviz = function(vizid = NA){
if (is.na(vizid)) {
if (is.na(self$url)) {
print("No vizualisation to show")
} else{
browseURL(self$url)
}
} else{
url <- paste(self$serveraddress, "visualizations/", vizid, "/", sep="")
browseURL(url)
}
}
)
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.