R Object Oriented Programming

Workspace

ls(), rm() used to show and remove variables.
dir(), list.dirs(), list.files() shows files and directories.
mode(), storage.mode() shows the type

a <- 7
b <- 4
dir()

## [1] "alcohol.csv"                          
## [2] "rObjectOrientedProgramming_cache"     
## [3] "rObjectOrientedProgramming_files"     
## [4] "rObjectOrientedProgramming.html"      
## [5] "rObjectOrientedProgramming.Rmd"       
## [6] "rObjectOrientedProgramming.Rproj"     
## [7] "rObjectOrientedProgrammingFunctions.R"
## [8] "twoBinaryValues.dat"

list.dirs()

##  [1] "."                                             
##  [2] "./.Rproj.user"                                 
##  [3] "./.Rproj.user/77436C57"                        
##  [4] "./.Rproj.user/77436C57/ctx"                    
##  [5] "./.Rproj.user/77436C57/pcs"                    
##  [6] "./.Rproj.user/77436C57/presentation"           
##  [7] "./.Rproj.user/77436C57/sdb"                    
##  [8] "./.Rproj.user/77436C57/sdb/per"                
##  [9] "./.Rproj.user/77436C57/sdb/per/t"              
## [10] "./.Rproj.user/77436C57/sdb/per/u"              
## [11] "./.Rproj.user/77436C57/sdb/prop"               
## [12] "./.Rproj.user/77436C57/sdb/s-DD263947"         
## [13] "./.Rproj.user/77436C57/viewer-cache"           
## [14] "./rObjectOrientedProgramming_cache"            
## [15] "./rObjectOrientedProgramming_cache/html"       
## [16] "./rObjectOrientedProgramming_files"            
## [17] "./rObjectOrientedProgramming_files/figure-html"

list.files()

## [1] "alcohol.csv"                          
## [2] "rObjectOrientedProgramming_cache"     
## [3] "rObjectOrientedProgramming_files"     
## [4] "rObjectOrientedProgramming.html"      
## [5] "rObjectOrientedProgramming.Rmd"       
## [6] "rObjectOrientedProgramming.Rproj"     
## [7] "rObjectOrientedProgrammingFunctions.R"
## [8] "twoBinaryValues.dat"

identical(dir(), list.files()) # This is true

## [1] TRUE

identical(dir(), list.dirs()) # Not true

## [1] FALSE

mode(dir())

## [1] "character"

storage.mode(list.dirs())

## [1] "character"

Discrete Data Types

integer, logical, character, factor.
single brace ‘[’ returns objects of the same type as the variable itself.
double brace ‘[[’ returns objects of the same type as the elements within the vector.

a <- integer(12)
a

##  [1] 0 0 0 0 0 0 0 0 0 0 0 0

a[1]

## [1] 0

a[[1]]

## [1] 0

single brace on a list will return a list, double brace may return a vector.
I wonder if that means double brace is simply a single brace with drop = FALSE?
[[ used to select a single element while dropping names. [ selects a single element but keeps names.
getElement(object, name)

?`[`
?`[[`

margin.table(), given a table-ish object and the requested margin (dimension number), calculates the sum of that margin out the memebers of that dimension.
- with no given margin, compmutes the sum of all values.
- dimensions go row=1, column=2, other=3:n

a<-matrix(1:12, nrow=3, byrow=TRUE)
margin.table(a)

## [1] 78

margin.table(a, 1)

## [1] 10 26 42

margin.table(a, 2)

## [1] 15 18 21 24

Apply Family of functions

apply()
- apply()’s a given function across a given margin
lapply()
- lapply()’s a function to each element in a list.
- returns a list.
sapply()
- sapply()’s a function to each element in a list.
- if return value can be coerced to a vector, then returns a vector; else, returns a list.
rapply()
- rapply()’s a recursive version of lapply().
tapply()
- tapply()’s a function to different parts of data within an array.
- requires 3 arguments
  - set of data to apply the function too.
  - set of factors to group the data by.
  - operation to perform
mapply()
- mapply()’s takes a function to apply and a list of arrays.
vapply()
- vapply()’s a function to data returning a vector.
- requires the vector type and length to be specified.
eaapply()
- eapply()’s a function to each entry in an environment()
similar to apply() family
- do.call()
  - do.call() works by applying the given function to all elements in a list. do.call(rbind, ) will create a dataframe out of the . I use this naming to indicate that it does not need to be a list. Could be an lapply() or anything else which returns a list.
- margin.table()
  - given object and dimension number, sums up an array.
- colSums(), rowSums()
  - specific implimentation of margin.table(). colSums() = margin.table(x, 1); rowSums() = margin.table(x, 2) -replicate()

data1<-matrix(1:12, nrow=3, byrow = TRUE)
data2<-list(one=c(1,2,3), two=c(TRUE, FALSE, TRUE, TRUE))
data3<-c(28.8, 27.3, 45.8, 34.8, 25.3)
fact1<-as.factor(c('pine', 'pine', 'oak', 'pine', 'oak'))
data4<-c(1,2,3)
data5<-c(1,2,3)
data6<-structure(10*(5:8), names = LETTERS[1:4])
# apply()
apply(data1, 1, sum)

## [1] 10 26 42

    margin.table(data1, 1)

## [1] 10 26 42

    rowSums(data1)

## [1] 10 26 42

apply(data1, 2, sum)

## [1] 15 18 21 24

    margin.table(data1, 2)

## [1] 15 18 21 24

    colSums(data1)

## [1] 15 18 21 24

# lapply()
lapply(data2, sum)

## $one
## [1] 6
## 
## $two
## [1] 3

    typeof(lapply(data2, sum))

## [1] "list"

    typeof(unlist(lapply(data2, sum)))

## [1] "double"

    typeof(do.call(rbind, lapply(data2, sum)))

## [1] "double"

# sapply()
sapply(data2, sum)

## one two 
##   6   3

    typeof(sapply(data2, sum))

## [1] "double"

    typeof(unlist(sapply(data2, sum)))

## [1] "double"

# rapply()
rapply(data2, sum)

## one two 
##   6   3

    typeof(rapply(data2, sum))

## [1] "double"

    typeof(unlist(rapply(data2, sum)))

## [1] "double"

# tapply()
tapply(data3, fact1, sd)

##       oak      pine 
## 14.495689  3.968627

    typeof(tapply(data3, fact1, sd))

## [1] "double"

    class(tapply(data3, fact1, sd))

## [1] "array"

    attributes(tapply(data3, fact1, sd))

## $dim
## [1] 2
## 
## $dimnames
## $dimnames[[1]]
## [1] "oak"  "pine"

# mapply()
mapply(sum, data4)

## [1] 1 2 3

mapply(sum, data4, data5)

## [1] 2 4 6

mapply(sum, list(data4, data5))

## [1] 6 6

# vapply()
vapply(data1, fivenum,c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0))

##         [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
## Min.       1    5    9    2    6   10    3    7   11     4     8    12
## 1st Qu.    1    5    9    2    6   10    3    7   11     4     8    12
## Median     1    5    9    2    6   10    3    7   11     4     8    12
## 3rd Qu.    1    5    9    2    6   10    3    7   11     4     8    12
## Max.       1    5    9    2    6   10    3    7   11     4     8    12

# eapply()
eapply(environment(), identity)

## $data6
##  A  B  C  D 
## 50 60 70 80 
## 
## $a
##      [,1] [,2] [,3] [,4]
## [1,]    1    2    3    4
## [2,]    5    6    7    8
## [3,]    9   10   11   12
## 
## $b
## [1] 4
## 
## $data1
##      [,1] [,2] [,3] [,4]
## [1,]    1    2    3    4
## [2,]    5    6    7    8
## [3,]    9   10   11   12
## 
## $data2
## $data2$one
## [1] 1 2 3
## 
## $data2$two
## [1]  TRUE FALSE  TRUE  TRUE
## 
## 
## $data3
## [1] 28.8 27.3 45.8 34.8 25.3
## 
## $data4
## [1] 1 2 3
## 
## $data5
## [1] 1 2 3
## 
## $fact1
## [1] pine pine oak  pine oak 
## Levels: oak pine

Reading Data

scan() allows reading data from the command line.
- read in data until an empty line is sent. Will c() each entry if given a variable name.
- if given a file name, will read in the filename.
read.table()
- read.csv()
- read.fwf()

Writing Data

cat() is a generic way of writing output.
print()
- prints a single variable.
format()
- converts object to a string and allows a great deal of control of the display of the object.
paste(), paste0()

format(exp(1), digits=2)

## [1] "2.7"

format(exp(1), digits=12)

## [1] "2.71828182846"

format(exp(1), digits=3, width=5, justify = 'right')

## [1] " 2.72"

format(exp(1), digits=3, width=5, justify = 'right', decimal.mark = '#')

## [1] " 2#72"

Connectors give a generic method for treating with a data source.
- httr::handle()
- url()
- file()
  - file() given name and mode.
  - mode controls how the file is treated.
    - open=‘wb’ to write binary.
    - open=‘rb’ to read binary.
  - writeBin() writes binary values to a file connection object.
  - writeChar(), readChar()
  - readLines(), writeLines()
  - readline(), writeline()

url('http://mail.neohapsis.com')

##                 description                       class 
## "http://mail.neohapsis.com"                       "url" 
##                        mode                        text 
##                         "r"                      "text" 
##                      opened                    can read 
##                    "closed"                       "yes" 
##                   can write 
##                        "no"

    typeof(url('http://mail.neohapsis.com'))

## [1] "integer"

    class(url('http://mail.neohapsis.com'))

## [1] "url"        "connection"

    attributes(url('http://mail.neohapsis.com'))

## $class
## [1] "url"        "connection"
## 
## $conn_id
## <pointer: 0xfe>

httr::handle('https://mail.neohapsis.com')

## Warning: closing unused connection 8 (http://mail.neohapsis.com)

## Warning: closing unused connection 7 (http://mail.neohapsis.com)

## Warning: closing unused connection 6 (http://mail.neohapsis.com)

## Warning: closing unused connection 5 (http://mail.neohapsis.com)

## Host: https://mail.neohapsis.com/ <0x7ff284779a00>

    typeof(httr::handle('https://mail.neohapsis.com'))

## [1] "list"

    class(httr::handle('https://mail.neohapsis.com'))

## [1] "handle"

    attributes(httr::handle('https://mail.neohapsis.com'))

## $names
## [1] "handle" "url"   
## 
## $class
## [1] "handle"

file('alcohol.csv')

##   description         class          mode          text        opened 
## "alcohol.csv"        "file"           "r"        "text"      "closed" 
##      can read     can write 
##         "yes"         "yes"

    typeof(file('alcohol.csv'))

## [1] "integer"

    class(file('alcohol.csv'))

## [1] "file"       "connection"

    attributes(file('alcohol.csv'))

## $class
## [1] "file"       "connection"
## 
## $conn_id
## <pointer: 0x11d>

binaryFile<-file('twoBinaryValues.dat', open='wb')
    writeBin(as.double(2.72), binaryFile, size=4)
    writeBin('hello there', binaryFile, size=nchar('hello there'))
    close(binaryFile)
binaryFile<-file('twoBinaryValues.dat', open='rb')
    readBin(binaryFile, double(), size=4)

## [1] 2.72

    readBin(binaryFile, character(), 12, size=1)

## [1] "hello there"

Network Sockets

socketConnection() lets us open up a socket.

usgs<-socketConnection(host='waterdata.usgs.gov', port = 80)
    typeof(usgs)

## [1] "integer"

    class(usgs)

## [1] "sockconn"   "connection"

    attributes(usgs)

## $class
## [1] "sockconn"   "connection"
## 
## $conn_id
## <pointer: 0x128>

writeLines('Get /ny/nwis/dv?cb_00060=on&format=rdb&site_no=04267500&referred_module=sw&period=&begin_date=2013-05-08&end_date=2014-05-08 HTTP/1.1', con = usgs)
writeLines('Host: waterdata.usgs.gov', con=usgs)
writeLines('\n\n',con=usgs)
lines<-readLines(usgs)
lines

## character(0)

socket primitives include:
- make.socket()
- read.socket()
- write.socket()
- close.socket()

Distributions

help(Distributions) will give a list of included distributions.
distribution functions are made up of:
- prefix: type of function requested.
  - d: distribution function.
    - Discrete distributions using the ‘probability mass function’
      - \(p(a \leq x \leq b) = \sum\limits_{i=a}^{b}f(i)\)
    - Continuous distributions using the ‘probability density function’
      - \(p(a \leq x \leq b) = \int_{a}^{b} f(s)ds\)
  - p: Cumulative Distribution function.
    - Discrete distributions using the ‘Cumulative Distribution function.’
      - \(F(a) = p(x \leq a) = \sum\limits_{i=-\infty}^{a}f(i)\)
      - \(p(a \leq x \leq b) = F(a) - F(b)\)
    - Continuous distributions using the ‘Cumulative Distribution function.’
      - \(F(a) - p(x\leq a) \int_{-\infty}^{a} f(s)ds\)
      - \(p(a \leq x \leq b) = F(a) - F(b)\)
  - q: inverse cumulative distribution (quantile)
    - Discrete Inverse Cumulative Distribution Function
      - \(p=p(x\leq a)=F(a)\)
```
qpois(.5, 10.0)
```
```
## [1] 10
```
    - Continious Inverse Cumulative Distribution function.
      - \(p=p(x\leq a)=F(a)\)
```
qchisq(.5, 10.0)
```
```
## [1] 9.341818
```
  - r: random number generated from disturbution
- suffix: distribution requested.
  - Discrete:
    - beta
    - binom
    - cauchy
    - geom
    - hyper
    - mutlinom
    - nbinom
    - pois
  - Continuous
    - chisq
    - exp
    - f
    - gamma
    - lnorm
    - norm
    - t
    - unif
    - weibull

Sampling

sample() requires one argument:
- If a vector is given, sample will return a set of random values from the elements of that vector.
- If a number is given, saomple will return a set of random numbers from 1 to n.
If you are sample()ing from a vector more elements than the vector contains, you must set replace=TRUE
sample() uses the uniform distribution by default. To change this, specify a vector of probabilities.

sample(c(1:10, 22, 35))

##  [1]  1  8  7  3 10  2 22  6 35  9  5  4

sample(3)

## [1] 3 2 1

sample(1:3, size=8, replace = TRUE)

## [1] 3 3 1 1 1 2 3 3

sample(1:3, size=8, replace = TRUE, prob = c(.1, .8, .1))

## [1] 2 2 2 2 2 2 2 3

String Operations

Will be using the following strings throughout

urls <- c("https://duckduckgo.com?q=Johann+Carl+Friedrich+Gauss",
     "https://search.yahoo.com/search?p=Jean+Baptiste+Joseph+Fourier",
     "http://www.bing.com/search?q=Isaac+Newton",
     "http://www.google.com/search?q=Brahmagupta")

Determine the length.
- Use nchar()
```
nchar(urls)
```
```
## [1] 52 62 41 42
```

Locate substrings.

use regexpr()

regexpr(':', urls)

## [1] 6 6 5 5
## attr(,"match.length")
## [1] 1 1 1 1
## attr(,"useBytes")
## [1] TRUE

regexpr(':', urls)[1]

## [1] 6

regexpr(':', urls)[4]

## [1] 5

Extract and/or Replace a substring.

use substr()

substr(urls, 1, regexpr(':', urls)-1)

## [1] "https" "https" "http"  "http"

mailto<-urls
substr(mailto, 1, regexpr(':', urls)-1)<-c('mailto:', 'mailto:', 'mailto:')
mailto

## [1] "mailt://duckduckgo.com?q=Johann+Carl+Friedrich+Gauss"          
## [2] "mailt://search.yahoo.com/search?p=Jean+Baptiste+Joseph+Fourier"
## [3] "mail://www.bing.com/search?q=Isaac+Newton"                     
## [4] "mail://www.google.com/search?q=Brahmagupta"

use substring()
- substring() maintained for compatability with S

substring(urls, 1, regexpr(':', urls)-1)

## [1] "https" "https" "http"  "http"

use gsub()
- Uses regular expressions. The expression below ‘^(.+:).+’ sets a capture group arround start of line ^ to the first : and then captures all of the remaining line. It then replaces each string with the contents of the capture group.

gsub('^(.+:).+', '\\1', urls )

## [1] "https:" "https:" "http:"  "http:"

use chartr()

chartr('=+',"# ", urls)

## [1] "https://duckduckgo.com?q#Johann Carl Friedrich Gauss"          
## [2] "https://search.yahoo.com/search?p#Jean Baptiste Joseph Fourier"
## [3] "http://www.bing.com/search?q#Isaac Newton"                     
## [4] "http://www.google.com/search?q#Brahmagupta"

Change the case.
- toupper() and tolower()

Split strings.

strsplit()

strsplit(urls, ':')

## [[1]]
## [1] "https"                                         
## [2] "//duckduckgo.com?q=Johann+Carl+Friedrich+Gauss"
## 
## [[2]]
## [1] "https"                                                   
## [2] "//search.yahoo.com/search?p=Jean+Baptiste+Joseph+Fourier"
## 
## [[3]]
## [1] "http"                                
## [2] "//www.bing.com/search?q=Isaac+Newton"
## 
## [[4]]
## [1] "http"                                 
## [2] "//www.google.com/search?q=Brahmagupta"

Express combined objects as a single string.
- sprintf()

sprintf('URL: %s, Count=%d', urls[1], 123.0)

## [1] "URL: https://duckduckgo.com?q=Johann+Carl+Friedrich+Gauss, Count=123"

Regex in R

help(regularexpression)
gregexpr()
- returns the number of results to a regex.
- returns the location (or 0) of all matches and the number of characters that were matched.

gregexpr('=', urls)

## [[1]]
## [1] 25
## attr(,"match.length")
## [1] 1
## attr(,"useBytes")
## [1] TRUE
## 
## [[2]]
## [1] 34
## attr(,"match.length")
## [1] 1
## attr(,"useBytes")
## [1] TRUE
## 
## [[3]]
## [1] 29
## attr(,"match.length")
## [1] 1
## attr(,"useBytes")
## [1] TRUE
## 
## [[4]]
## [1] 31
## attr(,"match.length")
## [1] 1
## attr(,"useBytes")
## [1] TRUE

gregexpr('=', urls)[[1]]

## [1] 25
## attr(,"match.length")
## [1] 1
## attr(,"useBytes")
## [1] TRUE

attr(gregexpr('=', urls)[[1]],'match.length')

## [1] 1

Time

Convert a string to POSIXlt
- strptime()
Convert a string to POSIXct
- as.POSIXct(strptime())

c('08:30:00 1867-07-01','18:15:00 1864-10-27')

## [1] "08:30:00 1867-07-01" "18:15:00 1864-10-27"

strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d')

## [1] "1867-07-01 08:30:00 LMT" "1864-10-27 18:15:00 LMT"

    typeof(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d'))

## [1] "list"

    typeof(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d')[1])

## [1] "list"

    class(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d'))

## [1] "POSIXlt" "POSIXt"

    attributes(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d'))

## $names
##  [1] "sec"    "min"    "hour"   "mday"   "mon"    "year"   "wday"  
##  [8] "yday"   "isdst"  "zone"   "gmtoff"
## 
## $class
## [1] "POSIXlt" "POSIXt"

strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d')[1]-strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d')[2]

## Time difference of 976.5938 days

as.POSIXct(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d'))

## [1] "1867-07-01 08:30:00 LMT" "1864-10-27 18:15:00 LMT"

Convert POSIXlt or POSIXct to string
- strpftime()

strftime(strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d'))

## [1] "1867-07-01 08:30:00" "1864-10-27 18:15:00"

Date Arithmetic
- difftime() is not required, but quite helpful.
- change difftime() units by casting.

datetime<-strptime(c('08:30:00 1867-07-01','18:15:00 1864-10-27'), format = '%H:%M:%S %Y-%m-%d')
datetime[1] - datetime[2]

## Time difference of 976.5938 days

    typeof(datetime[1] - datetime[2])

## [1] "double"

    class(datetime[1] - datetime[2])

## [1] "difftime"

    attributes(datetime[1] - datetime[2])

## $units
## [1] "days"
## 
## $class
## [1] "difftime"

as.double(datetime[1] - datetime[2])

## [1] 976.5938

# units
as.numeric(datetime[1] - datetime[2])

## [1] 976.5938

as.numeric(datetime[1] - datetime[2], units='weeks')

## [1] 139.5134

as.numeric(datetime[1] - datetime[2], units='secs')

## [1] 84377700

- best to use difftime() specifically

difftime(time1=datetime[1], time2=datetime[2], units='mins')

## Time difference of 1406295 mins

S3 Classes

class(), like other attribut commands let you set as well as get.
An objects class is a vector.
- First element is the objects base class.
- Inherits left to right.
Toy example, coin flips and die rolls.
- Die Class
  - Roll Die: method
  - Roll History: property
  - Reset: method
- Coin Class
  - Flip Coin: method
  - Flip History: property
  - reset: method

reset <- function(theObject){
    UseMethod('reset', theObject)
    print('Reset trials')
}

reset.default <- function(theObject){
    print('Unsoported class passed in')
}

reset.Die <- function(theObject){
    theObject$trials <- character(0)
    print('Reset Die object\n')
    return(theObject)
}

reset.Coin <- function(theObject){
    theObject$trials <- character(0)
    print('Reset Coin object\n')
    return(theObject)
}

oneDie <- list(trials=character(0))
class(oneDie) <- 'Die'

oneCoin <- list(trials=character(0))
class(oneCoin) <- 'Coin'

oneDie$trials <- c('3','4','1')
oneDie$trials

## [1] "3" "4" "1"

oneDie <- reset(oneDie)

## [1] "Reset Die object\n"

oneDie$trials

## character(0)

attributes(oneDie)

## $names
## [1] "trials"
## 
## $class
## [1] "Die"

Toy example, GeometricTrial.
- GeometricTrial: Base Class
  - History: character
  - reset: NULL
  - getHistory(): factor
  - singleTrial(): list
  - simulation(): factor
    - history is cleared.
    - singleTrial method is called until a successfull test.
    - result is returned.
- Die Class
  - singleTrial(): list
- Coin Class
  - singleTrial(): list
UseMethod()
- R will search for a function whose class matches the first element in the vector.
  - If no match, looks at the second element on through element n.
  - If n is reached with no match, calls the default function.
- Defined methods react to the class() attribute.

## Assign appropriate Class Names
GeometricTrial <- function(){
    me = list(history=character(0))
    class(me) <- append(class(me), 'GeometricTrial') # this adds the base class name to the class vector.
    return(me)
}

Die <- function(){
    me<-GeometricTrial()
    class(me) <- append(class(me), 'Die') # this adds the objects class to the class vector.
    return(me)
}
Coin <- function(){
    me<-GeometricTrial()
    class(me) <- append(class(me), 'Coin') # this adds the objects class to the class vector.
    return(me)
}
###### Methods
## methods defined
reset       <-  function(theObject)     UseMethod('reset', theObject)
singleTrial <-  function(theObject)     UseMethod('singleTrial', theObject)
simulation  <-  function(theObject)     UseMethod('simulation', theObject)
getHistory <- function(theObject)       UseMethod('getHistory', theObject)
## method base cases
reset.default       <- function(theObject)  print('Unsoported class passed in')
singleTrial.default <- function(theObject){ warning("Unrecognized object found for the singleTrial method");return(list(result='1', success=TRUE))}
simulation.default  <- function(theObject){ warning('Default simulation method called.  Object not recognized'); return(theObject)}
getHistory.default  <- function(theObject) return(factor())
## methods per supported type
reset.Die <- function(theObject){
    theObject$trials <- character(0)
    return(theObject)
}
reset.Coin <- function(theObject){
    theObject$trials <- character(0)
    return(theObject)
}
singleTrial.GeometricTrial <- function(theObject) NextMethod('singleTrial', theObject)
singleTrial.Die <- function(theObject){
    value <- as.integer(1+trunc(runif(1,0,6)))
    return(list(result=value, success=(value=='H')))
}
singleTrial.Coin <- function(theObject){
    value <- as.character(cut(as.integer(1+trunc(runif(1,0,2))), c(0,1,2), lables=c('H', 'T')))
    return(list(result=value, success=(value=='H')))
}
simulation.GeometricTrial <- function(theObject){
    theObject <- reset(theObject)
    repeat{
        thisTrial <- singleTrial(theObject)
        print(thisTrial)
        theObject <- append(theObject, thisTrial$result)
        if(thisTrial$success){
            break
        }
    return(theObject)
    }
}
getHistory.GeometricTrial <- function(theObject) return(as.factor(theObject$history))

coin<- Coin()
die <- Die()
class(coin)

## [1] "list"           "GeometricTrial" "Coin"

class(die)

## [1] "list"           "GeometricTrial" "Die"

coin<-
    simulation(coin)

## $result
## [1] "(1,2]"
## 
## $success
## [1] FALSE

die<-
    simulation(die)

## $result
## [1] 3
## 
## $success
## [1] FALSE

getHistory(coin)

## factor(0)
## Levels:

‘What are the most beautiful plots that can be made in one line of R?’ from Quora

n<-100
library(Rcmdr)
library(ggplot2)
scatter3d(rnorm(n=n, mean=5, sd=1),rnorm(n=n, mean=5, sd=1),rnorm(n=n, mean=5, sd=1))
df<-data.frame('x'=rnorm(n=n, mean=5, sd=1),'y'=rnorm(n=n, mean=5, sd=1),'z'=rnorm(n=n, mean=5, sd=1))
#ggplot(df)+aes(x=x, y=y)+geom_raster(aes(z=z))

Orange$Tree <- as.numeric(Orange$Tree)
ntrees <- max(Orange$Tree)
xrange <- range(Orange$age)
yrange <- range(Orange$circumference)
plot(xrange, yrange,type="n",xlab="Age (days)",ylab="Circumference (mm)")
colors <- rainbow(ntrees)

linetype <- c(1:ntrees)
plotchar <- seq(18, 18+ntrees, 1)
for (i in 1:ntrees) {
    tree <- subset(Orange, Tree==i)
    lines(tree$age, tree$circumference,type="b",lwd=2,lty=linetype[i],col=colors[i],pch=plotchar[i]    )
}
title("Tree Growth", "example of line plot")
legend(xrange[1], yrange[2],1:ntrees,cex=0.8,col=colors,pch=plotchar,lty=linetype,title="Tree")

library(rgl)
with(iris, plot3d(Sepal.Length, Sepal.Width, Petal.Length, type="s", col=as.numeric(Species)))
#subid <- currentSubscene3d()

time <- 0:500
xyz <- cbind(cos(time/20), sin(time/10), time)
lineid <- plot3d(xyz, type="l", col = c("black", "black"))["data"]
sphereid <- spheres3d(xyz[1, , drop=FALSE], radius = 8, col = "red")

More research needed for the following functions

structure()
stopifnot()
all.equal()
replicate()

R Object Oriented Programming

Micah Norman

June 1, 2015

Workspace

Discrete Data Types

Apply Family of functions

Reading Data

Writing Data

Network Sockets

Distributions

Sampling

String Operations

Regex in R

Time

S3 Classes

‘What are the most beautiful plots that can be made in one line of R?’ from Quora

More research needed for the following functions