Merge pull request #9 from priviere/master

update
priviere · Sep 22, 2016 · cbf20ed · cbf20ed
2 parents ac4ef24 + 7c1a9d4
commit cbf20ed
Show file tree

Hide file tree

Showing 13 changed files with 243 additions and 151 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: shinemas2R
 Type: Package
 Title: An R package to visualize outputs from the data base Seed History and Network Management System (SHiNeMaS)
-Version: 0.10.1
-Date: 2016-07-06
+Version: 0.10.2
+Date: 2016-09-15
 Authors@R: c(person("Yannick", "de Oliveira", role = "ctb"),
     person("Pierre", "Riviere", role = c("aut", "cre")))
 Author: Pierre Rivière

diff --git a/NEWS b/NEWS
@@ -1,3 +1,21 @@
+shinemas2R 0.10.2 -------------------------------------
+-----------------------------------------------------
+* update some little bugs regarding tests
+
+* update functions
+	- get.ggplot.R: 
+		. add argument data_network
+	- get.ggplot_ggnet.custom.R
+		. improve organise.sl, but still has to be finished ! cf #30
+	- get.data.R
+		.	update format of data for SR in order to have pairs of barplot for S and R
+	- format.data.R
+		. update S and SR output regarding PPBstats
+
+* vignette:
+	- update regarding changes in .R
+
+
 shinemas2R 0.10.1 -------------------------------------
 -----------------------------------------------------
 * resolve issues: #17, #19, #20, #21, #25, #40
@@ -6,7 +24,10 @@ shinemas2R 0.10.1 -------------------------------------
 	- get.ggplot.R: 
 		. update labels.generation argument possible values to "local"" or "total". In relation to #25
 	- get.pdf.R:
-		. add argument "includeimage", beeing a list containing the following elements: "content", "caption"and "width". In relation to #20
+		. add argument "includeimage", beeing a list containing the following elements: "content", "caption" and "width". In relation to #20
+
+* vignette:
+	- update regarding changes in .R
 
 
 shinemas2R 0.10 -------------------------------------

diff --git a/R/format.data.R b/R/format.data.R
@@ -13,6 +13,15 @@
 #' 
 #' @return The data set with the right format for the R package
 #' 
+#' @details 
+#' \itemize{
+#'  \item For PPBstats, it returns
+#'  \itemize{
+#'   \item a data-set fitting argument \code{data} in functions \code{MC} or \code{FWH} for shinemas2R.object = "data-classic-relation" or "data-classic-seed-lots"
+#'   \item a data-set fitting argument \code{data_version} in \code{get.ggplot} for shinemas2R.object = "data-S-relation", "data-SR-relation", "data-S-seed-lots" or "data-SR-seed-lots"
+#'  }
+#' }
+#' 
 #' @examples
 #' # See the vignette
 #' 
@@ -72,14 +81,28 @@ if( format == "PPBstats" ) {
 		data$format_location = data$father_person
 	}
 
-	out = data[,c("format_year", "format_location", "format_germplasm", "block", "X", "Y", vec_variables)]
-	colnames(out) = c("year", "location", "germplasm", "block", "X", "Y", vec_variables)
-	out$year = factor(out$year)
-	out$location = factor(out$location)
-	out$germplasm = factor(out$germplasm)
-	out$block = factor(out$block)
-	out$X = factor(out$X)
-	out$Y = factor(out$Y)
+	if( is.element(shinemas2R.object, c("data-classic-relation", "data-classic-seed-lots")) ) {
+		out = data[,c("format_year", "format_location", "format_germplasm", "block", "X", "Y", vec_variables)]
+		colnames(out) = c("year", "location", "germplasm", "block", "X", "Y", vec_variables)
+		out$year = factor(out$year)
+		out$location = factor(out$location)
+		out$germplasm = factor(out$germplasm)
+		out$block = factor(out$block)
+		out$X = factor(out$X)
+		out$Y = factor(out$Y)
+	}
+
+
+	if( is.element(shinemas2R.object, c("data-S-relation", "data-SR-relation", "data-S-seed-lots", "data-SR-seed-lots"))){
+		out = data[,c("format_year", "format_location", "format_germplasm", "expe_name", "sl_statut")]
+		colnames(out) = c("year", "location", "germplasm", "group", "version")
+		out$year = factor(out$year)
+		out$location = factor(out$location)
+		out$germplasm = factor(out$germplasm)
+		out$group = factor(out$group)
+		out$version = factor(out$version)
+	}
+
 	}
 
 return(out)

diff --git a/R/get.data.R b/R/get.data.R
@@ -207,7 +207,7 @@ mixrep_to_repro = TRUE
 # 1. Check parameters ----------
 
 # 1.1. Possibles values of arguments ----------
-if(!is.element(query.type, c("network", "data-classic", "data-S", "data-SR", "data-mixture-1", "cross", "variable", "person", "year", "project", "seed.lots", "selection.person", "reproduction.type", "germplasm.type", "germplasm", "methods", "person.info", "grandfather")))  { 	stop("query.type must be \"network\", \"data-classic\", \"data-S\", \"data-SR\", \"data-mixture-1\", \"cross\", \"variable\", \"person\", \"year\", \"project\", \"seed.lots\", \"selection.person\", \"reproduction.type\", \"germplasm.type\", \"germplasm\", \"methods\", \"person.info\" or \"grandfather\".") }
+if(!is.element(query.type, c("network", "data-classic", "data-S", "data-SR", "data-mixture-1", "cross", "species", "variable", "person", "year", "project", "seed.lots", "selection.person", "reproduction.type", "germplasm.type", "germplasm", "methods", "person.info", "grandfather")))  { 	stop("query.type must be \"network\", \"data-classic\", \"data-S\", \"data-SR\", \"data-mixture-1\", \"cross\", \"species\", \"variable\", \"person\", \"year\", \"project\", \"seed.lots\", \"selection.person\", \"reproduction.type\", \"germplasm.type\", \"germplasm\", \"methods\", \"person.info\" or \"grandfather\".") }
 
 test = c(germplasm.in, germplasm.out, germplasm.type.in, germplasm.type.out, year.in, year.out, project.in, project.out, person.in, person.out, seed.lot.in, seed.lot.out, relation.in, reproduction.type.in, variable.in)
 if(is.element(query.type, c( "variable", "person", "year", "project", "seed.lots", "selection.person", "reproduction.type", "germplasm.type", "germplasm")) & !is.null(test)) { stop("You can not use a filter on raw information on levels and variables.") }
@@ -1150,44 +1150,53 @@ if(nrow(d) > 0)  {
 											) 
 	d$sl_statut = paste(sapply(d$sl, function(x){unlist(strsplit(as.character(x),"_"))[3]}), d$sl_stat, sep = ":")
 	d = select(d, - sl_stat)
+	d$g = sapply(d$sl, function(x){unlist(strsplit(as.character(x),"_"))[1]})
+	d$exp_stat = paste(d$expe, d$sl_statut, sep = "-")
+
+	#expinfo = unique(
+	#								cbind.data.frame(
+	#																	exp = d$expe,
+	#																	g = sapply(d$sl, function(x){unlist(strsplit(as.character(x),"_"))[1]}), 
+	#																	sl_statut = d$sl_statut,
+	#																	sl = d$sl
+	#																)
+	#								)
 
-	expinfo = unique(
-									cbind.data.frame(
-																		exp = d$expe, 
-																		g = sapply(d$sl, function(x){unlist(strsplit(as.character(x),"_"))[1]}), 
-																		sl_statut = d$sl_statut,
-																		sl = d$sl
-																	)
-									)
+	#expinfo = expinfo[order(expinfo$exp, expinfo$sl_statut, decreasing = TRUE), ]
+	#expinfo$ok = sapply( expinfo$exp, function(x){floor(as.numeric(as.character(x)))} )
+	#liste = sort(unique(expinfo$ok)); name.exp = NULL
+	liste = sort(unique(d$expe))
 
-	expinfo = expinfo[order(expinfo$exp, expinfo$sl_statut, decreasing = TRUE), ]
-	expinfo$ok = sapply( expinfo$exp, function(x){floor(as.numeric(as.character(x)))} )
-	liste = unique(expinfo$ok); name.exp = NULL
-
 	name.exp.1 = name.exp.2 = NULL
 
 	for(i in 1:length(liste)) {
-		toto = droplevels(subset(expinfo, ok %in% liste[i]))
-		toget = grep("vracR", toto[,"sl_statut"])[1]
-		n11 = toto[toget,"g"]
-		n21 = toto[toget, "sl"]
+		toto = droplevels(subset(d, expe %in% liste[i]))
 
-		toget = grep("bouquetR",toto[,"sl_statut"])[1]
-		n12 = toto[toget,"g"]
-		n22 = toto[toget, "sl"]
+		toget_v = grep("vracS", toto[,"sl_statut"])
+		toget_b = grep("bouquetS", toto[,"sl_statut"])
+
+		n1_S = paste( as.character(toto[toget_v,"g"]), "|", as.character(toto[toget_b,"g"]), "(S)" )
+		n1_S = rep( n1_S, 2 ); names(n1_S) = toto[c(toget_v, toget_b), "exp_stat"]
 
-		n1 = paste( as.character(n11), as.character(n12), sep = " | " )
-		n1 = rep( n1, nrow(toto) ); names(n1) = toto[, "exp"]
+		n2_S = paste( as.character(toto[toget_v, "sl"]), "|", as.character(toto[toget_b, "sl"]), "(S)" )
+		n2_S = rep( n2_S, 2 ); names(n2_S) = toto[c(toget_v, toget_b), "exp_stat"]
+
+		toget_v = grep("vracR", toto[,"sl_statut"])
+		toget_b = grep("bouquetR", toto[,"sl_statut"])
 
-		n2 = paste( as.character(n21), as.character(n22), sep = " | " )
-		n2 = rep( n2, nrow(toto) ); names(n2) = toto[, "exp"]
+		n1_R = paste( as.character(toto[toget_v,"g"]), "|", as.character(toto[toget_b,"g"]), "(R)" )
+		n1_R = rep( n1_R, 2 ); names(n1_R) = toto[c(toget_v, toget_b), "exp_stat"]
 
-		name.exp.1 = c(name.exp.1, n1)
-		name.exp.2 = c(name.exp.2, n2)
+		n2_R = paste( as.character(toto[toget_v, "sl"]), "|", as.character(toto[toget_b, "sl"]), "(R)" )
+		n2_R = rep( n2_R, 2 ); names(n2_R) = toto[c(toget_v, toget_b), "exp_stat"]
+
+		name.exp.1 = c(name.exp.1, n1_S, n1_R)
+		name.exp.2 = c(name.exp.2, n2_S, n2_R)
 		}
 
-	d$expe_name = name.exp.1[as.character(d$expe)]	
-	d$expe_name_2 = name.exp.2[as.character(d$expe)]	
+	d$expe_name = name.exp.1[as.character(d$exp_stat)]	
+	d$expe_name_2 = name.exp.2[as.character(d$exp_stat)]	
+	d = select(d, - exp_stat)
 
 	d$sl = as.factor(d$sl)
 	d$sl_statut = as.factor(d$sl_statut)

diff --git a/R/get.ggplot.R b/R/get.ggplot.R
@@ -6,6 +6,8 @@
 #'
 #' @param data output from get.data with query.type = "network" or query.type = "data-...".
 #' 
+#' @param data_network for ggplot.type == "data-pie.on.network", the network ot plot the variable coming from data argument (that must be "data-classic").
+#' 
 #' @param correlated_group Name of the group of correlation in data. NULL by default meaning that \code{shinemas2R::get.data()$data$data} is taken.
 #' 
 #' @param merge_g_and_s Fuse germplasm and selection name information in a column named germplasm. TRUE by default.
@@ -135,6 +137,7 @@
 #' 
 get.ggplot <- function(
 	data,
+	data_network = NULL,
 	correlated_group = NULL,
 	merge_g_and_s = TRUE,
 	ggplot.type = NULL,
@@ -295,10 +298,6 @@ if(is.null(ggplot.type) & test2) {
 
 if( test2 & length(grep("data-", ggplot.type)) == 0 ) { stop("With data from \"data-...\", ggplot.type must be", paste(vec_all_ggplot_data, collapse = ", \n")) }
 
-t = is.null(info_db) & (ggplot.type == "data-pie.on.network" | ggplot.type == "data-pie.on.map")
-
-if( is.null(info_db) & (is.element("data-pie.on.network", ggplot.type) | is.element("data-pie.on.map", ggplot.type) ) ) { stop("You can not use ggplot.type == \"data-pie.on.network\" or \"data-pie.on.map\" because you can not be connected to SHiNeMaS, as you used is.get.data.output function.") }
-
 # 1.3. ggplot.display ----------
 
 # 1.3.1. network ----------
@@ -1015,46 +1014,7 @@ if( check.arg("data-pie.on.network", ggplot.type) ) {
 
 	list.plots = NULL
 	for(var in vec_variables){
-		vec_sl = unique(as.character(data$sl))
-
-		test = unique(is.element(vec_sl, get.data(db_user = info_db$db_user, db_host = info_db$db_host, db_name = info_db$db_name, db_password = info_db$db_password, query.type = "seed.lots")$data))
-		encrypt = length(test) == 1 & !test
-
-		if(encrypt){
-
-			v = get.data(db_user = info_db$db_user, db_host = info_db$db_host, db_name = info_db$db_name, db_password = info_db$db_password, query.type = "person")$data
-			vec = paste("person-", c(1:length(v)), sep = ""); names(vec) = v
-			vec_person = vec
-
-			v = get.data(db_user = info_db$db_user, db_host = info_db$db_host, db_name = info_db$db_name, db_password = info_db$db_password, query.type = "year")$data
-			vec = c(2000:(2000+length(v))); names(vec) = v
-			vec_year = vec
-
-			v = get.data(db_user = info_db$db_user, db_host = info_db$db_host, db_name = info_db$db_name, db_password = info_db$db_password, query.type = "germplasm")$data
-			vec = paste("germplasm-", c(1:length(v)), sep = ""); names(vec) = v
-			vec_germplasm = vec
-
-			reverse_encrypt_sl = function(sl, vec_germplasm, vec_person, vec_year){
-				a = unlist(strsplit(as.character(sl), "_"))
-				gs = as.character(a[1])
-				gs = unlist(strsplit(as.character(gs), "#"))
-				g = names(vec_germplasm)[which(vec_germplasm == as.character(gs[1]))]
-				if( is.na(gs[2]) ) { s = NULL } else { s = paste("#", gs[2], sep = "") }
-				p = names(vec_person)[which(vec_person == as.character(a[2]))]
-				y = names(vec_year)[which(vec_year == as.character(a[3]))]
-				d = as.character(a[4])
-				sl = paste(g, s, "_", p, "_", y, "_", d, sep = "")
-				return(sl)
-			}
-
-			vec_sl = sapply(vec_sl, reverse_encrypt_sl, vec_germplasm, vec_person, vec_year)
-			}
-
-		n = get.data(db_user = info_db$db_user, db_host = info_db$db_host, db_name = info_db$db_name, db_password = info_db$db_password, query.type = "network", seed.lot.in = vec_sl, filter.on = "father-son", network.info = FALSE)
-
-		if(encrypt){ n = encrypt.data(n) }
-
-		n = n$data
+		n = data_network$data
 
 		p = get.ggplot_plot.network(n, vertex.color, vertex.size, hide.labels.parts, labels.sex, labels.generation, organise.sl = organise.sl, labels.size = labels.size)
 		p_net = p$pnet
@@ -1064,7 +1024,7 @@ if( check.arg("data-pie.on.network", ggplot.type) ) {
 		tokeep = which(!is.na(d_tmp[,var]))
 		d_tmp = d_tmp[tokeep,]
 		d_tmp$sl = factor(d_tmp$sl)
-
+		
 		p = get.ggplot_pie.on.ggplot(p_net, data = d_tmp, variable = var, factor = "sl", x.origin = "X1", y.origin = "X2", r = pie.size*5, hide.labels.parts = hide.labels.parts, labels.size = labels.size)
 		# pie.size*5 to oversize the vertex size