R Programming
  • The wikipedia of R by me
  • Hello R
    • -What is R & RStudio
    • -Learning sources
    • -R online editor
    • -R environment
  • Data types
    • -Dealing with Number
    • -Dealing with String
    • -Dealing with Dates
    • -Dealing with NA's
    • -Dealing with Logicals
    • -Dealing with Factors
  • R data
    • -R object
    • -Data structures
      • --Basics
      • --Managing Vectors
      • --Managing Matrices
      • --Managing Data Frames
    • -Functions
    • -Importing/exporting data
    • -Shape&Transform data
    • -R management
  • Visualizations
  • Intro to R Bootcamp
    • -01-introduction
    • -02-data preparation
    • -03-data transformation
    • -04-visualization
  • R programming track
    • -a-Introduction to R
      • --1-Intro to basics
      • --2-Vectors
      • --3-Matrices
      • --4-Factors
      • --5-Data frames
      • --6-Lists
    • -b-Intermediate R
      • --1-Conditionals and Control Flow
      • --2-Loops
      • --3-Functions
      • --4-The apply family
      • --5-Utilities
    • -d-Writing Functions in R
      • --1-A quick refresher
      • --2-When and how you should write a function
      • --3-Functional programming
      • --4-Advanced inputs and outputs
      • --5-Robust functions
  • Data Wrangling with R
  • R-tutor
    • #R introduction
    • #Elementary Statistics with R
  • Hands-On Programming with R
  • R for Data Science
  • Advanced R
  • ggplot2
  • R packages
  • Statistik-1
  • Statistik-2
  • Statistik-3
  • Zeitreihen & Prognosen
  • Descriptive Analytics
  • Predictive Analytics
  • Prescriptive Analytics
  • R Graphics Cookbook
    • ggplot2 intro
    • ggplot2 custome
    • ggplot top-50
  • #Exploratory Data Analysis
    • -Data Summary
    • -Checklist Solution
  • #Data Mining
    • Untitled
    • Untitled
  • #Machine Learning
    • Intro to ML
    • Intro alghorithms
    • 1. Supervised Learning
  • Master R for Data Science
    • Learning R
    • Untitled
    • Untitled
  • Data Science Projects
    • Simple linear regression:
Powered by GitBook
On this page
  1. R programming track
  2. -d-Writing Functions in R

--4-Advanced inputs and outputs

Previous--3-Functional programmingNext--5-Robust functions

Last updated 6 years ago

#1-Dealing with failure

​

#2-Creating a safe function

# Pass the readLines() function to safely(), and assign the output to safe_readLines.
# Use safe_readLines() on the string "http://example.org" to read 
# the example homepage HTML file.
# Use safe_readLines() on "http://asdfasdasdkfjlda", a nonsense web address that 
# shouldn't be found

install.packages("purrr")
library(purrr)

readLines<-function (con = stdin(), n = -1L, ok = TRUE, warn = TRUE, 
encoding = "unknown", 
          skipNul = FALSE) 
{
  if (is.character(con)) {
    con <- file(con, "r")
    on.exit(close(con))
  }
  .Internal(readLines(con, n, ok, warn, encoding, skipNul))
}

# Create safe_readLines() by passing readLines() to safely()
safe_readLines <- safely(readLines)
safe_readLines

# Call safe_readLines() on "http://example.org"
safe_readLines("http://example.org")
safe_readLines
# Call safe_readLines() on "http://asdfasdasdkfjlda"
safe_readLines("http://asdfasdasdkfjlda")

safe_readLines

#3-Using map safely

# Use map() on urls with the safe_readLines() function instead and 
# assign the results to html.
# Call str() on html to examine the output.
# Extract the result from one of the two elements that was successful using 
# double square bracket subsetting.
# Extract the error from the element that was unsuccessful, again using 
# double square bracket subsetting.

install.packages("purrr")
library(purrr)

readLines<-function (con = stdin(), n = -1L, ok = TRUE, warn = TRUE, 
encoding = "unknown", 
                     skipNul = FALSE) 
{
  if (is.character(con)) {
    con <- file(con, "r")
    on.exit(close(con))
  }
  .Internal(readLines(con, n, ok, warn, encoding, skipNul))
}

urls <- list(
  example = "http://example.org",
  rproj = "http://www.r-project.org",
  asdf = "http://asdfasdasdkfjlda"
)

# Define safe_readLines()
safe_readLines <- safely(readLines)

# Use the safe_readLines() function with map(): html
html <- map(urls, safe_readLines)

# Call str() on html
str(html)

# Extract the result from one of the successful elements
html[["example"]][["result"]]

# Extract the error from the element that was unsuccessful
html[["asdf"]][["error"]]

#4-Working with safe output

# Examine the structure of transpose(html).
# Pull out all the results by subsetting transpose(html) and assign to 
# the variable res.
# Pull out all the errors by subsetting transpose(html) and assign to 
# the variable errs.

install.packages("purrr")
library(purrr)

readLines<-function (con = stdin(), n = -1L, ok = TRUE, warn = TRUE, 
encoding = "unknown", 
                     skipNul = FALSE) 
{
  if (is.character(con)) {
    con <- file(con, "r")
    on.exit(close(con))
  }
  .Internal(readLines(con, n, ok, warn, encoding, skipNul))
}

urls <- list(
  example = "http://example.org",
  rproj = "http://www.r-project.org",
  asdf = "http://asdfasdasdkfjlda"
)

# Define safe_readLines()
safe_readLines <- safely(readLines)

# Use the safe_readLines() function with map(): html
html <- map(urls, safe_readLines)

# Define save_readLines() and html
safe_readLines <- safely(readLines)
html <- map(urls, safe_readLines)

# Examine the structure of transpose(html)
str(transpose(html))

# Extract the results: res
res<-transpose(html)[["result"]]

# Extract the errors: errs
errs<-transpose(html)[["error"]]

#5-Working with errors and results

# Combine map_lgl() with is_null() to create a logical vector, is_ok, 
# that is TRUE when errs is NULL.
# Extract the successful results by subsetting res with is_ok.
# Extract the input from the unsuccessful results by subsetting urls with !is_ok.

install.packages("purrr")
library(purrr)

readLines<-function (con = stdin(), n = -1L, ok = TRUE, warn = TRUE, 
encoding = "unknown", 
                     skipNul = FALSE) 
{
  if (is.character(con)) {
    con <- file(con, "r")
    on.exit(close(con))
  }
  .Internal(readLines(con, n, ok, warn, encoding, skipNul))
}

urls <- list(
  example = "http://example.org",
  rproj = "http://www.r-project.org",
  asdf = "http://asdfasdasdkfjlda"
)

# Initialize some objects
safe_readLines <- safely(readLines)
html <- map(urls, safe_readLines)
res <- transpose(html)[["result"]]
errs <- transpose(html)[["error"]]

# Create a logical vector is_ok
is_ok <- map_lgl(errs, is_null)

# Extract the successful results
res[is_ok]

# Extract the input from the unsuccessful results
urls[!is_ok]

6-Maps over multiple arguments

#7-Getting started

# Create a list n containing the values: 5, 10, and 20.
# Use map() to iterate over n, each time applying the function rnorm().

# Create a list n containing the values: 5, 10, and 20
n<-list(5,10,20)

# Call map() on n with rnorm() to simulate three samples
map(n,rnorm)

#8-Mapping over two arguments

# Create a list mu containing the values: 1, 5, and 10.
# Edit the map() call to use map2() with both n and mu.

# Initialize n
n <- list(5, 10, 20)

# Create a list mu containing the values: 1, 5, and 10
mu<-list(1,5,10)

# Edit to call map2() on n and mu with rnorm() to simulate three samples
map2(n,mu, rnorm)

#9-Mapping over more than two arguments

# Create a list sd with the values: 0.1, 1 and 0.1.
# Edit your call to pmap() to also iterate over sd.

# Initialize n and mu
n <- list(5, 10, 20)
mu <- list(1, 5, 10)

# Create a sd list with the values: 0.1, 1 and 0.1
sd<-list(0.1,1,0.1)

# Edit this call to pmap() to iterate over the sd list as well
pmap(list(n, mu,sd), rnorm)

#10-Argument matching

#Without changing their ordering, simply name the elements of the argument list to 
#properly match the arguments of rnorm().

# Initialize n and mu
n <- list(5, 10, 20)
mu <- list(1, 5, 10)

# Create a sd list with the values: 0.1, 1 and 0.1
sd<-list(0.1,1,0.1)

# Name the elements of the argument list
pmap(list(mean = mu, n = n, sd = sd), rnorm)

#11-Mapping over functions and their arguments

# We've given you some code to get you started.
# Add min and max elements to runif_params with values 0 and 5 respectively.
# Add a rate element to rexp_params with value 5.
# Call invoke_map() on f() using the params list as the second argument, 
# keeping n = 5 as a global argument.


# Define list of functions
f <- list("rnorm", "runif", "rexp")

# Parameter list for rnorm()
rnorm_params <- list(mean = 10)

# Add a min element with value 0 and max element with value 5
runif_params <- list(min = 0, max = 5)

# Add a rate element with value 5
rexp_params <- list(rate = 5)

# Define params for each function
params <- list(
  rnorm_params,
  runif_params,
  rexp_params
)

# Call invoke_map() on f supplying params as the second argument
invoke_map(f, params,n = 5)

#12-Maps with side effects

#13-Walk

# We've included code from our simulation of three samples from three different 
# distributions, except we've bumped up the sample size to 50. 
# We've also added some names to f and params to help us remember what matches up 
# with what.
# Assign the simulated samples to sims.
# Call walk() on sims with the hist() function to create a histogram of each sample.

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)
sims

# Use walk() to make a histogram of each element in sims
walk(sims,hist.default)

#14-Walking over two or more arguments

# We've loaded sims in your workspace.
# The default value for the breaks argument to hist() is "Sturges". 
# Replace "Sturges" in the breaks_list list with reasonable breaks 
# for the histograms. 
# Let's use seq(6, 16, 0.5) for the Normal, seq(0, 5, 0.25) for the Uniform and 
# seq(0, 1.5, 0.1) for the Exponential.
# Use walk2() to create a histogram for each sample with the breaks in breaks_list.

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)


# Replace "Sturges" with reasonable breaks for each sample
breaks_list <- list(
  Normal = seq(6, 16, 0.5),
  Uniform = seq(0, 5, 0.25),
  Exp = seq(0, 1.5, 0.1)
)

# Use walk2() to make histograms with the right breaks
walk2(sims, breaks_list, hist)

#15-Putting together writing functions and walk

# Turn the snippet above into a function called find_breaks(), 
# which takes a single argument x and return the sequence of breaks.
# Check that your function works by calling find_breaks() on sims[[1]].

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)

# Turn this snippet into find_breaks()
find_breaks<-function(x){
  rng <- range(sims[[1]], na.rm = TRUE)
  seq(rng[1], rng[2], length.out = 30)
  
}
# Call find_breaks() on sims[[1]]
find_breaks()

#16-Nice breaks for all-X

#Use map() to iterate find_breaks() over sims and assign the result to nice_breaks.
#Use nice_breaks as the second argument to walk2() to iterate over both the 
# simulations and calculated breaks to plot histograms.

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)

# Turn this snippet into find_breaks()
find_breaks<-function(x){
  rng <- range(sims[[1]], na.rm = TRUE)
  seq(rng[1], rng[2], length.out = 30)
}
# Call find_breaks() on sims[[1]]
find_breaks()

# Use map() to iterate find_breaks() over sims: nice_breaks
nice_breaks<-map(sims,find_breaks)

# Use nice_breaks as the second argument to walk2()
walk2(sims,nice_breaks,hist)

#17-Walking with many arguments: pwalk

# Increase the sample size to 1000.
# Create a vector nice_titles that contains the character strings: 
# "Normal(10, 1)", "Uniform(0, 5)" and "Exp(5)".
# Use pwalk() instead of walk2() to iterate over the x, breaks and 
# main arguments to hist(). Like for pmap(), the first argument to pwalk() should 
# be a list() of arguments to hist() using matching by name. 
# Keep the xlab = "" argument as-is to keep things clean.

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)
sims

# Turn this snippet into find_breaks()
find_breaks<-function(x){
  rng <- range(sims[[1]], na.rm = TRUE)
  seq(rng[1], rng[2], length.out = 30)
  
}
# Call find_breaks() on sims[[1]]
find_breaks()

# Increase sample size to 1000
sims <- invoke_map(f, params, n = 1000)

# Compute nice_breaks (don't change this)
nice_breaks <- map(sims, find_breaks)
nice_breaks

# Create a vector nice_titles
nice_titles<-c("Normal(10, 1)","Uniform(0, 5)","Exp(5)")

# Use pwalk() instead of walk2()
pwalk(list(x=sims,breaks=nice_breaks,main=nice_titles),hist, xlab = "")

#18-Walking with pipes

#We've converted walk(sims, hist) to a piped statement: sims %>% walk(hist). 
#Pipe the result into map using summary() as the .f argument.

# Define list of functions
f <- list(Normal = "rnorm", Uniform = "runif", Exp = "rexp")

# Define params
params <- list(
  Normal = list(mean = 10),
  Uniform = list(min = 0, max = 5),
  Exp = list(rate = 5)
)

# Assign the simulated samples to sims
sims<-invoke_map(f, params, n = 50)
sims

# Turn this snippet into find_breaks()
find_breaks<-function(x){
  rng <- range(sims[[1]], na.rm = TRUE)
  seq(rng[1], rng[2], length.out = 30)
  
}
# Call find_breaks() on sims[[1]]
find_breaks()

# Increase sample size to 1000
sims <- invoke_map(f, params, n = 1000)


# Pipe this along to map(), using summary() as .f
sims %>% 
  walk(hist) %>%
  map(summary)

​ ​

​ ​

Map functions in purrr
Map functions in purrr
Map functions in purrr