[adegenet-commits] r210 - in pkg: R misc/bug-report.1.2-2.03 misc/bug-report.1.2-2.05
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Nov 20 12:47:18 CET 2008
Author: jombart
Date: 2008-11-20 12:47:18 +0100 (Thu, 20 Nov 2008)
New Revision: 210
Added:
pkg/misc/bug-report.1.2-2.05/.Rhistory
Modified:
pkg/R/monmonier.R
pkg/misc/bug-report.1.2-2.03/.RData
pkg/misc/bug-report.1.2-2.03/.Rhistory
Log:
Another fix for monmonier. Apparently fixes bug-report.1.2-2.05.
Modified: pkg/R/monmonier.R
===================================================================
--- pkg/R/monmonier.R 2008-11-20 10:52:23 UTC (rev 209)
+++ pkg/R/monmonier.R 2008-11-20 11:47:18 UTC (rev 210)
@@ -17,16 +17,16 @@
if(nrow(xy) != nrow(as.matrix(dist))) stop('Number of sites and number of observations differ')
## set to TRUE to debug
-## DEBUG <- TRUE
+DEBUG <- FALSE
-## if(DEBUG) {
-## plot.nb(cn, xy, col="grey", points=FALSE)
-## if(exists("x1")) {
-## x1 <<- x1
-## s.value(xy,x1,add.p=TRUE)
-## }
-## text(xy,lab=1:nrow(xy),font=2,col="darkgreen")
-## }
+if(DEBUG) {
+ plot.nb(cn, xy, col="grey", points=FALSE)
+ if(exists("x1")) {
+ x1 <<- x1
+ s.value(xy,x1,add.p=TRUE)
+ }
+ text(xy,lab=1:nrow(xy),font=2,col="darkgreen")
+}
## PRECISION of the xy coordinates (in digits)
## used when coordinates are inputed in C code.
@@ -154,9 +154,13 @@
## The segment that was just drawn before is removed from the checks for crossing (messy code 2)
if(!is.null(curDir)){
prevSeg <- grep(paste("dir",curDir,sep=""),rownames(subsetSeg))
- if(length(prevSeg)>0){
+ if(length(prevSeg)>0){ # this is not the 1st seg. in this dir
prevSeg <- prevSeg[length(prevSeg)]
subsetSeg <- segMat[-prevSeg,,drop=FALSE]
+ } else { # this is the 1st seg. in this direction -> rm 1st seg of other dir
+ otherDir <- ifelse(curDir==1L, 2, 1)
+ prevSeg <- grep(paste("dir",otherDir,"-1-2",sep=""),rownames(subsetSeg))
+ if(length(prevSeg)>0) { subsetSeg <- segMat[-prevSeg,,drop=FALSE] }
}
}
@@ -209,9 +213,9 @@
} else {temp <- 0}
## for debugging
- ## if(DEBUG) {
- ## if(temp==1) cat("\n can't go there (code",temp,")") else cat("\n new segment ok (code",temp,")")
- ## }
+ if(DEBUG) {
+ if(temp==1) cat("\n can't go there (code",temp,")") else cat("\n new segment ok (code",temp,")")
+ }
## if a code 1 or 3 is returned, CheckAllSeg returns FALSE
## else it returns TRUE
@@ -277,17 +281,17 @@
## 4) get back to 1)
while(keepExpanding){
hasExpanded <- FALSE # used to test if it is relevant to check for looping
- ## if(DEBUG){
- ## points(currentDir1$M[1],currentDir1$M[2],col="white",pch=20)
- ## points(currentDir2$M[1],currentDir2$M[2],col="white",pch=20)
- ## }
+ if(DEBUG){
+ points(currentDir1$M[1],currentDir1$M[2],col="white",pch=20)
+ points(currentDir2$M[1],currentDir2$M[2],col="white",pch=20)
+ }
if(s1 <= nrow(matSegVal)) { currentDir1 <- getNext(s1) }
if(s2 <= nrow(matSegVal)) { currentDir2 <- getNext(s2) }
- ## if(DEBUG){
- ## cat("\n\n ## dir1: trying edge",currentDir1$A[1],"-",currentDir1$B[1])
- ## points(currentDir1$M[1],currentDir1$M[2],col="blue",pch=20)
- ## readline("\npress enter")
- ## }
+ if(DEBUG){
+ cat("\n\n ## dir1: trying edge",currentDir1$A[1],"-",currentDir1$B[1])
+ points(currentDir1$M[1],currentDir1$M[2],col="blue",pch=20)
+ readline("\npress enter")
+ }
## first direction (dir1)
if( currentDir1$val > Dlim && s1 <= nrow(matSegVal)) {
@@ -311,19 +315,19 @@
## add 1 to the boundary length
current.bd.length <- current.bd.length + 1
hasExpanded <- TRUE
- ## if(DEBUG) {
- ## arrows(result[[run]]$dir1[[i1-1]]$M[1], result[[run]]$dir1[[i1-1]]$M[2],
- ## result[[run]]$dir1[[i1]]$M[1], result[[run]]$dir1[[i1]]$M[2],col="blue")
- ## }
+ if(DEBUG) {
+ arrows(result[[run]]$dir1[[i1-1]]$M[1], result[[run]]$dir1[[i1-1]]$M[2],
+ result[[run]]$dir1[[i1]]$M[1], result[[run]]$dir1[[i1]]$M[2],col="blue")
+ }
} else{ s1 <- s1+1 }
} # end "if( currentDir1$val>Dlim)"
- ## if(DEBUG){
- ## cat("\n\n ## dir2: trying edge",currentDir2$A[1],"-",currentDir2$B[1])
- ## points(currentDir2$M[1],currentDir2$M[2],col="red",pch=20)
- ## readline("\npress enter")
- ## }
+ if(DEBUG){
+ cat("\n\n ## dir2: trying edge",currentDir2$A[1],"-",currentDir2$B[1])
+ points(currentDir2$M[1],currentDir2$M[2],col="red",pch=20)
+ readline("\npress enter")
+ }
## second direction (dir2)
if( currentDir2$val > Dlim && s2 <= nrow(matSegVal)) {
@@ -346,10 +350,10 @@
## add 1 to the boundary length
current.bd.length <- current.bd.length + 1
hasExpanded <- TRUE
- ## if(DEBUG){
- ## arrows(result[[run]]$dir2[[i2-1]]$M[1], result[[run]]$dir2[[i2-1]]$M[2],
- ## result[[run]]$dir2[[i2]]$M[1], result[[run]]$dir2[[i2]]$M[2],col="red",cex=2)
- ## }
+ if(DEBUG){
+ arrows(result[[run]]$dir2[[i2-1]]$M[1], result[[run]]$dir2[[i2-1]]$M[2],
+ result[[run]]$dir2[[i2]]$M[1], result[[run]]$dir2[[i2]]$M[2],col="red",cex=2)
+ }
} else{ s2 <- s2+1 }
} # end "if( currentDir2$val>Dlim)"
@@ -388,14 +392,14 @@
}
## output for debugging
- ## if(DEBUG) {
- ## cat("\n","s1:",s1,"s2:",s2,"i1:",i1,"i2:",i2,"D1:",
- ## currentDir1$val,"D2:",currentDir2$val,"Dlim:",Dlim,
- ## "nrow(matSegVal)",nrow(matSegVal),"\n")
- ## cat("\n","D1:",currentDir1$val,"D2:",currentDir2$val,"Dlim:",Dlim,
- ## "cur.bd.le:", current.bd.length,"max length:", bd.length,"\n",
- ## "s1:",s1,"s2:",s2,"maxS:",nrow(matSegVal))
- ## }
+ if(DEBUG) {
+ cat("\n","s1:",s1,"s2:",s2,"i1:",i1,"i2:",i2,"D1:",
+ currentDir1$val,"D2:",currentDir2$val,"Dlim:",Dlim,
+ "nrow(matSegVal)",nrow(matSegVal),"\n")
+ cat("\n","D1:",currentDir1$val,"D2:",currentDir2$val,"Dlim:",Dlim,
+ "cur.bd.le:", current.bd.length,"max length:", bd.length,"\n",
+ "s1:",s1,"s2:",s2,"maxS:",nrow(matSegVal))
+ }
} # end of one given run
Modified: pkg/misc/bug-report.1.2-2.03/.RData
===================================================================
(Binary files differ)
Modified: pkg/misc/bug-report.1.2-2.03/.Rhistory
===================================================================
--- pkg/misc/bug-report.1.2-2.03/.Rhistory 2008-11-20 10:52:23 UTC (rev 209)
+++ pkg/misc/bug-report.1.2-2.03/.Rhistory 2008-11-20 11:47:18 UTC (rev 210)
@@ -1,15 +1,3 @@
-mon <- monmonier(coords, Da, cn, threshold=0.1, nrun=1, skip.local.diff = rep(1, 1))
-warnings()
-example(monmonier)
-q()
-n
-mon <- monmonier(coords, Da, cn, threshold=0.1, nrun=1, skip.local.diff = rep(1, 1))
-rm(monmonier)
-mon <- monmonier(coords, Da, cn, threshold=0.1, nrun=1, skip.local.diff = rep(1, 1))
-plot(mon)
-example(monmonier)
-?monmonier
- data(sim2pop)
gab <- chooseCN(sim2pop at other$xy,ask=FALSE,type=2)
@@ -154,3 +142,10 @@
q()
n
+coords
+source("/home/master/dev/adegenet/pkg/R/monmonier.R")
+ mon <- optimize.monmonier(coords, Da, cn, threshold=0)
+
+plot(mon)
+q()
+y
Added: pkg/misc/bug-report.1.2-2.05/.Rhistory
===================================================================
--- pkg/misc/bug-report.1.2-2.05/.Rhistory (rev 0)
+++ pkg/misc/bug-report.1.2-2.05/.Rhistory 2008-11-20 11:47:18 UTC (rev 210)
@@ -0,0 +1,205 @@
+plot(mon1)
+example(monmonier)
+rm(monmonier)
+rm(plot.monmonier)
+save.image()
+example(monmonier)
+?monmonier
+ plot(mon1,x1,met="greylevel",csize=.6)
+
+ data(sim2pop)
+
+ gab <- chooseCN(sim2pop at other$xy,ask=FALSE,type=2)
+
+ pca1 <- dudi.pca(sim2pop at tab,scale=FALSE, scannf=FALSE, nf=1)
+
+ gab <- chooseCN(sim2pop at other$xy,ask=FALSE,type=2)
+
+ mon1 <- monmonier(sim2pop at other$xy,dist(pca1$l1[,1]),gab,scanthres=FALSE)
+
+plot(mon1,var=pca1$l1[,1])
+
+plot(mon1,var=pca1$l1[,1])
+ temp <- sim2pop at pop
+ levels(temp) <- c(17,19)
+ temp <- as.numeric(as.character(temp))
+ plot(mon1)
+ points(sim2pop at other$xy,pch=temp,cex=2)
+ legend("topright",leg=c("Pop A", "Pop B"),pch=c(17,19))
+
+ xy <- matrix(runif(120,0,10), ncol=2)
+ x1 <- rnorm(60)
+ x1[xy[,2] > 5] <- x1[xy[,2] > 5]+3
+ cn1 <- chooseCN(xy,type=1,ask=FALSE)
+ mon1 <- optimize.monmonier(xy,dist(x1)^2,cn1,ntry=10)
+
+ # graphics
+ plot(mon1,x1,met="greylevel",csize=.6)
+
+10
+plot(mon1)
+ mon1 <- optimize.monmonier(xy,dist(x1)^2,cn1,ntry=10)
+
+d
+plot(mon1)
+plot(mon1,x1)
+ x2 <- rnorm(60)
+ sel <- (xy[,1]>3.5 & xy[,2]>3.5 & xy[,1]<6.5 & xy[,2]<6.5)
+ x2[sel] <- x2[sel]+4
+ cn2 <- chooseCN(xy,type=1,ask=FALSE)
+ mon2 <- optimize.monmonier(xy,dist(x2)^2,cn2,ntry=10)
+
+ # graphics
+ plot(mon2,x2,method="greylevel",add.arr=FALSE,bwd=6,col="red",csize=.5)
+ ## End(Not run)
+d
+ plot(mon2,x2,method="greylevel",add.arr=FALSE,bwd=6,col="red",csize=.5)
+
+ x2 <- rnorm(60)
+ sel <- (xy[,1]>3.5 & xy[,2]>3.5 & xy[,1]<6.5 & xy[,2]<6.5)
+ x2[sel] <- x2[sel]+4
+
+ mon2 <- optimize.monmonier(xy,dist(x2)^2,cn2,ntry=10)
+
+d
+ plot(mon2,x2,method="greylevel",add.arr=FALSE,bwd=6,col="red",csize=.5)
+
+q()
+y
+plot(mon1,x1)
+orig_coords <- read.table("/home/master/dev/adegenet/pkg/misc/bug-report.1.2-2.03/boot_coord.7.input")
+numpops <- length(orig_coords[,1])
+
+coords <- orig_coords
+numpops <- length(coords[,1])
+Da <- read.table("/home/master/dev/adegenet/pkg/misc/bug-report.1.2-2.03/boot_dist.7.input")
+Da <- as.dist(Da)
+
+ # Calc monmonier barrier
+ cn <- chooseCN(coords, ask=FALSE, type=1)
+ mon <- monmonier(coords, Da, cn, threshold=0, nrun=1, skip.local.diff = rep(1, 1)) #threshold is arbitrarily set at 0
+plot(mon)
+plot(mon,add.arr=FALSE)
+ mon <- optimize.monmonier(coords, Da, cn, threshold=0)
+
+q()
+n
+boot_coord_filename <- "boot_coord.21.input"
+boot_dist_filename <- "boot_dist.21.input"
+
+
+library(spdep)
+library(ade4)
+library(adegenet)
+library(gplots)
+install.packages("gplots")
+
+coords <- read.table(boot_coord_filename)
+Da <- read.table(boot_dist_filename)
+Da <- as.dist(Da)
+cn <- chooseCN(coords, ask=FALSE, type=1, plot.nb = FALSE)
+
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+save.image()
+?debug
+debug(checkNext)
+traceback()
+traceback(monmonier)
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+traceback()
+source("/home/master/dev/adegenet/pkg/R/monmonier.R")
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+debug(monmonier)
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+> debug(checkNext)
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+
+debug(checkNext)
+allSeg
+s1
+curDir
+prevSeg
+debug(checkNext)
+?ifelse
+ifelse(1==1,1,2)
+ifelse(2==1,1,2)
+ifelse(2==1,1,2)
+curDir=1L
+curDir
+is.integer(curDir)
+otherDir <- ifelse(curDir==1L, 2, 1)
+paste("dir",otherDir,"1-2",sep="")
+curDir=2L
+otherDir <- ifelse(curDir==1L, 2, 1)
+paste("dir",otherDir,"1-2",sep="")
+source("/home/master/dev/adegenet/pkg/R/monmonier.R")
+paste("dir",otherDir,"1-2",sep="")
+undebug(monmonier)
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+p
+source("/home/master/dev/adegenet/pkg/R/monmonier.R")
+mon <- monmonier(coords, Da, cn, threshold=NULL, scanthres = 0, nrun=1) #threshold is arbitrarily set at 0
+plot(mon)
+example(monmonier)
+?monmonier
+ data(sim2pop)
+
+ gab <- chooseCN(sim2pop at other$xy,ask=FALSE,type=2)
+
+ # filter random noise
+ pca1 <- dudi.pca(sim2pop at tab,scale=FALSE, scannf=FALSE, nf=1)
+
+ mon1 <- monmonier(sim2pop at other$xy,dist(pca1$l1[,1]),gab,scanthres=FALSE)
+
+ pca1 <- dudi.pca(sim2pop at tab,scale=FALSE, scannf=FALSE, nf=1)
+
+ mon1 <- monmonier(sim2pop at other$xy,dist(pca1$l1[,1]),gab,scanthres=FALSE)
+
+plot(mon1)
+ plot(mon1,var=pca1$l1[,1])
+ temp <- sim2pop at pop
+ levels(temp) <- c(17,19)
+ temp <- as.numeric(as.character(temp))
+ plot(mon1)
+ points(sim2pop at other$xy,pch=temp,cex=2)
+ legend("topright",leg=c("Pop A", "Pop B"),pch=c(17,19))
+
+ xy <- matrix(runif(120,0,10), ncol=2)
+ x1 <- rnorm(60)
+ x1[xy[,2] > 5] <- x1[xy[,2] > 5]+3
+ cn1 <- chooseCN(xy,type=1,ask=FALSE)
+ mon1 <- optimize.monmonier(xy,dist(x1)^2,cn1,ntry=10)
+
+d
+plot(mon1,x1)
+ x2 <- rnorm(60)
+ sel <- (xy[,1]>3.5 & xy[,2]>3.5 & xy[,1]<6.5 & xy[,2]<6.5)
+ x2[sel] <- x2[sel]+4
+ cn2 <- chooseCN(xy,type=1,ask=FALSE)
+ mon2 <- optimize.monmonier(xy,dist(x2)^2,cn2,ntry=10)
+
+d
+ plot(mon2,x2,method="greylevel",add.arr=FALSE,bwd=6,col="red",csize=.5)
+
+ plot(mon2,x2,method="greylevel",bwd=6,col="red",csize=.5)
+ load(system.file("files/mondata2.rda",package="adegenet"))
+ cn2 <- chooseCN(mondata2$xy,type=1,ask=FALSE)
+ mon2 <- monmonier(mondata2$xy,dist(mondata2$x2),cn2,threshold=2)
+ plot(mon2,mondata2$x2,method="greylevel",add.arr=FALSE,bwd=6,col="red",csize=.5)
+
+ load(system.file("files/mondata2.rda",package="adegenet"))
+ cn2 <- chooseCN(mondata2$xy,type=1,ask=FALSE)
+ mon2 <- monmonier(mondata2$xy,dist(mondata2$x2),cn2,threshold=2)
+ plot(mon2,mondata2$x2,method="greylevel",bwd=6,col="red",csize=.5)
+ cn2 <- chooseCN(xy,type=1,ask=FALSE)
+ mon2 <- optimize.monmonier(xy,dist(x2)^2,cn2,ntry=10)
+d
+plot(mon2)
+q()
+y
More information about the adegenet-commits
mailing list