ShimadaYoshio — Oct 16, 2013, 1:51 PM
library(ggplot2)
Warning: package 'ggplot2' was built under R version 3.0.2
library(gridExtra)
Loading required package: grid
# Another example with with unequal tile sizes
NANANA
[1] NA
x.cell.boundary <- c(0, 4, 6, 8, 10, 14)
example <- data.frame(
x = rep(c(2, 5, 7, 9, 12), 2),
y = factor(rep(c(1,2), each=5)),
z = rep(1:5, each=2),
w = rep(diff(x.cell.boundary), 2)
)
a1 <- qplot(x, y, fill=z, data=example, geom="tile")
a2 <- qplot(x, y, fill=z, data=example, geom="tile", width=w)
a3 <- qplot(x, y, fill=factor(z), data=example, geom="tile",
width=w)
grid.arrange(a1,a2,a3,ncol=1)
# You can manually set the colour of the tiles using
# scale_manual
#col <- c("darkblue", "blue", "green", "orange", "red")
#a4 <- qplot(x, y, fill=col[z],
NANANA
[1] NA
# width=w,group=1) +
# scale_fill_identity(labels=letters[1:5],
# breaks=col)
#grid.arrange(a1,a2,a3,a4,ncol=2)
NANANA
[1] NA
# Generate data
pp <- function (n,r=4) {
x <- seq(-r*pi, r*pi, len=n)
df <- expand.grid(x=x, y=x)
df$r <- sqrt(df$x^2 + df$y^2)
df$z <- cos(df$r^2)*exp(-df$r/6)
df
}
a1 <- qplot(x, y, data = pp(20), fill = z, geom = "raster")
# Interpolation worsens the apperance of this plot, but can help when
# rendering images.
a2 <- qplot(x, y, data = pp(20), fill = z, geom = "raster",
interpolate = TRUE)
# For the special cases where it is applicable, geom_raster is much
# faster than geom_tile:
pp200 <- pp(200)
base <- ggplot(pp200, aes(x, y, fill = z))
benchplot(base + geom_raster())
step user.self sys.self elapsed
1 construct 0.00 0.00 0.00
2 build 0.86 0.05 0.90
3 render 0.29 0.00 0.29
4 draw 0.05 0.00 0.05
5 TOTAL 1.20 0.05 1.24
benchplot(base + geom_tile())
step user.self sys.self elapsed
1 construct 0.00 0.00 0.00
2 build 0.59 0.01 0.61
3 render 0.42 0.03 0.45
4 draw 0.11 0.00 0.11
5 TOTAL 1.12 0.04 1.17
# justification
df <- expand.grid(x = 0:5, y = 0:5)
df$z <- runif(nrow(df))
# default is compatible with geom_tile()
a6 <- ggplot(df, aes(x, y, fill = z)) + geom_raster()
# zero padding
a7 <- ggplot(df, aes(x, y, fill = z)) +
geom_raster(hjust = 0, vjust = 0)
grid.arrange(a1,a2,a6,a7,ncol=2)
NANANA
[1] NA
p <- ggplot(mtcars, aes(x=wt, y=mpg))
a1 <- p + geom_point()
a2 <- p + geom_point() + geom_rug()
a3 <- p + geom_point() + geom_rug(sides="b") # Rug on bottom only
a4 <- p + geom_point() + geom_rug(sides="trbl") # All four sides
a5 <- p + geom_point() + geom_rug(position='jitter')
grid.arrange(a1,a2,a3,a4,a5,ncol=2)
NANANA
[1] NA
p <- qplot(wt, mpg, data = mtcars)
# Fixed slopes and intercepts
p + geom_abline() # Can't see it - outside the range of the data
p + geom_abline(intercept = 20)
# Calculate slope and intercept of line of best fit
coef(lm(mpg ~ wt, data = mtcars))
(Intercept) wt
37.285 -5.344
#(Intercept) wt
#37.285126 -5.344472
p + geom_abline(intercept = 37, slope = -5)
p + geom_abline(intercept = 10, colour = "red", size = 2)
# See ?stat_smooth for fitting smooth models to data
p + stat_smooth(method="lm", se=FALSE)
# Slopes and intercepts as data
p <- ggplot(mtcars, aes(x = wt, y=mpg), . ~ cyl) + geom_point()
df <- data.frame(a=rnorm(10, 25), b=rnorm(10, 0))
p + geom_abline(aes(intercept=a, slope=b), data=df)
# Slopes and intercepts from linear model
library(plyr)
coefs <- ddply(mtcars, .(cyl), function(df) {
m <- lm(mpg ~ wt, data=df)
data.frame(a = coef(m)[1], b = coef(m)[2])
})
str(coefs)
'data.frame': 3 obs. of 3 variables:
$ cyl: num 4 6 8
$ a : num 39.6 28.4 23.9
$ b : num -5.65 -2.78 -2.19
#'data.frame': 3 obs. of 3 variables:
# $ cyl: num 4 6 8
#$ a : num 39.6 28.4 23.9
#$ b : num -5.65 -2.78 -2.19
p + geom_abline(data=coefs, aes(intercept=a, slope=b))
# It's actually a bit easier to do this with stat_smooth
p + geom_smooth(aes(group=cyl), method="lm")
p + geom_smooth(aes(group=cyl), method="lm", fullrange=TRUE)
# With coordinate transforms
p + geom_abline(intercept = 37, slope = -5) + coord_flip()
p + geom_abline(intercept = 37, slope = -5) + coord_polar()
NANANA
[1] NA
a1 <- p <- ggplot(mtcars, aes(x = wt, y=mpg)) + geom_point()
#a2 <-hjust=1.5, vjust=0.5
a3 <- p + geom_hline(yintercept=20)
a4 <- p + geom_hline(yintercept=seq(10, 30, by=5))
grid.arrange(a1,a3,a4,ncol=2)
# With coordinate transforms
a1 <- p + geom_hline(aes(yintercept=mpg)) + coord_equal()
a2 <- p + geom_hline(aes(yintercept=mpg)) + coord_flip()
a3 <- p + geom_hline(aes(yintercept=mpg)) + coord_polar()
# To display different lines in different facets, you need to
# create a data frame.
a4 <- p <- qplot(mpg, wt, data=mtcars, facets = vs ~ am)
hline.data <- data.frame(z = 1:4, vs = c(0,0,1,1), am = c(0,1,0,1))
a5 <- p + geom_hline(aes(yintercept = z), hline.data)
grid.arrange(a1,a2,ncol=1)
grid.arrange(a3,a4,a5,ncol=1)
NANANA
[1] NA
# Fixed lines
a1 <- p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point()
a2 <- p + geom_vline(xintercept = 5)
a3 <- p + geom_vline(xintercept = 1:5)
a4 <- p + geom_vline(xintercept = 1:5, colour="green",
linetype = "longdash")
a5 <- p + geom_vline(aes(xintercept = wt))
grid.arrange(a1,a2,ncol=1)
grid.arrange(a3,a4,a5,ncol=1)
# With coordinate transforms
a1 <- p + geom_vline(aes(xintercept = wt)) + coord_equal()
a2 <- p + geom_vline(aes(xintercept = wt)) + coord_flip()
a3 <- p + geom_vline(aes(xintercept = wt)) + coord_polar()
a4 <- p2 <- p + aes(colour = factor(cyl))
a5 <- p2 + geom_vline(xintercept = 15)
grid.arrange(a1,a2,ncol=1)
grid.arrange(a3,a4,a5,ncol=1)
# To display different lines in different facets, you need to
# create a data frame.
a1 <- p <- qplot(mpg, wt, data=mtcars, facets = vs ~ am)
vline.data <- data.frame(z = c(15, 20, 25, 30), vs = c(0, 0, 1, 1),
am = c(0, 1, 0, 1))
a2 <- p + geom_vline(aes(xintercept = z), vline.data)
grid.arrange(a1,a2,ncol=2)
NANANA
[1] NA
# Generate data
library(plyr)
myear <- ddply(movies, .(year), colwise(mean, .(length, rating)))#?
p <- ggplot(myear, aes(length, rating))
a1 <- p + geom_path()
# Add aesthetic mappings
a2 <- p + geom_path(aes(size = year))
a3 <- p + geom_path(aes(colour = year))
# Change scale
a4 <- p + geom_path(aes(size = year)) + scale_size(range = c(1, 3))
# Set aesthetics to fixed value
a5 <- p + geom_path(colour = "green")
grid.arrange(a1,a2,ncol=1)
grid.arrange(a3,a4,a5,ncol=1)
# Control line join parameters
df <- data.frame(x = 1:3, y = c(4, 1, 9))
base <- ggplot(df, aes(x, y))
a1 <- base + geom_path(size = 10)
a2 <- base + geom_path(size = 10, lineend = "round")
a3 <- base + geom_path(size = 10, linejoin = "mitre",
lineend = "butt")
grid.arrange(a1,a2,a3,ncol=2)
# Use qplot instead
a1 <- qplot(length, rating, data=myear, geom="path")
# Using economic data:
# How is unemployment and personal savings rate related?
a2 <- qplot(unemploy/pop, psavert, data=economics)
a3 <- qplot(unemploy/pop, psavert, data=economics, geom="path")
a4 <- qplot(unemploy/pop, psavert, data=economics, geom="path",
size=as.numeric(date))
grid.arrange(a1,a2,a3,a4,ncol=2)
# How is rate of unemployment and length of unemployment?
a1 <- qplot(unemploy/pop, uempmed, data=economics)
a2 <- qplot(unemploy/pop, uempmed, data=economics, geom="path")
a3 <- qplot(unemploy/pop, uempmed, data=economics, geom="path") +
geom_point(data=head(economics, 1), colour="red") +
geom_point(data=tail(economics, 1), colour="blue")
a4 <- qplot(unemploy/pop, uempmed, data=economics, geom="path") +
geom_text(data=head(economics, 1), label="1967", colour="blue") +
geom_text(data=tail(economics, 1), label="2007", colour="blue")
grid.arrange(a1,a2,ncol=1)
grid.arrange(a3,a4,ncol=1)
# geom_path removes missing values on the ends of a line.
# use na.rm = T to suppress the warning message
df <- data.frame(
x = 1:5,
y1 = c(1, 2, 3, 4, NA),
y2 = c(NA, 2, 3, 4, 5),
y3 = c(1, 2, NA, 4, 5),
y4 = c(1, 2, 3, 4, 5))
a1 <- qplot(x, y1, data = df, geom = c("point","line"))
a2 <- qplot(x, y2, data = df, geom = c("point","line"))
a3 <- qplot(x, y3, data = df, geom = c("point","line"))
a4 <- qplot(x, y4, data = df, geom = c("point","line"))
grid.arrange(a1,a2,a3,a4,ncol=2)
Warning: Removed 1 rows containing missing values (geom_point). Warning:
Removed 1 rows containing missing values (geom_path). Warning: Removed 1
rows containing missing values (geom_point). Warning: Removed 1 rows
containing missing values (geom_path). Warning: Removed 1 rows containing
missing values (geom_point).
#Setting line type vs colour/size
# Line type needs to be applied to a line as a whole, so it can
# not be used with colour or size that vary across a line
x <- seq(0.01, .99, length=100)
df <- data.frame(x = rep(x, 2), y = c(qlogis(x), 2 * qlogis(x)),
group = rep(c("a","b"), each=100))
p <- ggplot(df, aes(x=x, y=y, group=group))
# Should work
a1 <- p + geom_line(linetype = 2)
a2 <- p + geom_line(aes(colour = group), linetype = 2)
a3 <- p + geom_line(aes(colour = x))
grid.arrange(a1,a2,a3,ncol=2)
# Should fail
should_stop(p + geom_line(aes(colour = x), linetype=2))
# Use the arrow parameter to add an arrow to the line
# See ?grid::arrow for more details
library(grid)
c <- ggplot(economics, aes(x = date, y = pop))
# Arrow defaults to "last"
a1 <- c + geom_path(arrow = arrow())
a2 <- c + geom_path(arrow = arrow(angle = 15, ends = "both",
length = unit(0.6, "inches")))
grid.arrange(a1,a2,ncol=2)
NANANA
[1] NA
# When using geom_polygon, you will typically need two data frames:
# one contains the coordinates of each polygon (positions), and the
# other the values associated with each polygon (values). An id
# variable links the two together
ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
values <- data.frame(
id = ids,
value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5)
)
positions <- data.frame(
id = rep(ids, each = 4),
x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
)
ggplot(values) + geom_map(aes(map_id = id), map = positions) +
expand_limits(positions)
a1 <- ggplot(values, aes(fill = value)) +
geom_map(aes(map_id = id), map = positions) +
expand_limits(positions)
a2 <- ggplot(values, aes(fill = value)) +
geom_map(aes(map_id = id), map = positions) +
expand_limits(positions) + ylim(0, 3)
grid.arrange(a1,a2,ncol=2)
# Better example
crimes <- data.frame(state = tolower(rownames(USArrests)),
USArrests)
library(reshape2) # for melt
crimesm <- melt(crimes, id = 1)
if (require(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)
}
Loading required package: maps
Warning: package 'maps' was built under R version 3.0.1
NANANA
[1] NA
# When using geom_polygon, you will typically need two data frames:
# one contains the coordinates of each polygon (positions), and the
# other the values associated with each polygon (values). An id
# variable links the two together
ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3", "2.3"))
values <- data.frame(
id = ids,
value = c(3, 3.1, 3.1, 3.2, 3.15, 3.5)
)
positions <- data.frame(
id = rep(ids, each = 4),
x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
)
# Currently we need to manually merge the two together
datapoly <- merge(values, positions, by=c("id"))
(p <- ggplot(datapoly, aes(x=x, y=y)) +
geom_polygon(aes(fill=value, group=id)))
# Which seems like a lot of work, but then it's easy to add on
# other features in this coordinate system, e.g.:
stream <- data.frame(
x = cumsum(runif(50, max = 0.1)),
y = cumsum(runif(50,max = 0.1))
)
p + geom_line(data = stream, colour="grey30", size = 5)
NANANA
[1] NA
df <- data.frame(
x = sample(10, 20, replace = TRUE),
y = sample(10, 20, replace = TRUE)
)
ggplot(df, aes(xmin = x, xmax = x + 1, ymin = y, ymax = y + 2)) +
geom_rect()
NANANA
[1] NA
p <- ggplot(mtcars, aes(x=wt, y=mpg, label=rownames(mtcars)))
a1 <- p + geom_text()
# Change size of the label
a2 <- p + geom_text(size=3)
a3 <- p + geom_text(size=10)
grid.arrange(a1,a2,a3,ncol=1)
a1 <- p <- p + geom_point()
# Set aesthetics to fixed value
a2 <- p + geom_text()
a3 <- p + geom_point() + geom_text(hjust=0, vjust=0)
a4 <- p + geom_point() + geom_text(angle = 45)
grid.arrange(a1,a2,a3,a4,ncol=1)
a3 <- p + geom_point() + geom_text(hjust=0, vjust=0)
a4 <- p + geom_point() + geom_text(size=3,hjust=1.5, vjust=0.5)
grid.arrange(a3,a4,ncol=1)
# Add aesthetic mappings
a1 <- p + geom_text(aes(colour=factor(cyl)))
a2 <- p + geom_text(aes(colour=factor(cyl))) +
scale_colour_discrete(l=40)
a3 <- p + geom_text(aes(size=wt))
a4 <- p + geom_text(aes(size=wt)) + scale_size(range=c(3,6))
grid.arrange(a1,a2,a3,a4,ncol=2)
# You can display expressions by setting parse = TRUE. The
# details of the display are described in ?plotmath, but note that
# geom_text uses strings, not expressions.
p + geom_text(aes(label = paste(wt, "^(", cyl, ")", sep = "")),
parse = TRUE)
# Add an annotation not from a variable source
a1 <- c <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
a2 <- c + geom_text(data = NULL, x = 5, y = 30,
label = "plot mpg vs. wt")
# Or, you can use annotate
a3 <- c + annotate("text", label = "plot mpg vs. wt", x = 2,
y = 15,size = 8, colour = "red")
# Use qplot instead
a4 <- qplot(wt, mpg, data = mtcars, label = rownames(mtcars),
geom=c("point", "text"))
grid.arrange(a1,a2,a3,a4,ncol=2)
#-------------------------!!!!!
qplot(wt, mpg, data = mtcars, label = rownames(mtcars), size = wt) +
geom_text(colour = "red")
p <- qplot(wt, mpg, data = mtcars, ###!!!!
size=as.factor(gear),
colour=as.factor(carb),
label = rownames(mtcars), size = cyl) +
geom_text(colour = 2,hjust=.5, vjust=.2) +
geom_hline(yintercept = mean(mtcars$mpg),colour="blue",
linetype = "longdash",size=.2) +
geom_vline(xintercept = mean(mtcars$wt),colour="blue",
linetype = "longdash",size=.2)
p
p + facet_wrap(vs ~ am , scales = "free")
p + facet_wrap(vs ~ am , scales = "free_x")
p + facet_wrap(vs ~ am , scales = "free_y")
p + facet_wrap( ~ am ,nrow=2,ncol=2)
p + facet_grid( vs ~ am )
#qplot(wt, mpg, z = cyl, data = mtcars, stat = "contour",
# geom = "path")
#--------------------------------------------
# You can specify family, fontface and lineheight
p <- ggplot(mtcars, aes(x=wt, y=mpg, label=rownames(mtcars)))
a1 <- p + geom_text(fontface=3)
a2 <- p + geom_text(aes(fontface=am+1))
a3 <- p + geom_text(aes(family=c("serif", "mono")[am+1]))
grid.arrange(a1,a2,a3,ncol=1)
NANANA
[1] NA
df <- expand.grid(x = 1:10, y=1:10)
df$angle <- runif(100, 0, 2*pi)
df$speed <- runif(100, 0, 0.5)
a1 <- qplot(x, y, data=df) + stat_spoke(aes(angle=angle),
radius = 0.5)
a2 <- last_plot() + scale_y_reverse()
a3 <- qplot(x, y, data=df) + stat_spoke(aes(angle=angle,
radius=speed))
grid.arrange(a1,a2,a3,ncol=2)
NANANA
[1] NA
a1 <- qplot(length, rating, data = movies, geom = "blank")
# Nothing to see here!
# Take the following scatter plot
a2 <- a <- ggplot(mtcars, aes(x = wt, y = mpg), . ~ cyl) +
geom_point()
# Add to that some lines with geom_abline()
df <- data.frame(a = rnorm(10, 25), b = rnorm(10, 0))
a3 <- a + geom_abline(aes(intercept = a, slope = b), data = df)
# Suppose you then wanted to remove the geom_point layer
# If you just remove geom_point, you will get an error
b <- ggplot(mtcars, aes(x = wt, y = mpg))
## Not run: b + geom_abline(aes(intercept = a, slope = b), data = df)
# Switching to geom_blank() gets the desired plot
c <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_blank()
a4 <- c + geom_abline(aes(intercept = a, slope = b), data = df)
grid.arrange(a1,a2,a3,a4,ncol=2)
NANANA
[1] NA
x <- rnorm(100)
a1 <- base <- qplot(x, geom = "density")
a2 <- base + stat_function(fun = dnorm, colour = "red")
a3 <- base + stat_function(fun = dnorm, colour = "red",
arg = list(mean = 3))
a4 <- base + stat_function(fun = dnorm, colour = "red",
arg = list(mean = -1,sd=0.5))
grid.arrange(a1,a2,a3,a4,ncol=2)
# Plot functions without data
# Examples adapted from Kohske Takahashi
# Specify range of x-axis
a1 <- qplot(c(0, 2), stat = "function", fun = exp, geom = "line")
a2 <- ggplot(data.frame(x = c(0, 2)), aes(x)) +
stat_function(fun = exp)
grid.arrange(a1,a2,ncol=1)
# Plot a normal curve
a1 <- ggplot(data.frame(x = c(-5, 5)), aes(x)) +
stat_function(fun = dnorm)
# With qplot
a2 <- qplot(c(-5, 5), stat = "function", fun = dnorm, geom = "line")
# Or
a3 <- qplot(c(-5, 5), geom = "blank") + stat_function(fun = dnorm)
# To specify a different mean or sd, use the args parameter to supply new values
a4 <- ggplot(data.frame(x = c(-5, 5)), aes(x)) +
stat_function(fun = dnorm, args = list(mean = 2, sd = .5))
grid.arrange(a1,a2,a3,a4,ncol=2)
# Two functions on the same plot
f <- ggplot(data.frame(x = c(0, 10)), aes(x))
a1 <- f + stat_function(fun = sin, colour = "red") +
stat_function(fun = cos, colour = "blue")
# Using a custom function
test <- function(x) {x ^ 2 + x + 20}
a2 <- f + stat_function(fun = test)
grid.arrange(a1,a2,ncol=1)
##遐皮ｩｶ###
f <- function() {
a <- 1:10
b <- a ^ 2
qplot(a, b)
}
f()
f1 <- function(a,b,c,d) {
a1 <- seq(min(a),max(a),by=0.01)
y <- a1^4+b*a1^3+c*a1+d
aa <- cbind(a1,y)
aa2 <- min(aa[,2])
qplot(a1, y,geom="line")
}
f1(a=1:10,b=-10,c=-3,d=10)
NANANA
[1] NA
# From ?qqplot
y <- rt(200, df = 5)
a1 <- qplot(sample = y, stat="qq")
# qplot is smart enough to use stat_qq if you use sample
a2 <- qplot(sample = y)
a3 <- qplot(sample = precip)
a4 <- qplot(sample = y, dist = qt, dparams = list(df = 5))
df <- data.frame(y)
a5 <- ggplot(df, aes(sample = y)) + stat_qq()
a6 <- ggplot(df, aes(sample = y)) + geom_point(stat = "qq")
grid.arrange(a1,a2,a3,a4,a5,a6,ncol=2)
# Use fitdistr from MASS to estimate distribution params
library(MASS)
Warning: package 'MASS' was built under R version 3.0.1
params <- as.list(fitdistr(y, "t")$estimate)
Warning: NaNs produced Warning: NaNs produced
# Using to explore the distribution of a variable
a1 <- qplot(sample = mpg, data = mtcars)
a2 <- qplot(sample = mpg, data = mtcars, colour = factor(cyl))
grid.arrange(a1,a2,ncol=2)
###################################
NANANA
[1] NA
p + scale_x_continuous(
breaks = seq(1, 8, by = 1),
labels = c("1st", "2nd", "3rd", "4th", "5th", "6th",
"7th", "8th")
)
Error: No layers in plot
q + scale_x_discrete(
breaks = seq(0, 1, by = 1),
labels = c(expression(a <= 10), expression(a > 10))
)
Error: non-numeric argument to binary operator
###
x <- data.frame("variable"=letters[1:5],
"value"=rnorm(5)) ## example data
x <- x[with(x,order(-value)), ] ## Sorting
x$variable <- ordered(x$variable,
levels=levels(x$variable)[unclass(x$variable)])
ggplot(x, aes(x=variable,y=value)) + geom_bar() +
scale_y_continuous("",formatter="percent") +
coord_flip()
Error: unused argument (formatter = "percent")
#-----------------------------------------
NANANA
[1] NA
require(ggplot2)
d <- data.frame(
x = c("80-", "90-", "100-", "110-", "120-", "130-", "140-", "150-", "160-", "170-", "180-"),
y = c(0, 9, 35, 81, 194, 276, 271, 207, 138, 55, 59),
z = seq(1, 11)
)
a1 <- ggplot(d, aes(x = reorder(x, z), y = y)) +
geom_bar(stat = "identity") +
xlab("Systolic blood pressure [mmHg]") +
ylab("Frequency") +
theme_gray(20, "serif")
a2 <- ggplot(d, aes(x = x, y = y)) +
geom_bar(stat = "identity") +
xlab("Systolic blood pressure [mmHg]") +
ylab("Frequency") +
theme_gray(20, "serif")
grid.arrange(a1,a2,ncol=1)
NANANA
[1] NA
library(reshape2) # for melt
library(plyr) # for ddply
ecm <- melt(economics, id = "date")
head(ecm,5)
date variable value
1 1967-06-30 pce 507.8
2 1967-07-31 pce 510.9
3 1967-08-31 pce 516.7
4 1967-09-30 pce 513.3
5 1967-10-31 pce 518.5
rescale01 <- function(x) (x - min(x)) / diff(range(x))
ecm <- ddply(ecm, "variable", transform,
value = rescale01(value))
head(ecm,5)
date variable value
1 1967-06-30 pce 0.0000000
2 1967-07-31 pce 0.0003371
3 1967-08-31 pce 0.0009677
4 1967-09-30 pce 0.0005980
5 1967-10-31 pce 0.0011634
a1 <- qplot(date, value, data=ecm, geom="line",
group=variable) ##
a2 <- qplot(date, value, data=ecm, geom="line",
linetype=variable) ##
a3 <- qplot(date, value, data=ecm, geom="line",
colour=variable) ##
grid.arrange(a1,a2,ncol=1)
a3
NANANA
[1] NA
dsmall <- diamonds[sample(nrow(diamonds), 100), ]
d <- qplot(carat, price, data=dsmall, shape=cut)
a2 <- d + scale_shape(solid = TRUE) # the default
a3 <- d + scale_shape(solid = FALSE)
a4 <- d + scale_shape(name="Cut of diamond")
a5 <- d + scale_shape(name="Cut of\ndiamond")
grid.arrange(d,a2,ncol=1)
grid.arrange(a3,a4,a5,ncol=1)
# To change order of levels, change order of
# underlying factor
levels(dsmall$cut) <- c("Fair", "Good", "Very Good",
"Premium", "Ideal")
# Need to recreate plot to pick up new data
a1 <- qplot(price, carat, data=dsmall, shape=cut)
# Or for short:
a2 <- d %+% dsmall
grid.arrange(a1,a2,ncol=1)
NANANA
[1] NA
p <- qplot(mpg, cyl, data=mtcars, size=cyl)
a1 <- p + scale_size("cylinders")
a2 <- p + scale_size("number\nof\ncylinders")
a3 <- p + scale_size(range = c(0, 10))
a4 <- p + scale_size(range = c(1, 2))
a5 <- p + scale_area()
scale_area is deprecated. Use scale_size_area instead. Note that the
behavior of scale_size_area is slightly different: by default it makes the
area proportional to the numeric value. (Deprecated; last used in version
0.9.2)
a6 <- p + scale_area(range = c(1, 25))
scale_area is deprecated. Use scale_size_area instead. Note that the
behavior of scale_size_area is slightly different: by default it makes the
area proportional to the numeric value. (Deprecated; last used in version
0.9.2)
a7<- qplot(mpg, cyl, data=mtcars, size=factor(cyl))
a8 <- last_plot() + scale_size_manual(values=c(2,4,6))
grid.arrange(p,a1,a2,a3,a4,ncol=2)
grid.arrange(a5,a6,a7,a8,ncol=2)
NANANA
[1] NA
p <- qplot(mpg, wt, data=mtcars, colour=factor(cyl))
a1 <- p + scale_colour_grey()
a2 <- p + scale_colour_grey(end = 0)
# You may want to turn off the pale grey background with this scale
a3 <- p + scale_colour_grey() + theme_bw()
# Colour of missing values is controlled with na.value:
miss <- factor(sample(c(NA, 1:5), nrow(mtcars),
rep = TRUE))
a4 <- qplot(mpg, wt, data = mtcars, colour = miss) +
scale_colour_grey()
a5 <- qplot(mpg, wt, data = mtcars, colour = miss) +
scale_colour_grey(na.value = "green")
grid.arrange(p,a1,ncol=1)
grid.arrange(a2,a3,a4,a5,ncol=2)
NANANA
[1] NA
dsub <- subset(diamonds, x > 5 & x < 6 & y > 5 & y < 6)
dsub$diff <- with(dsub, sqrt(abs(x-y))* sign(x-y))
d <- qplot(x, y, data=dsub, colour=diff)
a1 <- d + scale_colour_gradientn(colours = rainbow(7))
breaks <- c(-0.5, 0, 0.5)
a2 <- d + scale_colour_gradientn(colours = rainbow(7),
breaks = breaks, labels = format(breaks))
a3 <- d + scale_colour_gradientn(colours = topo.colors(10))
a4 <- d + scale_colour_gradientn(colours = terrain.colors(10))
# You can force them to be symmetric by supplying a vector of
# values, and turning rescaling off
max_val <- max(abs(dsub$diff))
values <- seq(-max_val, max_val, length = 11)
a5 <- d + scale_colour_gradientn(colours = topo.colors(10),
values = values, rescaler = function(x, ...) x, oob = identity)
a6 <- d + scale_colour_gradientn(colours = terrain.colors(10),
values = values, rescaler = function(x, ...) x, oob = identity)
grid.arrange(d,a1,a2,a3,a4,a5,a6,ncol=2)
NANANA
[1] NA
dsub <- subset(diamonds, x > 5 & x < 6 & y > 5 & y < 6)
dsub$diff <- with(dsub, sqrt(abs(x-y))* sign(x-y))
(d <- qplot(x, y, data=dsub, colour=diff))
d + scale_colour_gradient2()
# Change scale name
d + scale_colour_gradient2(expression(sqrt(abs(x - y))))
d + scale_colour_gradient2("Difference\nbetween\nwidth and\nheight")
# Change limits and colours
d + scale_colour_gradient2(limits=c(-0.2, 0.2))
# Using "muted" colours makes for pleasant graphics
# (and they have better perceptual properties too)
library(scales) # for muted
d + scale_colour_gradient2(low="red", high="blue")
d + scale_colour_gradient2(low=muted("red"),
high=muted("blue"))
# Using the Lab colour space also improves perceptual properties
# at the price of slightly slower operation
d + scale_colour_gradient2(space="Lab")
# About 5% of males are red-green colour blind, so it's a good
# idea to avoid that combination
d + scale_colour_gradient2(high=muted("green"))
# We can also make the middle stand out
d + scale_colour_gradient2(mid=muted("green"), high="white", low="white")
# or use a non zero mid point
(d <- qplot(carat, price, data=diamonds,
colour=price/carat))
d + scale_colour_gradient2(midpoint=
mean(diamonds$price / diamonds$carat))
# Fill gradients work much the same way
p <- qplot(letters[1:5], 1:5, fill= c(-3, 3, 5, 2, -2), geom="bar")
p + scale_fill_gradient2("fill")
Mapping a variable to y and also using stat="bin". With stat="bin", it
will attempt to set the y value to the count of cases in each group. This
can result in unexpected behavior and will not be allowed in a future
version of ggplot2. If you want y to represent counts of cases, use
stat="bin" and don't map a variable to y. If you want y to represent
values in the data, use stat="identity". See ?geom_bar for examples.
(Deprecated; last used in version 0.9.2)
NANANA
[1] NA
# scale_colour_gradient make it easy to use existing colour palettes
dsub <- subset(diamonds, x > 5 & x < 6 & y > 5 & y < 6)
dsub$diff <- with(dsub, sqrt(abs(x-y))* sign(x-y))
d <- qplot(x, y, data=dsub, colour=diff)
a1 <- d + scale_colour_gradientn(colours = rainbow(7))
breaks <- c(-0.5, 0, 0.5)
a2 <- d + scale_colour_gradientn(colours = rainbow(7),
breaks = breaks, labels = format(breaks))
a3 <- d + scale_colour_gradientn(colours = topo.colors(10))
a4 <- d + scale_colour_gradientn(colours = terrain.colors(10))
# You can force them to be symmetric by supplying a vector of
# values, and turning rescaling off
max_val <- max(abs(dsub$diff))
values <- seq(-max_val, max_val, length = 11)
a5 <- d + scale_colour_gradientn(colours = topo.colors(10),
values = values, rescaler = function(x, ...) x, oob = identity)
a6 <- d + scale_colour_gradientn(colours = terrain.colors(10),
values = values, rescaler = function(x, ...) x, oob = identity)
grid.arrange(d,a1,a2,a3,a4,a5,ncol=2)
NANANA
[1] NA
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
d <- qplot(carat, price, data=dsamp, colour=clarity)
# Change scale label
a1 <- d + scale_colour_hue()
a2 <- d + scale_colour_hue("clarity")
a3 <- d + scale_colour_hue(expression(clarity[beta]))
grid.arrange(d,a1,a2,a3,ncol=2)
# Adjust luminosity and chroma
a1 <- d + scale_colour_hue(l=40, c=30)
a2 <- d + scale_colour_hue(l=70, c=30)
a3 <- d + scale_colour_hue(l=70, c=150)
a4 <- d + scale_colour_hue(l=80, c=150)
grid.arrange(a1,a2,a3,a4,ncol=2)
# Change range of hues used
a1 <- d + scale_colour_hue(h=c(0, 90))
a2 <- d + scale_colour_hue(h=c(90, 180))
a3 <- d + scale_colour_hue(h=c(180, 270))
a4 <- d + scale_colour_hue(h=c(270, 360))
grid.arrange(a1,a2,a3,a4,ncol=2)
# Vary opacity
# (only works with pdf, quartz and cairo devices)
d <- ggplot(dsamp, aes(carat, price, colour = clarity))
a1 <- d + geom_point(alpha = 0.9) + ggtitle("alpha = 0.9")
a2 <- d + geom_point(alpha = 0.5) + ggtitle("alpha = 0.5")
a3 <- d + geom_point(alpha = 0.2) + ggtitle("alpha = 0.2")
grid.arrange(a1,a2,a3,ncol=1)
# Colour of missing values is controlled with na.value:
miss <- factor(sample(c(NA, 1:5), nrow(mtcars), rep = TRUE))
a1 <- qplot(mpg, wt, data = mtcars, colour = miss)
a2 <- qplot(mpg, wt, data = mtcars, colour = miss) +
NANA
Error: Don't know how to add NA to a plot
grid.arrange(a1,a2,ncol=1)
NANANA
[1] NA
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
d <- qplot(carat, price, data=dsamp, colour=clarity)
# Change scale label
a1 <- d + scale_colour_brewer()
a2 <- d + scale_colour_brewer("clarity")
a3 <- d + scale_colour_brewer(expression(clarity[beta]))
grid.arrange(d,a1,a2,a3,ncol=2)
# Select brewer palette to use, see ?scales::brewer_pal for more details
a1 <- d + scale_colour_brewer(type="seq")
a2 <- d + scale_colour_brewer(type="seq", palette=3)
a3 <- d + scale_colour_brewer(palette="Blues")
a4 <- d + scale_colour_brewer(palette="Set1")
grid.arrange(a1,a2,a3,a4,ncol=2)
# scale_fill_brewer works just the same as
# scale_colour_brewer but for fill colours
ggplot(diamonds, aes(x=price, fill=cut)) + #####
geom_histogram(position="dodge", binwidth=1000) +
scale_fill_brewer()
NANANA
[1] NA
p <- qplot(mpg, cyl, data = mtcars, alpha = cyl)
a1 <- p + scale_alpha("cylinders")
a2 <- p + scale_alpha("number\nof\ncylinders")
a3 <- p + scale_alpha(range = c(0.4, 0.8))
grid.arrange(p,a1,a2,a3,ncol=2)
a1 <- p <- qplot(mpg, cyl, data=mtcars, alpha = factor(cyl))
a2 <- p + scale_alpha_discrete(range = c(0.4, 0.8))
grid.arrange(a1,a2,ncol=1)
NANANA
[1] NA
p <- qplot(mpg, wt, data = mtcars, colour = factor(cyl))
a1 <- p + scale_colour_manual(values = c("red","blue", "green"))
a2 <- p + scale_colour_manual(
values = c("8" = "red","4" = "blue","6" = "green"))
# With rgb hex values
a3 <- p + scale_colour_manual(values = c("#FF0000", "#0000FF", "#00FF00"))
grid.arrange(p,a1,a2,a3,ncol=2)
# As with other scales you can use breaks to control the appearance
# of the legend
cols <- c("8" = "red","4" = "blue","6" = "darkgreen",
"10" = "orange")
a1 <- p + scale_colour_manual(values = cols)
a2 <- p + scale_colour_manual(values = cols,
breaks = c("4", "6", "8"))
a3 <- p + scale_colour_manual(values = cols,
breaks = c("8", "6", "4"))
a4 <- p + scale_colour_manual(values = cols,
breaks = c("4", "6", "8"),
labels = c("four", "six", "eight"))
# And limits to control the possible values of the scale
a5 <- p + scale_colour_manual(values = cols, limits = c("4", "8"))
# Notice that the values are matched with limits, and not breaks
a6 <- p + scale_colour_manual(limits = c(6, 8, 4),
breaks = c(8, 4, 6),
values = c("grey50", "grey80", "black"))
grid.arrange(a1,a2,a3,a4,a5,a6,ncol=2)
NANANA
[1] NA
colour <- c("red", "green", "blue", "yellow")
a1 <- qplot(1:4, 1:4, fill = colour, geom = "tile")
a2 <- qplot(1:4, 1:4, fill = colour, geom = "tile") +
scale_fill_identity()
# To get a legend guide, specify guide = "legend"
a3 <- qplot(1:4, 1:4, fill = colour, geom = "tile") +
scale_fill_identity(guide = "legend")
# But you'll typically also need to supply breaks and labels:
a4 <- qplot(1:4, 1:4, fill = colour, geom = "tile") +
scale_fill_identity("trt", labels = letters[1:4], breaks = colour,
guide = "legend")
grid.arrange(a1,a2,a3,a4,ncol=2)
# cyl scaled to appropriate size
a1 <- qplot(mpg, wt, data = mtcars, size = cyl)
# cyl used as point size
a2 <- qplot(mpg, wt, data = mtcars, size = cyl) +
scale_size_identity()
grid.arrange(a1,a2,ncol=1)
NANANA
[1] NA
qplot(cut, data=diamonds, stat="bin")
qplot(cut, data=diamonds, geom="bar")
# The discrete position scale is added automatically whenever you
# have a discrete position.
(d <- qplot(cut, clarity, data=subset(diamonds, carat > 1),
geom="jitter"))
d + scale_x_discrete("Cut")
d + scale_x_discrete("Cut", labels = c("Fair" = "F","Good" = "G",
"Very Good" = "VG","Perfect" = "P","Ideal" = "I"))
d + scale_y_discrete("Clarity")
d + scale_x_discrete("Cut") + scale_y_discrete("Clarity")
# Use limits to adjust the which levels (and in what order)
# are displayed
a1 <- d + scale_x_discrete(limits=c("Fair","Ideal"))
# you can also use the short hand functions xlim and ylim
a2 <- d + xlim("Fair","Ideal", "Good")
a3 <- d + ylim("I1", "IF")
grid.arrange(a1,a2,a3,ncol=2)
Warning: Removed 11189 rows containing missing values (geom_point).
Warning: Removed 9610 rows containing missing values (geom_point).
Warning: Removed 16770 rows containing missing values (geom_point).
# See ?reorder to reorder based on the values of another variable
a1 <- qplot(manufacturer, cty, data=mpg)
a2 <- qplot(reorder(manufacturer, cty), cty, data=mpg)
a3 <- qplot(reorder(manufacturer, displ), cty, data=mpg)
# Use abbreviate as a formatter to reduce long names
a4 <- qplot(reorder(manufacturer, cty), cty, data=mpg) +
scale_x_discrete(labels = abbreviate)
grid.arrange(a1,a2,a3,a4,ncol=2)
#~~~~~??
d <- qplot(iris[,1],iris[,2],data=iris,geom="jitter",
colour = iris[,5])
d + xlim("setosa","versicolor", "virginica")
d + scale_x_discrete(limits=c("setosa","versicolor", "virginica")) +
scale_y_discrete("setosa","versicolor", "virginica")
NANANA
[1] NA
(m <- qplot(rating, votes, data=subset(movies, votes > 1000),
na.rm = TRUE))
# Manipulating the default position scales lets you:
# * change the axis labels
m + scale_y_continuous("number of votes")
m + scale_y_continuous(expression(votes^alpha))
# * modify the axis limits
m + scale_y_continuous(limits=c(0, 5000))
m + scale_y_continuous(limits=c(1000, 10000))
m + scale_x_conti# you can also use the short hand functions xlim and ylim
Error: object 'scale_x_conti' not found
m + ylim(0, 5000)
m + ylim(1000, 10000)
m + xlim(7, 8)
# * choose where the ticks appear
m + scale_x_continuous(breaks=1:10)
m + scale_x_continuous(breaks=c(1,3,7,9))
# * manually label the ticks
m + scale_x_continuous(breaks=c(2,5,8),
labels=c("two", "five", "eight"))
m + scale_x_continuous(breaks=c(2,5,8),
labels=c("horrible", "ok", "awesome"))
m + scale_x_continuous(breaks=c(2,5,8),
labels=expression(Alpha, Beta, Omega))
# There are a few built in transformation that you can use:
m + scale_y_log10()
m + scale_y_sqrt()
m + scale_y_reverse()
# You can control the formatting of the labels with the formatter
# argument. Some common formats are built into the scales package:
x <- rnorm(10) * 100000
y <- seq(0, 1, length = 10)
p <- qplot(x, y)
library(scales)
p + scale_y_continuous(labels = percent)
p + scale_y_continuous(labels = dollar)
p + scale_x_continuous(labels = comma)
# qplot allows you to do some of this with a little less typing:
# * axis limits
qplot(rating, votes, data=movies, ylim=c(1e4, 5e4))
Warning: Removed 58018 rows containing missing values (geom_point).
# * axis labels
qplot(rating, votes, data=movies, xlab="My x axis", ylab="My y axis")
# * log scaling
qplot(rating, votes, data=movies, log="xy")
##scale_date 霆ｸ 蟷ｴ譛域律霆ｸ繧ｹ繧ｱ繝ｼ繝ｫ繧剃ｽ懊ｋ
# We'll start by creating some nonsense data with dates
df <- data.frame(
date = seq(Sys.Date(), len=100, by="1 day")[sample(100, 50)],
price = runif(50)
)
df <- df[order(df$date), ]
dt <- qplot(date, price, data=df, geom="line") + theme(aspect.ratio = 1/4)
# We can control the format of the labels, and the frequency of
# the major and minor tickmarks. See ?format.Date and ?seq.Date
# for more details.
library(scales) # to access breaks/formatting functions
dt + scale_x_date()
dt + scale_x_date(labels = date_format("%m/%d"))
dt + scale_x_date(labels = date_format("%W"))
dt + scale_x_date(labels = date_format("%W"),
breaks = date_breaks("week"))
dt + scale_x_date(breaks = date_breaks("months"),
labels = date_format("%b"))
dt + scale_x_date(breaks = date_breaks("4 weeks"),
labels = date_format("%d-%b"))
# We can use character string for breaks.
# See \code{\link{by}} argument in \code{\link{seq.Date}}.
dt + scale_x_date(breaks = "2 weeks")
dt + scale_x_date(breaks = "1 month", minor_breaks = "1 week")
# The date scale will attempt to pick sensible defaults for
# major and minor tick marks
qplot(date, price, data=df[1:10,], geom="line")
qplot(date, price, data=df[1:4,], geom="line")
df <- data.frame(
date = seq(Sys.Date(), len=1000, by="1 day"),
price = runif(500)
)
qplot(date, price, data=df, geom="line")
# A real example using economic time series data
qplot(date, psavert, data=economics)
qplot(date, psavert, data=economics, geom="path")
end <- max(economics$date)
last_plot() + scale_x_date(limits = c(as.Date("2000-1-1"), end))
last_plot() + scale_x_date(limits = c(as.Date("2005-1-1"), end))
Scale for 'x' is already present. Adding another scale for 'x', which will
replace the existing scale.
last_plot() + scale_x_date(limits = c(as.Date("2006-1-1"), end))
Scale for 'x' is already present. Adding another scale for 'x', which will
replace the existing scale.
# If we want to display multiple series, one for each variable
# it's easiest to first change the data from a "wide" to a "long"
# format:
library(reshape2) # for melt
em <- melt(economics, id = "date")
# Then we can group and facet by the new "variable" variable
qplot(date, value, data = em, geom = "line", group = variable)
##
qplot(date, value, data = em, geom = "line", group = variable) +
facet_grid(variable ~ ., scale = "free_y")
##scale_datetime 霆ｸ 蟷ｴ譛域律譎る俣霆ｸ繧ｹ繧ｱ繝ｼ繝ｫ繧剃ｽ懊ｋ
start <- ISOdate(2001, 1, 1, tz = "")
df <- data.frame(
day30 = start + round(runif(100, max = 30 * 86400)),
day7 = start + round(runif(100, max = 7 * 86400)),
day = start + round(runif(100, max = 86400)),
hour10 = start + round(runif(100, max = 10 * 3600)),
hour5 = start + round(runif(100, max = 5 * 3600)),
hour = start + round(runif(100, max = 3600)),
min10 = start + round(runif(100, max = 10 * 60)),
min5 = start + round(runif(100, max = 5 * 60)),
min = start + round(runif(100, max = 60)),
sec10 = start + round(runif(100, max = 10)),
y = runif(100)
)
# Automatic scale selection
qplot(sec10, y, data = df)
qplot(min, y, data = df)
qplot(min5, y, data = df)
qplot(min10, y, data = df)
qplot(hour, y, data = df)
qplot(hour5, y, data = df)
plot(hour10, y, data = df)
Error: object 'hour10' not found
qqplot(day, y, data = df)
Error: object 'day' not found
qplot(day30, y, data = df)
# Manual scale selection
qplot(day30, y, data = df)
library(scales) # to access breaks/formatting functions
last_plot() + scale_x_datetime(breaks = date_breaks("2 weeks"))
last_plot() + scale_x_datetime(breaks = date_breaks("10 days"))
Scale for 'x' is already present. Adding another scale for 'x', which will
replace the existing scale.
library(scales) # to access breaks/formatting functions
last_plot() + scale_x_datetime(breaks = date_breaks("10 days"),
labels = date_format("%d/%m"))
Scale for 'x' is already present. Adding another scale for 'x', which will
replace the existing scale.
last_plot() + scale_x_datetime(breaks = date_breaks("1 day"),
minor_breaks = date_breaks("2 hour"))
Scale for 'x' is already present. Adding another scale for 'x', which will
replace the existing scale.
#------------------------------------
if (require("maps")) {
# Create a lat-long dataframe from the maps package
nz <- map_data("nz")
nzmap <- ggplot(nz, aes(x=long, y=lat, group=group)) +
geom_polygon(fill="white", colour="black")
# Use cartesian coordinates
nzmap
# With default mercator projection
nzmap + coord_map()
# Other projections
nzmap + coord_map("cylindrical")
nzmap + coord_map("azequalarea",orientation=c(-36.92,174.6,0))
states <- map_data("state")
usamap <- ggplot(states, aes(x=long, y=lat, group=group)) +
geom_polygon(fill="white", colour="black")
# Use cartesian coordinates
usamap
# With mercator projection
usamap + coord_map()
# See ?mapproject for coordinate systems and their parameters
usamap + coord_map("gilbert")
usamap + coord_map("lagrange")
# For most projections, you'll need to set the orientation yourself
# as the automatic selection done by mapproject is not available to
# ggplot
usamap + coord_map("orthographic")
usamap + coord_map("stereographic")
usamap + coord_map("conic", lat0 = 30)
usamap + coord_map("bonne", lat0 = 50)
# World map, using geom_path instead of geom_polygon
world <- map_data("world")
worldmap <- ggplot(world, aes(x=long, y=lat, group=group)) +
geom_path() +
scale_y_continuous(breaks=(-2:2) * 30) +
scale_x_continuous(breaks=(-4:4) * 45)
# Orthographic projection with default orientation (looking down at North pole)
worldmap + coord_map("ortho")
# Looking up up at South Pole
worldmap + coord_map("ortho", orientation=c(-90, 0, 0))
# Centered on New York (currently has issues with closing polygons)
worldmap + coord_map("ortho", orientation=c(41, -74, 0))
}
#------------------------------------------
library(ggmap)
(map = ggmap(get_googlemap(center = c(137.5, 35.5), zoom = 5)) +
geom_point(data = read.csv("http://earthquake.usgs.gov/earthquakes/catalogs/eqs7day-M2.5.txt"),
aes(Lon, Lat, size = Magnitude, colour = Depth)))
Warning: unable to resolve 'maps.googleapis.com'
Error: cannot open URL
'http://maps.googleapis.com/maps/api/staticmap?center=35.5,137.5&zoom=5&size=%20640x640&maptype=terrain&sensor=false'
##-----------------------------------------------
library(ggplot2)
library(reshape)
Warning: package 'reshape' was built under R version 3.0.1
Attaching package: 'reshape'
The following object is masked from 'package:reshape2':
colsplit, melt, recast
The following object is masked from 'package:plyr':
rename, round_any
df <- data.frame(x = rnorm(1000, 0, 1), y = rnorm(1000,
0, 2), z = rnorm(1000, 2, 1.5))
head(df)
x y z
1 -0.3346 2.3970 1.2257
2 1.0003 2.5897 2.5597
3 0.2454 0.1162 3.5992
4 0.3518 1.0509 3.1526
5 0.5483 -1.1997 3.5466
6 0.8159 -1.9362 -0.8235
df.m <- melt(df)
Using as id variables
head(df.m)
variable value
1 x -0.3346
2 x 1.0003
3 x 0.2454
4 x 0.3518
5 x 0.5483
6 x 0.8159
summary(df.m)
variable value
x:1000 Min. :-6.583
y:1000 1st Qu.:-0.527
z:1000 Median : 0.576
Mean : 0.673
3rd Qu.: 1.864
Max. : 6.680
ggplot(df.m) +
geom_freqpoly(aes(x=value, y=..density..,
colour=variable)) +
geom_vline(xintercept=c(-3,3), linetype="dotted")
stat_bin: binwidth defaulted to range/30. Use 'binwidth = x' to adjust
this.
#--------------------------------------------------
qplot(1:5, 1:5) + opts(panel.grid.major = theme_line(linetype = "2925"))
'opts' is deprecated. Use 'theme' instead. (Deprecated; last used in
version 0.9.1) theme_line is deprecated. Use 'element_line' instead.
(Deprecated; last used in version 0.9.1)
qplot(1:5, 1:5)
grid.edit("panel.grid.major.x.polyline", grep = TRUE,
gp = gpar(lty = "5195"))
grid.edit("panel.grid.major.y.polyline", grep = TRUE,
gp = gpar(lty = "33"))
#------------------------------------------
set.seed(123)
data <- data.frame(x = sample(1:20, 100, replace = TRUE))
ggplot(data, aes(x)) + geom_dotplot(binwidth = 1) +
theme(panel.grid = element_blank())
ggplot(data, aes(x)) + geom_dotplot(binwidth = 1) +
theme(panel.grid.minor = element_blank(),
panel.grid.major = element_line(colour = "white",size=0.75))
#--------------------------------------------------
data = data.frame(Category = c("A", "B", "C", "D"),
Value = runif(4))
ggplot(data,aes(x = factor(0),y = Value,fill = Category)) +
geom_bar(stat = "identity",position = "fill") +
scale_fill_brewer(palette = 'Set1') +
coord_polar(theta = "y") +
opts(axis.ticks = theme_blank(),
axis.text.y = theme_blank(),
axis.text.x = theme_blank())
'opts' is deprecated. Use 'theme' instead. (Deprecated; last used in
version 0.9.1) 'theme_blank' is deprecated. Use 'element_blank' instead.
(Deprecated; last used in version 0.9.1) 'theme_blank' is deprecated. Use
'element_blank' instead. (Deprecated; last used in version 0.9.1)
'theme_blank' is deprecated. Use 'element_blank' instead. (Deprecated;
last used in version 0.9.1)
ggplot(data,aes(x = factor(0),y = Value,fill = Category)) +
geom_bar(stat = "identity",position = "fill") +
scale_fill_brewer(palette = 'Set1') +
coord_polar(theta = "y") +
+ theme(axis.ticks = element_blank(),
axis.text.y = element_blank(),
axis.text.x = element_blank())
Error: argument "e2" is missing, with no default
#-----------------------------------------------
ids <- factor(c("1.1", "2.1", "1.2", "2.2", "1.3",
"2.3"))
values <- data.frame(
id = ids,
val1 = cumsum(runif(6, max = 0.5)),
val2 = cumsum(runif(6, max = 50))
)
positions <- data.frame(
id = rep(ids, each = 4),
x = c(2, 1, 1.1, 2.2, 1, 0, 0.3, 1.1, 2.2, 1.1, 1.2, 2.5, 1.1, 0.3,
0.5, 1.2, 2.5, 1.2, 1.3, 2.7, 1.2, 0.5, 0.6, 1.3),
y = c(-0.5, 0, 1, 0.5, 0, 0.5, 1.5, 1, 0.5, 1, 2.1, 1.7, 1, 1.5,
2.2, 2.1, 1.7, 2.1, 3.2, 2.8, 2.1, 2.2, 3.3, 3.2)
)
values <- melt(values)
Using id as id variables
datapoly <- merge(values, positions, by=c("id"))
p <- ggplot(datapoly, aes(x=x, y=y)) +
geom_polygon(aes(fill=value, group=id),
colour="black")
p <- p + facet_wrap(~ variable)
p
