#########################################################################
## ##
## Package: BatchMap ##
## ##
## File: plot.raw.data.R ##
## Contains: plot.onemap, create.dataframe.for.plot.outcross, ##
## plot.by.segreg.type ##
## ##
## Written by Antonio Augusto Franco Garcia with minor modifications ##
## by Marcelo Mollinari and Gabriel Rodrigues Alves Margarido ##
## copyright (c) 2015 Antonio Augusto Franco Garcia ##
## ##
## First version: 2015/03/31 ##
## Last update: 2016/01/15 ##
## License: GNU General Public License version 3 or later ##
## ##
#########################################################################
##' Draw a graphic of raw data for any OneMap population
##'
##' Shows a heatmap (in ggplot2, a graphic of geom "tile") for raw data.
##' Lines correspond to markers and columns to individuals.
##' The function can plot a graph for all marker types, depending of the cross type (dominant/codominant markers, in all combinations).
##' The function receives a onemap object of class \code{onemap}, reads information
##' from genotypes from this object, converts it to a long dataframe format
##' using function melt() from package reshape2() or internal function create.dataframe.for.plot.outcross(), converts numbers from the object
##' to genetic notation (according to the cross type), then plots the graphic.
##' If there is more than 20 markers, removes y labels
##' For outcross populations, it can show all markers together, or it can split them according the segregation
##' pattern.
##'
##' @param x an object of class \code{onemap}, with data and additional information
##'
##' @param all a TRUE/FALSE option to indicate if results will be
##' plotted together (if TRUE) or splitted based on their
##' segregation pattern. Only used for outcross populations.
##'
##' @param ... currently ignored
##'
##' @return a ggplot graphic
##'
##' @import ggplot2
##'
##' @examples
##' data(example.out) # Loads a fake full-sib dataset installed with onemap
##' plot(example.out) # This will show you the graph for all markers
##' plot(example.out, all=FALSE) # This will show you the graph splitted for marker types
##'
##' # You can store the graphic in an object, then save it.
##' # For details, see the help of ggplot2's function ggsave()
##' g <- plot(example.out, all=FALSE)
##'
##' @export
plot.onemap <- function(x, all=TRUE, ...) {
# Creating the data frame
if (is(x, "outcross")) {
df.OM <- create.dataframe.for.plot.outcross(x)
}
else {
df.OM <- data.frame(x$geno)
df.OM <- reshape2::melt(df.OM) # function from package reshape
df.OM[is.na(df.OM)] <- 0 # To avoid problems with NAs
df.OM <- cbind(ind=1:x$n.ind, df.OM)
df.OM$value <- factor(df.OM$value)
}
# Plotting
g <- ggplot(data=df.OM, aes(x=ind, y=variable, fill=factor(value)))
g <- g + geom_tile()
g <- g + xlab("Individual") + ylab("Marker")
if (is(x, "outcross")) {
g <- g + scale_fill_manual(name="Genotype",
values=c("#00A08A", "#5BBCD6", "#F2AD00", "#F98400", "#FF0000"))
if (x$n.mar>20)
g <- g + theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
if (all==TRUE) g
else g <- g + facet_grid( . ~ Mk.type) + theme(axis.text.x=element_text(size=5))
}
else {
if (is(x, "backcross") || is(x, "riself") || is(x, "risib")) {
g <- g + scale_fill_manual(name="Genotype", labels=labels.OM,
values=c("#F21A00","#3B9AB2","#EBCC2A"))
} else if (is(x, "f2")) {
g <- g + scale_fill_manual(name="Genotype", labels=labels.OM,
values=c("#000000", "#ECCBAE", "#046C9A", "#D69C4E", "#85D4E3", "#74A089"))
}
if (x$n.mar>20) g <- g + theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())
}
return(g)
}
##'
##' Create a dataframe suitable for a ggplot2 graphic
##'
##' An internal function that prepares a dataframe suitable for
##' drawing a graphic of raw data using ggplot2, i. e., a data frame
##' with long format
##'
##' @param x an object of classes \code{onemap} and \code{outcross}, with data and additional information
##'
##' @return a dataframe
##'
create.dataframe.for.plot.outcross <- function(x) {
# Markers of A type
for (i in 1:4) {
if (length(which(x$segr.type==paste("A.",i,sep=""))!=0)) {
F1.A <- data.frame(x$geno[,which(x$segr.type==paste("A.",i,sep=""))])
colnames(F1.A) <- colnames(x$geno)[which(x$segr.type==paste("A.",i,sep=""))]
F1.A <- reshape2::melt(F1.A)
F1.A <- cbind(ind=1:x$n.ind, F1.A, Mk.type=paste("A.",i,sep=""))
F1.A$value <- factor(F1.A$value)
if (!exists("F1.A.")) F1.A. <- data.frame(F1.A)
else F1.A. <- rbind(F1.A.,F1.A)
} else F1.A. <- NULL
}
# Markers of B type
for (i in 1:3) {
if (length(which(x$segr.type==paste("B",i,".",i+4,sep=""))!=0)) {
F1.B <- data.frame(x$geno[,which(x$segr.type==paste("B",i,".",i+4,sep=""))])
colnames(F1.B) <- colnames(x$geno)[which(x$segr.type==paste("B",i,".",i+4,sep=""))]
F1.B <- reshape2::melt(F1.B)
F1.B <- cbind(ind=1:x$n.ind, F1.B, Mk.type=paste("B",i,".",i+4,sep=""))
F1.B$value <- factor(F1.B$value)
if (!exists("F1.B.")) F1.B. <- data.frame(F1.B)
else F1.B. <- rbind(F1.B.,F1.B)
} else F1.B. <- NULL
}
# Markers of C type
for (i in 8) {
if (length(which(x$segr.type==paste("C.",i,sep=""))!=0)) {
F1.C <- data.frame(x$geno[,which(x$segr.type==paste("C.",i,sep=""))])
colnames(F1.C) <- colnames(x$geno)[which(x$segr.type==paste("C.",i,sep=""))]
F1.C <- reshape2::melt(F1.C)
F1.C <- cbind(ind=1:x$n.ind, F1.C, Mk.type=paste("C.",i,sep=""))
F1.C$value <- factor(F1.C$value)
if (!exists("F1.C.")) F1.C. <- data.frame(F1.C)
else F1.C. <- rbind(F1.C.,F1.C)
} else F1.C. <- NULL
}
# Markers of D1 type
for (i in 9:13) {
if (length(which(x$segr.type==paste("D1.",i,sep=""))!=0)) {
F1.D1 <- data.frame(x$geno[,which(x$segr.type==paste("D1.",i,sep=""))])
colnames(F1.D1) <- colnames(x$geno)[which(x$segr.type==paste("D1.",i,sep=""))]
F1.D1 <- reshape2::melt(F1.D1)
F1.D1 <- cbind(ind=1:x$n.ind, F1.D1, Mk.type=paste("D1.",i,sep=""))
F1.D1$value <- factor(F1.D1$value)
if (!exists("F1.D1.")) F1.D1. <- data.frame(F1.D1)
else F1.D1. <- rbind(F1.D1.,F1.D1)
} else F1.D1. <- NULL
}
# Markers of D2 type
for (i in 14:18) {
if (length(which(x$segr.type==paste("D2.",i,sep=""))!=0)) {
F1.D2 <- data.frame(x$geno[,which(x$segr.type==paste("D2.",i,sep=""))])
colnames(F1.D2) <- colnames(x$geno)[which(x$segr.type==paste("D2.",i,sep=""))]
F1.D2 <- reshape2::melt(F1.D2)
F1.D2 <- cbind(ind=1:x$n.ind, F1.D2, Mk.type=paste("D2.",i,sep=""))
F1.D2$value <- factor(F1.D2$value)
if (!exists("F1.D2.")) F1.D2. <- data.frame(F1.D2)
else F1.D2. <- rbind(F1.D2.,F1.D2)
} else F1.D2. <- NULL
}
# Defining classes and combining
# It was not working if any class was missing; now it is
if (!is.null(F1.A.)) class(F1.A.) <- "data.frame"
if (!is.null(F1.B.)) class(F1.B.) <- "data.frame"
if (!is.null(F1.C.)) class(F1.C.) <- "data.frame"
if (!is.null(F1.D1.)) class(F1.D1.) <- "data.frame"
if (!is.null(F1.D2.)) class(F1.D2.) <- "data.frame"
return(rbind(F1.A.,F1.B.,F1.C.,F1.D1.,F1.D2.))
}
##'
##' Draw a graphic showing the number of markers of each segregation pattern.
##'
##' The function receives an object of class \code{onemap}.
##' For outcrossing populations, it can show detailed information (all 18 possible categories),
##' or a simplified version.
##'
##' @param x an object of class \code{onemap}
##' @param subcateg a TRUE/FALSE option to indicate if results will be plotted showing
##' all possible categories (only for outcrossing populations)
##' @param ... Not used
##' @return a ggplot graphic
##'
##' @import ggplot2
##'
##' @examples
##' data(example.out) #Outcrossing data
##' plot.by.segreg.type(example.out)
##' plot.by.segreg.type(example.out, subcateg=FALSE)
##'
##' # You can store the graphic in an object, then save it.
##' # For details, see the help of ggplot2's function ggsave()
##' data(example.out) #Outcrossing data
##' g <- plot.by.segreg.type(example.out)
##'
##' @method plot by.segreg.type
##' @export
plot.by.segreg.type <- function(x, subcateg=TRUE, ...) {
# Create a dataframe, indicating the category and subcategory
df <- data.frame(segr.type=factor(x$segr.type),Type=999)
t <- c("A","B","C","D1","D2")
for (i in t){
if (length(grep(i, x$segr.type))>0)
df[grep(i, x$segr.type),]$Type <- i
}
# Plot the graphic, with option for subcategory for outcross
if (is(x, "outcross") && subcateg==TRUE){
g <- ggplot(data=df, aes(x=Type, fill=segr.type))
g <- g + geom_bar()
g <- g + xlab("Segregation Type") + ylab("Count")
}
else {
g <- ggplot(data=df, aes(x=Type, fill="orange"))
g <- g + geom_bar()
g <- g + xlab("Segregation Type") + ylab("Count") + theme(legend.position="none")
}
return(g)
}
#####
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.