datalove

### Title: Back to basics: High quality plots using base R graphics
###	An interactive tutorial for the Davis R Users Group meeting on April 24, 2015
###
### Date created: 20150418
### Last updated: 20150423
###
### Author: Michael Koontz
### Email: mikoontz@gmail.com
###	Twitter: @michaeljkoontz
###

datalove

############################
# Mapinfo TAB to __________
############################
# https://karlhennermann.wordpress.com/2013/03/15/converting-data-between-mapinfo-and-arcgis/

ogr2ogr -f "ESRI Shapefile" output.shp National_heritage_public.TAB
ogr2ogr -f "GeoJSON" output.json National_heritage_public.TAB

datalove

identical          <- function(x) UseMethod("identical") 
identical.my_class <- function(x) do_something(x)
identical.default  <- base::identical

datalove

    files <- list.files("C:/R/packages", pattern = "^MYPACKAGENAME.*\\.zip", full.names = TRUE)
    files <- gsub("-([0-9]{1})\\.","-0\\1\\.", files)
    files
    latest_file <- sort(files, decreasing = TRUE)[1]
    latest_file
    dest <- "\\\\intranet.mycompany.org/INTRANET/Shared/R/bin/windows/contrib/3.0"
    
    copy_success <- file.copy(latest_file, dest)
    copy_success
    

datalove

# Let's say we're doing some analysis on the mtcars data..

# displacement/cylinder for high horsepower cars 
mtcars %>% 
  filter(hp > 100) %>% 
  mutate(disp_cyl = disp/cyl) %>% filter(disp_cyl > 25) %>%
  group_by(cyl,am) %>% summarise(mean_hp = mean(hp), mean_disp_cyl = mean(disp_cyl))

# or displacement/cylinder for all cars
mtcars %>%  

datalove

`%>>%` <- function(x,y) {
  cl <- match.call()
  lhs <- cl[[2]] ; rhs <- cl[[3]]
  if(length(rhs) == 1) {
    y(x)
  } else {
    rhsl <- as.list(rhs)
    rhsl <- c(rhsl[1], lhs, rhsl[2:length(rhsl)]) # swap in the lhs as the first arg in rhs
    eval(as.call(rhsl))
  }

datalove

library(dplyr)

# you can pull out a column from a tbl_df like this, but it's ugly and awkward to type 
mtcars %>% .[['mpg']]
mtcars %>% .[[1]]

# So let's make a nice function
pull <- function(x,y) {x[,if(is.name(substitute(y))) deparse(substitute(y)) else y]}

# works on tbl_df or dataframes equally well

datalove

decode <- function(x, ...) {

  odds <- function(x) { unlist(x[1:length(x) %% 2 == 1][1:floor(length(x)/2)]) }
  even <- function(x) { unlist(x[1:length(x) %% 2 == 0]) }
  last <- function(x) { unlist(if(length(x) %% 2 == 1) tail(x,1)) }
  
  interpret_args <- function(x) { if(is.call(x)) {eval(x)} else if(is.name(x)) {as.character(x)} else {x} }
  
  args <- eval(substitute(alist(...)))
  args <- lapply(args, interpret_args)

datalove

########################################################
# Takes an arbitrarily long list of input columns and 
# returns a boolean indicating whether or not each row 
# is an outlier. 
#
# The function uses the critical value for Mahalanobis 
# Distance calculated from an upper tailed ChiSq 
# distribution with p=0.001.
########################################################

datalove

###################################################################
# Takes an arbitrarily long list of input columns and returns a 
# boolean indicating whether or not each row is an outlier.
###################################################################

# create vector of inputs
inputs <- grep("^input[0-9]+$",ls(), value = TRUE)

# capture columns as a matrix
x <- sapply(inputs, function(y) {eval(parse(text = y))})