@@ -1,6 +1,7 @@

 CHANGES IN VERSION 0.99.6

 ------------------------

- o now read.beast support characters in support values <2015-01-18, Sun>

+ o read.beast now supports support values of sets such as {x, y, z} <2015-01-19, Mon>

+ o now read.beast supports characters in support values <2015-01-18, Sun>

  o add example of gzoom and groupOTU in vignette <2015-01-14, Wed> 

  o implement groupOTU methods <2015-01-14, Wed>

  o export get.offspring.tip <2015-01-14, Wed>

@@ -223,89 +223,44 @@ read.stats_beast <- function(file) {

     stats2 <- lapply(stats, function(x) {

         y <- unlist(strsplit(x, ","))

-        idx <- grep("=\\{", y)

-        if (length(idx) > 0) {

-            si.idx <- grep("\\}$", y[idx]) ## single item {x}

-            if (length(si.idx) > 0) {

-                y[idx[si.idx]] %<>% sub("\\{", "", .) %>% sub("\\}$", "", .)

-                idx <- idx[-si.idx]

-            }

-        }

-        hasRange <- FALSE

-        if (length(idx) > 0) {

-            ii <- grep("\\}$", y[idx+1])

-            if (length(ii) > 0) {

-                idx <- idx[ii]

-                hasRange <- TRUE

-            }

-        }

-        

-        if (hasRange) {

-            names.range <- gsub("=\\{.*", "", y[idx])

-            nr.lower <- paste0(names.range, "_lower")

-            nr.upper <- paste0(names.range, "_upper")

-            

-            lo <- gsub(".*=\\{", "", y[idx])

-            hi <- gsub("\\}", "", y[idx+1])

-        

-            jj <- -c(idx, idx+1)

-        } else {

-            jj <- seq_along(y)

-        }

-        y <- y[jj]

+        sidx <- grep("=\\{", y)

+        eidx <- grep("\\}$", y)

-        a <- grep("\\{", y)

-        b <- grep("\\}", y)

         flag <- FALSE

-        if (length(a) > 0) {

+        if (length(sidx) > 0) {

             flag <- TRUE

-            m <- sapply(seq_along(a), function(k) {

-                p <- y[a[k]:b[k]]

-                ii <- c(ii,i) 

-                gsub(".*=\\{", "", p) %>% gsub("\\}$", "", .) %>% list

+            SETS <- sapply(seq_along(sidx), function(k) {

+                p <- y[sidx[k]:eidx[k]]

+                gsub(".*=\\{", "", p) %>% gsub("\\}$", "", .) %>% list                

             })

-            names(m) <- gsub("=.*", "", y[a])

-        }

+            names(SETS) <- gsub("=.*", "", y[sidx])

-        if (flag) {

-            k <- sapply(seq_along(a), function(i) a[i]:b[i]) %>% as.vector

-            y <- y[-k]

+            kk <- sapply(seq_along(sidx), function(k) sidx[k]:eidx[k]) %>% unlist

+            y <- y[-kk]

         }

-        names <- gsub("=.*", "", y)

+        

+        name <- gsub("=.*", "", y)

         val <- gsub(".*=", "", y) %>% gsub("^\\{", "", .) %>%

             gsub("\\}$", "", .) 

-        if (hasRange) {

-            nn <- c(nr.lower, nr.upper, names)

-        } else {

-            nn <- names

-        }

+

         if (flag) {

-            nn <- c(nn, names(m))

+            nn <- c(name, names(SETS))

+        } else {

+            nn <- name

         }

         res <- character(length(nn))

         names(res) <- nn

-        if (hasRange) {

-            for (i in seq_along(nr.lower)) {

-                res[i] <- lo[i]

-            }

-            j <- i

-            for (i in seq_along(nr.upper)) {

-                res[i+j] <- hi[i] 

-            }

-            j <- i+j

-        } else {

-            j <- 0

-        }

-        for (i in seq_along(names)) {

-            res[i+j] <- val[i]

+

+        for (i in seq_along(name)) {

+            res[i] <- val[i]

         }

         if (flag) {

-            j <- i+j

-            for (i in seq_along(m)) {

-                res[i+j] <- m[i]

+            j <- i

+            for (i in seq_along(SETS)) {

+                res[i+j] <- SETS[i]

             }

         }

@@ -324,42 +279,9 @@ read.stats_beast <- function(file) {

     }))

     stats3 <- as.data.frame(stats3)

-

-    hasQuote <- function(stats3, cn) {

-        for (i in 1:nrow(stats3)) {

-            if ( is.na(stats3[i,cn]) ) {

-                next

-            } else {

-                return(grepl("\"", stats3[i, cn]))

-            }

-        }

-    }

-    

-    for (j in 1:ncol(stats3)) {

-        if (hasQuote(stats3,j)) {

-            next

-        } else {

-            len <- sapply(stats3[,j], length)

-            if (any(len > 1)) {

-                next

-                ## for (i in 1:length(stats3[,j])) {

-                ##     print(i)

-                ##     stats3[i,j] %<>% unlist %<>%

-                ##           as.character %<>% as.numeric %<>% c

-                ## }

-            } else {

-                stats3[,j] %<>% as.character

-                i <- which(stats3[,j] == "NA")

-                if(length(i) > 0) {

-                    stats3[i,j] <- NA

-                }

-                stats3[,j] %<>% as.numeric

-            }

-        }

-    }

+    colnames(stats3) <- gsub("(\\d+)%", "0.\\1", colnames(stats3))

     stats3$node <- node

-    colnames(stats3) <- gsub("(\\d+)%", "0.\\1", colnames(stats3))

     return(stats3)

 }

@@ -115,20 +115,64 @@ fortify.beast <- function(model, data,

     stats <- model@stats

-    if (!is.null(ndigits)) {

-        idx <- which(colnames(stats) != "node")

-        for (ii in idx) {

-            if (is.numeric(stats[, ii])) {

-                stats[, ii] <- round(stats[,ii], ndigits)

+    idx <- which(colnames(stats) != "node")

+    for (ii in idx) {

+        if (is.character_beast(stats, ii)) {

+            len <- sapply(stats[,ii], length)

+            if (any(len > 1)) {

+                stats[,ii] %<>% sapply(., function(x) {

+                    y <- unlist(x) %>% as.character %>% gsub("\"", "", .)

+                    if (length(y) == 1) {

+                        return(y)

+                    } else {

+                        return(paste0('{', paste0(y, collapse = ','), '}'))

+                    }

+                })

+            } else {

+                stats[,ii] %<>% unlist %>% as.character %>% gsub("\"", "", .)

             }

+            next

+        }

+        

+        len <- sapply(stats[,ii], length)

+        if ( all(len == 1) ) {

+            stats[, ii] %<>% unlist %>% as.character %>% as.numeric

+            if (!is.null(ndigits)) {

+                stats[, ii] %<>% round(., ndigits)

+            }

+        } else if (all(len <= 2)) {

+            stats[, ii] %<>% sapply(., function(x) {

+                y <- unlist(x) %>% as.character %>% as.numeric

+                if (!is.null(ndigits)) {

+                    y %<>% round(., ndigits)

+                }

+                if (length(y) == 1) {

+                    return(y)

+                } else {

+                    return(paste0('[', paste0(y, collapse = ','), ']'))

+                }

+            })

+        } else {

+            stats[,ii] %<>% sapply(., function(x) {

+                y <- unlist(x) %>% as.character %>% as.numeric

+                if (!is.null(ndigits)) {

+                    y %<>% round(., ndigits)

+                }

+                if (length(y) == 1) {

+                    return(y)

+                } else {

+                    return(paste0('{', paste0(y, collapse = ','), '}'))

+                }

+            })  

         }

     }

-

+            

+      

     cn <- colnames(stats)

     lo <- cn[grep("_lower", cn)]

     hi <- gsub("lower$", "upper", lo)

     rid <- gsub("_lower$", "", lo)

-

+    

     for (i in seq_along(rid)) {

         stats[, rid[i]] <- paste0("[", stats[, lo[i]], ",", stats[, hi[i]], "]")

         stats[is.na(stats[, lo[i]]), rid[i]] <- NA

@@ -186,6 +186,20 @@ extract.treeinfo.jplace <- function(object, layout="phylogram", ladderize=TRUE,

     return(df)

 }

+

+is.character_beast <- function(stats3, cn) {

+    for (i in 1:nrow(stats3)) {

+        if ( is.na(stats3[i,cn]) ) {

+            next

+        } else {

+            res <- grepl("[a-df-zA-DF-Z]+", unlist(stats3[i, cn]))

+            return(all(res == TRUE))

+        }

+    }

+    return(FALSE)

+}

+

+

 is.tree <- function(x) {

     if (class(x) %in% c("phylo",

                         "phylo4",