forked from plotly/plotly.R
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathplotly.R
More file actions
234 lines (223 loc) · 8.75 KB
/
plotly.R
File metadata and controls
234 lines (223 loc) · 8.75 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
#' Main interface to plotly
#'
#' Plotly interface object. See up-to-date documentation and examples at
#' https://plot.ly/API
#'
#' @description
#' A call to \code{plotly(username, key)} creates an object of class
#' 'PlotlyClass', which has methods:
#' \itemize{
#' \item Plotting: py$plotly(x1, y1[, x2, y2, ...], kwargs=kwargs) or
#' py$plotly({data1[, data2, ...]}, kwargs=kwargs), py$ggplotly()
#' \item Styling Data: py$style(data1,data2,..., kwargs=kwargs)
#' \item Styling Layout: py$layout(layout, kwargs=kwargs)
#' \item Utilities: py$get_figure(file_owner, file_id)
#' }
#'
#' @import knitr
#' @import RJSONIO
#' @param username plotly username
#' @param key plotly API key
#' @param base_url plotly server
#'
#' @return An object of class PlotlyClass, except for the final object after
#' adding layers becomes a list class.
#' @details See documentation and examples at https://plot.ly/API
#' @references https://plot.ly/API
#' @author Chris Parmer chris@@plot.ly
#' @export
#' @examples \dontrun{
#' ## View https://plot.ly/API for more examples
#' ## Generate a simple plot
#' username <- 'anna.lyst' # fill in with your plotly username
#' api_key <- 'y37zkd' # fill in with your plotly API key
#' py <- plotly(username, api_key)
#' ## generate some data
#' x <- c(0, 1, 2)
#' y <- c(10, 11, 12)
#'
#' ## Send data to Plotly. Plotly will render an interactive graph and will
#' ## return a URL where you can view your plot
#' ## This call sends data to Plotly, Plotly renders an interactive
#' ## graph, and returns a URL where you can view your plot
#' response <- py$plot(x, y)
#' response$url # view your plot at this URL
#' browseURL(response$url) # use browseURL to go to the URL in your browser
#'
#' ## Export ggplots directly to plot.ly
#' ggiris <- qplot(Petal.Width, Sepal.Length, data=iris, color=Species)
#' py$ggplotly(ggiris)
#' data(canada.cities, package="maps")
#' viz <- ggplot(canada.cities, aes(long, lat)) +
#' borders(regions="canada", name="borders") +
#' coord_equal() +
#' geom_point(aes(text=name, size=pop), colour="red",
#' alpha=1/2, name="cities")
#' py$ggplotly(viz)
#' }
plotly <- function(username=NULL, key=NULL, base_url=NULL) {
if (is.null(username)) {
username <- get_credentials_file(c("username", "api_key"))$username
}
if (is.null(key)) {
key <- get_credentials_file(c("username", "api_key"))$api_key
}
if (is.null(username) || username == "" || is.null(key) || key == "") {
stop("Credentials Not Found!\n
It looks like you haven't set up your Plotly account credentials yet.\n
To get started, save your plotly username and API key by calling:\n
> set_credentials_file(UserName, ApiKey)\n
For more help, see https://plot.ly/R or contact <[email protected]>.")
}
# Plotly server
if (is.null(base_url)) {
base_url <- get_config_file("plotly_domain")$plotly_domain
}
if (is.null(base_url) || base_url == "") {
base_url <- "https://plot.ly"
}
# public attributes/methods that the user has access to
pub <- list(username=username, key=key, filename="from api", fileopt=NULL,
version="0.5.1")
priv <- list()
pub$makecall <- function(args, kwargs, origin) {
if (is.null(kwargs$filename))
kwargs$filename <- pub$filename
if (is.null(kwargs$fileopt))
kwargs$fileopt <- NULL
url <- paste(base_url, "/clientresp", sep="")
respst <- postForm(url, platform="R", version=pub$version,
args=toJSON(args, digits=50, collapse=""), un=pub$username,
key=pub$key, origin=origin,
kwargs=toJSON(kwargs, digits=50, collapse=""),
.opts=list(sslversion=1, # 1 is for TLSv1
cainfo=system.file("CurlSSL",
"cacert.pem",
package="RCurl")))
if (is.raw(respst)) {
respst <- rawToChar(respst)
}
resp <- fromJSON(respst, simplify = FALSE)
if (!is.null(resp$filename))
pub$filename <- resp$filename
if (!is.null(resp$error))
cat(resp$err)
if (!is.null(resp$warning))
cat(resp$warning)
if (!is.null(resp$message))
cat(resp$message)
return(resp)
}
priv$plotly_hook <- function(before, options, envir) {
if (!before) {
# set width and height from options or default square
w <- if(is.null(options[["width"]])) "600" else options[["width"]]
h <- if(is.null(options[["height"]])) "600" else options[["height"]]
paste("<iframe height=\"", h,
"\" id=\"igraph\" scrolling=\"no\" seamless=\"seamless\"\n\t\t\t\tsrc=\"",
options[["url"]], "\" width=\"", w,
"\" frameBorder=\"0\"></iframe>", sep="")
}
}
pub$plotly <- function(..., kwargs = list(filename = NULL, fileopt = NULL)) {
args <- list(...)
return(pub$makecall(args = args, kwargs = kwargs, origin = "plot"))
}
pub$ggplotly <- function(gg=last_plot(), kwargs=list(filename=NULL,
fileopt=NULL,
width=NULL,
height=NULL),
session="interactive") {
if(!is.ggplot(gg)){
stop("gg must be a ggplot")
}
pargs <- gg2list(gg)
if (!"auto_open" %in% names(kwargs)) {
kwargs <- c(kwargs, auto_open=TRUE)
}
pargs$kwargs <- c(pargs$kwargs, kwargs)
if (session == "interactive") { # we are on the command line
resp <- do.call(pub$plotly, pargs)
if (pargs$kwargs$auto_open) {
browseURL(resp$url)
}
invisible(list(data=pargs, response=resp))
} else if (session == "notebook") { # we are in the IR notebook
do.call(pub$irplot, pargs)
invisible(list(data=pargs))
} else if (session == "knitr") { # we are in knitr/RStudio
do.call(pub$iplot, pargs)
invisible(list(data=pargs))
} else {
stop("Value of session can be: 'interactive', 'notebook', or 'knitr'.")
}
}
pub$get_figure <- function(file_owner, file_id) {
headers <- c("plotly-username"=pub$username,
"plotly-apikey"=pub$key,
"plotly-version"=pub$version,
"plotly-platform"="R")
response_handler <- basicTextGatherer()
header_handler <- basicTextGatherer()
curlPerform(url=paste(base_url, "apigetfile", file_owner, file_id,
sep="/"),
httpheader=headers,
writefunction=response_handler$update,
headerfunction=header_handler$update)
resp_header <- as.list(parseHTTPHeader(header_handler$value()))
# Parse status
if (resp_header$status != "200") {
cat(resp_header$statusMsg)
stop(resp_header$status)
}
body_string <- response_handler$value()
resp <- RJSONIO::fromJSON(body_string)
if (!is.null(resp$error) && resp$error != "")
stop(resp$err)
if (!is.null(resp$warning) && resp$error != "")
cat(resp$warning)
if (!is.null(resp$message) && resp$error != "")
cat(resp$message)
resp$payload$figure
}
pub$iplot <- function(..., kwargs = list(filename = NULL, fileopt = NULL)) {
# Embed plotly graphs as iframes for knitr documents
r <- pub$plotly(..., kwargs = kwargs)
# bind url to the knitr options and pass into the plotly knitr hook
knit_hooks$set(plotly = function(before, options, envir) {
options[["url"]] <- r[["url"]]
priv$plotly_hook(before, options, envir)
})
}
pub$irplot <- function(..., kwargs=list(filename=NULL, fileopt=NULL,
width=NULL, height=NULL)) {
# Embed plotly graphs as iframes in IR notebooks
r <- pub$plotly(..., kwargs=kwargs)
w <- if (is.null(kwargs$width)) "100%" else kwargs$width
h <- if (is.null(kwargs$height)) "525" else kwargs$height
html <- paste("<iframe height=\"", h, "\" id=\"igraph\" scrolling=\"no\" seamless=\"seamless\"\n\t\t\t\tsrc=\"",
r$url, "\" width=\"", w, "\" frameBorder=\"0\"></iframe>", sep="")
require(IRdisplay)
display_html(html)
}
pub$embed <- function(url) {
# knitr hook
knit_hooks$set(plotly = function(before, options, envir) {
options[["url"]] <- url
priv$plotly_hook(before, options, envir)
})
}
pub$layout <- function(..., kwargs = list(filename = NULL, fileopt = NULL)) {
args <- list(...)
return(pub$makecall(args = args, kwargs = kwargs, origin = "layout"))
}
pub$style <- function(..., kwargs = list(filename = NULL, fileopt = NULL)) {
args <- list(...)
cat(kwargs)
return(pub$makecall(args = args, kwargs = kwargs, origin = "style"))
}
## wrap up the object
pub <- list2env(pub)
class(pub) <- "PlotlyClass"
return(pub)
}