The problem, as you mention, is that once you create the second plot,
the information from the 1st plot is lost. One option is to create
the first plot, then convert all the points used to create the first
plot into device coordinates rather than user coordinates (using
grconvertX and grconvertY). Then you can make the second plot and
have the user click on a point using the locator function. Convert
the return value from locator with grconvertX and grconvertY to device
coordinates (the device coordinates will remain the same even with
changes in the user coordinates) then find the point from the 1st plot
whose device coordinates are closest to the device coordinates of the
clicked point (this is what identify does automatically, but you will
need to do by hand because of the changes to user coordinates) and
update the second plot accordingly.
On Thu, Feb 6, 2014 at 9:48 AM, Lukas Casier <lukas.casier at gmail.com>
wrote:> Hi,
>
> I am using a plotting window, splitting it into two and using the identify
> function on the plot in the first column to determine which plot in the
> second column should be drawn. The first time, this works fine. However,
> the second time (when I want to refresh the second plot based on the output
> of the identify function applied on the first plot), it gives me the error
> message:
> no point within 0.25 inches!
>
> I know the coordinates are calculated in the right way because it works
> perfectly the first time. Also, I have tried to open a second plot window
> for the second plot, but the problem is that the locator is still on for
> the first plot. So upon switching from first window to second window, the
> locator is off for the first window (the one I want the locator to be on
> for) and on for the second window. Of course, I cannot identify points
> anymore as the coordinates concern the first plot and the locator for that
> window is off. A solution to this problem (like activating/deactivating the
> locator for plotting windows) could solve my general problem as well.
> Remark that in this case, I have tried using dev.set and dev.prev. That
> does not work and even results in my first plotting window being completely
> cleared.
>
> The code looks as follows (the two relevant functions):
>
> showVariantFamMap <- function(varFam, ...)
> {
> if(!hasArg(unit))
> unit <- determineTimeUnit()
> nodeInfo <- getVariantFamNodeInformation(varFam,unit)
> edgeInfo <- getVariantFamEdgeInformation(varFam,unit)
> nodeList <- keys(nodeInfo)
> map <- new("graphNEL", nodes = nodeList, edgemode =
"directed")
> edges <- keys(edgeInfo)
> edgeList <- list()
> eAttrs <- list()
> labelNames <- list()
> labelText <- list()
> l <- getVariantFamActivityInformation(varFam, unit)
> l <- append(l,getVariantFamOriginatorInformation(varFam,unit))
> for(i in 1:length(edges))
> {
> edge <- unlist(str_split(edges[i], " - "))
> map <- addEdge(edge[1], edge[2], map)
> temp <- unlist(edgeInfo[[edges[i]]])
> t <- list()
> j <- 3
> while(j <= length(temp))
> {
> t <- append(t,as.numeric(temp[j]))
> j <- j + 3
> }
> m <- round(mean(unlist(t)), digits = 2)
> s <- round(sd(unlist(t)), digits = 2)
> labelNames <-
append(labelNames,paste(edge[1],"~",edge[2],sep=""))
> labelText <-
append(labelText,paste("(",m,",",s,")",sep=""))
> }
> labels <- unlist(labelText)
> names(labels) <- unlist(labelNames)
> labelFont <- rep(1, length(labelNames))
> labelFontSize <- unlist(labelFont)
> names(labelFontSize) <- labelNames
> eAttrs$label <- labels
> eAttrs$labelfontsize <- labelFontSize #does not work yet
> dev.new()
> plot.new()
> par(mfrow = c(1,2))
> x <- layoutGraph(map, edgeAttrs = eAttrs, recipEdges =
"distinct")
> graph <- renderGraph(x)
> res <- identifyComponent(graph,l)
> graph
> }
>
> identifyComponent <- function(graph, inf)
> {
> par(mai=graphRenderInfo(graph)$mai, usr=graphRenderInfo(graph)$usr)
> nodeCds <- cbind(nodeRenderInfo(graph)$nodeX,nodeRenderInfo(graph)
> $nodeY)
> actDur <- inf[[1]]
> wDur <- inf[[2]]
> occ <- inf[[7]]
> orActDur <- inf[[5]]
> b <- agopen(graph, name="test") #Get all the edges of the
graph
> a <- AgEdge(b)
>
> noEdges <- length(a)
> edgeCds <- matrix(nrow = noEdges, ncol = 2)
> edgeNames <- list()
> length(edgeNames) <- noEdges
> noNodes <- nrow(nodeCds)
> compNames <- list()
> length(compNames) <- noNodes + noEdges
> compNames <- append(compNames,rownames(nodeCds))
>
> for(i in 1:noEdges)
> {
> e <- a[[i]]
> c <- splines(e)[[1]]
> startPoint <- cPoints(c)[[1]]
> endPoint <- cPoints(c)[[length(cPoints(c))]]
> controlPoint <- cPoints(c)[[ceiling(length(cPoints(c))/2)]]
> eCd <- calculateBezierPoint(startPoint,controlPoint,endPoint)
> edgeCds[i,1] <- eCd[1,1]
> edgeCds[i,2] <- eCd[1,2]
> edgeNames[i] <- paste(head(e), "-", tail(e))
> }
>
> rownames(edgeCds) <- edgeNames
> compNames <- append(compNames,edgeNames)
> compNames[sapply(compNames, is.null)] <- NULL
>
> points(nodeCds, pch=4, col=3)
> #points(edgeCds, pch=4, col=3)
>
> #coords <- rbind(nodeCds,edgeCds)
> coords <- nodeCds
> n <- nrow(coords)
> x <- coords[,1]
> y <- coords[,2]
>
> sel <- rep(FALSE, length(x)); res <- "Nothing selected."
> while(sum(sel) < n) { #Documentation online
> ans <- identify(x[!sel], y[!sel], n=1, plot=FALSE)
> if(!length(ans)) break
> ans <- which(!sel)[ans]
> cat(paste("SELECTED COMPONENT", rownames(coords)[ans],
"\n"))
> sel[ans] <- TRUE
> res <- rownames(coords)[ans]
> choice <- c("High-level view", "Originator
view")
> i<-menu(choice, graphics=TRUE, title="Indicate the type of
analysis")
> if(i==0) { stop("You must indicate the type of analysis!") }
> else if(i==1)
> {
> print(actDur[res,], quote = FALSE)
> print(wDur[res,], quote = FALSE)
> }
> else if(i==2)
> {
> par(mfg=c(1,2))
> cols <- rainbow(nrow(occ))
> plot(occ[,res],orActDur[,res],col = cols)
> legend("topright", col = cols, legend = rownames(occ),
fill=cols)
> }
> }
> }
>
> Kind regards,
> Lukas
> Student Catholic University Leuven
>
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
--
Gregory (Greg) L. Snow Ph.D.
538280 at gmail.com