The code below produces two boxes on my image. I am planning to analyze pixels within those boxes further.
I want to put a condition that if along an edge of a box, there is a black color (or a similar color such as grey) pixel then don't proceed. How can i specify such condition?
In below example, in the case of the red square I don't want to proceed further as it has black pixels at the top right hand corner. While I would like to proceed in the case of green square as it doesn't have a black color pixel along it's edge.
library(raster)
r1 <- brick(system.file("external/rlogo.grd", package="raster"))
x <- crop(r1, extent(0,50,0,50))
plotRGB(x)
plot(extent(c(0,20,0,20)), lwd=2, col="red", add=TRUE)
plot(extent(c(21,35,0,10)), lwd=2, col="Green", add=TRUE)
That is not very well defined as in this case color is made of RGB values. But here is a general solution that you could adapt. I 'flatten' these to a single channel by taking the average, and then test for the smallest value being below a threshold (white is 255, 255, 255 in RGB, black is 0,0,0) at the boundary
proceed <- function(f, e, threshold) {
lns <- as(as(e, 'SpatialPolygons'), 'SpatialLines')
v <- unlist(extract(f, lns))
ifelse( min(v, na.rm=TRUE) < threshold, FALSE, TRUE)
}
# flat <- mean(x) # not sophisticated see
# http://stackoverflow.com/questions/687261/converting-rgb-to-grayscale-intensity
flat <- sum(x * c(0.2989, 0.5870, 0.1140))
proceed(flat, extent(c(0,20,0,20)), 100)
proceed(flat, extent(c(21,35,0,10)), 100)
(much improved after seeing jbaums' solution; which is now gone)
Related
I want to take x, convert it into a black and white image. Then i want to convert all pixels that are below 100 to 0 and convert all pixels that are above 100 to 255. I want to get a sharper image where background will be white and objects within image will be black. And then store new x (black and white sharp image) on my hard drive. How could i do it?
library(raster)
r1 <- brick(system.file("external/rlogo.grd", package="raster"))
x <- crop(r1, extent(0,50,0,50))
plotRGB(x)
Based upon earlier question, i wrote below lines to convert r1 to black and white. But plotRGB function fails :(. Plot function works but it doesnt return me a black and white image
flat <- sum(x * c(0.2989, 0.5870, 0.1140))
plotRGB(flat)
flat
plot(flat)
========update1==========
in case anyone interested,
image colors can be swapped easily by using "1-twoclasses" in place of "twoclasses" in image and plot functions below
To actually see grays you need to provide these colors.
library(raster)
r1 <- brick(system.file("external/rlogo.grd", package="raster"))
x <- crop(r1, extent(0,50,0,50))
flat <- sum(x * c(0.2989, 0.5870, 0.1140))
plot(flat, col=gray(seq(0,1,0.1)))
You can use the reclassify function to get values that are either 0 or 255 but in this case it would seem more sensible to use 1 and 2
twoclasses <- cut(flat, c(0,100,255))
plot(twoclasses, col=gray(c(0,1)))
To write to disk, you can do something like:
png(width=ncol(twoclasses)*10, height=nrow(twoclasses)*10)
par(mai=c(0,0,0,0))
image(twoclasses, col=gray(c(0,1)))
dev.off()
I found this R code online:
stdDev <- 0.75;
x <- seq(-5,5,by=0.01)
y <- dnorm(x,sd=stdDev)
right <- qnorm(0.95,sd=stdDev)
plot(x,y,type="l",xaxt="n",ylab="p",
xlab=expression(paste('Assumed Distribution of ',bar(x))),
axes=FALSE,ylim=c(0,max(y)*1.05),xlim=c(min(x),max(x)),
frame.plot=FALSE)
axis(1,at=c(-5,right,0,5),
pos = c(0,0),
labels=c(expression(' '),expression(bar(x)[cr]),expression(mu[0]),expression('')))
axis(2)
xReject <- seq(right,5,by=0.01)
yReject <- dnorm(xReject,sd=stdDev)
polygon(c(xReject,xReject[length(xReject)],xReject[1]),
c(yReject,0, 0), col='red')
It is doing what I need, which is plotting the normal distribution, and shading a right rejection area according to some number (0.95). What I want to ask is:
How can I change this code to shade a two sided rejection area?
How do I change it for a left side one sided area?
And assume that I want a chi square or F distribution instead, is it enough to just change the dnorm & qnorm commands accordingly?
Another question: In this plot, the plot itself is higher than the y-axis. How do I fix it that the axis matches the height of the plot?
Thank you!
You can start with a polygon covering the whole area under the curve and removing the part that is not rejected:
## Calculate the 5th percentile
left <- qnorm(0.05,sd=stdDev)
## x and y for the whole area
xReject <- c(seq(-5,5,by=0.01))
yReject <- dnorm(xReject,sd=stdDev)
## set y = 0 for the area that is not rejected
yReject[xReject > left & xReject < right] <- 0
## Plot the red areas
polygon(c(xReject,xReject[length(xReject)],xReject[1]),
c(yReject,0, 0), col='red')
As before but set to zero the not rejected areas
yReject[xReject > left] <- 0
Almost. For example for the chi squared distribution you have to give the df (degrees of freedom and not sd). And also the xlim has to be changed. But apart from that the code would be the same.
The line axis(2) draws the y-axis. You can give some extra arguments to have it the way you want. You can try for example:
s <- seq(0,0.55,0.05)
axis(2, at = s, labels = s)
Hope it helps,
alex
Take the polygon calls which shade the right-side rejection area and repeat those lines, substituting the coordinates of the left-side area.
i think this will do it
left <- qnorm(0.05,sd=stdDev)
xLeject <- seq(left,-5,by=-0.01)
yLeject <- dnorm(xLeject,sd=stdDev)
polygon(c(xLeject,xLeject[length(xLeject)],xLeject[1]),
c(yLeject,0, 0), col='red')
As to graph extent, see plot(..., ylim=(lower,upper))
I have a grid of rectangles, whose coordinates are stored in the variable say, 'gridPoints' as shown below:
gridData.Grid=GridTopology(c(min(data$LATITUDE),min(data$LONGITUDE)),c(0.005,0.005),c(32,32));
gridPoints = as.data.frame(coordinates(gridData.Grid))[1:1000,];
names(gridPoints) = c("LATITUDE","LONGITUDE");
plot(gridPoints,col=4);
points(data,col=2);
When plotted, these are the black points in the image,
Now, I have another data set of points called say , 'data', which when plotted are the blue points above.
I would want a count of how many blue points fall within each rectangle in the grid. Each rectangle can be represented by the center of the rectangle, along with the corresponding count of blue points within it in the output. Also, if the blue point lies on any of the sides of the rectangle, it can be considered as lying within the rectangle while making the count. The plot has the blue and black points looking like circles, but they are just standard points/coordinates and hence, much smaller than the circles. In a special case, the rectangle can also be a square.
Try this,
x <- seq(0,10,by=2)
y <- seq(0, 30, by=10)
grid <- expand.grid(x, y)
N <- 100
points <- cbind(runif(N, 0, 10), runif(N, 0, 30))
plot(grid, t="n", xaxs="i", yaxs="i")
points(points, col="blue", pch="+")
abline(v=x, h=y)
binxy <- data.frame(x=findInterval(points[,1], x),
y=findInterval(points[,2], y))
(results <- table(binxy))
d <- as.data.frame.table(results)
xx <- x[-length(x)] + 0.5*diff(x)
d$x <- xx[d$x]
yy <- y[-length(y)] + 0.5*diff(y)
d$y <- yy[d$y]
with(d, text(x, y, label=Freq))
A more general approach (may be overkill for this case, but if you generalize to arbitrary polygons it will still work) is to use the over function in the sp package. This will find which polygon each point is contained in (then you can count them up).
You will need to do some conversions up front (to spatial objects) but this method will work with more complicated polygons than rectangles.
If all the rectangles are exactly the same size, then you could use k nearest neighbor techniques using the centers of the rectangles, see the knn and knn1 functions in the class package.
I have a data.frame with X and Y coordinate values. X axis is position information and Y axis is log ratio values. The points are colored based log ratio values(green > 0.25 , -0.25 < grey < 0.25, and red < -0.25). The orange dashed horizontal lines are log2 values of 0.58, 0, and -1.
A circular binary segmentation algorithm segments changes in log ratio, indicated by horizontal blue line. In the image attached one can see several segments, most if it close to log2 of 0. Close to the left end of the figure are small blue segment with log value close to 0.58, and a much smaller (almost invisible because of surrounding red points) blue segment at log value close to -1 (right edge of plot). I have x and y coordinates of these blue segments in another data.frame. I want to achieve the following
1) add circles bounding these blue segments above -0.70 < log2 > 0.50. This helps in identifying small segments that could be missed
2) Add transparent colors to these circles using alpha values so that the blue segment is seen
3) The size of the circle would be based on the width of these blue segments.
I am also open to other ideas of highligting these blue segments at -0.70 < log2 > 0.5. Maybe I should suppress plotting the points (green and red) where these blue segments are found. I am using R to make this plot. Appreciate the help.
This was the code used: There are two df objects. The df(X) contains Chr.no, Chr.Start, Chr.End and Log2. The df(Y) is similar, but different col.names such as loc. start, and loc. end. And instead of Log2, they have seg.mean values
for (i in 1:25) { # Plot each chromosome separately
plot(X[which(X$Chr.No ==i),"Chr.Start"], X[which(X$Chr.No ==i),"Log2"], ylim=c(-4.0,4.0), col=X[which(X$Chr.No ==i),"Color"], pch=16, cex=0.4, ylab="Log2", xlab="Genomic Position", main= paste("KCL:180522_SS", "chromosome", i, sep=" "))
abline(h=c(-1,0,log2(3/2)), lty=2, col="chocolate")
xleft = Y[which(Y$Chr.No ==i),"loc.start"] # Left limit of the blue horizontal line
xright = Y[which(Y$Chr.No ==i),"loc.end"] # Right limit of the blue horizontal line
ybottom= Y[which(Y$Chr.No ==i),"seg.mean"] - 0.010 # Adding thickness to the "seg.mean"
ytop = Y[which(Y$Chr.No ==i),"seg.mean"] + 0.010 # Adding thickness to the "seg.mean"
rect(xleft=xleft, ybottom=ybottom, xright=xright, ytop=ytop, col="blue", border="blue")
}
#Dwin Yes, "Color" is a vector of "lightgreen", "grey" and "red". These are the color information for the pch=16 in the plot(x,y). I do not want to modify the pch=16 points. The horizontal "blue" line segments are added by the 'rect', and they span many pch=16 points. As you can see there are many "blue" segments, some very small and some large in length that differ in their log2 values.This is what I want to bound with a filled transparent circle. Not all "blue" segments, but only the ones where the "blue" segment 0.25< log2 > 0.25. In this figure the smaller "blue" segments are close to the edges of the plot, and since they are difficult to spot, I want to highlight them with a filled circle around them. Please let me know if I am still not clear. Thanks
(Deleted incorrect method based on guess about the manner in which the blue points (which were really segments) were being constructed.)
Edit: With the new information I would suggest drawing ordinary "points", i.e, open circles at the x-vector formed by (xleft+xright)/2 and the y-vector using ytop (which should be the same as ybottom) each for the selected ytop values that meet your criteria. You would make a logical vectors to select each of these vectors. So:
selvec <- ytop < -0.70 | ytop > 0.5
points ( x= (xleft[selvec]+xright[selvec])/2, y= ytop[selvec], cex =1.5, col="blue")
You could also use transparency if you used the rgb() function to create a color with transparency:
points ( x= (xleft[selvec]+xright[selvec])/2, y= ytop[selvec], cex = 2, col=rgb(0, 0, 1, 0.3) )
.... should give you transparent circles if your output device supports it.
I use R code below to build bubble chart.
pdf(file='myfigure.pdf',height=10,width=13)
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
symbols(x,y, circles=radius,fg="white",bg=col,ylim=c(-20,140))
text(x, y, name, cex=1.5,font=4)
dev.off()
But I want the bubbles with 3d surface, say gradient fills and shadow. like the chart below.
Anyone knows how to use R to release it? Thanks!
Thanks for all the suggestions.While finally I tried a silly way by drawing multiple circles from dark to light to make it gradient filled. Any suggestions to make it better? Thanks!
makeTransparent<-function(someColor, alpha)
{
newColor<-col2rgb(someColor)
apply(newColor, 2, function(curcoldata){rgb(red=curcoldata[1], green=curcoldata[2], blue=curcoldata[3],alpha=alpha,maxColorValue=255)})
}
pdf(file='myfigure.pdf',height=10,width=13)
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
x2<-c()
y2<-c()
circles<-c()
bg<-c()
fg<-c()
num<-30
radius_min<-0.3
alpha_min<-40
alpha_max<-180
for (i in 1:num){
x2<-c(x2,x)
y2<-c(y2,y)
circles<-c(circles,radius*(radius_min+(i-1)*(1-radius_min)/num))
bg<-c(bg,makeTransparent(col,alpha=alpha_max-(i-1)*(alpha_max-alpha_min)/num))
if(i!=num){fg<-c(fg,makeTransparent(col,alpha=alpha_max-(i-1)*(alpha_max-alpha_min)/num))}else{fg<-c(fg,rep('white',length(x)))}
}
symbols(x2,y2,circles=circles,fg=fg,bg=bg)
text(x, y, name, cex=1.5,font=4)
dev.off()
Here is a solution (inspired by #Edward's solution for this question):
#First your data:
y<-c(123,92,104,23,17,89,13)
x<-c(11,45,24,50,18,7,2)
size<-c(1236,1067,1176,610,539,864,1026)
radius<-sqrt(size/pi)
col<-c(2,2,3,4,5,5,6)
name<-c("Acura", "Alfa Romeo","AM General","Aston Martin Lagonda","Audi","BMW","Bugatti")
#Then a simple function to draw a circle based on its center and its radius:
circle <- function (r, x0, y0, col){
t <- seq(0, 2 * pi, by = 0.01)
x <- r * cos(t) + x0
y <- r * sin(t) + y0
lines(x, y, col=col)
}
#This is a smoothing factor:
sm <- 500
#The asp parameter is important here since we are actually drawing the circles and not plotting some circle symbols: if asp is not equal to 1 they will appear as ellipse.
plot(x,y,type="n",asp=1)
#This can probably be vectorized but I'm not a good vectorizer so if anyone wants to give it a try:
for(j in 1:length(x)){
radius[j]*sm:1/sm -> radiuses
colorRampPalette(c(palette()[col[j]], "white"))->col_grad
col_grad(length(radiuses))->colx
for(i in 1:length(radiuses)){circle(radiuses[i], x[j], y[j], col=colx[i])}
}
text(x, y, name, cex=1.5,font=4)
See ?colorRampPalette for more information on how this function works.
Edit: with shadows
offset<-c(2,-2) #Offset of the shadow circles
library(scales) #For function alpha
plot(x,y,type="n",asp=1)
for(j in 1:length(x)){
radius[j]*sm:1/sm -> radiuses
colorRampPalette(c(palette()[col[j]], "white"))->col_grad
col_grad(length(radiuses))->colx
for(i in 1:length(radiuses)){circle(radiuses[i], x[j]+offset[1], y[j]+offset[2], col=alpha("grey90",0.1))} #the alpha, the nuance of grey can be tweaked with obviously for the desired effect
for(i in 1:length(radiuses)){circle(radiuses[i], x[j], y[j], col=colx[i])}
}
text(x, y, name, cex=1.5,font=4)