I am trying to process a tissue image in R and I have been able to highlight certain cells with black color and rest background is white in color. My question is very similar to this (being a newbie I am unable to post picture)
How to circle/highlight/rectangle certain regions of an image?
Just that I need to know how will this be possible in R. I have tried many functions and searched for many techniques but no result yet. Here is the code and the original image
img<-readJPEG("img.jpg")
img<-array(img,c(480,640,3))
imgDm <- dim(img)
imgRGB <- data.frame(
x = rep(1:imgDm[2], each = imgDm[1]),
y = rep(imgDm[1]:1, imgDm[2]),
R = as.vector(img[,,1]),
G = as.vector(img[,,2]),
B = as.vector(img[,,3])
)
library(ggplot2)
plotTheme <- function() {
theme(
panel.background = element_rect(
size = 3,
colour = "black",
fill = "white"),
axis.ticks = element_line(
size = 2),
panel.grid.major = element_line(
colour = "gray80",
linetype = "dotted"),
panel.grid.minor = element_line(
colour = "gray90",
linetype = "dashed"),
axis.title.x = element_text(
size = rel(1.2),
face = "bold"),
axis.title.y = element_text(
size = rel(1.2),
face = "bold"),
plot.title = element_text(
size = 20,
face = "bold",
vjust = 1.5)
)
}
ggplot(data = imgRGB, aes(x = x, y = y)) + geom_point(colour = rgb(imgRGB[c("R", "G", "B")])) +labs(title = "Original Image: Tissue") +xlab("x") +ylab("y") +plotTheme()
kClusters <- 3
kMeans <- kmeans(imgRGB[, c("R", "G", "B")], centers = kClusters)
kColours <- rgb(kMeans$centers[kMeans$cluster,])
kColours[kColours=="#8B8B8B"]<-"#1874CD"
kColours[kColours=="#565656"]<-"#FFFFFF"
kColours[kColours=="#CCCCCC"]<-"#FFFFFF"
ggplot(data = imgRGB, aes(x = x, y = y)) + geom_point(colour = kColours) +labs(title = paste("k-Means Clustering of", kClusters, "Colours")) +xlab("x") +ylab("y") + plotTheme()
Image:
This is the image I have processed until now:
Related
I have a data with over 700 observations but below is a sample. Using geom_curve I want to make a plot where the line size(total_trips) corresponds to a color say 3 different colors. For instance between 0-100 (total_trips) can have a color of red
df <- data.frame(
origin_x = c(659627.8,642136.2,648774.7,659627.8,659627.8,658455.7,659627.8,659620.6,661641.8,656246.4),
origin_y = c(6473200,6473200,6462166,6473200,6473200,6467413,6473200,6467163,6479577,6487039),
dest_x = c(642136.2,659627.8,659627.8,648774.7,659620.6,659627.8,658455.7,659627.8,659627.8,659627.8),
dest_y = c(6456563,6473200,6473200,6462166,6467163,6473200,6467413,6473200,6473200,6473200
),
total_trips = c(4002,49878,2011,500,100,3000,2500,654,900,600))
I tried
ggplot() + geom_sf(data=shapefile, colour='grey', fill='grey93', size = 0.25) +
geom_curve(
data = df),
aes(
x = origin_x,
xend = dest_x,
y = origin_y,
yend = dest_y,
size = n,
colour= as.factor(c('red','blue'))),
curvature = 0.3
) + scale_alpha_continuous(range = c(0.09,1)) +
theme(
axis.title = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
plot.title = element_text(hjust = 0.5, size = 6),
plot.caption = element_text(hjust = 1),
plot.caption.position = 'plot',
axis.ticks = element_blank(),
panel.background = element_rect(fill = 'white'),
panel.grid = element_blank(),
plot.background = element_rect(color = NA, size = 0.5, fill=NA),
panel.border = element_rect(color = 'black', fill = NA, size=0.2) ,
legend.position = c(0.89,0.15),
legend.key.size = unit(0.4, 'cm'),
legend.text = element_text(size=7)
) +
annotation_scale(location = 'br', style = 'ticks') + coord_sf(crs=3301) +
annotation_north_arrow(location = 'tr', width = unit(0.20, 'cm'),height = unit(0.5,'cm'))
If I understand correctly - you want to change the colour of the line according to a categorised continuous variable (total_trips), we can do this:
Use cut to categorise the variable and give labels to the groups
Add this new variable to the aes(colour =.
library(dplyr)
library(ggplot2)
df <- df |> mutate(trips = cut(total_trips, c(0, 2000, 5000, 50000),
labels = c("0-2k", "2k-5k", "5k-50k")))
ggplot() +
geom_curve(data = df, aes(x = origin_x,
xend = dest_x,
y = origin_y,
yend = dest_y,
size = total_trips,
colour = trips
))
Output:
Not sure if this is what you want, though – your sample dataset doesn't contain the variable n that you mention in size = n, and you haven't provided us with shapefile.
So I've been trying to work with a data.frame and a shapefile I've been using the below code:
Jul_Col_map <-
ggplot(data = Jul_Data, aes(x = Long_DD, y = Lat_DD, color = Coliform)) +
geom_point(size = 4) +
geom_sf(aes(Cave_initial), size = 1) +
scale_color_gradient(low = "blue", high = "red") +
labs(x = "",
y = "",
color = "Coliform (cfu/100mL)") +
guides(color = guide_colourbar(barwidth = 0.5, barheight = 10)) +
theme_classic() +
theme(axis.text.x = element_text(face = "bold", color = "black", size = 12), axis.text.y =
element_text(face = "bold", color = "black", size = 12), axis.title.x = element_text(face =
"bold", color = "black", size = 16), axis.title.y = element_text(face = "bold", color = "black",
size = 16))
Jul_Col_map
But I always get the error
Error in FUN(X[[i]], ...) : object 'Long_DD' not found
I have properly uploaded the data set and converted it to a sf using st_as_sf and when I run selected code everything works fine until I actually want to show the map.
I would like to add two (same) legends in ggplot and also want to change legend title and labels. I have tried this:
library(ggplot2)
ggplot(ToothGrowth, aes(x = len, color=factor(dose), fill= factor(dose))) +
geom_density(alpha=0.4) +
theme(panel.background = element_rect(fill = "khaki1", colour = "darkorchid3", size = 2, linetype = "solid"),
panel.grid.major = element_line(size = 0.5, linetype = 'solid', colour = "white"),
panel.grid.minor = element_line(size = 0.25, linetype = 'solid', colour = "white"),
plot.background = element_rect(fill = "bisque2"),
text = element_text(colour="blue4"), axis.title = element_text(size = rel(1.25)), axis.text = element_text(colour="blue4", size = 12),
legend.position=c(.90,.85), legend.background =
element_rect(fill="lightsalmon", colour = "tomato3", size = 1.25),
legend.title = element_text(colour="navy", face="bold"),
legend.text = element_text( colour="midnightblue", face="bold"), strip.background = element_rect(fill="olivedrab1", colour = "darkorchid3", size = 2, linetype = "solid"),
strip.text = element_text(colour="coral4", size=12, angle=0, face="bold")) +
scale_fill_discrete(name = "Dose", labels = c("A", "B", "C")) +
facet_wrap(~supp)
but I got this plot:
I want this plot:
Can somebody help me? Thank you.
As #erocoar and others have suggested, grid.arrange from gridExtra is useful here. Borrowing heavily from from the linked question:
library(gridExtra)
out <- by(data = ToothGrowth, INDICES = ToothGrowth$supp, FUN = function(m) {
m <- droplevels(m)
m <- ggplot(m, aes(x = len, fill= factor(dose)), color=factor(dose)) +
geom_density(alpha=0.4) +
theme(panel.background = element_rect(fill = "khaki1", colour = "darkorchid3",
size = 2, linetype = "solid"),
panel.grid.major = element_line(size = 0.5, linetype = 'solid',
colour = "white"),
panel.grid.minor = element_line(size = 0.25, linetype = 'solid',
colour = "white"),
plot.background = element_rect(fill = "bisque2"),
text = element_text(colour="blue4"),
axis.title = element_text(size = rel(1.25)),
axis.text = element_text(colour="blue4", size = 12),
legend.position=c(.90,.85),
legend.background = element_rect(fill="lightsalmon",
colour = "tomato3", size = 1.25),
legend.title = element_text(colour="navy", face="bold"),
legend.text = element_text( colour="midnightblue", face="bold"),
strip.background = element_rect(fill="olivedrab1",
colour = "darkorchid3", size = 2,
linetype = "solid"),
strip.text = element_text(colour="coral4", size=12, angle=0,
face="bold")) +
scale_fill_discrete(name = "Dose", labels = c("A", "B", "C")) +
xlim(0,35) +
ylim(0,0.2) +
ggtitle(m$supp)
})
do.call(grid.arrange, list(grobs = out, ncol = 2))
Some things to note.
I moved the color argument outside of the aes() call and this removed the extra legend.
I manually set the x and y limits for a consistent look.
I needed to add a title.
To get the plots side by side I had to add a second argument to do.call(). When supplying more than one argument it needs to be in a list.
I hope this helps.
I have produced some nice plots with the plotLearnerPrediction function of the MLR package. I was able to make some adjustments to the returned ggplot (see my code below). But I am not sure how to make the last adjustment. Namely, I want to change the coloring of the data points based on labels (groups in example plot).
My last plot (with black data points)
Another produced plot (overlapping data points)
This is the last version of my code (normally part of a for loop):
plot <- plotLearnerPrediction(learner = learner_name, task = tasks[[i]], cv = 0,
pointsize = 1.5, gridsize = 500) +
ggtitle(trimws(sprintf("Predictions %s %s", meta$name[i], meta$nr[i])),
subtitle = sprintf("DR = %s, ML = %s, CV = LOO, ACC = %.2f", meta$type[i],
toupper(strsplit(learner_name, "classif.")[[1]][2]), acc[[i]])) +
xlab(sprintf("%s 1", lab)) +
ylab(sprintf("%s 2", lab)) +
scale_fill_manual(values = colors) +
theme(plot.title = element_text(size = 18, face = "bold"),
plot.subtitle = element_text(size = 12, face = "bold", colour = "grey40"),
axis.text.x = element_text(vjust = 0.5, hjust = 1),
axis.text = element_text(size = 14, face = "bold"),
axis.title.x = element_text(vjust = 0.5),
axis.title = element_text(size = 16, face = "bold"),
#panel.grid.minor = element_line(colour = "grey80"),
axis.line.x = element_line(color = "black", size = 1),
axis.line.y = element_line(color = "black", size = 1),
panel.grid.major = element_line(colour = "grey80"),
panel.background = element_rect(fill = "white"),
legend.justification = "top",
legend.margin = margin(l = 0),
legend.title = element_blank(),
legend.text = element_text(size = 14))
Below is a part of the source code of the plotLearnerPrediction function. I want to overrule geom_point(colour = "black"). Adding simply geom_point(colour = "pink") to my code will not color data points, but the whole plot. Is there a solution to overrule that code with a vector of colors? Possibly a change in the aes() is also needed to change colors based on groups.
else if (taskdim == 2L) {
p = ggplot(mapping = aes_string(x = x1n, y = x2n))
p = p + geom_tile(data = grid, mapping = aes_string(fill = target))
p = p + scale_fill_gradient2(low = bg.cols[1L], mid = bg.cols[2L],
high = bg.cols[3L], space = "Lab")
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n, colour = target), size = pointsize)
p = p + geom_point(data = data, mapping = aes_string(x = x1n,
y = x2n), size = pointsize, colour = "black",
shape = 1)
p = p + scale_colour_gradient2(low = bg.cols[1L],
mid = bg.cols[2L], high = bg.cols[3L], space = "Lab")
p = p + guides(colour = FALSE)
}
You can always hack into gg objects. The following works for ggplot2 2.2.1 and adds a manual alpha value to all geom_point layers.
library(mlr)
library(ggplot2)
g = plotLearnerPrediction(makeLearner("classif.qda"), iris.task)
ids.geom.point = which(sapply(g$layers, function(z) class(z$geom)[[1]]) == "GeomPoint")
for(i in ids.geom.point) {
g$layers[[i]]$aes_params$alpha = 0.1
}
g
The plotLearnerPrediction() function returns the ggplot plot object, which allows for some level of customization without having to modify the source code. In your particular case, you can use scale_fill_manual() to set custom fill colors:
library(mlr)
g = plotLearnerPrediction(makeLearner("classif.randomForest"), iris.task)
g + scale_fill_manual(values = c("yellow", "orange", "red"))
I am making a plot to be submitted to an academic journal.
I used png() function for anti-aliasing, but the legend in the plot is too big.
Please refer to the sample code and plot below.
posn.d <- position_dodge(0.1)
plot_test <- ggplot(mtcars, aes(factor(gear), hp, shape = factor(am)))+
ylab("HP")+
stat_summary(fun.y = mean, geom = "point", position = posn.d, aes(shape = factor(am)), size = 1)+
stat_summary(fun.y = mean, geom = "line", position = posn.d, aes(group = factor(am), linetype = factor(am)), size = 0.4)+
stat_summary(fun.data = mean_se, fun.args = list(mult = 1), geom = "errorbar", width = 0.1, position =posn.d, size=0.3)+
theme(legend.key = element_rect(colour = "white"), panel.border = element_blank(), panel.grid.major = element_blank(),
panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"),
axis.title.y=element_text(vjust=1,face="bold",size=6), axis.title.x = element_blank(),
axis.text.x=element_text(size=6, face = "bold"), axis.text.y=element_text(size=6, face = "bold"),
axis.line.x=element_line(size=0.2),axis.line.y=element_line(size=0.2),axis.ticks=element_line(size=0.2),
plot.title=element_text(hjust=0,vjust=2,face="bold", size=3))+
scale_linetype_manual(name = "AM", labels = c("am0", "am1"), values = c("solid", "dotted"))+
scale_shape_manual(name = "AM", labels = c("am0", "am1"), values = c(16, 15))+
scale_x_discrete(labels = c("three", "four", "five"))
png(width = 100, height = 35, units="mm", filename = "test.jpg", type = "cairo", antialias = "subpixel", family = "malgun", res = 300)
plot_test
dev.off()
I tried to reduce the size of the legend title and text, by adding
legend.title = element_text(size = 4, face = "bold"), legend.text = element_text(size = 4)
in the theme().
But the space between legend texts and title are still too large and look difficult to control.
Could anyone help me without changing the whole image size or resolution?
(Because the size and resolution can not be controlled freely to conform to the guidelines of the journal.)