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?numericInput
checkboxGroupInput("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?dateInput
submitButton("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 ?sliderInput
output
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.R
plotOutput('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 rpubs
yaml 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()
gvisMotionChart
gvisGeoChart
gvisTable
gvisLineChart
gvisColumnChart
gvisTreeMap
print(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:
css
img
js
layouts
index.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))