I have a plot that I would like to recreate within R. Here is the plot:
From: Boring, E. G. (1941). Statistical frequencies as dynamic equilibria. Psychological Review, 48(4), 279.
This is a little above my paygrade (abilities) hence asking here. Boring states:
On the first occasion A can occur only 'never' (0) or 'always' (1). On
the second occasion the frequencies
are 0,1/2, or 1; on the third 0, 1/3,
2/3, or 1 etc, etc.
Obviously, you don't have to worry about labels etc. Just a hint to generate the data and how to plot would be great. ;) I have no clue how to even start...
here is an example:
library(plyr)
ps <- ldply(1:36, function(i)data.frame(s=0:i, n=i))
plot.new()
plot.window(c(1,36), c(0,1))
apply(ps, 1, function(x){
s<-x[1]; n<-x[2];
lines(c(n, n+1, n, n+1), c(s/n, s/(n+1), s/n, (s+1)/(n+1)), type="o")})
axis(1)
axis(2)
ps represents all points. Each point has two children.
So draw lines from each point to the children.
A solution using base graphics:
x <- 1:36
boring <- function(x, n=1)n/(x+n-1)
plot(x, boring(x), type="l", usr=c(0, 36, 0, 1))
for(i in 1:36){
lines(tail(x, 36-i+1), head(boring(x, i), 36-i+1), type="o", cex=0.5)
lines(tail(x, 36-i+1), 1-head(boring(x, i), 36-i+1, type="o", cex=0.5))
}
Related
plot(USArrests$Murder, USArrests$UrbanPop,
xlab="murder", ylab="% urban population", pch=20, col="grey",
ylim=c(20, 100), xlim=c(0, 20))
text(USArrests$Murder, USArrests$UrbanPop, labels=rownames(USArrests),
cex=0.7, pos=3)
I tried everything, reducing font size with cex, change the positions, change the ylim, xlim to fit the size, I also tried changing the margins, which didn't really help me so I got rid of them. At this point, I don't know how to do this with base R tool. I do know ggplot method, which is way easier. But I want to know if I can do the same task with the base plot(),text() code.
To find neighbors which are too near you could run kmeans() cluster analysis about the data. It's quite a hack, though!
First, subset your data.
dat <- USArrests[c("Murder", "UrbanPop")]
Set a seed. Play around with that. Different seeds => different results.
set.seed(42)
Analyze clusters with kmeans(), option centers assigns number of clusters, play around with that.
dat$cl <- kmeans(dat, centers=10, nstart=5)$cluster
Now split data and assign altering pos numbers for positioning later in the text() command.
l <- split(dat, dat$cl)
l <- lapply(l, function(x) within(x, {
if (nrow(x) == 1)
pos <- 2 # for those with just one observation in cluster
else
pos <- as.numeric(as.character(factor((1:nrow(x)) %% 2, labels=c(2, 4))))
}))
Assemble.
dat <- do.call(rbind, unname(l))
Now plot into a png with a somewhat high resolution, I chose 800x800.
png("plot.png", 800, 800, "px")
plot(dat$Murder, dat$UrbanPop, xlab="murder", ylab="% urban population",
pch=20, col="grey", ylim=c(20, 100), xlim=c(0, 20))
# the sapply assigns the text position according to `pos` column
sapply(c(4, 2), function(x)
with(dat[dat$pos == x, ],
text(Murder, UrbanPop, labels=rownames(dat[dat$pos == x, ]),
cex=0.7, pos=x)))
dev.off()
Which gives me:
I'm sure you can optimize this further.
Suppose we have a multi-panel plot in R, created by using layout(). I would like to draw an arrow from a specified point in one panel to a specified point in another panel. Thus, the arrow goes across panels of the layout. The starting point of the arrow is specified in the coordinates of its panel, and the end point of the arrow is specified in the coordinates of the destination panel.
As a minimal example, consider this:
layout( matrix( 1:2 , nrow=2 ) )
plot( x=c(1,2) , y=c(1,2) , main="Plot 1" )
plot( x=c(10,20) , y=c(10,20) , main="Plot 2" )
# I want to make an arrow
# from point c(x=1.2,y=1.2) in Plot 1
# to point c(x=18,y=18) in Plot 2
I've searched for methods to accomplish this, but haven't found anything. Thank you for solutions or pointers.
Update
(I'm keeping the previous answer below this, but this more-programmatic way is better given your comments.)
The trick is knowing how to convert from "user" coordinates to the coordinates of the overarching device. This can be done with grconvertX and *Y. I've made some sloppy helper functions here, though they are barely necessary.
user2ndc <- function(x, y) {
list(x = grconvertX(x, 'user', 'ndc'),
y = grconvertY(y, 'user', 'ndc'))
}
ndc2user <- function(x, y) {
list(x = grconvertX(x, 'ndc', 'user'),
y = grconvertY(y, 'ndc', 'user'))
}
For the sake of keeping magic-constants out of the code, I'll predefine your points-of-interest:
pointfrom <- list(x = 1.2, y = 1.2)
pointto <- list(x = 18, y = 18)
It's important that the conversion from 'user' to 'ndc' happen while the plot is still current; once you switch from plot 1 to 2, the coordinates change.
layout( matrix( 1:2 , nrow=2 ) )
Plot 1.
plot( x=c(1,2) , y=c(1,2) , main="Plot 1" )
points(y~x, data=pointfrom, pch=16, col='red')
ndcfrom <- with(pointfrom, user2ndc(x, y))
Plot 2.
plot( x=c(10,20) , y=c(10,20) , main="Plot 2" )
points(y~x, data=pointto, pch=16, col='red')
ndcto <- with(pointto, user2ndc(x, y))
As I did before (far below here), I remap the region on which the next plotting commands will take place. Under the hood, layout is doing things like this. (Some neat tricks can be done with par(fig=..., new=T), including overlaying one plot in, around, or barely-overlapping another.)
par(fig=c(0:1,0:1), new=TRUE)
plot.new()
newpoints <- ndc2user(c(ndcfrom$x, ndcto$x), c(ndcfrom$y, ndcto$y))
with(newpoints, arrows(x[1], y[1], x[2], y[2], col='green', lwd=2))
I might have been able to avoid the ndc2user conversino from ndc back to current user points, but that's playing with margins and axis-expansion and things like that, so I opted not to.
It is possible that the translated points may be outside of the user-points region of this last overlaid plot, in which case they may be masked. To fix this, add xpd=NA to arrows (or in a par(xpd=NA) before it).
Generalized
Okay, so imagine you want to be able to determine the coordinates of any drawing after layout completion. There's a more complex implementation that currently supports what you're asking for. the only requirement is that you call NDC$add() after every (meaningful) plot. For example:
NDC$reset()
layout(matrix(1:4, nrow=2))
plot(1)
NDC$add()
plot(11)
NDC$add()
plot(21)
NDC$add()
plot(31)
NDC$add()
with(NDC$convert(1:4, c(1,1,1,1), c(1,11,21,31)), {
arrows(x[1], y[1], x[2], y[2], xpd=NA, col='red')
arrows(x[2], y[2], x[3], y[3], xpd=NA, col='blue')
arrows(x[3], y[3], x[4], y[4], xpd=NA, col='green')
})
Source can be found here: https://gist.github.com/r2evans/8a8ba8fff060bade13bf21e89f0616c5
Previous Answer
One way is to use par(fig=...,new=TRUE), but it does not preserve the coordinates you e
layout(matrix(1:4,nr=2))
plot(1)
plot(1)
plot(1)
plot(1)
par(fig=c(0,1,0,1),new=TRUE)
plot.new()
lines(c(0.25,0.75),c(0.25,0.75),col='blue',lwd=2)
Since you may be more likely to use this if you have better (non-arbitrary) control over the ends of the points, here's a trick to allow you more control over the points. If I use this, connectiong the top-left point with the bottom-right point:
p <- locator(2)
str(p)
# List of 2
# $ x: num [1:2] 0.181 0.819
# $ y: num [1:2] 0.9738 0.0265
and then in place of lines above I use this:
with(p, arrows(x[1], y[1], x[2], y[2], col='green', lwd=2))
I get
(This picture and the values in p demonstrate how the coordinates are different. When using par(fig=...,new=T);plot.new();, the coordinates return to
par('usr')
# [1] -0.04 1.04 -0.04 1.04
There might be trickery to try to workaround this (such as if you need to automate this step), but it likely will be non-trivial (and not robust).
I'd like if someone could help me with this problem I've been hours trying to solve.
I have to plot a chessboard with no external libraries (using only the default graphical functions in R).
My attempt is working with black squares till I have to filter and paint the white squares:
plot(c(1:9),c(1:9),type="n")
for (i in 1:8){
rect(i,1:9,i+1,9,col="black",border="white")
}
I could do it manually in this way, but I know there's a simpler way:
plot(c(1:9),c(1:9),type="n")
rect(1, 2, 2, 1,col="black",border="white")
rect(4, 1, 3, 2,col="black",border="white")
rect(6, 1, 5, 2,col="black",border="white")
rect(7, 1, 8, 2,col="black",border="white")
(...)
I've tried adding a function to filter even numbers inside the loop but doesn't seems to works for me.
I would appreciate any suggestion!
Use image and just repeat 0:1 over and over. Then you can mess with the limits a bit to make it fit nice.
image(matrix(1:0, 9, 9), col=0:1, xlim=c(-.05,.93), ylim=c(-.05,.93))
Just change the col= argument in your solution as shown. Also note that c(1:9) can be written as just 1:9 :
plot(1:9, 1:9, type = "n")
for (i in 1:8) {
col <- if (i %% 2) c("white", "black") else c("black", "white")
rect(i, 1:9, i+1, 9, col = col, border = "white")
}
remembering Jeremy Kun's post
https://jeremykun.com/2018/03/25/a-parlor-trick-for-set/ on Set helped
me figure the hard part (for me) of this question. i realized that
diagonals on the board (what bishops move on) have a constant color.
and, so, their Y-intercept (where they hit the Y-axis) will uniquely
determine their color, and adjacent Y values will have different
colors. for a square at (x,y), the y intercept (since the slope is 1)
will be at Y == (y-x). since the parity is the same for addition as
for subtraction, and i'm never sure which mod functions (in which
languages) may give a negative result, i use "(x+y) %% 2".
b <- matrix(nrow=8,ncol=8) # basic board
colorindex <- (col(b)+row(b))%%2 # parity of the Y-intercept
# for each square
colors <- c("red", "white")[colorindex+1] # choose colors
side <- 1/8 # side of one square
ux <- col(b)*side # upper x values
lx <- ux-side # lower x values
uy <- row(b)*side # upper y
ly <- uy-side # upper y
plot.new() # initialize R graphics
rect(lx, ly, ux, uy, col=colors, asp=1) # draw the board
I have created a stacked histogram using the multhist function in the plotrix library, but I am unable to add a straight line to this histogram. Code that I would normally use doesn't seem to work in this setting.
Here's an example. I am trying to add the mean and standard errors of the overall distribution as simple vertical lines on the histogram, but these do not work properly. What am I doing wrong?
library(plotrix)
test1<-rnorm(30,0)
test2<-rnorm(30,0)
test3<-rnorm(30,0)
forstats<-c(test1,test2,test3)
mn<-mean(forstats)
se<-std.error(forstats)
together<-list(test1,test2,test3)
multhist(together, col=c(7,4,2), space=c(0,0), beside=FALSE,right=FALSE)
abline(v=mn)
abline(v=mn+se)
abline(v=mn-se)
multhist uses barplot, so, as #BenBolker mentions here, the x-axis corresponds to bin index. It's a bit tricky to convert between native coordinates and bin index units, so I've put together another function for stacked histograms (for frequencies, anyway):
histstack <- function(x, breaks, col=rainbow(length(x)), ...) {
col <- rev(col)
if (length(breaks)==1) {
rng <- range(pretty(range(x)))
breaks <- seq(rng[1], rng[2], length.out=breaks)
}
h <- lapply(x, hist, plot=FALSE, breaks=breaks)
cumcounts <- apply(sapply(h, '[[', 'counts'), 1, cumsum)
for(i in seq_along(h)) {
h[[i]]$counts <- cumcounts[nrow(cumcounts) - i + 1, ]
}
max_cnt <- max(sapply(h, '[[', 'counts'))
plot(h[[1]], xlim=range(sapply(h, '[', 'breaks')), yaxt='n',
ylim=c(0, max(pretty(max_cnt))), col=col[1], ...)
sapply(seq_along(h)[-1], function(i) plot(h[[i]], col=col[i], add=TRUE, ...))
axis(2, at=pretty(c(0, max_cnt)), labels=pretty(c(0, max_cnt)), ...)
}
And here it is:
histstack(together, seq(-3, 3, 0.5), col=c(7, 4, 2), main='',
las=1, xlab='', ylab='')
abline(v=c(mn, mn+se, mn-se), lwd=2, )
IMO the x-axis labelling is probably more appropriate than that of multhist, since multhist implies that counts relate to the mid-bin values, whereas above it's clear that the x-axis ticks delineate the bins.
I know that we normally do in this way:
x=c(rep(0.3,100),rep(0.5,700))
plot(table(x))
However, we can only get a few dots or vertical lines in the graph.
What should I do if I want 100 dots above 0.3 and 700 dots above 0.5?
Something like this?
x <- c(rep(.3,100), rep(.5, 700))
y <- c(seq(0,1, length.out=100), seq(0,1,length.out=700))
plot(x,y)
edit: (following OP's comment)
In that case, something like this should work.
x <- rep(seq(1, 10)/10, seq(100, 1000, by=100))
x.t <- as.matrix(table(x))
y <- unlist(apply(x.t, 1, function(x) seq(1,x)))
plot(x,y)
You can lay with the linetype and linewidth settings...
plot(table(x),lty=3,lwd=0.5)
For smaller numbers (counts) you can use stripchart with method="stack" like this:
stripchart(c(rep(0.3,10),rep(0.5,70)), pch=19, method="stack", ylim=c(0,100))
But stripchart does not work for 700 dots.
Edit:
The dots() function from the package TeachingDemos is probably what you want:
require(TeachingDemos)
dots(x)