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@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.
