#' Define regions of interest.
#' Interactively define ROI-s, points or polygons, using mouse clicks.
#' @param points integer. Number of points to define.
#' @param polygons integer. Number of polygons to define.
#' @param marks character vector; one or more names describing the areas to be defined.
#' @param what integer. which image should be scored again. Use CZshowStatus() to identify the file.
#' @param ... arguments passed to locator().
#' @export
#' @importFrom RSQLite dbGetQuery
#' @importFrom raster plotRGB nbands brick
#' @importFrom rgeos plot readWKT
#' @importFrom utils head flush.console packageVersion setTxtProgressBar txtProgressBar
#' @examples
#' \dontrun{
#' require(colorZapper)
#' dir = system.file(package = "colorZapper", "sample")
#' CZopen(path = tempfile() )
#' CZaddFiles(dir)
#' CZdefine(points = 1, marks = c('wing', 'tail'))
#' }
setGeneric("CZdefine", function(points, polygons, ...) standardGeneric("CZdefine") )
# points
#' @export
#' @rdname CZdefine
setMethod("CZdefine",signature = c(points = "numeric", polygons = "missing"),
definition = function(points , marks = NA, what, ...) {
stopifnot( colorZapper_file_active() )
qstr = "select * from files f WHERE f.id not in (select distinct id from ROI WHERE instr(wkt, 'MULTIPOINT') = 1 )"
if(!missing(what))
qstr = paste("select * from files f WHERE f.id in", paste('(', paste(what, collapse = ","), ')') )
f = dbGetQuery(getOption('cz.con'), qstr)
if(missing(what) & nrow(f) == 0) stop("You pushed points on all images here.")
basedir = dbGetQuery(getOption('cz.con'), "SELECT basedir from nfo")$basedir
f$path = paste(basedir, f$path, sep = '/')
for(i in 1:nrow(f) ) {
bi = brick(f[i, 'path'] )
if( nbands(bi) != 3)
warning(basename(f[i, 'path']), ' has ', nbands(bi), ' bands but 3 are expected.')
plotRGB (bi, maxpixels = Inf)
for(j in 1:length(marks) ) {
v = locator(type = "p", n = points, ...)
v = paste("MULTIPOINT(", paste("(", v$x, v$y, ")", collapse = ","), ")")
points(rgeos::readWKT(v), cex = 2)
d = data.frame( id = f[i, 'id'], wkt = v, mark = marks[j] , pk = NA)
dbWriteTable(getOption('cz.con'), "ROI", d, row.names = FALSE, append = TRUE)
}
if(Sys.getenv("RSTUDIO") == "1") dev.off()
flush.console()
cat(i, "of", nrow(f), "\n" )
}
})
# polygons
#' @export
#' @rdname CZdefine
setMethod("CZdefine",signature = c(points = "missing", polygons = "numeric"),
definition = function(polygons , marks = NA, what, ...) {
stopifnot( colorZapper_file_active() )
qstr = "select * from files f WHERE f.id not in (select distinct id from ROI WHERE instr(wkt, 'MULTIPOLYGON') = 1 )"
if(!missing(what))
qstr = paste("select * from files f WHERE f.id in", paste('(', paste(what, collapse = ","), ')') )
f = dbGetQuery(getOption('cz.con'), qstr)
if(missing(what) & nrow(f) == 0) stop("You painted polygons on all images here.")
basedir = dbGetQuery(getOption('cz.con'), "SELECT basedir from nfo")$basedir
f$path = paste(basedir, f$path, sep = '/')
for(i in 1:nrow(f) ) {
bi = brick(f[i, 'path'] )
if( nbands(bi) != 3)
warning(basename(f[i, 'path']), ' has ', nbands(bi), ' bands but 3 are expected.')
marksCol = as.numeric(factor(marks))
plotRGB (bi, maxpixels = Inf)
for(j in 1:length(marks) ) {
P = vector(mode = "list", length = polygons)
nj = 0
while(nj < polygons) {
nj = nj+1
P[[nj]] = locator(type = "l")
}
gp = lapply(P, function(p) { list( x = c(p$x, p$x[1]),y = c(p$y, p$y[1]) ) } )
gp = sapply(gp, function(p) paste(p$x, p$y, collapse = ",") )
gp = paste('((', gp, '))', collapse = ",")
gp = paste('MULTIPOLYGON(', gp, ')')
plot(rgeos::readWKT(gp), border = 2, col = adjustcolor(marksCol[j], .2), add = TRUE)
d = data.frame( id = f[i, 'id'], wkt = gp, mark = marks[j], pk = NA)
dbWriteTable(getOption('cz.con'), "ROI", d, row.names = FALSE, append = TRUE)
}
if(Sys.getenv("RSTUDIO") == "1") dev.off()
flush.console()
cat(i, "of", nrow(f), "\n" )
}
}
)
#' Check out defined ROI-s
#' Plot the defined ROI-s on the original image.
#' @param file destination pdf file.
#' @note Warning! this can take a long time for many images.
#' @export
#' @examples
#' \dontrun{
#' require(colorZapper)
#' dir = system.file(package = "colorZapper", "sample")
#' CZopen(path = tempfile() )
#' CZaddFiles(dir)
#' CZdefine(points = 1)
#' CZdefine(polygons = 1, what = 1)
#' CZcheck()
#' }
CZcheck <- function(file = tempfile(fileext = ".pdf") ) {
stopifnot( colorZapper_file_active())
d = db2list(getOption('cz.con'))
pdf(file)
pb = txtProgressBar(1, length(d$files$id), style=3)
message('Printing images and marks to pdf ...')
for(i in d$files$id ) {
setTxtProgressBar(pb, i)
fi = d$files[d$files$id == i, 'path']
ri = raster::brick( fi )
roii = lapply(d$ROI[d$ROI$id == i, 'wkt'], rgeos::readWKT)
plotRGB(ri, margins = TRUE, main = basename(fi) )
for(j in roii) {
if( inherits(j, "SpatialPoints") )
points(j, col = "red", cex = 2) else
plot(j, border = "red", lwd = 2, col = adjustcolor("red", 0.4) , add = TRUE)
}
}
dev.off()
message("Trying to open", file)
system(file)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.