Skip to content

Commit

Permalink
Added omplete point deletion ability
Browse files Browse the repository at this point in the history
  • Loading branch information
@droglenc
droglenc committed May 10, 2018
1 parent 409984c commit 595063a
Show file tree
Hide file tree
Showing 24 changed files with 172 additions and 163 deletions.
7 changes: 6 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# RFishBC 0.0.7 ongoing

* Updated tests.
* `digitizeRadii()`: Modified. Added ability (using `iSelectPt()`) to delete points after selection for scale-bar, transect, and annuli selection. This removed the use of `locator()` and thus key-presses are used to terminate the selection of points. Added the `pch.del=` and `col.del=` arguments. Removed the `orig.pts` data.frame from the returned object.
* `findScalingFactor()`: Modified. Added ability (using `iSelectPt()`) to delete points after selection for scale-bar. Added `pch.sel=`, `col.sel=`, `cex.sel=`, `pch.del=`, and `col.del=` arguments.
* `RFBCoptions()`: Modified. Added the `pch.del=` and `col.del=` arguments. Removed `pch.show2=`, `col.show2=`, and `cex.show2=`
* `showDigitizedImage()`: Modified. Removed the ability to show the original (before snapping to the transect) points. Thus, removed `showOrigPts=`, `pch.show2=`, `col.show2=`, and `cex.show2=`.
* `iSelectPt()`: Added.

# RFishBC 0.0.6 9-May-18
* Added some tests.
Expand Down
66 changes: 7 additions & 59 deletions R/RFishBC-internals.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#'
#' @rdname FSA-internals
#' @keywords internal
#' @aliases .onAttach STOP WARN CATLINE BULLET DONE NOTE iHndlFilenames iGetImage iSelectPts iPts2Rad iSnap2Transect iScalingFactorFromScaleBar iPlaceText
#' @aliases .onAttach STOP WARN CATLINE BULLET DONE NOTE iHndlFilenames iGetImage iScalingFactorFromScaleBar iPlaceText


########################################################################
Expand Down Expand Up @@ -115,70 +115,18 @@ iGetImage <- function(fname,id,sepWindow,windowSize,
}




iSelectPt <- function(msg,pch.sel,col.sel,cex.sel,pch.del,col.del) {
## Internal function for handling mouse down event
mouseDown <- function(buttons,x,y) {
tmp <- data.frame(x=grconvertX(x,"ndc","user"),
y=grconvertY(y,"ndc","user"))
points(y~x,data=tmp,pch=pch.sel,col=col.sel,cex=cex.sel)
dat <<- rbind(dat,tmp)
NULL
}
## Internal function for handling key press event
keyPress <- function(key) {
if (key %in% c("f","q")) return(invisible(1))
if (key %in% c("d","r")) {
n <- nrow(dat)
if (n>=1) {
points(y~x,data=dat[n,],pch=pch.del,col=col.del,cex=cex.sel)
dat <<- dat[-n,]
}
NULL
}
}
## Main function
dat <- data.frame(x=NULL,y=NULL)
getGraphicsEvent(msg,onMouseDown=mouseDown,onKeybd=keyPress)
dat
}



########################################################################
## Convert selected x-y points to radial measurements
## Finds the scaling factor from two points selected by the user.
########################################################################
iPts2Rad <- function(pts,edgeIsAnnulus,scalingFactor,pixW2H,id,reading) {
#### Number of radial measurements is one less than number of points selected
n <- nrow(pts)-1
#### Distances in x- and y- directions, corrected for pixel w to h ratio
distx <- (pts$x[2:(n+1)]-pts$x[1])*pixW2H
disty <- pts$y[2:(n+1)]-pts$y[1]
#### Distances between points
distxy <- sqrt(distx^2+disty^2)
#### Correct distances for scalingFactor ... and call a radius
rad <- distxy*scalingFactor
#### Sort radii in increasing order (probably redundant)
rad <- rad[order(rad)]
#### create data.frame with radii information
data.frame(id=as.character(rep(id,n)),
reading=as.character(rep(ifelse(is.null(reading),NA,reading),n)),
agecap=ifelse(edgeIsAnnulus,n,n-1),
ann=seq_len(n),
rad=rad,radcap=max(rad),
stringsAsFactors=FALSE)
}



iScalingFactorFromScaleBar <- function(knownLength,pixW2H,
iScalingFactorFromScaleBar <- function(msg2,knownLength,pixW2H,
col.scaleBar,lwd.scaleBar,
pch.sel,col.sel,cex.sel,
pch.del,col.del) {
sbPts <- iSelectPt(" Press 'f' when finished, 'd' to delete selection.",
sbPts <- iSelectPt("Select ends of scale-bar:",msg2,
pch.sel=pch.sel,col.sel=col.sel,cex.sel=cex.sel,
pch.del=pch.del,col.del=col.del)
pch.del=pch.del,col.del=col.del,
snap2Transect=FALSE,slpTransect=NULL,
intTransect=NULL,slpPerpTransect=NULL)
if (nrow(sbPts)<2) {
WARN("Two endpoints were not selected for the scale bar;\n","
thus, a scaling factor of 1 will be used.")
Expand Down
156 changes: 106 additions & 50 deletions R/digitizeRadii.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,8 @@
#' @param pch.sel See details in \code{\link{RFBCoptions}}.
#' @param col.sel See details in \code{\link{RFBCoptions}}.
#' @param cex.sel See details in \code{\link{RFBCoptions}}.
#' @param pch.del See details in \code{\link{RFBCoptions}}.
#' @param col.del See details in \code{\link{RFBCoptions}}.
#' @param showInfo See details in \code{\link{RFBCoptions}}.
#' @param pos.info See details in \code{\link{RFBCoptions}}.
#' @param cex.info See details in \code{\link{RFBCoptions}}.
Expand Down Expand Up @@ -50,7 +52,6 @@
#' \item{\code{slpPerpTransect}: }{The slope of the line perpendicular to the transect.}
#' \item{\code{windowSize}: }{A numeric of length two that contains the width and height of the window used to display the structure image. One of these units was set by the given \code{windowSize} value.}
#' \item{\code{pixW2H}: }{The ratio of pixel width to height. This is used to correct measurements for when an image is not square.}
#' \item{\code{orig.pts}: }{A data.frame that contains the \dQuote{original} \code{x} and \code{y} coordinates on the image for the selected annuli. If \code{snap2Transect=FALSE} then these are the same as the points in \code{pts}. If \code{snap2Transect=TRUE} then these are the originally selected points and will be different then the points in \code{pts}.}
#' \item{\code{pts}: }{A data.frame that contains the \code{x} and \code{y} coordinates on the image for the selected annuli. These points may be \dQuote{snapped} to the transect if \code{snap2Transect==TRUE}.}
#' \item{\code{radii}: }{A data.frome that contains the unique \code{id}, the \code{reading} code, the age-at-capture in \code{agecap}, the annulus number in \code{ann}, the radial measurements in \code{rad}, and the radial measurement at capture in \code{radcap}.}
#' }.
Expand All @@ -65,7 +66,7 @@
#'
digitizeRadii <- function(img,id,reading,suffix,
description,edgeIsAnnulus,popID,
sepWindow,windowSize,confirmSelection,
sepWindow,windowSize,
scaleBar,scaleBarLength,col.scaleBar,lwd.scaleBar,
scalingFactor,showTransect,snap2Transect,
col.transect,lwd.transect,
Expand All @@ -83,30 +84,32 @@ digitizeRadii <- function(img,id,reading,suffix,
if (missing(popID)) popID <- iGetopt("popID")
if (missing(scaleBar)) scaleBar <- iGetopt("scaleBar")
if (missing(scaleBarLength)) scaleBarLength <- iGetopt("scaleBarLength")
if (missing(scalingFactor)) scalingFactor <- iGetopt("scalingFactor")
if (scaleBar & is.null(scaleBarLength))
STOP("Must provide a 'scaleBarLength' when 'scaleBar=TRUE'.")
if (!is.null(scaleBarLength)) {
if (!is.numeric(scaleBarLength)) STOP("'scaleBarLength' must be numeric.")
if (scaleBarLength<=0) STOP("'scaleBarLength' must be positive.")
if (scalingFactor!=RFBCoptions()$scalingFactor)
STOP("Can not set both 'scaleBarLength' and 'scalingFactor'.")
}
if (!scaleBar & !is.null(scaleBarLength))
STOP("Can not use 'scaleBarLength=' with 'scaleBar=FALSE'.")
if (missing(col.scaleBar)) col.scaleBar <- iGetopt("col.scaleBar")
if (missing(lwd.scaleBar)) lwd.scaleBar <- iGetopt("lwd.scaleBar")
if (missing(scalingFactor)) scalingFactor <- iGetopt("scalingFactor")
if (!is.null(scalingFactor)) {
if (!is.numeric(scalingFactor)) STOP("'scalingFactor' must be numeric.")
if (scalingFactor<=0) STOP("'scalingFactor' must be positive.")
}
if (missing(col.scaleBar)) col.scaleBar <- iGetopt("col.scaleBar")
if (missing(lwd.scaleBar)) lwd.scaleBar <- iGetopt("lwd.scaleBar")
if (missing(showTransect)) showTransect<- iGetopt("showTransect")
if (missing(snap2Transect)) snap2Transect<- iGetopt("snap2Transect")
if (missing(col.transect)) col.transect <- iGetopt("col.transect")
if (missing(lwd.transect)) lwd.transect <- iGetopt("lwd.transect")
if (missing(pch.sel)) pch.sel <- iGetopt("pch.sel")
if (missing(col.sel)) col.sel <- iGetopt("col.sel")
if (missing(cex.sel)) cex.sel <- iGetopt("cex.sel")
if (missing(pch.del)) pch.del <- iGetopt("pch.del")
if (missing(col.del)) col.del <- iGetopt("col.del")
if (missing(cex.sel)) cex.sel <- iGetopt("cex.sel")
if (missing(sepWindow)) sepWindow <- iGetopt("sepWindow")
if (missing(windowSize)) windowSize <- iGetopt("windowSize")
if (!is.numeric(windowSize)) STOP("'windowSize' must be numeric.")
Expand All @@ -115,6 +118,7 @@ digitizeRadii <- function(img,id,reading,suffix,
if (missing(pos.info)) pos.info <- iGetopt("pos.info")
if (missing(cex.info)) cex.info <- iGetopt("cex.info")
if (missing(col.info)) col.info <- iGetopt("col.info")
msg2 <- " Press 'f' when finished, 'd' to delete selection."

## Handle getting the image filename =========================================
img <- iHndlFilenames(img,filter="images",multi=FALSE)
Expand All @@ -136,85 +140,63 @@ digitizeRadii <- function(img,id,reading,suffix,
## Loads image given in img ==================================================
windowInfo <- iGetImage(img,id,sepWindow,windowSize,
showInfo,pos.info,cex.info,col.info)
DONE("Loaded the ",img," image.")
DONE("Loaded the ",img," image.\n")

## Allows user to select a scaling bar to get a scaling factor ===============
if (scaleBar) { ## scaleBar is on the plot
NOTE("Select the endpoints of the scale-bar.")
sfSource <- "scaleBar"
sbInfo <- iScalingFactorFromScaleBar(scaleBarLength,windowInfo$pixW2H,
sbInfo <- iScalingFactorFromScaleBar(msg2,scaleBarLength,windowInfo$pixW2H,
col.scaleBar=col.scaleBar,
lwd.scaleBar=lwd.scaleBar,
pch.sel=pch.sel,col.sel=col.sel,
cex.sel=cex.sel,
pch.del=pch.del,col.del=col.del)
sbPts <- sbInfo$sbPts
scalingFactor <- sbInfo$scalingFactor
DONE("Found scaling factor from the selected scale-bar.")
DONE("Found scaling factor from the selected scale-bar.\n")
} else { ## No scale bar on the plot ... using the scaling factor
DONE("Using the scaling factor provided in 'scalingFactor'.")
DONE("Using the scaling factor provided in 'scalingFactor'.\n")
sbPts <- NULL
scaleBarLength <- NULL
sfSource <- "Provided"
}

## User selects a transect on the image ======================================
NOTE("Select the FOCUS (center) and MARGIN (edge) of the structure.")
trans.pts <- iSelectPt(" Press 'f' when finished, 'd' to delete selection.",
trans.pts <- iSelectPt("Select FOCUS and MARGIN:",msg2,
pch.sel=pch.sel,col.sel=col.sel,cex.sel=cex.sel,
pch.del=pch.del,col.del=col.del)
if (nrow(trans.pts)<2) STOP("Either the FOCUSE or MARGIN was not selected.")
pch.del=pch.del,col.del=col.del,
snap2Transect=FALSE,slpTransect=NULL,
intTransect=NULL,slpPerpTransect=NULL)
if (nrow(trans.pts)<2) STOP("Either the FOCUS or MARGIN was not selected.")
#### Calculate slope, intercept, and perpendicular slope to transect
slpTransect <- diff(trans.pts$y)/diff(trans.pts$x)
intTransect <- trans.pts$y[1]-slpTransect*trans.pts$x[1]
slpPerpTransect <- -1/slpTransect
#### Show the transect if asked to
if (showTransect) {
graphics::lines(y~x,data=trans.pts,lwd=lwd.transect,col=col.transect)
DONE("Transect selected and shown on image.")
DONE("Transect selected and shown on image.\n")
} else {
DONE("Transect selected.")
DONE("Transect selected.\n")
}

## User selects annuli on the image ==========================================
NOTE("Select points that are annuli.")
#### Initially populate pts and orig.pts with transect points
pts <- orig.pts <- trans.pts
#### Selected points will be snapped to transect if snap2Transect==TRUE
#### orig.pts are as selected by the user, pts may be on transect if
#### snap2Transect==TRUE but may not be if snap2Transect==FALSE
repeat {
tmp2 <- as.data.frame(graphics::locator(n=1,
type=ifelse(snap2Transect,"n","p"),
pch=pch.sel,col=col.sel,cex=cex.sel))
if (!nrow(tmp2)>0) {
## no point was selected, user must have selected stop locator
break
} else {
## A point was selected
orig.pts <- rbind(orig.pts,tmp2)
if (!snap2Transect) {
## if not snapping points then pts=orig.pts
pts <- orig.pts
} else {
## snap points to the transect
tmp2 <- iSnap2Transect(tmp2,slpTransect=slpTransect,
intTransect=intTransect,
slpPerpTransect=slpPerpTransect)
## plot the snapped point
graphics::points(y~x,data=tmp2,pch=pch.sel,col=col.sel,cex=cex.sel)
## and add snapped point to matrix of points
pts <- rbind(pts,tmp2)
}
}
} # end repeat
pts <- iSelectPt("Select ANNULI:",msg2,
pch.sel=pch.sel,col.sel=col.sel,cex.sel=cex.sel,
pch.del=pch.del,col.del=col.del,
snap2Transect=snap2Transect,slpTransect=slpTransect,
intTransect=intTransect,slpPerpTransect=slpPerpTransect)
#### Make sure some points were selected
if (!nrow(pts)>2) STOP("No points were selected as annuli.")
if (!nrow(pts)>0) STOP("No points were selected as annuli.")
#### Add transection (focus and margin) to the points
pts <- rbind(trans.pts,pts)
#### Re-order points by distance from the first point (the focus)
pts <- iOrderPts(pts)
orig.pts <- iOrderPts(orig.pts)
#### Tell the user how many points were selected
DONE(nrow(pts)," points were selected.")
DONE(nrow(pts)," points were selected.\n")

## Converts selected points to radial measurements ===========================
radii <- iPts2Rad(pts,edgeIsAnnulus=edgeIsAnnulus,scalingFactor=scalingFactor,
Expand All @@ -234,16 +216,89 @@ digitizeRadii <- function(img,id,reading,suffix,
slpPerpTransect=slpPerpTransect,
windowSize=windowInfo$windowSize,
pixW2H=windowInfo$pixW2H,
orig.pts=orig.pts,pts=pts,radii=radii)
pts=pts,radii=radii)
#### Write the RData file
save(dat,file=datanm)
#### Tell user what happend and invisibly return the R object
DONE("Results written to ",datanm)
DONE("Results written to ",datanm,"\n")
invisible(dat)
}



########################################################################
## =====================================================================
## INTERNAL FUNCTIONS specific to digitizeRadii()
## others shared with other functions in RFishBC-internals
## =====================================================================
########################################################################

########################################################################
## Allows the user to interactively select a point on the image. User
## can de-select a point with a key press and must select a key to
## identify that they are done selecting points.
########################################################################
iSelectPt <- function(msg1,msg2,
pch.sel,col.sel,cex.sel,
pch.del,col.del,
snap2Transect,slpTransect,intTransect,slpPerpTransect) {
## Internal function for handling mouse down event
mouseDown <- function(buttons,x,y) {
tmp <- data.frame(x=graphics::grconvertX(x,"ndc","user"),
y=graphics::grconvertY(y,"ndc","user"))
if (snap2Transect)
tmp <- iSnap2Transect(tmp,slpTransect,intTransect,slpPerpTransect)
graphics::points(y~x,data=tmp,pch=pch.sel,col=col.sel,cex=cex.sel)
dat <<- rbind(dat,tmp)
NULL
}
## Internal function for handling key press event
keyPress <- function(key) {
if (key %in% c("f","q")) return(invisible(1))
if (key %in% c("d","r")) {
n <- nrow(dat)
if (n>=1) {
graphics::points(y~x,data=dat[n,],pch=pch.del,col=col.del,cex=cex.sel)
dat <<- dat[-n,]
}
NULL
}
}
## Main function
dat <- data.frame(x=NULL,y=NULL)
grDevices::getGraphicsEvent(paste0(msg1,msg2),consolePrompt=msg2,
onMouseDown=mouseDown,onKeybd=keyPress)
dat
}



########################################################################
## Convert selected x-y points to radial measurements
########################################################################
iPts2Rad <- function(pts,edgeIsAnnulus,scalingFactor,pixW2H,id,reading) {
#### Number of radial measurements is one less than number of points selected
n <- nrow(pts)-1
#### Distances in x- and y- directions, corrected for pixel w to h ratio
distx <- (pts$x[2:(n+1)]-pts$x[1])*pixW2H
disty <- pts$y[2:(n+1)]-pts$y[1]
#### Distances between points
distxy <- sqrt(distx^2+disty^2)
#### Correct distances for scalingFactor ... and call a radius
rad <- distxy*scalingFactor
#### Sort radii in increasing order (probably redundant)
rad <- rad[order(rad)]
#### create data.frame with radii information
data.frame(id=as.character(rep(id,n)),
reading=as.character(rep(ifelse(is.null(reading),NA,reading),n)),
agecap=ifelse(edgeIsAnnulus,n,n-1),
ann=seq_len(n),
rad=rad,radcap=max(rad),
stringsAsFactors=FALSE)
}



########################################################################
## Snaps selected points to the transect
##
Expand All @@ -260,6 +315,7 @@ iSnap2Transect <- function(pts,slpTransect,intTransect,slpPerpTransect) {
}



########################################################################
## Orders a data.frame of x-y coordinates by distance from first point.
########################################################################
Expand Down
Loading

0 comments on commit 595063a

Please sign in to comment.