# All examples

# Tables

### Regular R output

    #for the dataset
    data('mtcars')
    mcor <-cor(mtcars)
    # Print mcor and round to 2 digits
    round(mcor,digits=2)

    ##        mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
    ## mpg   1.00 -0.85 -0.85 -0.78  0.68 -0.87  0.42  0.66  0.60  0.48 -0.55
    ## cyl  -0.85  1.00  0.90  0.83 -0.70  0.78 -0.59 -0.81 -0.52 -0.49  0.53
    ## disp -0.85  0.90  1.00  0.79 -0.71  0.89 -0.43 -0.71 -0.59 -0.56  0.39
    ## hp   -0.78  0.83  0.79  1.00 -0.45  0.66 -0.71 -0.72 -0.24 -0.13  0.75
    ## drat  0.68 -0.70 -0.71 -0.45  1.00 -0.71  0.09  0.44  0.71  0.70 -0.09
    ## wt   -0.87  0.78  0.89  0.66 -0.71  1.00 -0.17 -0.55 -0.69 -0.58  0.43
    ## qsec  0.42 -0.59 -0.43 -0.71  0.09 -0.17  1.00  0.74 -0.23 -0.21 -0.66
    ## vs    0.66 -0.81 -0.71 -0.72  0.44 -0.55  0.74  1.00  0.17  0.21 -0.57
    ## am    0.60 -0.52 -0.59 -0.24  0.71 -0.69 -0.23  0.17  1.00  0.79  0.06
    ## gear  0.48 -0.49 -0.56 -0.13  0.70 -0.58 -0.21  0.21  0.79  1.00  0.27
    ## carb -0.55  0.53  0.39  0.75 -0.09  0.43 -0.66 -0.57  0.06  0.27  1.00

### HTML table using xtable

    library(xtable)
    print(xtable(mcor), type='html', comment=F)

| mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb
--- | --- | --- | --- | --- | --- | --- | --- | --- | --- | --- | ---
mpg | 1.00 | -0.85 | -0.85 | -0.78 | 0.68 | -0.87 | 0.42 | 0.66 | 0.60 | 0.48 | -0.55
cyl | -0.85 | 1.00 | 0.90 | 0.83 | -0.70 | 0.78 | -0.59 | -0.81 | -0.52 | -0.49 | 0.53
disp | -0.85 | 0.90 | 1.00 | 0.79 | -0.71 | 0.89 | -0.43 | -0.71 | -0.59 | -0.56 | 0.39
hp | -0.78 | 0.83 | 0.79 | 1.00 | -0.45 | 0.66 | -0.71 | -0.72 | -0.24 | -0.13 | 0.75
drat | 0.68 | -0.70 | -0.71 | -0.45 | 1.00 | -0.71 | 0.09 | 0.44 | 0.71 | 0.70 | -0.09
wt | -0.87 | 0.78 | 0.89 | 0.66 | -0.71 | 1.00 | -0.17 | -0.55 | -0.69 | -0.58 | 0.43
qsec | 0.42 | -0.59 | -0.43 | -0.71 | 0.09 | -0.17 | 1.00 | 0.74 | -0.23 | -0.21 | -0.66
vs | 0.66 | -0.81 | -0.71 | -0.72 | 0.44 | -0.55 | 0.74 | 1.00 | 0.17 | 0.21 | -0.57
am | 0.60 | -0.52 | -0.59 | -0.24 | 0.71 | -0.69 | -0.23 | 0.17 | 1.00 | 0.79 | 0.06
gear | 0.48 | -0.49 | -0.56 | -0.13 | 0.70 | -0.58 | -0.21 | 0.21 | 0.79 | 1.00 | 0.27
carb | -0.55 | 0.53 | 0.39 | 0.75 | -0.09 | 0.43 | -0.66 | -0.57 | 0.06 | 0.27 | 1.00

# 2d graphs

These 2d examples are both from Winsong Chang's excellent R Graphics Cookbook.

## Correlation Matrix Example

### Correlation plot

    library(corrplot)
    corrplot(mcor)

## Network Graph Example

    library(igraph)

    ## Loading required package: methods

    # Specify edges for a directed graph
    gd <-graph(c(1,2, 2,3, 2,4, 1,4, 5,5, 3,6))
    plot(gd)

    # For an undirected graph
    gu <-graph(c(1,2, 2,3, 2,4, 1,4, 5,5, 3,6),directed=FALSE)
    # No labels
    plot(gu,vertex.label=NA)

Author: Jim Hester Created: 2013 Mar 27 10:54:38 PM Last Modified: 2013 Oct 16 03:53:30 PM

# Cars example

From statmethods.net.

    # ggplot2 examples
    library(ggplot2)
    #use color brewer as default discrete colors
    scale_colour_discrete <- function(...) scale_color_brewer(palette="Set1", ...)
    scale_fill_discrete <- function(...) scale_fill_brewer(palette="Set1", ...)

    data('mtcars')
    # create factors with value labels
    mtcars$gear <- factor(mtcars$gear,levels=c(3,4,5),
         labels=c("3gears","4gears","5gears"))
    mtcars$am <- factor(mtcars$am,levels=c(0,1),
         labels=c("Automatic","Manual"))
    mtcars$cyl <- factor(mtcars$cyl,levels=c(4,6,8),
       labels=c("4cyl","6cyl","8cyl"))
    head(mtcars)

    ##                    mpg  cyl disp  hp drat    wt  qsec vs        am   gear
    ## Mazda RX4         21.0 6cyl  160 110 3.90 2.620 16.46  0    Manual 4gears
    ## Mazda RX4 Wag     21.0 6cyl  160 110 3.90 2.875 17.02  0    Manual 4gears
    ## Datsun 710        22.8 4cyl  108  93 3.85 2.320 18.61  1    Manual 4gears
    ## Hornet 4 Drive    21.4 6cyl  258 110 3.08 3.215 19.44  1 Automatic 3gears
    ## Hornet Sportabout 18.7 8cyl  360 175 3.15 3.440 17.02  0 Automatic 3gears
    ## Valiant           18.1 6cyl  225 105 2.76 3.460 20.22  1 Automatic 3gears
    ##                   carb
    ## Mazda RX4            4
    ## Mazda RX4 Wag        4
    ## Datsun 710           1
    ## Hornet 4 Drive       1
    ## Hornet Sportabout    2
    ## Valiant              1

## Kernel density plots for mpg

Grouped by number of gears (indicated by color).

    qplot(mpg, data=mtcars, geom="density", fill=gear, alpha=I(.5),
       main="Distribution of Gas Milage", xlab="Miles Per Gallon",
       ylab="Density")

## Scatterplot of mpg vs. hp

For each combination of gears and cylinders in each facet, transmission type is represented by shape and color.

    qplot(hp, mpg, data=mtcars, shape=am, color=am,
       facets=gear~cyl, size=I(3),
       xlab="Horsepower", ylab="Miles per Gallon")

## Regressions of mpg on weight

Separate for each number of cylinders.

    qplot(wt, mpg, data=mtcars, geom=c("point", "smooth"),
       method="lm", formula=y~x, color=cyl,
       main="Regression of MPG on Weight",
       xlab="Weight", ylab="Miles per Gallon")

## Boxplots of mpg by number of gears

Observations (points) are overlayed and jittered.

    qplot(gear, mpg, data=mtcars, geom=c("boxplot", "jitter"),
       fill=gear, main="Mileage by Gear Number",
       xlab="", ylab="Miles per Gallon")

Author: Jim Hester Created: 2013 Mar 20 10:57:07 AM Last Modified: 2014 Mar 18 11:55:56 AM

# Other Languages

Syntax examples taken from http://softwaremaniacs.org/media/soft/highlight/test.html.

## R

    library(ggplot2)

    centre <- function(x, type, ...) {
      switch(type,
             mean = mean(x),
             median = median(x),
             trimmed = mean(x, trim = .1))
    }

    myVar1
    myVar.2
    data$x
    foo "bar" baz
    # test "test"
    "test # test"

    (123) (1) (10) (0.1) (.2) (1e-7)
    (1.2e+7) (2e) (3e+10) (0x0) (0xa)
    (0xabcdef1234567890) (123L) (1L)
    (0x10L) (10000000L) (1e6L) (1.1L)
    (1e-3L) (4123.381E-10i)
    (3.) (3.E10) # BUG: .E10 should be part of number

    # Numbers in some different contexts
    1L
    0x40
    .234
    3.
    1L + 30
    plot(cars, xlim=20)
    plot(cars, xlim=0x20)
    foo<-30
    my.data.3 <- read() # not a number
    c(1,2,3)
    1%%2

    "this is a quote that spans
    multiple lines
    \"

    is this still a quote? it should be.
    # even still!

    " # now we're done.

    'same for
    single quotes #'

    # keywords
    NULL, NA, TRUE, FALSE, Inf, NaN, NA_integer_,
    NA_real_, NA_character_, NA_complex_, function,
    while, repeat, for, if, in, else, next, break,
    ..., ..1, ..2

    # not keywords
    the quick brown fox jumped over the lazy dogs
    null na true false inf nan na_integer_ na_real_
    na_character_ na_complex_ Function While Repeat
    For If In Else Next Break .. .... "NULL" `NULL` 'NULL'

    # operators
    +, -, *, /, %%, ^, >, >=, <, <=, ==, !=, !, &, |, ~,
    ->, <-, <<-, $, :, ::

    # infix operator
    foo %union% bar
    %"test"%
    `"test"`

## Bash

    #!/bin/bash

    ###### BEGIN CONFIG
    ACCEPTED_HOSTS="/root/.hag_accepted.conf"
    BE_VERBOSE=false
    ###### END CONFIG

    if [ "$UID" -ne 0 ]
    then
     echo "Superuser rights is required"
     echo 'Printing the # sign'
     exit 2
    fi

    if test $# -eq 0
    then
    elif test [ $1 == 'start' ]
    else
    fi

    genApacheConf(){
     if [[ "$2" = "www" ]]
     then
      full_domain=$1
     else
      full_domain=$2.$1
     fi
     host_root="${APACHE_HOME_DIR}$1/$2"
     echo -e "# Host $1/$2 :"
    }

## Perl

    # loads object
    sub load
    {
      my $flds = $c->db_load($id,@_) || do {
        Carp::carp "Can`t load (class: $c, id: $id): '$!'"; return undef
      };
      my $o = $c->_perl_new();
      $id12 = $id / 24 / 3600;
      $o->{'ID'} = $id12 + 123;
      #$o->{'SHCUT'} = $flds->{'SHCUT'};
      my $p = $o->props;
      my $vt;
      $string =~ m/^sought_text$/;
      $items = split //, 'abc';
      for my $key (keys %$p)
      {
        if(${$vt.'::property'}) {
          $o->{$key . '_real'} = $flds->{$key};
          tie $o->{$key}, 'CMSBuilder::Property', $o, $key;
        }
      }
      $o->save if delete $o->{'_save_after_load'};
      return $o;
    }

    =head1 NAME
    POD till the end of file

## Ruby

    class A < B; def self.create(object = User) object end end
    class Zebra; def inspect; "X#{2 + self.object_id}" end end

    module ABC::DEF
      include Comparable

      # @param test
      # @return [String] nothing
      def foo(test)
        Thread.new do |blockvar|
          ABC::DEF.reverse(:a_symbol, :'a symbol', :<=>, 'test' + test)
        end.join
      end

      def [](index) self[index] end
      def ==(other) other == self end
    end

    anIdentifier = an_identifier
    Constant = 1
    render action: :new

## Python

    @requires_authorization
    def somefunc(param1='', param2=0):
        r'''A docstring'''
        if param1 > param2: # interesting
                print 'Gre\'ater'
            return (param2 - param1 + 1) or None

            class SomeClass:
                pass

            >>> message = '''interpreter
            ... prompt'''

Author: Jim Hester Created: 2013 Apr 23 09:05:58 AM Last Modified: 2014 Mar 13 01:45:32 PM

# Illusions

The R implementations for these are from Kohske Takahashi(( ???))(https://twitter.com/kohske). See http://rpubs.com/kohske/R-de-illusion from statmethods.net

## Cafe wall illusion

All the lines are actually parallel.

    library(grid)
    rs <- expand.grid(x = seq(0, 1, 1/10), y = seq(0, 1, 1/10))
    grid.rect(rs$x, rs$y, 1/10/2, 1/10/2, gp = gpar(fill = "black", col = NA))
    grid.rect(rs$x + 1/10/4, rs$y + 1/10/2, 1/10/2, 1/10/2, gp = gpar(fill = "black", col = NA))
    ls <- expand.grid(x = 0:1, y = seq(0, 1, 1/20) - 1/20/2)
    grid.polyline(ls$x, ls$y, id = gl(nrow(ls)/2, 2), gp = gpar(col = "grey50", lwd = 1))

## Ouchi

Move your frame of reference to see the effect.

    grid.newpage()
    nx <- 10; ny <- 30
    rs <- expand.grid(x = seq(0, 1, 1/nx/2), y = seq(0, 1, 1/ny/2))
    grid.rect(rs$x, rs$y, 1/nx/2, 1/ny/2, gp = gpar(col = NA, fill = c("black", "white")))
    rs <- expand.grid(x = seq(0.25, 0.75, 1/nx/2), y = seq(0.25, 0.75, 1/ny/2))
    grid.rect(rs$y, rs$x, 1/ny/2, 1/nx/2, gp = gpar(col = NA, fill = c("black", "white")))

## Fraser illusion

All the lines are actually parallel.

    library(plyr)
    grid.newpage()
    n <- 10; ny <- 8; L <- 0.01; c <- seq(0, 1, length = n); d <- 1.2*diff(c)[1]/2
    col <- c("black", "white")
    x <- c(c-d, c, c+d, c)
    y <- rep(c(0, -d, 0, d), each = n)
    w <- c(c-d, c-d+L, c+d, c+d-L)
    z <- c(0, L, 0, -L)
    ys <- seq(0, 1, length = ny)
    grid.rect(gp = gpar(fill = gray(0.5), col = NA))
    l_ply(1:ny, function(i) {n
      if (i%%2==0) {
        co <- rev(col)
        z <- -z
      } else {
        co <- col
      }
      grid.polygon(x, y + ys[i], id = rep(1:n, 4), gp = gpar(fill = co, col = NA))
      grid.polygon(w, rep(z, each = n) + ys[i], id = rep(1:n, 4), gp = gpar(fill = rev(co), col = NA))
    })

## Fraser-Wilcox illusion

    grid.newpage()
    No <- 3
    wo <- 1/3/2
    po <- seq(0, 1, by = wo)[(1:No) * 2]
    Nc <- 8
    tc <- seq(pi * 11/12, pi * 1/12, len = Nc)
    px <- c(outer(wo * cos(tc), po, `+`))
    wc <- rep(sin(tc), No)
    ag <- rep(1:No, each = Nc)
    dc <- 21
    th <- seq(0, 2 * pi, len = dc)
    grid.rect(gp = gpar(col = NA, fill = "#D2D200"))
    for (y0 in seq(0, 1, len = 10)) {
      for (i in seq_along(px)) {
        th <- seq(pi/2, pi/2 + 2 * pi, len = 21)
        if (ag[i]%%2==0) th <- rev(th)
        x <- px[i] + 0.5 * 0.04 * cos(th) * wc[i]
        y <- y0 + 0.04 * sin(th)
        grid.polygon(x, y, gp = gpar(fill = "#3278FE"))
        grid.polyline(x[1:((dc + 1)/2)], y[1:((dc + 1)/2)], gp = gpar(lineend = "butt", lwd = 3, col = gray(0)))
        grid.polyline(x[-(1:((dc - 1)/2))], y[-(1:((dc - 1)/2))], gp = gpar(lineend = "butt", lwd = 3, col = gray(1)))
      }
    }

## Parallel curves

These curves are the same offset apart for every x, even though it looks like they converge.

    x=1:100
    y=1/log10(x)
    y2=y+.2
    plot(x,y, type='l', ylim=c(0,1.5))
    lines(x,y2)

# Map plots

## USA Arrests

Examples from http://docs.ggplot2.org/current/geom_map.html.

    library(ggplot2)
    crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)
    library(reshape2) # for melt
    crimesm <- melt(crimes, id = 1)
    library(maps)
    states_map <- map_data("state")
    ggplot(crimes, aes(map_id = state)) + geom_map(aes(fill = Murder), map = states_map) + expand_limits(x = states_map$long, y = states_map$lat)
    last_plot() + coord_map()
    ggplot(crimesm, aes(map_id = state)) + geom_map(aes(fill = value), map = states_map) + expand_limits(x = states_map$long, y = states_map$lat) + facet_wrap( ~ variable)
    great_lakes_states = c('michigan', 'illinois', 'ohio', 'wisconsin', 'indiana')
    great_lakes_map = subset(states_map, region %in% great_lakes_states)
    ggplot(subset(crimesm, state %in% great_lakes_states), aes(map_id = state)) + geom_map(aes(fill = value), map = great_lakes_map) + expand_limits(x=great_lakes_map$long, y=great_lakes_map$lat) + facet_wrap( ~ variable)

Author: Jim Hester Created: 2013 Mar 28 02:44:48 PM Last Modified: 2014 Mar 05 02:16:35 PM

# Math expressions

MathJax examples.

## simple

α+β=γ

## The Lorenz Equations

$$\begin{aligned} \dot{x} &amp; = \sigma(y-x) \\ \dot{y} &amp; = \rho x - y - xz \\ \dot{z} &amp; = -\beta z + xy \end{aligned}$$

## Coins

The probability of getting (k) heads when flipping (n) coins is
$$ P(E) = {n \choose k} p^k (1-p)^{ n-k} $$

## An Identity of Ramanujan

$$ \frac{1}{\Bigl(\sqrt{\phi \sqrt{5}}-\phi\Bigr) e^{\frac25 \pi}} = 1+\frac{e^{-2\pi}} {1+\frac{e^{-4\pi}} {1+\frac{e^{-6\pi}} {1+\frac{e^{-8\pi}} {1+\ldots} } } } $$

Author: Jim Hester Created: 2013 Apr 01 03:27:26 PM Last Modified: 2014 Mar 18 11:51:39 AM

# Example messages

    print('this is a print')

    ## [1] "this is a print"

    cat('this is a cat\n')

    ## this is a cat

    message('this is a message')

    ## this is a message

    stop('this is an error')

    ## Error: this is an error

    warning('this is a warning')

    ## Warning: this is a warning

    print('this is a print')

    ## [1] "this is a print"

    cat('this is a cat\n')

    ## this is a cat

    message('this is a message')

    ## this is a message

    warning('this is a warning')

    ## Warning: this is a warning

    stop('this is an error')

    ## Error: this is an error

Author: Jim Hester Created: 2013 Mar 28 03:22:28 PM Last Modified: 2013 Dec 10 08:08:37 AM