I would like to make a plot like the this image what I want, however I don't know how. I wrote the code below but I don't find a way to obtain the plot. The point here is to add density lines to my original plot (Relation Masa-SFR) the density is supposed to be every 0.3 in x. I mean one line from 7 to 7.3, the next one from 7.3 to 7.6 and so on. With the code below (continue until x=12), I obtain the this [plot][2]
plot(SFsl$MEDMASS, SFR_SalpToMPA,xlim= range(7:12),
ylim= range(-3:2.5),ylab="log(SFR(M(sun)/yr)",
xlab="log(M(star)/(M(sun)")
title("Relacion Masa-SFR")
par(new=TRUE)
FCUTsfrsl1=(SFsl$MEDMASS >= 7 & SFsl$MEDMASS <=7.3 &
SFR_SalpToMPA < 2 & SFR_SalpToMPA > -3)
x <- SFR_SalpToMPA[FCUTsfrsl1]
y <- density(x)
plot(y$y, y$x, type='l',ylim=range(-3:2.5), col="red",
ylab="", xlab="", axes=FALSE)
I did what you said but I obtained this plot, I don't know if I did something wrong
Since I don't have your data, I had to make some up. If this does what you want, I think you can adapt it to your actual data.
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y)
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values for density calc
for (i in 1:length(intx3)) {
xx <- seq(min(intx3[[i]]), max(intx3[[i]]), length.out = 512)
lines(xx, density(inty[[i]])$y, col = "red")
}
This produce the following image. You need to look closely but there is a separate density plot for each 0.3 unit interval.
EDIT Change the dimension that is used to compute the density
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y, xlim = c(7, 15))
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values
# This gives the density values in the horizontal direction (desired)
# This is the change, the above is unchanged.
for (i in 1:length(intx3)) {
yy <- seq(min(inty[[i]]), max(inty[[i]]), length.out = 512)
offset <- min(intx3[[i]])
lines(density(intx3[[i]])$y + offset, yy, col = "red")
}
Which gives:
Related
I have written my own code to simulate the Conway maxwell distribution sample.
This is the pmf (Guikema & Goffelt, 2008):
However, I have met some problem to plot the density plot.
rcomp <- function(n,lamb,v)
{
u <- runif(n)
w <- integer(n)
for(i in 1:n) {
z=sum(sapply( 0:100, function(j) (( ((lamb)^j) / (factorial(j)) )^v) ))
x <- seq(1, 50, 1) #seq of 1 to 50, increase by 1
px <- (((lamb^x)/factorial(x))^v)/z
# px is pmf of re-parameter conway maxwell
w[i] <- if (u[i] < px[1]) 0 else (max (which (cumsum(px) <= u[i])))
}
return (w)
}
dcomp <- function(x,lamb,v) {
z=sum(sapply( 0:100, function(j) (( ((lamb)^j) / (factorial(j)) )^v) ))
px <- (((lamb^x)/factorial(x))^v)/z
return(px)
}
As I wanna plot the density plot to check whether lamb or v is location parameter, the plot I get is weird.
x = rcomp(100,6,0.2); pdf = dcomp(x,6,0.2)
x1 = rcomp(100,6,0.5); pdf1 = dcomp(x1,6,0.5)
x2 = rcomp(100,6,0.7); pdf2 = dcomp(x2,6,0.7)
plot(x2, pdf2, type="l", lwd=1,lty=1,col="blue")
How could I solve this problem?
Source: Guikema & Goffelt (2008), A Flexible Count Data Regression Model for Risk Analysis. Risk Analysis 28(1): 215.
You have to sort the values of the x coordinate if you want a graph to connect the points in their axis order.
Note, however, that there might be better ways to graph the density you want. See the red curve. I first create a vector x of values within a certain range and then compute the PDF for those values. These pairs (x, y) are what function lines plots.
set.seed(2673) # Make the results reproducible
x2 <- rcomp(100, 6, 0.7)
x2 <- sort(x2)
pdf2 <- dcomp(x2, 6, 0.7)
plot(x2, pdf2, type = "l", lwd = 1, lty = 1, col = "blue")
x <- seq(0, 50, length.out = 100)
y <- dcomp(x, 6, 0.2)
lines(x, y, type = "l", col = "red")
I am trying to create a clean perspective plot. I am able to create a nice plot with a predictive "mesh" based on my data, however it extends past my x and y limits. My code is below. I apologize for the lack of reproducible data.
dat<-data.frame(x,y,z);rm(x,y,z)
m1i<-(lm(z~poly(y,2)*x, data=dat))
xr<-range(dat$x)
xseq<-seq((xr[1]-1),xr[2], length=30)#the subtraction just made my prediction limits larger than what my data has- so it predicts for data I don't have
yr<-range(dat$y)
yseq<-seq((yr[1]-0.5),yr[2], length=30)#same as above, just so my predictions started at 0
zp<-outer(xseq,yseq, function(a,b) predict(m1i, newdata=data.frame(x=a,y=b)))
nrz<-nrow(zp)
ncz<-ncol(zp)
jet.colors<-colorRampPalette(c("grey60","white"))
nbcol<-100
color<-jet.colors(nbcol)
zfacet<-zp[-1,-1]+zp[-1,-ncz]+zp[-nrz,-1]+zp[-nrz,-ncz]
facetcol<-cut(zfacet,nbcol)
res<-persp(x=xseq,y=yseq,z=zp, col=color[facetcol],theta=40, phi=10,
ylab="Set Time (hr)", xlab="Distance (m)",
zlab="Proportion Captured", nticks=5, ticktype="detailed",
xlim=c(0,5),
ylim=c(0,4), zlim=c(0,1.1))
I get a warning when I run the code
In persp.default(x = xseq, y = yseq, z = zp, col = color[facetcol], :
surface extends beyond the box
I would like to cut off the surface so it ends at my box limits.
perspPlotExample
There are several reasons why you can get this warning. Either your x, y or z variable extends beyond the limits you set. The fix for the x and y variables is to cut the variables where necessary. The z variable you can set to NA. Below is a reproducible example.
# generate data
N <- 100
x <- rnorm(N, 2, 0.5)
y <- rnorm(N, 2, 0.4)
z <- 0.1*y^2 * x + rnorm(N)
dat<-data.frame(x,y,z);rm(x,y,z)
# run code from question (not copied)
# set z beyond limit to NA
zp[zp < 0] <- NA
zp[zp > 1.1] <- NA
# plot
persp(x = xseq[xseq > 0 & xseq < 5],
y = yseq[yseq > 0 & yseq < 4],
z = zp[xseq > 0 & xseq < 5, yseq > 0 & yseq < 4],
theta = 40, phi = 10,
ylab = "Set Time (hr)", xlab = "Distance (m)",
zlab = "Proportion Captured", nticks = 5, ticktype = "detailed",
xlim = c(0,5),
ylim = c(0,4),
zlim = c(0,1.1))
I am wondering if you could help me out with the following question:
I have a correlation matrix and a third variable (continuous) for every possible pair in the correlation matrix.
Here is a toy example:
set.seed(1234)
x <- rnorm(1000,2,1)
y <- 0.1*x+rnorm(1000,1,1)
z <- y+rnorm(1000)
third.dimension <- c("(x,y)" = 0.3, "(x,z)" = 0.5, "(y,z)"= 1)
my.df <- data.frame(x,y,z)
First, I want to create a heatmap of that correlation matrix which I do with
heatmap(cor(my.df))
Next, I would like to have a coloured dot within each "cell" of the heatmap, depending on the value of the third dimension for the respective pair. Example - if the value is between 0 and 0.49, I have a black dot, if it is between 0.5 and 1, a grey dot etc.
Hence, where I have the correlation between z and y, say, I would have a grey dot painted in the corresponding "cell" of the correlation matrix.
Thanks in advance for the help!
This should work for you:
set.seed(1234)
x <- rnorm(1000,2,1)
y <- 0.1*x+rnorm(1000,1,1)
z <- y+rnorm(1000)
third.dimension <- c("(x,y)" = 0.3, "(x,z)" = 0.5, "(y,z)"= 1)
my.df <- data.frame(x,y,z)
# required function
val2col <- function(z, zlim, col = heat.colors(12), breaks){
if(!missing(breaks)){
if(length(breaks) != (length(col)+1)){stop("must have one more break than color")}
}
if(missing(breaks) & !missing(zlim)){
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1))
}
if(missing(breaks) & missing(zlim)){
zlim <- range(z, na.rm=TRUE)
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1))
}
CUT <- cut(z, breaks=breaks, include.lowest = TRUE)
colorlevels <- col[match(CUT, levels(CUT))] # assign colors to heights for each point
return(colorlevels)
}
# plot
COR <- list(
x = seq(ncol(my.df)),
y = seq(ncol(my.df)),
z = cor(my.df)
)
image(COR, xaxt="n", yaxt="n")
axis(1, at=COR$x, labels = names(my.df))
axis(2, at=COR$x, labels = names(my.df))
box()
COR$col <- val2col(c(COR$z), col = grey.colors(21), zlim=c(0,1))
points(expand.grid(x=COR$x, y=COR$y), col=COR$col, pch=16, cex=3)
I am trying to plot rings of trees and calculate their areas. However, I have noticed that in reality not all rings have symmetric radii like a circle. I have data measurements of 4 radii, and I would like to plot rings (or any similar shape) following each point of every radio like this example (this figure was done manually with vectors in PowerPoint):
the problem is that in R I found only the possibility to plot these rings with the circles option from the symbols() function, and I got this graph:
using this R script:
data <- data.frame(
a = c(1,4,5,8, 10),
b = c(1, 3,7,9, 10),
c = c(2, 6, 8, 9 ,10),
d = c(1, 3, 4, 7, 9) )
data$y <- (data$a - data$b)/2 # y position
data$x <- (data$d - data$c)/2 # x position
data$z <- rowMeans(data[,1:4]) # radio length
symbols(x = data$x, y = data$y, circles=data$z,
xlim = c(-10, 10)*1.5, ylim = c(-10, 10)*1.5, inches = F, fg = "orange", lwd = 2)
I have checked some packages with functions to draw ellipses (elliplot, ellipse, ellipseplot, car, etc), but I don't like their functions. I am not interested in use these packages, on the contrary I would like to write an own code.
My idea is to plot a shape which best meets the real figure of a ring with my data values of the four radii, it can be an ellipse, oval, etc.
With a circle I am using only data of one radio (in my example, the mean of all radii).
With a ellipse would be better, because I can use at least two values, the major-axis (A+B), and the minor-axis (C+D). But would be great to draw a shape that use the values of four radii (A, B, C, D) or even more radii.
Here a guy drew a very nice superellipse using a R script, and another one drew some ellipses likes rings also in R.
However, I don't know how to use their methods to my specific problem.
If somebody have idea how to start drawing at least an ellipse in R would be nice. But would be great to know how to draw a shape (oval, ellipse, etc.) using the values of four radii and finally calculate their area.
I would appreciate very much your help or any direction to do that.
UPDATE:
Thanks #cuttlefish44 for your excellent answer, that was very useful to explain tree growth to my students. However, most tropical trees have very irregular shapes and now I am wondering to know if can I draw this other shape with an additional radio "E" and the radii axes at different positions like this scheme:
any direction would be very useful for me.
If A & B are on y-axis and C & D are on x-axis, it isn't difficult to calculate the parameters of ellipses. I used optim() to get params (Note: this approach has tiny error, such as 2.439826e-12).
data manipulation
# change all data into xy coordinates and make ring-factor
library(reshape2); library(dplyr)
data <- data.frame(
a = c(1, 4, 5, 8, 10),
b = c(1, 3, 7, 9, 10) * -1,
c = c(2, 6, 8, 9, 10) * -1,
d = c(1, 3, 4, 7, 9) )
data <- t(data)
colnames(data) <- LETTERS[1:ncol(data)] # ring-factor
df <- melt(data, value.name = "x") # change into long-form
df$y <- df$x # make xy coordinates
df[df$Var1=="a"|df$Var1=="b", "x"] <- 0
df[df$Var1=="c"|df$Var1=="d", "y"] <- 0
calculation of center coordinates, ox & oy
center <- df %>% group_by(Var2) %>% summarize(sum(x)/2, sum(y)/2) %>% as.data.frame()
calculation of parameters of ellipse; semi-major and -minor axis, ra & rb
opt.f <- function(par, subset, center) { # target function
ox <- center[[1]] # par[1] and par[2] are ra and rb
oy <- center[[2]]
x <- subset$x
y <- subset$y
sum(abs((x - ox)^2/par[1]^2 + (y - oy)^2/par[2]^2 - 1)) # from ellipse equation
}
lev <- levels(df$Var2)
## search parameters
res <- sapply(1:length(lev), function(a)
optim(c(1,1), opt.f, subset = subset(df, Var2 == lev[a]),
center = center[a, 2:3], control = list(reltol = 1.0e-12)))
res # result. you can get detail by res[,1etc]. values are not 0 but much nearly 0
function to plot (Probably some packages have similar one)
radian <- function(degree) degree/180*pi
plot.ellipse <- function(ox, oy, ra, rb, phi=0, start=0, end=360, length=100, func=lines, ...) {
theta <- c(seq(radian(start), radian(end), length=length), radian(end))
if (phi == 0) {
func(ra*cos(theta)+ox, rb*sin(theta)+oy, ...)
} else {
x <- ra*cos(theta)
y <- rb*sin(theta)
phi <- radian(phi)
cosine <- cos(phi)
sine <- sin(phi)
func(cosine*x-sine*y+ox, sine*x+cosine*y+oy, ...)
}
}
draw
plot(0, type="n", xlim=c(-10, 10), ylim =c(-10, 10), asp=1, xlab="x", ylab="y", axes = F)
axis(1, pos=0);axis(2, pos=0, las=2)
points(df$x, df$y)
for(a in 1:length(lev)) plot.ellipse(ox = center[a, 2], oy = center[a, 3],
ra = res[,a]$par[1], rb = res[,a]$par[2], length=300)
area <- sapply(res[1,], function(a) pi * a[1] * a[2])
How would you you make an image from a matrix in R?
Matrix values would correspond to pixel intensity on image (although I am just interested in 0,1 values white or black at the moment.), while column and row numbers correspond to vertical and horizontal location on the image.
By make an image I mean display it on the screen and save it as a jpg.
You can display it on the screen easiest using 'image':
m = matrix(runif(100),10,10)
par(mar=c(0, 0, 0, 0))
image(m, useRaster=TRUE, axes=FALSE)
You can also have a look at the raster package...
Set up a plot with no margin:
par(mar = rep(0, 4))
Image the matrix with greyscale, like spacedman's answer but completely filling the device:
m = matrix(runif(100),10,10)
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
Wrap that in a call to png() to create the file:
png("simpleIm.png")
par(mar = rep(0, 4))
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
dev.off()
If you need to do this with spatial axes (defaults to [0,1] for X and Y) then use the image.default(x, y, z, ...) form where x and y give the central positions of the pixels in z. x and y can be of length dim(z) + 1 to give corner coordinates for that convention.
Centres of pixels (this is the default for image):
x <- seq(0, 1, length = nrow(m))
y <- seq(0, 1, length = ncol(m))
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Corners of pixels (need 1 extra x and y, and 0 is now the very bottom left corner):
x <- seq(0, 1, length = nrow(m) + 1)
y <- seq(0, 1, length = ncol(m) + 1)
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Note that from R 2.13 image.default gains an argument useRaster which uses the very efficient newish graphics function rasterImage rather than the old image which is effectively multiple calls to rect under the hood to draw every pixel as a polygon.
I do a matrix (where the vertical axis increases going down) one of two ways. Below is the first way using heatmap.2(). It has more control over how the numeric values are formatted in the plot (see the formatC statement below), but is a little harder to deal with when changing the layout.
library(gplots)
#Build the matrix data to look like a correlation matrix
x <- matrix(rnorm(64), nrow=8)
x <- (x - min(x))/(max(x) - min(x)) #Scale the data to be between 0 and 1
for (i in 1:8) x[i, i] <- 1.0 #Make the diagonal all 1's
#Format the data for the plot
xval <- formatC(x, format="f", digits=2)
pal <- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb")
#Plot the matrix
x_hm <- heatmap.2(x, Rowv=FALSE, Colv=FALSE, dendrogram="none", main="8 X 8 Matrix Using Heatmap.2", xlab="Columns", ylab="Rows", col=pal, tracecol="#303030", trace="none", cellnote=xval, notecol="black", notecex=0.8, keysize = 1.5, margins=c(5, 5))
You can create a heatmap of the matrix.
library(pheatmap)
# Create a 10x10 matrix of random numbers
m = matrix(runif(100), 10, 10)
# Save output to jpeg
jpeg("heatmap.jpg")
pheatmap(m, cluster_row = FALSE, cluster_col = FALSE, color=gray.colors(2,start=1,end=0))
dev.off()
See ?pheatmap for more options.
Try levelplot:
library(lattice)
levelplot(matrix)
Here's the second way (again, where the vertical axis increases going down). This method is easier to layout, but has less control over the format of the numeric values displayed in the plot.
library(plotrix)
#Build the matrix data to look like a correlation matrix
n <- 8
x <- matrix(runif(n*n), nrow=n)
xmin <- 0
xmax <- 1
for (i in 1:n) x[i, i] <- 1.0 #Make the diagonal all 1's
#Generate the palette for the matrix and the legend. Generate labels for the legend
palmat <- color.scale(x, c(1, 0.4), c(1, 0.4), c(0.96, 1))
palleg <- color.gradient(c(1, 0.4), c(1, 0.4), c(0.96, 1), nslices=100)
lableg <- c(formatC(xmin, format="f", digits=2), formatC(1*(xmax-xmin)/4, format="f", digits=2), formatC(2*(xmax-xmin)/4, format="f", digits=2), formatC(3*(xmax-xmin)/4, format="f", digits=2), formatC(xmax, format="f", digits=2))
#Set up the plot area and plot the matrix
par(mar=c(5, 5, 5, 8))
color2D.matplot(x, cellcolors=palmat, main=paste(n, " X ", n, " Matrix Using Color2D.matplot", sep=""), show.values=2, vcol=rgb(0,0,0), axes=FALSE, vcex=0.7)
axis(1, at=seq(1, n, 1)-0.5, labels=seq(1, n, 1), tck=-0.01, padj=-1)
#In the axis() statement below, note that the labels are decreasing. This is because
#the above color2D.matplot() statement has "axes=FALSE" and a normal axis()
#statement was used.
axis(2, at=seq(1, n, 1)-0.5, labels=seq(n, 1, -1), tck=-0.01, padj=0.7)
#Plot the legend
pardat <- par()
color.legend(pardat$usr[2]+0.5, 0, pardat$usr[2]+1, pardat$usr[2], paste(" ", lableg, sep=""), palleg, align="rb", gradient="y", cex=0.7)
With ggplot2:
library(tidyverse)
n <- 12
m <- matrix(rnorm(n*n),n,n)
rownames(m) <- colnames(m) <- 1:n
df <- as.data.frame(m) %>% gather(key='y', value='val')
df$y <- as.integer(df$y)
df$x <- rep(1:n, n)
ggplot(df, aes(x, y, fill= val)) +
geom_tile() +
geom_text(aes(x, y, label=round(val,2))) +
scale_fill_gradient(low = "white", high = "red") +
theme_bw()