Commit ade8d325 authored by Barry Rowlingson's avatar Barry Rowlingson

ggplot+xkcd style

parent 870223c2
......@@ -8,3 +8,5 @@ License: What license is it under?
Encoding: UTF-8
LazyData: true
RoxygenNote: 6.0.1
Imports: ggplot2,
xkcd
......@@ -16,3 +16,22 @@ do_all <- function(){
house_of_cards()
}
grid_all <- function(){
grid.arrange(
linear(),
quadratic(),
logarithmic(),
exponential(),
loess_plot(),
linear_no_slope(),
logistic(),
confidence(),
piecewise(),
connecting_lines(),
ad_hoc(),
house_of_cards()
)
}
......@@ -8,9 +8,21 @@ xo = function(){
}
baseplot <- function(name){
plot(xkcd$x, xkcd$y, pch=19, cex=2, asp=1, bty="n", axes=FALSE, xlab="", ylab="")
plot(xkcd$x, xkcd$y, pch=19, cex=2, bty="n", axes=FALSE, xlab="", ylab="")
box(bty="L", col="grey", lwd=5)
text(0.1, 9,name, cex=3, adj=0, col="grey", xpd=NA)
text(min(xkcd$x), 9,name, cex=3, adj=0, col="grey", xpd=NA)
}
ggbaseplot <- function(name){
ggplot(xkcd, aes(x=x,y=y)) + geom_point(size=3) + xkcd::theme_xkcd() +
theme(axis.text=element_blank(), axis.title=element_blank(),
axis.ticks=element_line(size=0)) +
xkcdaxis(c(0,10),c(0,10),size=3) +
geom_text(x=0.2,y=9.5,label=name,size=10, hjust=0, vjust=1, family="xkcd", col="grey",lineheight=0.9)
}
xkline <- function(d,lwd=2,col="red"){
geom_line(data=d, aes(x=x,y=y), col=col,lwd=lwd)
}
###
......@@ -21,18 +33,19 @@ baseplot <- function(name){
linear <- function(){
m = lm(y~x, data=xkcd)
baseplot("LINEAR")
abline(m, col=xo()$col, lwd=xo()$lwd)
d = data.frame(x=xkcd$x, y=predict(m))
ggbaseplot("LINEAR") +
xkline(d)
}
### 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)
nd = data.frame(x=xo()$xrange, y=f)
ggbaseplot("QUADRATIC") +
xkline(nd)
}
### 3. logarithmic
......@@ -43,9 +56,10 @@ logarithmic <- function(){
}
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
d = data.frame(x=xo()$xrange, y=f)
ggbaseplot("LOGARITHMIC") +
xkline(d)
}
......@@ -57,9 +71,8 @@ exponential <- function(){
}
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
ggbaseplot("EXPONENTIAL") +
xkline(data.frame(x=xo()$xrange, y=f))
}
### 5. loess
......@@ -67,15 +80,15 @@ exponential <- function(){
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)
ggbaseplot("LOESS") +
xkline(data.frame(x=xo()$xrange, y=f))
}
### 6. linear no slope
linear_no_slope <- function(){
baseplot("LINEAR")
abline(h=mean(xkcd$y), col=xo()$col, lwd=xo()$lwd)
ggbaseplot("LINEAR,\nNO SLOPE") +
xkline(data.frame(x=range(xkcd$x),y=rep(mean(xkcd$y),2)))
}
### 7. logistic
......@@ -87,14 +100,14 @@ logistic <- function(){
}
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)
ggbaseplot("LOGISTIC") +
xkline(data.frame(x=xo()$xrange, y=f))
}
### 8. confidence interval
confidence <- function(){
baseplot("CI-TODO")
ggbaseplot("CONFIDENCE\nINTERVAL\ntodo")
}
### 9. piecewise
......@@ -106,21 +119,24 @@ piecewise <- function(){
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)
list(xkline(data.frame(x=d$x, y=m1$fit)),
xkline(data.frame(x=n1$x, y=f1$fit + f1$se.fit*2),lwd=0.5),
xkline(data.frame(x=n1$x, y=f1$fit - f1$se.fit*2),lwd=0.5)
)
}
baseplot("PIECEWISE")
part(d1)
part(d2)
p1 = part(d1)
p2 = part(d2)
ggbaseplot("PIECEWISE") +
p1[[1]] + p1[[2]] + p1[[3]] +
p2[[1]] + p2[[2]] + p2[[3]]
}
### 10. connecting lines
connecting_lines <- function(){
baseplot("CONNECTING\nLINES")
lines(xkcd$x, xkcd$y, col=xo()$col, lwd=xo()$lwd)
ggbaseplot("CONNECTING\nLINES") +
xkline(data.frame(x=xkcd$x,y= xkcd$y))
}
......@@ -128,12 +144,12 @@ connecting_lines <- function(){
ad_hoc <- function(){
## running median looks close
ym = runmed(xkcd$y,5)
baseplot("AD-HOC")
lines(xkcd$x, ym, col=xo()$col, lwd=xo()$lwd)
ggbaseplot("AD-HOC") +
xkline(data.frame(x=xkcd$x, y=ym))
}
### 12. house of cards
house_of_cards <- function(){
baseplot("HOC - TODO")
ggbaseplot("HOUSE OF\nCARDS\ntodo")
}
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