Fix bug in packaged version

 - Fix for bug that throws "no applicable method" error for package
 - Fix bug that prevents making new gbt object without marker table

gbtools/DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gbtools
 Type: Package
-Version: 2.2
+Version: 2.3
 Title: Interactive visualization of metagenome assemblies in R
-Date: 2015-06-12
+Date: 2015-06-20
 Author: Brandon Seah
 Maintainer: Brandon Seah <kbseah@mpi-bremen.de>
 Description: gbtools lets you visualize metagenome assemblies by GC-coverage or differential coverage plots, and interactively bin them

gbtools/NAMESPACE

@@ -1,11 +1,21 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
+S3method(add,gbtbin)
+S3method(choosebin,gbt)
+S3method(gbt,default)
+S3method(gbtbin,default)
+S3method(lej,gbtbin)
 S3method(plot,gbt)
 S3method(points,gbtbin)
 S3method(print,gbt)
 S3method(print,gbtbin)
 S3method(summary,gbt)
 S3method(summary,gbtbin)
+S3method(userAdd,gbt)
+S3method(winnow,gbt)
+S3method(winnow,gbtbin)
+S3method(winnowMark,gbt)
+S3method(winnowMark,gbtbin)
 export(add)
 export(choosebin)
 export(fastgFishing)

gbtools/R/add.R

@@ -12,9 +12,3 @@
 #' @seealso \code{\link{lej}}
 #' @export
 add <- function(x1, x2) UseMethod("add")
-add.gbtbin <- function(x1,x2) {
-## Merge two bins; i.e. take their union
-    result <- setOperation(x1=x1,x2=x2,shortlist="all")
-    result$call[[length(result$call)+1]] <- match.call()  # Record function call 
-    return(result)
-}

gbtools/R/add.gbtbin.R~ → gbtools/R/add.gbtbin.R

@@ -14,6 +14,6 @@
 add.gbtbin <- function(x1,x2) {
 ## Merge two bins; i.e. take their union
     result <- setOperation(x1=x1,x2=x2,shortlist="all")
-    result$call <- match.call()  # Record function call that returned this merged bin
+    result$call[[length(result$call)+1]] <- match.call()  # Record function call 
     return(result)
 }

gbtools/R/choosebin.R

@@ -13,56 +13,3 @@
 #' @export
 #'
 choosebin <- function(x, ... ) UseMethod ("choosebin")  # Defines generic for choosebin function
-choosebin.gbt <- function(x,  # Object of class gbt
-                          slice,  # Which slices used for the plot from which points to be chosen?
-                          taxon="Class",  # Deprecated - user don't change this
-                          num.points=6,  # Number of points to pick in polygon
-                          draw.polygon=TRUE,  # Add polygon overlay to plot?
-                          save=FALSE,  # Save list of contigs in bin to external file?
-                          file="interactive_bin.list"  # Name of file to save list of contigs in bin
-                          ) {
-    require(sp)
-## Wrapper for picking bin interactively from GC-cov or diff-cov plot
-    if (!is.numeric(slice) || length(slice) > 2) {
-        cat ("gbtools ERROR: Please specify the library(-ies) used to make the plot in focus\n")
-    } else {
-        bin <- pickBinPoints(num.points=num.points,
-                             draw.polygon=draw.polygon)
-        if (length(slice)==1) {  # Pick bin from GC-coverage plot
-            X <- merge(data.frame(ID=x$scaff$ID,
-                                  Ref_GC=x$scaff$Ref_GC),
-                       data.frame(ID=x$covs$ID,
-                                  Avg_fold=x$covs[slice[1]+1]),
-                       by="ID")
-            names(X) <- c("ID","Ref_GC","Avg_fold")
-            inpolygon <- sp::point.in.polygon(X$Ref_GC,
-                                              X$Avg_fold,
-                                              bin$x,
-                                              bin$y)
-        }
-        else if (length(slice)==2) {  # Pick bin from differential coverage plot
-            X <- merge(data.frame(ID=x$scaff$ID,
-                                  Ref_GC=x$scaff$Ref_GC),
-                       data.frame(ID=x$covs$ID,
-                                  Avg_fold_1=x$covs[slice[1]+1],
-                                  Avg_fold_2=x$covs[slice[2]+1]),
-                       by="ID")
-            names(X) <- c("ID","Ref_GC","Avg_fold_1","Avg_fold_2")
-            inpolygon <- sp::point.in.polygon(X$Avg_fold_1,
-                                              X$Avg_fold_2,
-                                              bin$x,
-                                              bin$y)
-        }
-        X.subset <- X[which(inpolygon==1),]
-        X.shortlist <- as.character(X.subset$ID)
-        result <- gbtbin(shortlist=X.shortlist,
-                         x=x,
-                         slice=slice,
-                         taxon=taxon,
-                         points=bin,
-                         save=save,
-                         file=file)
-        result$call[[length(result$call)+1]] <- match.call()  # Record choosebin() function call
-        return(result)
-    }
-}

gbtools/R/choosebin.gbt.R~ → gbtools/R/choosebin.gbt.R

@@ -61,7 +61,7 @@ choosebin.gbt <- function(x,  # Object of class gbt
                          points=bin,
                          save=save,
                          file=file)
-        result$call <- match.call()  # Record the choosebin() call used to produce this bin
+        result$call[[length(result$call)+1]] <- match.call()  # Record choosebin() function call
         return(result)
     }
-}
+}

gbtools/R/gbt.R

@@ -24,134 +24,3 @@
 #'
 #' @export
 gbt <- function(covstats,mark,marksource,ssu,trna) UseMethod ("gbt")
-gbt.default <- function (covstats,  # Vector of filenames for coverage tables 
-                         mark=NA,   # Vector of filenames for marker gene taxonomy tables
-                         marksource=NA,  # Vector of source names for each marker gene table
-                         ssu=NA,    # Filename for SSU annotation table
-                         trna=NA    # Filename for tRNA annotation table
-                         ) {
-## Create new gbt objects
-    if ( class(covstats)!="character" || length(covstats)==0 ) {  # Check that covstats argument is character class
-        cat ("gbtools ERROR: covstats argument must be a list of file names!\n")
-    }
-    else {
-        ## Read Coverage tables ##############################################
-        if (length(covstats)==1) {
-            scaff <- read.table(file=as.character(covstats),
-                                sep="\t",
-                                header=T)
-            covs <- data.frame(ID=scaff$ID,
-                               scaff$Avg_fold)
-        }
-        else {
-            scaff <- read.table(file=as.character(covstats[1]),
-                                sep="\t",
-                                header=T)  # Contains all other data associated per contig
-            covs <- data.frame(ID=scaff$ID,
-                               scaff$Avg_fold)  # Contains scaffold ID and coverage data
-            for (i in 2:length(covstats)) {  # Read the other covstats files
-                scafftemp <- read.table(file=as.character(covstats[i]),
-                                        sep="\t",
-                                        header=T)
-                covs <- merge(covs,
-                              data.frame(ID=scafftemp$ID,
-                                         scafftemp$Avg_fold),
-                              by="ID")
-            }
-        }
-
-        ## Read taxonomic marker table ##########################################
-        if ( !is.na(marksource[1]) ) { # Read list of marker sources
-            markTab <- NA
-            if ( !is.na(mark[1]) ) {  # Read marker table
-                for (i in 1:length(marksource)) {
-                    markTabTemp <- read.table(file=as.character(mark[i]),
-                                              sep="\t",  # Tab separated input only
-                                              fill=TRUE,  # Fill ragged lines 
-                                              header=T)
-                    namesvec <- names(markTabTemp)
-                    if (length(which(!markTabTemp$scaffold %in% scaff$ID)) > 0) {
-                        # Catch marker tables where scaffold IDs dont match
-                        # what's in the scaff table
-                        cat ("gbtools WARNING: Scaffold IDs in marker table ")
-                        print (as.character(mark[i]))
-                        cat (" doesn't match contig coverage tables \n")
-                    }
-                    numMarksTemp <- dim(markTabTemp)[1]
-                    sourcevector <- rep(as.character(marksource[i]),numMarksTemp)
-                    markTabTemp <- cbind(markTabTemp,sourcevector)
-                    names(markTabTemp) <- c(namesvec,"source")
-                    if ( length(markTab)==1 && is.na (markTab)) {
-                        markTab <- markTabTemp
-                    } else {
-                        markTab <- rbind(markTab,markTabTemp)
-                    }
-                }
-            } else {
-                cat ("gbtools WARNING: Marker tables not supplied. marksource parameter ignored \n")
-                marksource <- NA
-                numMarks <- NA
-                markTab <- NA
-            }
-        } else {
-            cat ("gbtools WARNING: marksource not supplied.\n")
-        }
-
-        ## Read SSU marker table ##############################################
-        if ( !is.na(ssu[1]) ) {  
-            ssuTab <- read.table(file=as.character(ssu),sep="\t",header=T)
-            numSsu <- dim(ssuTab)[1]
-        } else {
-            ssu <- NA
-            ssuTab <- NA
-            numSsu <- NA
-        }
-
-        ## Read tRNA marker table #############################################
-        if ( !is.na(trna[1]) ) {  # Read tRNA marker table
-            trnaTab <- read.table(file=as.character(trna),sep="\t",skip=3,header=F)
-            names(trnaTab) <- c("scaffold",
-                                "tRNA_no",
-                                "tRNA_begin",
-                                "tRNA_end",
-                                "tRNA_type",
-                                "Anticodon",
-                                "Intron_begin",
-                                "Intron_end",
-                                "Cove_score")
-            numTrna <- dim(trnaTab)[1]
-        } else {
-            trna <- NA
-            trnaTab <- NA
-            numTrna <- NA
-        }
-
-        ## Generate summary statistics #######################################
-        summarystats <- list(Total_length=sum(scaff$Length),
-                             Num_scaffolds=length(scaff$ID),
-                             Scaff_length_max=max(scaff$Length),
-                             Scaff_length_min=min(scaff$Length),
-                             Scaff_length_median=median(scaff$Length),
-                             Scaff_length_N50=getN50(scaff$Length),
-                             Num_markers=table(markTab$source),
-                             Num_SSU=numSsu,
-                             Num_tRNAs=numTrna)
-
-        ## Package and return result #########################################
-        userTab <- list()  # Create userTab as an empty list to hold user-custom data
-        userSource <- ""  # Create userSource vector to hold names of user-custom data
-        result <- list(scaff=scaff,
-                       covs=covs,
-                       markTab=markTab,
-                       markSource=marksource,
-                       ssuTab=ssuTab,
-                       trnaTab=trnaTab,
-                       userTab=userTab,
-                       userSource=userSource,
-                       summary=summarystats)
-        result$call <- list()
-        result$call[[1]] <- match.call()  # Record function call that produces this gbt object
-        class(result) <- "gbt"
-        result
-    }    
-}