##' @importFrom ggplot2 last_plot
get_tree_view <- function(tree_view) {
    if (is.null(tree_view))
        tree_view <- last_plot()

    return(tree_view)
}



## has.field <- function(tree_object, field) {
##     if ( ! field %in% get.fields(tree_object) ) {
##         return(FALSE)
##     }

##     if (is(tree_object, "codeml")) {
##         is_codeml <- TRUE
##         tree <- tree_object@rst
##     } else {
##         is_codeml <- FALSE
##         tree <- tree_object
##     }

##     if (.hasSlot(tree, field)) {
##         has_slot <- TRUE
##     } else {
##         has_slot <- FALSE
##     }

##     if (has_slot == FALSE) {
##         if (has.extraInfo(tree_object) == FALSE) {
##             return(FALSE)
##         }

##         if (nrow(tree_object@extraInfo) == 0) {
##             return(FALSE)
##         }

##         if (!field %in% colnames(tree_object@extraInfo)) {
##             return(FALSE)
##         }
##     }
##     res <- TRUE
##     attr(res, "has_slot") <- has_slot
##     attr(res, "is_codeml") <- is_codeml
##     return(res)
## }

## append_extraInfo <- function(df, object) {
##     if (has.extraInfo(object)) {
##         info <- object@extraInfo
##         if ("parent" %in% colnames(info)) {
##             res <- merge(df, info, by.x=c("node", "parent"), by.y=c("node", "parent"))
##         } else {
##             res <- merge(df, info, by.x="node", by.y="node")
##         }
##     } else {
##         return(df)
##     }

##     i <- order(res$node, decreasing = FALSE)
##     res <- res[i,]
##     return(res)
## }

## get.fields.tree <- function(object) {
##     if (is(object, "codeml")) {
##         fields <- c(get.fields(object@rst),
##                     get.fields(object@mlc))
##         fields <- unique(fields)
##     } else {
##         fields <- object@fields
##     }

##     if (has.slot(object, "extraInfo")) {
##         extraInfo <- object@extraInfo
##         if (nrow(extraInfo) > 0) {
##             cn <- colnames(extraInfo)
##             i <- match(c("x", "y", "isTip", "node", "parent", "label", "branch", "branch.length"), cn)
##             i <- i[!is.na(i)]
##             fields %<>% c(cn[-i])
##         }
##     }
##     return(fields)
## }

## print_fields <- function(object, len=5) {
##     fields <- get.fields(object)
##     n <- length(fields)
##     i <- floor(n/len)
##     for (j in 0:i) {
##         ii <- 1:len + len * j
##         if (j == i) {
##             x <- n %% len
##             if (x == 0) {
##                 ii <- NULL
##             } else {
##                 ii <- ii[1:x]
##             }
##         }

##         if (!is.null(ii)) {
##             cat("\t", paste0("'",
##                              paste(fields[ii], collapse="',\t'"),
##                              "'")
##                 )
##         }
##         if ( j == i) {
##             cat(".\n")
##         } else {
##             cat(",\n")
##         }
##     }
## }

## plot.subs <- function(x, layout, show.tip.label,
##                       tip.label.size,
##                       tip.label.hjust,
##                       position, annotation,
##                       annotation.color = "black",
##                       annotation.size=3, ...) {

##     p <- ggtree(x, layout=layout, ...)
##     if (show.tip.label) {
##         p <- p + geom_tiplab(hjust = tip.label.hjust,
##                              size  = tip.label.size)
##     }
##     if (!is.null(annotation) && !is.na(annotation)) {
##         p <- p + geom_text(aes_string(x=position, label=annotation),
##                            size=annotation.size,
##                            color=annotation.color, vjust=-.5)
##     }
##     p + theme_tree2()
## }

## .add_new_line <- function(res) {
##     ## res <- paste0(strwrap(res, 50), collapse="\n")
##     ## res %<>% gsub("\\s/\n", "\n", .) %>% gsub("\n/\\s", "\n", .)
##     if (nchar(res) > 50) {
##         idx <- gregexpr("/", res)[[1]]
##         i <- idx[floor(length(idx)/2)]
##         res <- paste0(substring(res, 1, i-1), "\n", substring(res, i+1))
##     }
##     return(res)
## }

## get.subs_ <- function(tree, fasta, translate=TRUE, removeGap=TRUE) {
##     N <- getNodeNum(tree)
##     node <- 1:N
##     parent <- sapply(node, getParent, tr=tree)
##     label <- getNodeName(tree)
##     subs <- sapply(seq_along(node), function(i) {
##         if (i == getRoot(tree)) {
##             return(NA)
##         }
##         res <- getSubsLabel(fasta, label[parent[i]], label[i], translate, removeGap)
##         if (is.null(res)) {
##             return('')
##         }
##         .add_new_line(res)
##     })

##     dd <- data.frame(node=node, parent=parent, label=label, subs=subs)
##     dd <- dd[dd$parent != 0,]
##     dd <- dd[, -c(1,2)]
##     dd[,1] <- as.character(dd[,1])
##     dd[,2] <- as.character(dd[,2])
##     return(dd)
## }

## getSubsLabel <- function(seqs, A, B, translate, removeGap) {
##     seqA <- seqs[A]
##     seqB <- seqs[B]

##     if (nchar(seqA) != nchar(seqB)) {
##         stop("seqA should have equal length to seqB")
##     }

##     if (translate == TRUE) {
##         AA <- seqA %>% seq2codon %>% codon2AA
##         BB <- seqB %>% seq2codon %>% codon2AA
##     } else {
##         ## strsplit is faster than substring
##         ##
##         ## n <- nchar(seqA) ## should equals to nchar(seqB)
##         ## AA <- substring(seqA, 1:n, 1:n)
##         ## BB <- substring(seqB, 1:n, 1:n)
##         AA <- strsplit(seqA, split="") %>% unlist
##         BB <- strsplit(seqB, split="") %>% unlist
##     }

##     ii <- which(AA != BB)

##     if (removeGap == TRUE) {
##         if (length(ii) > 0 && translate == TRUE) {
##             ii <- ii[AA[ii] != "X" & BB[ii] != "X"]
##         }

##         if (length(ii) > 0 && translate == FALSE) {
##             ii <- ii[AA[ii] != "-" & BB[ii] != "-"]
##         }
##     }

##     if (length(ii) == 0) {
##         return(NULL)
##     }

##     res <- paste(AA[ii], ii, BB[ii], sep="", collapse=" / ")
##     return(res)
## }

## seq2codon <- function(x) {
##     substring(x, first=seq(1, nchar(x)-2, 3), last=seq(3, nchar(x), 3))
## }

## ## @importFrom Biostrings GENETIC_CODE
## codon2AA <- function(codon) {
##     ## a genetic code name vector
##     GENETIC_CODE <- get_fun_from_pkg("Biostrings", "GENETIC_CODE")
##     aa <- GENETIC_CODE[codon]
##     aa[is.na(aa)] <- "X"
##     return(aa)
## }


## getPhyInfo <- function(phy) {
##     line1 <- readLines(phy, n=1)
##     res <- strsplit(line1, split="\\s")[[1]]
##     res <- res[res != ""]

##     return(list(num=as.numeric(res[1]), width=as.numeric(res[2])))
## }

## get_seqtype <- function(seq) {
##     if (length(grep("[^-ACGT]+", seq[1])) == 0) {
##         seq_type = "NT" ## NucleoTide
##     } else {
##         seq_type = "AA" ## Amino Acid
##     }
##     return(seq_type)
## }

reverse.treeview <- function(tv) {
    tv$data <- reverse.treeview.data(tv$data)
    return(tv)
}

reverse.treeview.data <- function(df) {
    root <- df$node[df$node == df$parent]
    df$x <- getXcoord2(df$x, root, df$parent, df$node,
                       df$length, start=max(df$x), rev=TRUE)
    return(df)
}


## jplace_treetext_to_phylo <- function(tree.text) {
##     ## move edge label to node label separate by @
##     tr <- gsub('(:[0-9\\.eE\\+\\-]+)\\{(\\d+)\\}', '\\@\\2\\1', tree.text)
##     phylo <- read.tree(text=tr)
##     if (length(grep('@', phylo$tip.label)) > 0) {
##         phylo$node.label[1] %<>% gsub("(.*)\\{(\\d+)\\}", "\\1@\\2", .)
##         tip.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$tip.label))
##         node.edgeNum <- as.numeric(gsub("[^@]*@(\\d*)", "\\1",phylo$node.label))
##         phylo$tip.label %<>% gsub("@\\d+", "", .)
##         phylo$node.label %<>% gsub("@\\d+", "", .)
##         if (all(phylo$node.label == "")) {
##             phylo$node.label <- NULL
##         }

##         N <- getNodeNum(phylo)
##         edgeNum.df <- data.frame(node=1:N, edgeNum=c(tip.edgeNum, node.edgeNum))
##         ## root node is not encoded with edge number
##         edgeNum.df <- edgeNum.df[!is.na(edgeNum.df[,2]),]
##         attr(phylo, "edgeNum") <- edgeNum.df
##     }

##     ## using :edge_length{edge_num} to match edge_num to node_num
##     ## this is not a good idea since there may exists identical edge_length.
##     ## but we can use it to verify our method.
##     ##
##     ## en.matches <- gregexpr(":[0-9\\.eE\\+\\-]+\\{\\d+\\}", tree.text)
##     ## matches <- en.matches[[1]]
##     ## match.pos <- as.numeric(matches)
##     ## match.len <- attr(matches, 'match.length')

##     ## edgeLN <- substring(tree.text, match.pos+1, match.pos+match.len-2)
##     ## edgeLN.df <- data.frame(length=as.numeric(gsub("\\{.+", "", edgeLN)),
##     ##                         edgeNum = as.numeric(gsub(".+\\{", "", edgeLN)))

##     ## xx <- merge(edgeLN.df, edgeNum.df, by.x="node", by.y="node")

##     return(phylo)
## }

extract.treeinfo.jplace <- function(object, layout="rectangular", ladderize=TRUE, right=FALSE, ...) {

    tree <- get.tree(object)

    df <- fortify.phylo(tree, layout=layout, ladderize=ladderize, right=right, ...)

    edgeNum.df <- attr(tree, "edgeNum")
    if (!is.null(edgeNum.df)) {
        df2 <- merge(df, edgeNum.df, by.x="node", by.y="node", all.x=TRUE)
        df <- df2[match(df[, "node"], df2[, "node"]),]
    }

    attr(df, "ladderize") <- ladderize
    attr(df, "right") <- right
    return(df)
}

## ## convert edge number to node number for EPA/pplacer output
## edgeNum2nodeNum <- function(jp, edgeNum) {
##     edges <- attr(jp@phylo, "edgeNum")

##     idx <- which(edges$edgeNum == edgeNum)
##     if (length(idx) == 0) {
##         return(NA)
##     }

##     edges[idx, "node"]
## }

## 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))
##             res <- grepl("^[0-9\\.eE-]+$", unlist(stats3[i, cn]))
##             return(all(res == FALSE))
##         }
##     }
##     return(FALSE)
## }


is.tree <- function(x) {
    if (class(x) %in% c("phylo",
                        "phylo4",
                        "jplace",
                        "baseml",
                        "paml_rst",
                        "baseml_mlc",
                        "codeml_mlc",
                        "codeml",
                        "hyphy",
                        "beast")
        ) {
        return(TRUE)
    }
    return(FALSE)
}



color_scale <- function(c1="grey", c2="red", n=100) {
    pal <- colorRampPalette(c(c1, c2))
    colors <- pal(n)
    return(colors)
}

getIdx <- function(v, MIN, MAX, interval=NULL) {
    res <- sapply(v, getIdx_internal, MIN=MIN, MAX=MAX, interval=interval)
    attr(res, "interval") <- interval
    return(res)
}

getIdx_internal <- function(v, MIN, MAX, interval=NULL) {
    if (is.na(v)) {
        return(NA)
    }
    if ( MIN == MAX ) {
        return(100)
    }
    res <- max(which(interval <= v))
    return(res)
}


get_color_attribute <- function(p) {
    p$data[, "color"]
}

is.tree_attribute <- function(df, var) {
    if(length(var) == 1 &&
       !is.null(var)    &&
       var %in% colnames(df)) {
        return(TRUE)
    }
    return(FALSE)
}

is.tree_attribute_ <- function(p, var) {
    is.tree_attribute(p$data, var)
}




## `%IN%` <- function(x, table) {
##     ii <- NULL ## satisify codetools
##     idx <- match(x, table, nomatch=NA)
##     ii <<- idx[!is.na(idx)]
##     res <- as.logical(idx)
##     res[is.na(res)] <- FALSE
##     return(res)
## }
## geom_nplace <- function(data, map, place, ...) {
##     label <- NULL
##     ii <- 1:nrow(data)
##     geom_text(subset=.(label %IN% data[[map]]), label = data[ii, place], ...)
## }


roundDigit <- function(d) {
    i <- 0
    while(d < 1) {
        d <- d * 10
        i <- i + 1
    }
    round(d)/10^i
}


## . function was from plyr package
##' capture name of variable
##'
##' @rdname dotFun
##' @export
##' @title .
##' @param ... expression
##' @param .env environment
##' @return expression
##' @examples
##' x <- 1
##' eval(.(x)[[1]])
. <- function (..., .env = parent.frame()) {
    structure(as.list(match.call()[-1]), env = .env, class = "quoted")
}


## from ChIPseeker
##' @importFrom grDevices colorRampPalette
getCols <- function (n) {
    col <- c("#8dd3c7", "#ffffb3", "#bebada", "#fb8072", "#80b1d3",
             "#fdb462", "#b3de69", "#fccde5", "#d9d9d9", "#bc80bd",
             "#ccebc5", "#ffed6f")
    col2 <- c("#1f78b4", "#ffff33", "#c2a5cf", "#ff7f00", "#810f7c",
              "#a6cee3", "#006d2c", "#4d4d4d", "#8c510a", "#d73027",
              "#78c679", "#7f0000", "#41b6c4", "#e7298a", "#54278f")
    col3 <- c("#a6cee3", "#1f78b4", "#b2df8a", "#33a02c", "#fb9a99",
              "#e31a1c", "#fdbf6f", "#ff7f00", "#cab2d6", "#6a3d9a",
              "#ffff99", "#b15928")
    colorRampPalette(col3)(n)
}

##' @importFrom rvcheck get_fun_from_pkg
hist <- get_fun_from_pkg("graphics", "hist")