Commit 866af663 authored by Barry Rowlingson's avatar Barry Rowlingson

Initial commit

parents
^.*\.Rproj$
^\.Rproj\.user$
.Rproj.user
.Rhistory
.RData
Package: xkcd2048
Title: What the Package Does (one line, title case)
Version: 0.0.0.9000
Authors@R: person("First", "Last", email = "first.last@example.com", role = c("aut", "cre"))
Description: What the package does (one paragraph).
Depends: R (>= 3.4.4)
License: What license is it under?
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.0.1
# Generated by roxygen2: do not edit by hand
xo = function(){
list(
col = "red",
lwd = 5,
xrange = seq(min(xkcd$x), max(xkcd$x), len=100)
)
}
baseplot <- function(name){
plot(xkcd$x, xkcd$y, pch=19, cex=2, asp=1, bty="n", axes=FALSE, xlab="", ylab="")
box(bty="L", col="grey", lwd=5)
text(0.1, 9,name, cex=3, adj=0, col="grey")
}
###
### xkcd 2048 fits
###
### 1. linear
linear <- function(){
m = lm(y~x, data=xkcd)
baseplot("LINEAR")
abline(m, col=xo()$col, lwd=xo()$lwd)
}
### 2. quadratic
quadratic <- function(){
m = lm(y~poly(x,2), data=xkcd)
baseplot("QUADRATIC")
f = predict(m, newdata = data.frame(x=xo()$xrange))
lines(xo()$xrange, f, col=xo()$col, lwd=xo()$lwd)
}
### 3. logarithmic
logarithmic <- function(){
logp = function(x, b1, b2){
b1*log(b2*x)
}
m = nls(y~logp(x,a,b), data=xkcd, start=list(a=3, b=2))
f = predict(m, newdata = data.frame(x=xo()$xrange))
baseplot("LOGARITHMIC")
lines(xo()$xrange, f, col=xo()$col, lwd=xo()$lwd)
m
}
### 4. exponential
exponential <- function(){
expp = function(x, b0, b1, b2){
b0+b1*exp(b2*x)
}
m = nls(y~expp(x,a,b,c ), data=xkcd, start=list(a=0, b=3, c=.2 ))
f = predict(m, newdata = data.frame(x=xo()$xrange))
baseplot("EXPONENTIAL")
lines(xo()$xrange, f, col=xo()$col, lwd=xo()$lwd)
m
}
### 5. loess
loess_plot <- function(){
m = loess(y~x, data=xkcd)
f = predict(m, xo()$xrange)
baseplot("LOESS")
lines(xo()$xrange, f, col=xo()$col, lwd=xo()$lwd)
}
### 6. linear no slope
linear_no_slope <- function(){
baseplot("LINEAR")
abline(h=mean(xkcd$y), col=xo()$col, lwd=xo()$lwd)
}
### 7. logistic
logistic <- function(){
logitp = function(x, p0, p1, p2, p3){
t = p2 + p3*x
p0 + p1 * (1/(1+exp(-t)))
}
m =nls(y~logitp(x, a, b, c, d), data=xkcd, start=list(a=2, b=5, c=-5, d=1))
f = predict(m, newdata=data.frame(x=xo()$xrange))
baseplot("LOGISTIC")
lines(xo()$xrange, f, col=xo()$col, lwd=xo()$lwd)
}
### 8. confidence interval
### 9. piecewise
piecewise <- function(){
d1 = xkcd[1:(nrow(xkcd)/2),]
d2 = xkcd[-(1:(nrow(xkcd)/2)),]
part <- function(d){
n1 = data.frame(x=seq(min(d$x),max(d$x),len=100))
m1 = lm(y~x, data=d)
f1 = predict(m1, newdata=n1, se.fit=TRUE)
lines(d$x, m1$fit, col=xo()$col, lwd=xo()$lwd)
lines(n1$x, f1$fit + f1$se.fit*2, col=xo()$col)
lines(n1$x, f1$fit - f1$se.fit*2, col=xo()$col)
}
baseplot("PIECEWISE")
part(d1)
part(d2)
}
### 10. connecting lines
### 11. ad-hoc filter
### 12. house of cards
File added
Version: 1.0
RestoreWorkspace: No
SaveWorkspace: No
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
Encoding: UTF-8
AutoAppendNewline: Yes
StripTrailingWhitespace: Yes
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment