test <- NULL
for(i in 1:1000){
p <- rgamma(1,239,10)
yrep <- rpois (10,p)
test <- c(test,yrep)}
hist (test, xlab="T (yrep)", yaxt="n", cex=1,col = "yellow")
lines(rep(22,2), col="red", c(0,100))
print(mean(test<=22))
I got
But why the red line cannot exceed the histogram? How to edit my code to let the red line be normal?
You can try abline instead:
test <- NULL
for(i in 1:1000){
p <- rgamma(1,239,10)
yrep <- rpois (10,p)
test <- c(test,yrep)}
hist (test, xlab="T (yrep)", yaxt="n", cex=1,col = "yellow")
abline(v=22, col="red")
#Vincent's answer fixes the problem using abline. But if you need to know how high to go (perhaps you don't want a full-vertical line), then here's "why":
First, hist(.) returns a list that includes some meta about the histogram.
set.seed(42)
# test <- ...
h <- hist (test, xlab="T (yrep)", yaxt="n", cex=1,col = "yellow")
str(h)
# List of 6
# $ breaks : int [1:20] 8 10 12 14 16 18 20 22 24 26 ...
# $ counts : int [1:19] 18 70 191 405 812 1154 1554 1545 1358 1084 ...
# $ density : num [1:19] 0.0009 0.0035 0.00955 0.02025 0.0406 ...
# $ mids : num [1:19] 9 11 13 15 17 19 21 23 25 27 ...
# $ xname : chr "test"
# $ equidist: logi TRUE
# - attr(*, "class")= chr "histogram"
The y-axis is defined off of the $counts variable, so we can see that it goes up to at least 1554.
Another way to see what the axis is doing is with
par("usr")
# [1] 6.48 47.52 -62.16 1616.16
This tells us that the x-axis ranges from 6.48 to 47.52, and the y-axis ranges from -62.16 to 1616.16. (The reason y includes negative values is that by default, R expands the plot by 4% in both directions.) From this, you could know that your line would need to span from 0 (or -62.16 if you wanted to start at the true bottom) to 1616.16 (or around up). This says that our look at h$counts would have ended near the top of the hist bars but not at the top of the plotted region.
Related
library(rgl)
library(brainR)
template <- readNIfTI(system.file("MNI152_T1_2mm_brain.nii.gz",
package = "brainR"), reorient = FALSE)
misc3d::contour3d(template, level = 4500, alpha = .7, draw = T)
With the above code one can can generate a 3D model of the brain.
The argument draw = FALSE asks contour3d to compute and return the contour surface as a triangle mesh object without drawing it.
a <- misc3d::contour3d(template, level = 4500, alpha = .7, draw = F)
str(a)
List of 10
$ v1 : num [1:110433, 1:3] 45 45 46 46 47 47 43 43 44 44 ...
$ v2 : num [1:110433, 1:3] 44.1 46 46 47 47 ...
$ v3 : num [1:110433, 1:3] 45 45 45 46 46 ...
$ color : chr "white"
$ color2 : logi NA
$ fill : logi TRUE
$ material: chr "default"
$ col.mesh: logi NA
$ alpha : num 0.7
$ smooth : num 0
- attr(*, "class")= chr "Triangles3D"
I would like to use the external surface of the above object to project heat maps, or say, colouring the surface... I also wonder how to determine certain positions in this model, e.g. EEG channel positions. Is it possible to generate only the surface with a$v1, a$v2 ... using function rgl:::surface3d? Thank you in advance,
I was able to draw the triangle mesh in colors with rgl. Some considerations:
I'm using rgl::triangles3d With this function, points are taken in consecutive triplets, each point v1 v2 v3 a triangle vertex (see
?triangles3d) so i had to extract the points and reorder them.
colors are mapped to vertex, taken in groups of three also. I created a simple color_map based on the x position of each vertex. Of course you must create your desired color map.
Hope this will help you.
data<-misc3d::contour3d(template, level = 4500, alpha = .7, draw = F)
points <- rbind(data$v1, data$v2, data$v3)
points <- points[order(rep(1:(nrow(points)/3),3), rep(1:3, nrow(points)/3)),]
color_map <- c("red","blue","green")[cut(points[,1], 3, labels=F)]
rgl::open3d()
rgl::triangles3d(points, alpha=.7, color = color_map)
Edit
Coordinates x, y, z are in the scale of the positions of the array template i.e. point c(5.4, 10.8, 30.1) is related to the level of the array around [5, 10, 30], that is, that point should be around level=4500
I have made a stripchart with a threshold marked in red. I would like to label the point that falls to the left of the threshold, but can't seem to get the 'text' function working at all.
stripchart screenshot
Here is the stripchart code:
stripchart(ctrls$`Staining Green`, method="jitter", pch=4, xlab='Staining Green', cex.lab=2)
abline(v=5,col=2,lty=3)
I first tried to filter only those samples below the threshold:
Staining.Green <- filter(QCcontrols, Staining.Green < 5)
then adding the text with
text(Staining.Green$`Staining Green` + 0.1, 1.1, labels = Staining.Green$Sample_Name, cex = 2)
This didn't add any text to the chart.
Then I tried labeling all the points, in case I was making it too complicated, with variations on:
text(ctrls$`Staining Green` + 0.1, 1.1, labels = ctrls$Sample_Name)
Again, no text added, and no error message.
Any suggestions greatly appreciated!
Update: my ctrls object is more complex than I realized - maybe this is tripping me up:
List of 17
$ Restoration : num [1:504] 0.0799 0.089 0.1015 0.1096 0.1092 ...
..- attr(*, "threshold")= num 0
$ Staining Green : num [1:504] 25.1 23.5 21.1 19.7 22.3 ...
..- attr(*, "threshold")= num 5
$ Staining Red : num [1:504] 39.8 40.9 36.9 33.2 33.2 ...
..- attr(*, "threshold")= num 5.......```
Here is one example using the built in data set for airquality:
stripchart(airquality$Ozone,
main="Mean ozone in parts per billion at Roosevelt Island",
xlab="Parts Per Billion",
ylab="Ozone",
method="jitter",
col="orange",
pch=4
)
abline(v = 5, col = 2, lty = 3)
with(subset(airquality, Ozone < 5), text(Ozone, 1.1, labels = Ozone))
Plot
Data
The lowest values of Ozone are:
head(sort(airquality$Ozone), 5)
[1] 1 4 6 7 7
Edit:
Here's a quick demo with a list with a similar structure:
vec1 <- c(0.0799, 0.089, 0.1015, 0.1096, 0.1092)
attr(vec1, 'threshold') <- 4
vec2 <- c(25.1, 3, 21.1, 19.7, 22.3)
attr(vec2, 'threshold') <- 5
ctrls <- list(Restoration = vec1, `Staining Green` = vec2)
stripchart(ctrls$`Staining Green`,
method="jitter",
pch=4,
xlab='Staining Green',
cex.lab=2
)
abline(v=5,col=2,lty=3)
text(ctrls$`Staining Green`[ctrls$`Staining Green` < 5], 1.1, labels = ctrls$`Staining Green`[ctrls$`Staining Green` < 5])
Note: Instead of explicitly including 5 for threshold you can substitute the threshold from your list attribute:
attr(ctrls$`Staining Green`, "threshold")
[1] 5
Plot
Could someone explain with details how this code is working?
require(lattice)
?lattice # essential reading
data <- dgamma(seq(from=0.00001,to=0.01,by=0.00001),shape = .1, scale = .01)
dfrm <- data.frame(dgam = data, param="s.1.01")
dfrm <- rbind(dfrm, data.frame(dgam =
dgamma( seq(from=0.00001,to=0.01,by=0.00001),
shape = .2, scale = .01),
param="s.2.01") )
dfrm <- cbind( dfrm, X.val=seq(from=0.00001,to=0.01,by=0.00001) )
str(dfrm)
#'data.frame': 2000 obs. of 3 variables:
# $ dgam : num 5263 2817 1954 1507 1231 ...
# $ param: Factor w/ 2 levels "s.1.01","s.2.01": 1 1 1 1 1 1 1 1 1 1 ...
# $ X.val: num 1e-05 2e-05 3e-05 4e-05 5e-05 6e-05 7e-05 8e-05 9e-05 1e-04 ...
xyplot( dgam ~ X.val ,
group=param,
data=dfrm, type="l")
For instance, In which part is specificating the prior and posterior?
I've found the code in the answer given here How to plot Bayesian prior and posterior distributions in one panel using R?
That answer only illustrates how to plot two curves in the same plot, but does not at all involve computing a true posterior given a prior and data. Namely, it just plots two Gamma distributions with shape=0.1 and shape=0.2, and these are distinguished in the data frame by including a factor column param where "s.1.01" and "s.2.01" indicate the respective distributions.
Code below plots an image and then plots circle on that image. I want to make all pixels that fall outside that circle black. How could I do that?
library(raster)
library(plotrix)
r1 <- brick(system.file("external/rlogo.grd", package="raster"))
width=50
height=40
x <- crop(r1, extent(0,width,0,height))
plotRGB(x)
circlex=20
circley=15
radius=10
draw.circle(circlex,circley,radius,border="blue")
Look at the 'x'-object with str() and you see this:
..# data :Formal class '.MultipleRasterData' [package "raster"] with 14 slots
.. .. ..# values : num [1:2500, 1:3] 255 248 221 199 198 210 221 190 104 79 ...
.. .. .. ..- attr(*, "dimnames")=List of 2
.. .. .. .. ..$ : NULL
.. .. .. .. ..$ : chr [1:3] "red" "green" "blue"
....so the 1:50 by 1:50 values are mapped to three columns. The X values are probably 0:2500 %% 50 and the y values are probably 0:2500 %/% 50
So remembering that the "origin" if upper left corner for raster objects but the lower left corner for plot functions, and so the y-value of 20 becomes 50-20 or 30, this gives you close to what you ask for (with apologies for putting the y-sequence first):
x#data#values[( ((1:2500 %/% 50 )- 30)^2 + ((1:2500 %% 50) - 20)^2 ) >=100, 1] <- 0
x#data#values[( ((1:2500 %/% 50 )- 30)^2 + ((1:2500 %% 50) - 20)^2 ) >=100, 2] <- 0
x#data#values[( ((1:2500 %/% 50 )- 30)^2 + ((1:2500 %% 50) - 20)^2 ) >=100, 3] <- 0
plotRGB(x)
draw.circle(20,20,10,border="blue")
The logic is that the criteria are of the form (x-dx)^2+(y-dy)^2 > r^2 where dx and dy are the center coordinates of the circle and r is the radius == 10.
EDITS after question changed:
For each color layer, the code with named parameters would be similar to this one that makes the darkest "red". This gives a roughly circular mask although getting the centers to line up is not handled correctly:
x#data#values[( ((1:(height*width) %/% (height*5/4) )- (height-circley*5/4) )^2 +
((1:(height*width) %% width) - circlex )^2 ) >= radius^2, 1] <- 0
Further experimentation delivers this which seems pretty close:
x#data#values[( ((1:(height*width) %/% (height) )- (height-circley) *5/4)^2 +
((1:(height*width) %% width) - circlex )^2 ) >= radius^2, 1] <- 0
plotRGB(x, asp=5/4, addfun=function() draw.circle(circlex,circley,radius,border="blue") )
Obviously you could substitute the width/height scaling factor for the new aspect ratio everywhere that 5/4 appears.
Here it is a more generic solution that also works for rasters with different coordinate systems.
The function rasterToPoints() converts the raster to points. Following your example, head(rasterToPoints(x)) returns the following:
> head(rasterToPoints(x))
x y red green blue
[1,] 0.5 39.5 255 255 251
[2,] 1.5 39.5 204 205 199
[3,] 2.5 39.5 171 172 164
[4,] 3.5 39.5 157 159 148
[5,] 4.5 39.5 162 164 151
[6,] 5.5 39.5 187 189 176
We then need to find which points fall outside the circle and set their values to zero:
is_outside_circ = (rasterToPoints(x)[,1] - circlex)^2 + (rasterToPoints(x)[,2] - circley)^2 >= radius^2
x#data#values[ is_outside_circ,] <- 0
plotRGB(x)
draw.circle(circlex,circley,radius,border="blue")
Result: black points outside circle
I have two densities that overlap as seen in the attached picture. I want to find out where the two lines meet. How would I go about doing that?
This is the code that produced the image:
... #reading in files etc.
pdf("test-plot.pdf")
d1 <- density(somedata)
d2 <- density(someotherdata)
plot(d1)
par(col="red")
lines(d2)
dev.off()
The original data is just two monodimensional vectors, so what I'm interested in is the intersection point of their densities.
I tried to use the solution shown in here, but unfortunately, it neither gives me a number nor even draws the lines correctly:
edit: I have found what I was looking for
# create and plot example data
set.seed(1)
plotrange <- c(-1,8)
d1 <- density(rchisq(1000, df=2), from=plotrange[1], to=plotrange[2])
d2 <- density(rchisq(1000, df=3)-1, from=plotrange[1], to=plotrange[2])
plot(d1)
lines(d2)
# look for points of intersection
poi <- which(diff(d1$y > d2$y) != 0)
# Mark those points with a circle:
points(x=d1$x[poi], y=d1$y[poi], col="red")
# or with lines:
abline(v=d1$x[poi], col="orange", lty=2)
abline(h=d1$y[poi], col="orange", lty=2)
intersect(x,y)
see this help file
For example: If your data are in the same data.frame df
intersect(df$col1, df$col2)
Here is a small example extending John's answer with an example.
require(ggplot2)
require(reshape2)
set.seed(12)
df <- data.frame(x = round(rnorm(100, 20, 10),1), y = round((100/log(100:199)),1))
str(df)
# 'data.frame': 200 obs. of 2 variables:
# $ variable: Factor w/ 2 levels "x","y": 1 1 1 1 1 1 1 1 1 1 ...
# $ value : num 16.8 25.7 20.5 22 19 ...
# Melt and plot
mdf <- melt(df)
ggplot(mdf) +
geom_density(aes(x = value, color = variable))
# Find points that intersect
intersect(df$x, df$y)
# [1] 18.9 20.1 21.3 21.5 21.0 19.6 19.0 20.0 19.8
# To make the answer more complete, here is the source code of intersect.
function (x, y)
{
y <- as.vector(y)
unique(y[match(as.vector(x), y, 0L)])
}
<bytecode: 0x10285d400>
<environment: namespace:base>
>
# It's actually posible to use unique and match to produce the same output
unique(as.vector(df$y)[match(as.vector(df$x), df$y, 0L)])
# [1] 18.9 20.1 21.3 21.5 21.0 19.6 19.0 20.0 19.8!
I'm sure your answers are correct, but here's what finally worked for me:
d1$x[abs(d1$y-d2$y) < 0.00001 && d1$x < 1000 && d1$x > 500]
(because I really only needed to find out one value and am a total R newbie, which made it difficult to understand your answers, since I don't even understand most basic R concepts yet. Thank you for your help and sorry.