install.packages("shiny"); library(shiny) = install/load shiny packageui.R - controls appearance/all style elements
www directory with an index.html file enclosed can be used instead of ui.R
shiny-text-output, shiny-plot-output, or shiny-html-output) server.R - controls functionsrunApp() executes the Shiny application
runApp(display.mode = 'showcase') = displays the code from ui.R and server.R and highlights what is being executed depending on the inputs"," must be included ONLY INBETWEEN objects/functions on the same level library(shiny) = first line, loads the shiny packageshinyUI() = shiny UI wrapper, contains sub-methods to create panels/parts/viewable objectpageWithSideBar() = creates page with main/side bar divisionheaderPanel("title") = specifies header of the pagesideBarPanel() = specifies parameters/objects in the side bar (on the left)mainPanel() = specifies parameters/objects in the main panel (on the right)shinyUI(fluidpage()) (tutorial) <– produces responsive web pages
fluidRow() = creates row of content with width 12 that can be subdivided into columns
column(4, ...) = creates a column of width 4 within the fluid rowstyle = "CSS" = can be used as the last element of the column to specify additional styleabsolutePanel(top=0, left=0, right=0) = used to produce floating panels on top of the page (documentation)
fixed = TRUE = panel will not scroll with page, which means the panel will always stay in the same position as you scroll through the pagedraggable = TRUE = make panel movable by the usertop = 40 / bottom = 50 = position from the top/bottom edge of the browser window
top = 0, bottom = 0 = creates panel that spans the entire vertical length of windowleft = 40 / right = 50 = position from the left/right edge of the browser window
top = 0, bottom = 0 = creates panel that spans the entire horizontal length of windowheight = 30 / width = 40 = specifies the height/width of the panelstyle = "opacity:0.92; z-index = 100" = makes panel transparent and ensures the panel is always the top-most elementh1/2/3/4('heading') = creates heading for the panelp('pargraph') = creates regular text/paragraphcode('code') = renders code format on the pagebr() = inserts line breaktags$hr() = inserts horizontal linetags$ol()/ tags$ul() = initiates ordered/unordered listdiv( ... , style = "CSS Code") / span( ... , style = "CSS Code") = used to add additional style to particular parts of the app
div should be used for a section/block, span should be used for a specific part/inlinewithMathJax() = add this element to allow Shiny to process LaTeX
\\(LaTeX\\)$$LaTeX$$textInput(inputId = "id", label = "textLabel") = creates a plain text input field
inputId = field identifierlabel = text that appear above/before a fieldnumericInput('HTMLlabel', 'printedLabel', value = 0, min = 0, max = 10, step = 1) = create a number input field with incrementer (up/down arrows)
'HTMLLabel' = name given to the field, not printed, and can be called'printedLabel' = text that shows up above the input box explaining the fieldvalue = default numeric value that the field should take; 0 is an examplemin = minimum value that can be set in the field (if a smaller value is manually entered, then the value becomes the minimum specified once user clicks away from the field)max = max value that can be set in the fieldstep = increments for the up/down arrows?numericInputcheckboxGroupInput("id2", "Checkbox",choices = c("Value 1" = "1", ...), selected = "1", inline = TRUE) = creates a series of checkboxes
"id2", "Checkbox" = field identifier/labelchoices = list of checkboxes and their labels
"checkboxName" = "fieldIdentifier"fieldIdentifier should generally be different from checkbox to checkbox, so we can properly identify the responses selected = specifies the checkboxes that should be selected by default; uses fieldIndentifier valuesinline = whether the options should be displayed inlinedateInput("fieldID", "fieldLabel") = creates a selectable date field (dropdown calendar/date picker automatically generated)
"fieldID" = field identifier"fieldLabel" = text/name displayed above fields?dateInputsubmitButton("Submit") = creates a submit button that updates the output/calculations only when the user submits the new inputs (default behavior = all changes update reactively/in real time)actionButton(inputId = "goButton", label = "test") = creates a button with the specified label and id
sliderInput("id", "label", value = 70, min = 62, max = 74, 0.05) = creates a slider for input
numericInput and more information can be found ?sliderInputoutput element in server.R to render their value textOutput("fieldId", inline = FALSE) = prints the value of the variable/field in text format
inline = TRUE = inserts the result inline with the HTML elementinline = FALSE = inserts the result in block code formatverbatimTextOutput("fieldId") = prints out the value of the specified field defined in server.RplotOutput('fieldId') = plots the output (‘sampleHist’ for example) created from server.R scriptoutput$test <- renderText({input$goButton}); isolate(paste(input$t1, input$2))}) = isolate action executes when the button is pressed
if (input$goButton == 1){ Conditional statements } = create different behavior depending on the number of times the button is pressed# load shiny package
library(shiny)
# begin shiny UI
shinyUI(navbarPage("Shiny Project",
# create first tab
tabPanel("Documentation",
# load MathJax library so LaTeX can be used for math equations
withMathJax(), h3("Why is the Variance Estimator \\(S^2\\) divided by \\(n-1?\\)"),
# paragraph and bold text
p("The ", strong("sample variance")," can be calculated in ", strong(em("two")),
" different ways:",
"$$S^2 \\mbox{(unbiased)} = \\frac{\\sum_{i=1}^n (X_i - \\bar X)^2}{n-1}
~~~\\mbox{and}~~S^2\\mbox{(biased)}=\\frac{\\sum_{i=1}^n (X_i-\\bar X)^2}{n}$$",
"The unbiased calculation is most often used, as it provides a ",
strong(em("more accurate")), " estimate of population variance"),
# break used to space sections
br(), p("To show this empirically, we simulated the following in the ",
strong("Simulation Experiment"), " tab: "), br(),
# ordered list
tags$ol(
tags$li("Create population by drawing observations from values 1 to 20."),
tags$li("Draw a number of samples of specified size from the population"),
tags$li("Plot difference between sample and true population variance"),
tags$li("Show the effects of sample size vs accuracy of variance estimated")
)),
# second tab
tabPanel("Simulation Experiment",
# fluid row for space holders
fluidRow(
# fluid columns
column(4, div(style = "height: 150px")),
column(4, div(style = "height: 150px")),
column(4, div(style = "height: 150px"))),
# main content
fluidRow(
column(12,h4("We start by generating a population of ",
span(textOutput("population", inline = TRUE),
style = "color: red; font-size: 20px"),
" observations from values 1 to 20:"),
tags$hr(),htmlOutput("popHist"),
# additional style
style = "padding-left: 20px"
)
),
# absolute panel
absolutePanel(
# position attributes
top = 50, left = 0, right =0,
fixed = TRUE,
# panel with predefined background
wellPanel(
fluidRow(
# sliders
column(4, sliderInput("population", "Size of Population:",
min = 100, max = 500, value = 250),
p(strong("Population Variance: "),
textOutput("popVar", inline = TRUE))),
column(4, sliderInput("numSample", "Number of Samples:",
min = 100, max = 500, value = 300),
p(strong("Sample Variance (biased): "),
textOutput("biaVar", inline = TRUE))),
column(4, sliderInput("sampleSize", "Size of Samples:",
min = 2, max = 15, value = 10),
p(strong("Sample Variance (unbiased): "),
textOutput("unbiaVar", inline = TRUE)))),
style = "opacity: 0.92; z-index: 100;"
))
)
))
library() calls to load packages/data<<- operator should be used to assign values to variables in the parent environmentx <<- x + 1 will define x to be the sum of 1 and the value of x (defined in the parent environment/working environment)shinyServer() = initiates the server function
function(input, output){} = defines a function that performs actions on the inputs user makes and produces an output objectreactive(function) = can be used to wrap functions/expressions to create reactive expressions
renderText({x()}) = returns value of x, “()” must be included (syntax)reactive function example
# start shinyServer
shinyServer(
# specify input/output function
function(input, output) {
# set x as a reactive function that adds 100 to input1
x <- reactive({as.numeric(input$text1)+100})
# set value of x to output object text1
output$text1 <- renderText({x() })
# set value of x plus value of input object text2 to output object text1
output$text2 <- renderText({x() + as.numeric(input$text2)})
}
)shinyServer()
output$oid1 <- renderPrint({input$id1}) = stores the user input value in field id1 and stores the rendered, printed text in the oid1 variable of the output object
renderPrint({expression}) = reactive function to render the specified expression{} is used to ensure the value is an expressionoid1 = variable in the output object that stores the result from the subsequent commandoutput$sampleHist <- renderPlot({code}) = stores plot generated by code into sampleHist variable
renderPlot({code}) = renders a plot generated by the enclosed R codeoutput$sampleGVisPlot <- renderGvis({code}) = renders Google Visualization object# load libraries
library(shiny)
require(googleVis)
# begin shiny server
shinyServer(function(input, output) {
# define reactive parameters
pop<- reactive({sample(1:20, input$population, replace = TRUE)})
bootstrapSample<-reactive({sample(pop(),input$sampleSize*input$numSample,
replace = TRUE)})
popVar<- reactive({round(var(pop()),2)})
# print text through reactive funtion
output$biaVar <- renderText({
sample<- as.data.frame(matrix(bootstrapSample(), nrow = input$numSample,
ncol =input$sampleSize))
return(round(mean(rowSums((sample-rowMeans(sample))^2)/input$sampleSize), 2))
})
# google visualization histogram
output$popHist <- renderGvis({
popHist <- gvisHistogram(data.frame(pop()), options = list(
height = "300px",
legend = "{position: 'none'}", title = "Population Distribution",
subtitle = "samples randomly drawn (with replacement) from values 1 to 20",
histogram = "{ hideBucketItems: true, bucketSize: 2 }",
hAxis = "{ title: 'Values', maxAlternation: 1, showTextEvery: 1}",
vAxis = "{ title: 'Frequency'}"
))
return(popHist)
})
})
runApp (requires R knowledge)runApp(display.mode = 'showcase') = highlights execution while running a shiny applicationcat = can be used to display output to stdout/R consolebrowser() = interrupts execution (tutorial)manipulate Packagemanipulate = package/function can be leveraged to create quick interactive graphics by allowing the user to vary the different variables to a model/calculation# load data and manipulate package
library(UsingR)
library(manipulate)
# plotting function
myHist <- function(mu){
# histogram
hist(galton$child,col="blue",breaks=100)
# vertical line to highlight the mean
lines(c(mu, mu), c(0, 150),col="red",lwd=5)
# calculate mean squared error
mse <- mean((galton$child - mu)^2)
# updates the mean value as the mean is changed by the user
text(63, 150, paste("mu = ", mu))
# updates the mean squared error value as the mean is changed by the user
text(63, 140, paste("MSE = ", round(mse, 2)))
}
# creates a slider to vary the mean for the histogram
manipulate(myHist(mu), mu = slider(62, 74, step = 0.5))
lattice plotting system)devtools must be installed first (install.packages("devtools"))require(devtools); install_github('rCharts', 'ramnathv') installs the rCharts package from GitHubrPlot = paneled scatter plotsmPlot = time series plot (similar to stock price charts)nPlot = stacked/grouped bar chartsn1 <- nplot(...)
n1$ + TAB in R Console brings up list of all functions contained in the objectn1$html() = prints out the HTML for the plotn1$save("filename.html") = saves result to a file named “filename.html”n1$print() = print out the JavaScriptn1$show("inline", include_assets = TRUE, cdn = F) = embed HTML/JS code directly with in Rmd file (for HTML output)
n1$publish('plotname', host = 'gist'/'rpubs') = publishes the plot under the specified plotname as a gist or to rpubsyaml ext_widgets : {rCharts: ["libraries/nvd3"]}cat('<iframe src="map3.html" width=100%, height=600></iframe>') to embed a map or chart form a saved file (saved with: map3$save('map3.html', cdn = TRUE))# load rCharts package
require(rCharts); library(datasets); library(knitr)
# create dataframe with HairEyeColor data
haireye = as.data.frame(HairEyeColor)
# create a nPlot object
n1 <- nPlot(Freq ~ Hair, group = 'Eye', type = 'multiBarChart',
data = subset(haireye, Sex == 'Male'))
# save the nPlot object to a html page
n1$show("inline", include_assets = TRUE, cdn = F)
ggvis packageggvis is a data visualization package for R that lets you:
shiny’s infrastructure to publish interactive graphics usable from any browser (either within your company or to the world).%>%, to chain graphing functions
set_options(renderer = "canvas") = can be used to control what renderer the graphics is produced withmtcars %>% ggvis(~mpg, ~wt, fill = ~ as.factor(am)) %>% layer_points() %>% layer_smooths()gvisMotionChartgvisGeoChartgvisTablegvisLineChartgvisColumnChartgvisTreeMapprint(chart, "chart") = prints the JavaScript for creating the interactive plot so it can be embedded in slidify/HTML document
print(chart) = prints HTML + JavaScript directlyop <- options(gvis.plot.tag='chart')plot.gvis, so that only the chart component of the HTML file is written into the output fileplot(chart) can then be called to print the plots to HTMLgvisMerge(chart1, chart2, horizontal = TRUE, tableOptions = "bgcolor = \"#CCCCCC\" cellspacing = 10) = combines the two plots into one horizontally (1 x 2 panel)
gvisMerge() can only combine TWO plots at a time horizontal = FALSE = combines plots vertically (TRUE for horizontal combination)tableOptions = ... = used to specify attributes of the combined plotdemo(googleVis) = demos how each of the plot works# load googleVis package
library(googleVis)
# set gvis.plot options to only return the chart
op <- options(gvis.plot.tag='chart')
# create initial data with x variable as "label" and y variable as "var1/var2"
df <- data.frame(label=c("US", "GB", "BR"), val1=c(1,3,4), val2=c(23,12,32))
# set up a gvisLineChart with x and y
Line <- gvisLineChart(df, xvar="label", yvar=c("val1","val2"),
# set options for the graph (list) - title and location of legend
options=list(title="Hello World", legend="bottom",
# set title text style
titleTextStyle="{color:'red', fontSize:18}",
# set vertical gridlines
vAxis="{gridlines:{color:'red', count:3}}",
# set horizontal axis title and style
hAxis="{title:'My Label', titleTextStyle:{color:'blue'}}",
# set plotting style of the data
series="[{color:'green', targetAxisIndex: 0},
{color: 'blue',targetAxisIndex:1}]",
# set vertical axis labels and formats
vAxes="[{title:'Value 1 (%)', format:'##,######%'},
{title:'Value 2 (\U00A3)'}]",
# set line plot to be smoothed and set width and height of the plot
curveType="function", width=500, height=300
))
# print the chart in JavaScript
plot(Line)
G <- gvisGeoChart(Exports, "Country", "Profit",options=list(width=200, height=100))
T1 <- gvisTable(Exports,options=list(width=200, height=270))
M <- gvisMotionChart(Fruits, "Fruit", "Year", options=list(width=400, height=370))
GT <- gvisMerge(G,T1, horizontal=FALSE)
GTM <- gvisMerge(GT, M, horizontal=TRUE,tableOptions="bgcolor=\"#CCCCCC\" cellspacing=10")
plot(GTM)
|
|
devtools installed in R (install.packages("devtools"))devtools::install_github('rstudio/shinyapps'), which installs the shinyapps package from GitHubdeployApp() commanddevtools installed in Rdevtools::install_github("ropensci/plotly"), which installs plotly package from GitHublibrary(plotly); set_credentials_file("<username>", "<token>") with the appropriate username and token filled inplotly() methods to upload plots to your account# load packages
library(plotly); library(ggplot2)
# make sure your plot.ly credentials are set correctly using the following command
# set_credentials_file(username=<FILL IN>, api_key=<FILL IN>)
# load data
load("courseraData.rda")
# bar plot using ggplot2
g <- ggplot(myData, aes(y = enrollment, x = class, fill = as.factor(offering)))
g <- g + geom_bar(stat = "identity")
g
# initiate plotly object
py <- plotly()
# interface with plot.ly and ggplot2 to upload the plot to plot.ly under your credentials
out <- py$ggplotly(g)
# typing this in R console will return the url of the generated plot
out$response$url
## [1] "https://plot.ly/~sxing/75"
.Rmd file)
.Rmd file)
final products are HTML files, which can be viewed with any web browser and shared easily
devtools package installed in Rinstall_github('slidify', 'ramnathv'); install_github('slidifyLibraries', 'ramnathv') to install the slidify packageslibrary(slidify)setwd("~/project")author("title") = sets up initial files for a new slidify project (performs the following things)
title (or any name you typed) directory is created inside the current working directoryassets subdirectory and a file named index.Rmd are created inside title directoryassets subdirectory is populated with the following empty folders:
cssimgjslayoutsindex.Rmd R Markdown file will open up in RStudioslidify("index.Rmd") = processes the R Markdown file into a HTML page and imports all necessary librarieslibrary(knitr); browseURL("index.html") = opens up the built-in web browser in R Studio and displays the slidify presentation
field : value # comment
title = title of documentsubtitle = subtitle of documentauthor = author of documentjob = occupation of author (can be left blank)framework = controls formatting, usually the name of a library is used (i.e. io2012)
highlighter = controls effects for presentation (i.e highlight.js)hitheme = specifies theme of code (i.e. tomorrow)widgets = loads additional libraries to display LaTeX math equations(mathjax), quiz-styles components (quiz), and additional style (bootstrap = Twitter-created style)
$expresion$ for inline expressions, and $$expression$$ for block equationsmode = selfcontained/standalone/draft = depending whether the presentation will be given with Internet access or not
standalone = all the JavaScript libraries will be save locally so that the presentation can be executed without Internet accessselfcontained = load all JavaScript library at time of presentationlogo = displays a logo in title slideurl = specify path to assets/other folders that are used in the presentation
../ signifies the parent directory ---
title : Slidify
subtitle : Data meets presentation
author : Jeffrey Leek, Assistant Professor of Biostatistics
job : Johns Hopkins Bloomberg School of Public Health
logo : bloomberg_shield.png
framework : io2012 # {io2012, html5slides, shower, dzslides, ...}
highlighter : highlight.js # {highlight.js, prettify, highlight}
hitheme : tomorrow #
url:
lib: ../../libraries
assets: ../../assets
widgets : [mathjax] # {mathjax, quiz, bootstrap}
mode : selfcontained # {standalone, draft}
---
## = signifies the title of the slide \(\rightarrow\) equivalent of h1 element in HTML--- = marks the end of a slide.class #id = assigns class and id attributes (CSS) to the slide and can be used to customize the style of the pageindex.Rmd file and most of the time it should function correctly--- &radio before slide content for multiple choice (make sure quiz is included in widgets)## = signifies title of questions1. a, 2. b, etc.)
2. _b_)*** .hint = denotes the hint that will be displayed when the user clicks on Show Hint button*** .explanation = denotes the explanation that will be displayed when the user clicks on Show Answer buttonslidify
--- &radio
## Question 1
What is 1 + 1?
1. 1
2. _2_
3. 3
4. 4
*** .hint
This is a hint
*** .explanation
This is an explanation
knit HTML button can be used to generate previews for the presentation as wellpublish_github("user", "repo") can be used to publish the slidify document on to your on-line repo.Rpres file \(\rightarrow\) converted to .md file \(\rightarrow\) .html filealt-f + f + p)class: classname = specify slide-specific control from CSScss: file.css = can be used to import an external CSS file
transition property (similar to YAML) can be specified to control the transition between the previous and current slidestransition: linear = creates 2D linear transition (html5) between slidestransition: rotate = creates 3D rotating transition (html5) between slidestype can be added to specify the appearance of the slide (“slide type”)type: section and type: sub-section = distinct background and font colors, slightly larger heading text, appear at a different indent level within the slide navigation menutype: prompt and type: alert = distinct background color to communicate to viewers that the slide has different intent*** in between two sections of content on a slide to separate it into two columnsleft: 70% can be used to specify the proportions of each columnright: 30% works similarlyfont-family: fontname = changes the font of slide (specified in the same way as HTML)font-import: http://fonts.googleapis.com/css?family=Risque = imports font
.reveal to work (.reveal section del applies to any text enclosed by ~~text~~) .Rmd fileinstall.packages()devtools::install_github()fairly easily maintained with proper documentation
R/ sub-directoryman/ sub-directorylibrary(name) to load the package)M.m-p format, “majorNumber.minorNumber-patchLevel”)gpclib
R/ directoryexport("\<function>") = export a functionimport("\<package>") = import a packageimportFrom("\<package>", "\<function>") = import specific function from a packageexportClasses("\<class>") = indicate the new types of S4 (4th version of S) classes created with the package (objects of the specified class can be created)exportMethods("\<generic>") = methods that can operate on the new class objects# read.polyfile/write.polyfile are functions available to user
export("read.polyfile", "write.polyfile")
# import plot function from graphics package
importFrom(graphics, plot)
# gpc.poly/gpc.poly.nohole classes can be created by the user
exportClasses("gpc.poly", "gpc.poly.nohole")
# the listed methods can be applied to the gpc.poly/gpc.poly.nohole classes
exportMethods("show", "get.bbox", "plot", "intersect”, "union”, "setdiff",
"[", "append.poly", "scale.poly", "area.poly", "get.pts",
"coerce", "tristrip", "triangulate")
.Rd) should be placed in the man/ sub-directoryconcepts/package/datasets overview can also be documented
\name{} = name of function\alias{} = anything listed as alias will bring up the help file (?line is the same as ?residuals.tukeyline)
\title{} = full title of the function\description{} = full description of the purpose of function\usage{} = format/syntax of function\arguments{} = explanation of the arguments in the syntax of function\details{} = notes/details about limitation/features of the function\value{} = specifies what object is returned\reference{} = references for the function (paper/book from which the method is created)example: line function
\name{line}
\alias{line}
\alias{residuals.tukeyline}
\title{Robust Line Fitting}
\description{
Fit a line robustly as recommended in \emph{Exploratory Data Analysis}.
}
\usage{
line(x, y)
}
\arguments{
\item{x, y}{the arguments can be any way of specifying x-y pairs. See
\code{\link{xy.coords}}.}
}
\details{
Cases with missing values are omitted.
Long vectors are not supported.
}
\value{
An object of class \code{"tukeyline"}.
Methods are available for the generic functions \code{coef},
\code{residuals}, \code{fitted}, and \code{print}.
}
\references{
Tukey, J. W. (1977).
\emph{Exploratory Data Analysis},
Reading Massachusetts: Addison-Wesley.
}
.tar.gz)system() function
system("R CMD build newpackage")system("R CMD check newpackage")package.skeleton() function in the utils package = creates a “skeleton” R package
R/, man/), DESCRIPTION file, NAMESPACE file, documentation filesR/ directoryman/ directoryR/ and man/ sub-directories (or just use package.skeleton())R/ sub-directoryman/ sub-directorytopten function.R script and add documentation directly to the script
#' = denotes the beginning of documentation
#' on the subsequent lines as you type or complete sections@param x definition = format of the documentation for the arguments
x = argument name (formatted in code format when processed to differentiate from definition)definiton = explanation of the what x represents@author = author of the function@details = detailed description of the function and its purpose@seealso = links to relevant functions used in creating the current function that may be of interest to the user@import package function = imports specific function from specified package@export = denotes that this function is exported for public use@return = specifies what is returned by the method#' Building a Model with Top Ten Features
#'
#' This function develops a prediction algorithm based on the top 10 features
#' in 'x' that are most predictive of 'y'.
#'
#' @param x a n x p matrix of n observations and p predictors
#' @param y a vector of length n representing the response
#' @return a 'lm' object representing the linear model with the top 10 predictors
#' @author Roger Peng
#' @details
#' This function runs a univariate regression of y on each predictor in x and
#' calculates the p-value indicating the significance of the association. The
#' final set of 10 predictors is the taken from the 10 smallest p-values.
#' @seealso \code{lm}
#' @import stats
#' @export
topten <- function(x, y) {
p <- ncol(x)
if(p < 10)
stop("there are less than 10 predictors")
pvalues <- numeric(p)
for(i in seq_len(p)) {
fit <- lm(y ~ x[, i])
summ <- summary(fit)
pvalues[i] <- summ$coefficients[2, 4]
}
ord <- order(pvalues)
x10 <- x[, ord]
fit <- lm(y ~ x10)
coef(fit)
}
#' Prediction with Top Ten Features
#'
#' This function takes a set coefficients produced by the \code{topten}
#' function and makes a prediction for each of the values provided in the
#' input 'X' matrix.
#'
#' @param X a n x 10 matrix containing n observations
#' @param b a vector of coefficients obtained from the \code{topten} function
#' @return a numeric vector containing the predicted values
predict10 <- function(X, b) {
X <- cbind(1, X)
drop(X %*% b)
}
OOB structure in R is structured differently than most of the other languages
methods packagesetClass() function in methods packageclass() function
numeric = number data, can be vectors as well (series of numbers)logical = TRUE, FALSE, NA
character = string of characterslm = linear model class, output from a linear modelnew()getS3method(<genericFunction>, <class>) = returns code for S3 method for a given class
mean.default)getMethod(<genericFunction>, <signature/class>) = returns code for S4 method for a given class
plot, mean, predict)
plot) will return the content of the function methods("mean") = returns methods associated with S3 generic functionshowMethods("show") = returns methods associated with S4 generic function
show is equivalent of print, but generally not called directly as objects are auto-printed data.frame where each column can be of different class, the function uses the methods correspondingly
as.ts(x) and x are completed different
as.ts() = converts object to time seriesNote: ?Classes, ?Methods, ?setClass, ?setMethod, and ?setGeneric contains very helpful documentation
example
# S3 method: mean
mean
## function (x, ...)
## UseMethod("mean")
## <bytecode: 0x7f9a85b2bff0>
## <environment: namespace:base>
# associated methods
methods("mean")
## [1] mean.Date mean.default mean.difftime mean.POSIXct mean.POSIXlt
# code for mean (first 10 lines)
# note: no specific funcyion got numeric class, so default is used
head(getS3method("mean", "default"), 10)
##
## 1 function (x, trim = 0, na.rm = FALSE, ...)
## 2 {
## 3 if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
## 4 warning("argument is not numeric or logical: returning NA")
## 5 return(NA_real_)
## 6 }
## 7 if (na.rm)
## 8 x <- x[!is.na(x)]
## 9 if (!is.numeric(trim) || length(trim) != 1L)
## 10 stop("'trim' must be numeric of length one")
# S4 method: show
show
## standardGeneric for "show" defined from package "methods"
##
## function (object)
## standardGeneric("show")
## <bytecode: 0x7f9a8397f718>
## <environment: 0x7f9a831dcab0>
## Methods may be defined for arguments: object
## Use showMethods("show") for currently available ones.
## (This generic function excludes non-simple inheritance; see ?setIs)
# associated methods
showMethods("show")
## Function: show (package methods)
## object="ANY"
## object="C++Class"
## object="C++Function"
## object="C++Object"
## object="classGeneratorFunction"
## object="classRepresentation"
## object="color"
## object="Enum"
## object="EnumDef"
## object="envRefClass"
## object="function"
## (inherited from: object="ANY")
## object="genericFunction"
## object="genericFunctionWithTrace"
## object="MethodDefinition"
## object="MethodDefinitionWithTrace"
## object="MethodSelectionReport"
## object="MethodWithNext"
## object="MethodWithNextWithTrace"
## object="Module"
## object="namedList"
## object="ObjectsWithPackage"
## object="oldClass"
## object="refClassRepresentation"
## object="refMethodDef"
## object="refObjectGenerator"
## object="signature"
## object="sourceEnvironment"
## object="SQL"
## object="standardGeneric"
## (inherited from: object="genericFunction")
## object="SymbolicConstant"
## object="traceable"
methods = extend generic functions to specify the behavior of generic functions on new classes
setClass() = function to create new class
setMethod() = define methods for class
@ is used to access the slots/attributes of the classshowClass() = displays definition/information about classprint show, summary, and plot should be writtenploygon class with set of (x, y) coordinates with setClass()plot function with setMethod()# load methods library
library(methods)
# create polygon class with x and y coordinates as slots
setClass("polygon", representation(x = "numeric", y = "numeric"))
# create plot method for ploygon class (ploygon = signature in this case)
setMethod("plot", "polygon",
# create function
function(x, y, ...) {
# plot the x and y coordinates
plot(x@x, x@y, type = "n", ...)
# plots lines between all (x, y) pairs
# x@x[1] is added at the end because we need
# to connect the last point of polygon to the first
xp <- c(x@x, x@x[1])
yp <- c(x@y, x@y[1])
lines(xp, yp)
})
## Creating a generic function for 'plot' from package 'graphics' in the global environment
## [1] "plot"
# print polygon method
showMethods("plot")
## Function: plot (package graphics)
## x="ANY"
## x="color"
## x="polygon"
## Create dataset of PM and O3 for all US taking year 2013 (annual
## data from EPA)
## This uses data from
## http://aqsdr1.epa.gov/aqsweb/aqstmp/airdata/download_files.html
## Read in the 2013 Annual Data
d <- read.csv("annual_all_2013.csv", nrow = 68210)
# subset data to just variables we are interested in
sub <- subset(d, Parameter.Name %in% c("PM2.5 - Local Conditions", "Ozone")
& Pullutant.Standard %in% c("Ozone 8-Hour 2008", "PM25 Annual 2006"),
c(Longitude, Latitude, Parameter.Name, Arithmetic.Mean))
# calculate the average pollution for each location
pollavg <- aggregate(sub[, "Arithmetic.Mean"],
sub[, c("Longitude", "Latitude", "Parameter.Name")],
mean, na.rm = TRUE)
# refactors the Name parameter to drop all other levels
pollavg$Parameter.Name <- factor(pollavg$Parameter.Name, labels = c("ozone", "pm25"))
# renaming the last column from "x" (automatically generated) to "level"
names(pollavg)[4] <- "level"
# Remove unneeded objects
rm(d, sub)
# extract out just the location information for convenience
monitors <- data.matrix(pollavg[, c("Longitude", "Latitude")])
# load fields package which allows us to calculate distances on earth
library(fields)
# build function to calculate the distances for the given set of coordinates
# input = lon (longitude), lat (latitude), radius (radius in miles for finding monitors)
pollutant <- function(df) {
# extract longitude/lagitude
x <- data.matrix(df[, c("lon", "lat")])
# extract radius
r <- df$radius
# calculate distances between all monitors and input coordinates
d <- rdist.earth(monitors, x)
# locations for find which distance is less than the input radius
use <- lapply(seq_len(ncol(d)), function(i) {
which(d[, i] < r[i])
})
# calculate levels of ozone and pm2.5 at each selected locations
levels <- sapply(use, function(idx) {
with(pollavg[idx, ], tapply(level, Parameter.Name, mean))
})
# convert to data.frame and transpose
dlevel <- as.data.frame(t(levels))
# return the input data frame and the calculated levels
data.frame(df, dlevel)
}
model.require(){} = defines dependencies on other packages
model.transform(){} = needed if the data needs to be transformed in anyway before feeding into the modelmodel.predict(){} = performs the predictionyhat.config
username = "<user@email.com>" = user name for yhat websiteapikey = "<generatedKey>" = unique API key generated when you open an account with yhatenv="http://sandbox.yhathq.com/" = software environment (always going to be this link)yhat.deploy("name") = uploads the model to yhat servers with provided credentials under the specified name
## Send to yhat
library(yhatr)
model.require <- function() {
library(fields)
}
model.transform <- function(df) {
df
}
model.predict <- function(df) {
pollutant(df)
}
yhat.config <- c(
username="email@gmail.com",
apikey="90d2a80bb532cabb2387aa51ac4553cc",
env="http://sandbox.yhathq.com/"
)
yhat.deploy("pollutant")
{ "variable" : "value"}
{ "lon" : -76.61, "lat": 39.28, "radius": 50 }yhat.predict function
yhat.config (see above section)yhat.predict("name", df) = returns the result by feeding the input data to the model hosted on yhat under your credentialslibrary(yhatr)
yhat.config <- c(
username="email@gmail.com",
apikey="90d2a80bb532cabb2387aa51ac4553cc",
env="http://sandbox.yhathq.com/"
)
df <- data.frame(lon = c(-76.6167, -118.25), lat = c(39.2833, 34.05),
radius = 20)
yhat.predict("pollutant", df)
curl -X POST -H "Content-Type: application/json" \
--user email@gmail.com:90d2a80bb532cabb2387aa51ac4553cc \
--data '{ "lon" : -76.61, "lat": 39.28, "radius": 50 }' \
http://cloud.yhathq.com/rdpeng@gmail.com/models/pollutant/
# load library
library(yhatr)
# yhat functions
model.require <- function() {}
model.transform <- function(df) {
transform(df, Wind = as.numeric(as.character(Wind)),
Temp = as.integer(as.character(Temp)))
}
model.predict <- function(df) {
result <- data.frame(Ozone = predict(fit, newdata = df))
cl <- data.frame(clWind = class(df$Wind), clTemp = class(df$Temp))
data.frame(result, Temp = as.character(df$Temp),
Wind = as.character(df$Wind), cl)
}
# model
fit <- lm(Ozone ~ Wind + Temp, data = airquality)
# configuration
yhat.config <- c(
username="email@gmail.com",
apikey="90d2a80bb532cabb2387aa51ac4553cc",
env="http://sandbox.yhathq.com/"
)
# deploy to yhat
yhat.deploy("ozone")
# predict using uploaded model
yhat.predict("ozone", data.frame(Wind = 9.7, Temp = 67))