R/report_mig_interannual.R

In stacomiR: Fish Migration Monitoring

#' Class "report_mig_interannual"
#'
#' When daily report are written in the t_reportjournalier_bjo table by the
#' \link{report_mig-class} they can be used by this class to display
#' interannual comparisons of migration.
#' When running its connect method, this class will run the \link{report_mig-class}
#' for each year where data are missing, or
#' where the annual sum in the t_reportjournalier_bjo table differs from the counts
#' generated by the \link{report_annual-class} : rows have been changed in the database.
#' Different charts are produced with different
#' period grouping. See \link{write_database,report_mig-method} for details about how
#' this method inserts data in the t_reportjournalier_bjo table.
#'
#' @include ref_year.R
#' @slot dc An object of class \link{ref_dc-class}, the counting device
#' @slot data A \code{data.frame} data loaded from the daily migration table t_bilanmigrationjournalier_bjo
#' @slot taxa An object of class \link{ref_taxa-class}
#' @slot stage An object of class \link{ref_stage-class}
#' @slot start_year An object of class \link{ref_year-class}. ref_year allows to choose year of beginning
#' @slot end_year An object of class \link{ref_year-class}
#' ref_year allows to choose last year of the report
#' @slot calcdata A \code{list} of calculated data, filled in by the calcule method
#'
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @family report Objects
#' @keywords classes
#' @example inst/examples/report_mig_interannual-example.R
#' @aliases report_mig_interannual
#' @export
setClass(
		Class = "report_mig_interannual",
		representation =
				representation(
						dc = "ref_dc",
						taxa = "ref_taxa",
						stage = "ref_stage",
						data = "data.frame",
						start_year = "ref_year",
						end_year = "ref_year",
						calcdata = "list"
				),
		prototype = prototype(
				dc = new("ref_dc"),
				taxa = new("ref_taxa"),
				stage = new("ref_stage"),
				data = data.frame(),
				start_year = new("ref_year"),
				end_year = new("ref_year"),
				calcdata = list()
		)
)
setValidity("report_mig_interannual", function(object)
		{
			# if more than one taxa, the connect method will fail when trying to run the write_database for missing data
			# also plots have not been developed accordingly
			rep1 = ifelse(
					length(object@taxa@taxa_selected) == 1,
					TRUE,
					gettext("report_mig_interannual can only take one taxa", domain = "R-stacomiR")
			)
			# same for stage
			rep2 = ifelse(
					length(object@stage@stage_selected) == 1,
					TRUE,
					gettext("report_mig_interannual can only take one stage", domain = "R-stacomiR")
			)
			# multiple DC are allowed
			return(ifelse(rep1 & rep2 , TRUE , c(1:2)[!c(rep1, rep2)]))
		})


#' connect method for report_mig_interannual
#'
#' This method will check if the data in the t_reportjournalier_bjo table has no missing data,
#' if missing the program will load missing data. As a second step,
#' the program will check if the numbers in the table  t_reportjournalier_bjo differ from those in the database,
#' and propose to re-run the report_mig (which has a write_database methode to write daily reports) for those years.
#' @note We expect different results between daily reports from the t_reportjournalier_bjo table and the annual sums
#' from report_annual for glass eels as those may have been weighted and not only counted. The t_reportjournalier_bjo table used by report_mig_interannual
#' contains the sum of glass eel numbers converted from weights and those directly counted. The report_annual does not.
#' @param object An object of class \link{report_mig_interannual-class}
#' @param silent Stops messages from being displayed if silent=TRUE, default FALSE
#' @param check Checks that data are corresponding between report_annual and report_mig
#' @return report_mig_interannual an instantiated object with values filled with user choice
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @aliases connect.report_mig_interannual
#' @importFrom utils menu
setMethod(
		"connect",
		signature = signature("report_mig_interannual"),
		definition = function(object,
				silent = FALSE,
				check = TRUE)
		{
			# object<-r_mig_interannual
			# object<-bmi_cha
			# object<-bmi_des
			# object<-r_mig_interannual_vichy
			# require(dplyr); require(ggplot2)
			#---------------------------------------------------------------------------------------
			# this function will be run several times if missing data or mismatching data are found
			# later in the script (hence the encapsulation)
			
			# if not silent display information about the connection
			if (!silent) {
				host <-	options("stacomiR.host")				
				funout(gettextf("host:%s", host, domain = "R-StacomiR"))
				port <- options("stacomiR.port")
				funout(gettextf("port:%s", port, domain = "R-StacomiR"))
				# getting the database name
				dbname <- options("stacomiR.dbname")
				funout(gettextf("dbname:%s", dbname, domain = "R-StacomiR"))
			}
			
			#---------------------------------------------------------------------------------------
			
			
			fn_connect <- function() {
				les_annees = (object@start_year@year_selected):(object@end_year@year_selected)
				tax = object@taxa@taxa_selected
				std = object@stage@stage_selected
				dic = object@dc@dc_selected
				requete = new("RequeteDBwhere")
				requete@where = paste(
						"WHERE bjo_annee IN ",
						vector_to_listsql(les_annees),
						" AND bjo_tax_code='",
						tax,
						"' AND bjo_std_code='",
						std,
						"' AND bjo_dis_identifiant in",
						vector_to_listsql(dic),
						sep = ""
				)
				requete@select = paste(
						"SELECT * FROM ",
						get_schema(),
						"t_bilanmigrationjournalier_bjo",
						sep = ""
				)
				requete@order_by = " ORDER BY bjo_jour "
				requete <- stacomirtools::query(requete)
				t_bilanmigrationjournalier_bjo <- requete@query
				if (nrow(t_bilanmigrationjournalier_bjo)>0) {
					t_bilanmigrationjournalier_bjo <- stacomirtools::killfactor(t_bilanmigrationjournalier_bjo)
				}
				return(t_bilanmigrationjournalier_bjo)
			}
			
			#---------------------------------------------------------------------------------------			
			
			object@data <- fn_connect()
			if (nrow(object@data) == 0) {
				funout(
						gettextf("No data in table t_bilanmigrationjournalier_bjo", domain = "R-StacomiR")
				)
				check = TRUE
			}
			#browser()
			if (check) {
				#----------------------------------------------------------------------
				# Loading a report Annuel to compare numbers
				#----------------------------------------------------------------------
				report_annual <- as(object, "report_annual")
				report_annual <- connect(report_annual)
				#----------------------------------------------------------------------
				# MAIN LOOP, there can be several dic
				#----------------------------------------------------------------------
				dic <- object@dc@dc_selected
				for (i in 1:length(dic)) {
					#i=1
					############################################
					# function creating a table to compare actual counts with those stored in
					# in the t_reportjournalier_bjo table
					###########################################
					#==========================================
					
					fn_check <- function() {
						data1 <-
								report_annual@data[report_annual@data$ope_dic_identifiant == dic[i], c("effectif", "annee")]
						# data from report_migInterannuel
						data2 <- object@data[object@data$bjo_dis_identifiant == dic[i], ]
						data21 <-
								dplyr::select(data2, bjo_annee, bjo_valeur, bjo_labelquantite)
						
						data22 <- dplyr::group_by(data21, bjo_annee, bjo_labelquantite)
						if (nrow(data22) == 0)
							data22$bjo_valeur <- as.numeric(data22$bjo_valeur)
						data23 <- dplyr::summarize(data22, total = sum(bjo_valeur))
						data24 <-
								dplyr::filter(dplyr::ungroup(data23),
										bjo_labelquantite == "Effectif_total")
						data24 <- dplyr::select(data24, bjo_annee, total)
						data24 <-
								dplyr::rename(data24, annee = bjo_annee, effectif_bjo = total)
						data124 <- merge(data1,
								data24,
								all.x = TRUE,
								all.y = TRUE,
								by = "annee")
						return(data124)
					}
					#==========================================
					# table with 3 columns : annee; effectif; effectif_bjo
					compared_numbers <- fn_check()
					# as we have changed the report_annual to split data between years
					# some unwanted data might step in outside the year range
					# we correct for that
					compared_numbers <- compared_numbers[compared_numbers$annee >= object@start_year@year_selected &
									compared_numbers$annee <= object@end_year@year_selected, ]
					
					#-------------------------------------------------------------------------------------
					# First test, if missing data, the program will propose to load the data by running report_mig
					#-------------------------------------------------------------------------------------
					# when data are missing, NA appear in the effectif_bjo column
					if (any(is.na(compared_numbers$effectif_bjo))) {
						index_missing_years <- which(is.na(compared_numbers$effectif_bjo))
						missing_years <- compared_numbers$annee[index_missing_years]
						if (!silent &
								length(dic) > 1)
							funout(gettextf("DC with missing values : %s ", dic[i], domain = "R-StacomiR"))
						if (!silent)
							funout(gettextf(
											"Years with no value : %s ",
											stringr::str_c(missing_years, collapse = "; "),
											domain = "R-StacomiR"
									))
						if (!silent)
							funout(
									gettextf(
											"Some years are missing in the t_reportjournalier_bjo table, loading them now !",
											domain = "R-StacomiR"
									)
							)
						
						
						for (y in 1:length(missing_years)) {
							Y <- missing_years[y]
							bM = new("report_mig")
							if (!silent)
								funout(gettextf("Running report_mig for year %s", Y, domain = "R-StacomiR"))
							bM = choice_c(
									bM,
									dc = dic[i],
									taxa = object@taxa@taxa_selected,
									stage = object@stage@stage_selected,
									datedebut = stringr::str_c(Y, "-01-01"),
									datefin = stringr::str_c(Y, "-12-31")
							)
							bM <- charge(bM, silent = silent)
							bM <- connect(bM, silent = silent)
							bM <- calcule(bM, silent = silent)
							if (nrow(bM@data) > 0) {
								# below the argument check_for_bjo is necessary
								# as the write database method from report_mig
								# uses the connect method from report_mig_interannual and the
								# program runs in endless loops...
								write_database(bM, silent = silent, check_for_bjo = FALSE)
							}
						} # end for loop to write new reports
						# reloading everything
						object@data <- fn_connect()
						compared_numbers <- fn_check()
						
					} # end if any...
					
					#-------------------------------------------------------------------------------------
					# Second test, for existing report with different numbers, again the data will be witten again
					# if the previous test failed, and user confirmed that there was a problem
					# the object@data and  compared_numbers are reloaded (see above)
					# this test will only be run if the stage is not glass eel, for glass eels it does not make sense
					# as some of the "effectif_total" in the bjo table correspond to weights not counts.
					#-------------------------------------------------------------------------------------
					
					if (object@taxa@taxa_selected == 2038 &
							object@stage@stage_selected == "CIV") {
						if (!silent)
							funout(
									gettext(
											"For glass eel it is not possible to check that data are up to date",
											domain = "R-StacomiR"
									)
							)
						
					} else if (!all(round(compared_numbers$effectif) == round(compared_numbers$effectif_bjo))) {
						index_different_years <-
								which(round(compared_numbers$effectif) != round(compared_numbers$effectif_bjo))
						differing_years <- compared_numbers$annee[index_different_years]
						if (!silent)
							funout(
									gettextf(
											"Years with values differing between t_reportjournalier_bjo and report_annual : %s ",
											stringr::str_c(differing_years, collapse = "; "),
											domain = "R-StacomiR"
									)
							)
						#==================================
						reload_years_with_error = function() {
							bM = new("report_mig")
							for (Y in differing_years) {
								# Y=differing_years[1]
								funout(gettextf("Running report_mig to correct data for year %s", Y))
								bM = choice_c(
										bM,
										dc = dic[i],
										taxa = object@taxa@taxa_selected,
										stage = object@stage@stage_selected,
										datedebut = stringr::str_c(Y, "-01-01"),
										datefin = stringr::str_c(Y, "-12-31")
								)
								bM <- charge(bM, silent = silent)
								bM <- connect(bM, silent = silent)
								bM <- calcule(bM, silent = silent)
								# report annual may have different numbers from report mig
								# so I'm adding an additional check there
								bma_num <- compared_numbers[compared_numbers$annee==Y,"effectif"]
								bjo_num <- compared_numbers[compared_numbers$annee==Y,"effectif_bjo"]
								bjo_num_new <- sum(bM@calcdata[[stringr::str_c("dc_", dic[i])]][["data"]][,"Effectif_total"])
								if (nrow(bM@data) > 0) {
									if (!round(bjo_num_new) == round(bjo_num)){
										# check for bjo will ensure that previous report are deleted
										write_database(bM,
												silent = silent,
												check_for_bjo = TRUE)
									} else {									
											funout(
													gettextf(
															paste("There is a difference between report_annual Na= %s and report_mig ",
																	"Nj= %s but the sums are the same between report_mig and the database (t_bilanmigrationjournalier_bjo).",
																	"This difference is due to migration report overlapping between two years and the program. No writing in the db."),
															round(bma_num), round(bjo_num),
															domain = "R-StacomiR"
													)
											)										
									} # end else  numbers are equal => do nothing
								} # end test nrow
							}  # end for loop to write new reports
							# the data are loaded again
							object@data <- fn_connect()
							# I need to assign the result one step up (in the environment of the connect function)
							assign("object", object, envir = parent.frame(n = 1))
							
						} # end reload year with errors
						#==================================
						
						if (!silent) {
							choice2 <-
									menu(
											c("yes", "no"),
											graphics = TRUE,
											title = gettextf("Data changed, rerun ?", domain = "R-StacomiR")
									)
							if (choice2 == 1)
								reload_years_with_error()
							
						} else {
							reload_years_with_error()
						}
					} # secondary check
				} # end for
			} # end check
			#-------------------------------------------------------------------------------------
			# Final check for data
			# index of data already present in the database
			#-------------------------------------------------------------------------------------
			les_annees = object@start_year@year_selected:object@end_year@year_selected
			index = unique(object@data$bjo_annee) %in% les_annees
			# s'il manque des donnees pour certaines annees selectionnnees"
			if (!silent) {
				if (length(les_annees[!index]) > 0)
				{
					funout(paste(
									gettext(
											"Attention, there is no migration summary for these year\n",
											domain = "R-stacomiR"
									),
									paste(les_annees[!index], collapse = ","),
									gettext(
											", this taxa and this stage (report_mig_interannual.r)\n",
											domain = "R-stacomiR"
									)
							))
				} # end if
				
				# si toutes les annees sont presentes
				if (length(les_annees[index]) > 0) {
					funout(paste(
									gettext("Interannual migrations query completed", domain = "R-stacomiR"),
									paste(les_annees[index], collapse = ","),
									"\n"
							))
				}
			}
			return(object)
		}
)

#' supprime method for report_mig_interannual class, deletes values in table t_bilanmigrationjournalier_bjo
#' @param object An object of class \link{report_mig_interannual-class}
#' @return nothing, called for its side effect, removing lines from the database
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @aliases supprime.report_mig_interannual
setMethod(
		"supprime",
		signature = signature("report_mig_interannual"),
		definition = function(object)
		{
			# recuperation des annees taxa et stage concernes
			les_annees = (object@start_year@year_selected):(object@end_year@year_selected)
			tax = object@taxa@taxa_selected
			std = object@stage@stage_selected
			dic = object@dc@dc_selected
			con = new("ConnectionDB")
			con <- connect(con)
			on.exit(pool::poolClose(con@connection))
			sql = stringr::str_c(
					"DELETE from ",
					get_schema(),
					"t_bilanmigrationjournalier_bjo ",   
					" WHERE bjo_annee IN (",
					paste(les_annees, collapse = ","),
					") AND bjo_tax_code='",
					tax,
					"' AND bjo_std_code='",
					std,
					"' AND bjo_dis_identifiant=",
					dic
			)
			pool::dbExecute(con@connection, statement = sql)
			
			sql = stringr::str_c(
					"DELETE from ",
					get_schema(),
					"t_bilanmigrationmensuel_bme ",    
					" WHERE bme_annee IN (",
					paste(les_annees, collapse = ","),
					") AND bme_tax_code='",
					tax,
					"' AND bme_std_code='",
					std,
					"' AND bme_dis_identifiant=",
					dic      
			)
			pool::dbExecute(con@connection, statement = sql)	    
			return(invisible(NULL))
		}

)

#' loading method for report_mig_interannual class
#' @param object An object of class \link{report_mig_interannual-class}
#' @param silent Boolean, if TRUE, information messages are not displayed
#' @return An object of class  \link{report_mig_interannual-class} with slots set from values assigned in \code{envir_stacomi} environment
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @aliases charge.report_mig_interannual
#' @keywords internal
setMethod(
		"charge",
		signature = signature("report_mig_interannual"),
		definition = function(object, silent = FALSE)
		{
			report_mig_interannual <- object
			if (exists("ref_dc", envir_stacomi)) {
				report_mig_interannual@dc <- get("ref_dc", envir_stacomi)
			} else {
				funout(
						gettext(
								"You need to choose a counting device, clic on validate\n",
								domain = "R-stacomiR"
						),
						arret = TRUE
				)
			}
			if (exists("ref_taxa", envir_stacomi)) {
				report_mig_interannual@taxa <- get("ref_taxa", envir_stacomi)
			} else {
				funout(
						gettext("You need to choose a taxa, clic on validate\n", domain = "R-stacomiR"),
						arret = TRUE
				)
			}
			if (exists("ref_stage", envir_stacomi)) {
				report_mig_interannual@stage <- get("ref_stage", envir_stacomi)
			} else
			{
				funout(
						gettext("You need to choose a stage, clic on validate\n", domain = "R-stacomiR"),
						arret = TRUE
				)
			}
			if (exists("start_year", envir_stacomi)) {
				report_mig_interannual@start_year <- get("start_year", envir_stacomi)
			} else {
				funout(gettext("You need to choose the starting year\n", domain = "R-stacomiR"),
						arret = TRUE)
			}
			if (exists("end_year", envir_stacomi)) {
				report_mig_interannual@end_year <- get("end_year", envir_stacomi)
			} else {
				funout(gettext("You need to choose the ending year\n", domain = "R-stacomiR"),
						arret = TRUE)
			}
			# this will test that only one taxa and one stage have been loaded (multiple dc are allowed)
			validObject(report_mig_interannual)
			assign("report_mig_interannual",
					report_mig_interannual,
					envir_stacomi)
			if (!silent)
				funout(
						gettext(
								"Writing report_mig_interannual in the environment envir_stacomi : write r_mig_interannual=get('report_mig_interannual',envir_stacomi) ",
								domain = "R-stacomiR"
						)
				)
			
			return(report_mig_interannual)
		}
)

#' command line interface for report_mig_interannual class
#' @param object An object of class \link{report_mig_interannual-class}
#' @param dc A numeric or integer, the code of the dc, coerced to integer,see \link{choice_c,ref_dc-method}
#' @param taxa Either a species name in latin or the SANDRE code for species (ie 2038=Anguilla anguilla),
#' it should match the ref.tr_taxon_tax referential table in the stacomi database, see \link{choice_c,ref_taxa-method}
#' @param stage A stage code matching the ref.tr_stadedeveloppement_std table in the stacomi database, see \link{choice_c,ref_stage-method}
#' @param start_year The starting the first year, passed as character or integer
#' @param end_year the finishing year
#' @param silent Boolean, if TRUE, information messages are not displayed
#' @return An object of class \link{report_mig_interannual-class} with data selected
#' The choice_c method fills in the data slot for classes \link{ref_dc-class}, \link{ref_taxa-class}, \link{ref_stage-class} and two slots of \link{ref_year-class}
#' @aliases choice_c.report_mig_interannual
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
setMethod(
		"choice_c",
		signature = signature("report_mig_interannual"),
		definition = function(object,
				dc,
				taxa,
				stage,
				start_year,
				end_year,
				silent = FALSE) {
			# code for debug using example
			#report_mig_interannual<-r_mig_interannual;dc=c(16);taxa="Anguilla anguilla";stage=c("AGJ");start_year="1984";end_year="2016"
			report_mig_interannual <- object
			report_mig_interannual@dc = charge(report_mig_interannual@dc)
			# loads and verifies the dc
			# this will set dc_selected slot
			report_mig_interannual@dc <-
					choice_c(object = report_mig_interannual@dc, dc)
			# only taxa present in the report_mig are used
			report_mig_interannual@taxa <-
					charge_with_filter(object = report_mig_interannual@taxa, report_mig_interannual@dc@dc_selected)
			report_mig_interannual@taxa <-
					choice_c(report_mig_interannual@taxa, taxa)
			report_mig_interannual@stage <-
					charge_with_filter(
							object = report_mig_interannual@stage,
							report_mig_interannual@dc@dc_selected,
							report_mig_interannual@taxa@taxa_selected
					)
			report_mig_interannual@stage <-
					choice_c(report_mig_interannual@stage, stage)
			# depending on report_object the method will load data and issue a warning if data are not present
			# this is the first step, the second verification will be done in method connect
			
			report_mig_interannual@start_year <-
					charge(object = report_mig_interannual@start_year,
							objectreport = "report_mig_interannual")
			report_mig_interannual@start_year <-
					choice_c(
							object = report_mig_interannual@start_year,
							nomassign = "start_year",
							annee = start_year,
							silent = silent
					)
			report_mig_interannual@end_year@data <-
					report_mig_interannual@start_year@data
			report_mig_interannual@end_year <-
					choice_c(
							object = report_mig_interannual@end_year,
							nomassign = "end_year",
							annee = end_year,
							silent = silent
					)
			assign("report_mig_interannual", report_mig_interannual, envir = envir_stacomi)
			return(report_mig_interannual)
		}
)


#' calcule method for report_mig_interannual
#'
#' Performs the calculation of seasonal coefficients for the plot(plot.type="seasonal") method. The numbers
#' are split according to the period chosen, one of "day","week","month","2 weeks", French labels are also
#' accepted as arguments. Once this is done, the seasonality of the migration is displayed using the day when the
#' first fish was seen, then the days (or period) corresponding to 5, 50 , 95, and 100 percent of the migration.
#' The duration of 90% of the migraton between Q5 and Q95 is also of interest.
#'
#' @param object An object of class \link{report_mig_interannual-class}
#' @param silent Boolean, if TRUE, information messages are not displayed, only warnings and errors
#' @param timesplit One of "day","week","month","2 weeks", "jour","semaine","quinzaine","mois"
#' @note The class report_mig_interannual does not handle escapement rates nor
#' 'devenir' i.e. the destination of the fishes.
#' @return An object of class \link{report_mig_interannual-class} with calcdata slot filled.
#' @aliases calcule.report_mig_interannual
#' @author Marion Legrand
setMethod(
		"calcule",
		signature = signature("report_mig_interannual"),
		definition = function(object,
				silent = FALSE,
				timesplit = "mois") {
			report_mig_interannual <- object
			#report_mig_interannual<-r_mig_interannual
			#report_mig_interannual<-r_mig_interannual_vichy;silent=FALSE;timesplit="mois"
			#require(dplyr)
			if (!timesplit %in% c("jour",
					"day",
					"month",
					"mois",
					"week",
					"semaine",
					"quinzaine",
					"2 weeks"))
				stop (
						stringr::str_c(
								"timesplit should be one of :",
								"jour ",
								"day ",
								"month ",
								"mois ",
								"week ",
								"semaine ",
								"month ",
								"mois ",
								"quinzaine ",
								"2 weeks "
						)
				)
			# back to French labels for consistency with fun_report_mig_interannual code
			timesplit <-
					switch(
							timesplit,
							"day" = "jour_365",
							"jour" = "jour_365",
							"week" = "semaine",
							"month" = "mois",
							"2 weeks" = "quinzaine",
							timesplit
					)
			# there should be just one station, this will be tested
			station <- report_mig_interannual@dc@station
			taxa <- report_mig_interannual@taxa@taxa_selected
			stage <- report_mig_interannual@stage@stage_selected
			if (length(unique(report_mig_interannual@dc@station)) != 1)
				stop(
						"You have more than one station in the report, the dc from the report should belong to the same station"
				)
			if (nrow(report_mig_interannual@data) == 0)
				stop(
						"No rows in report_mig_interannual@data, nothing to run calculations on, you should run a report_mig_mult on this dc first"
				)
			
			datadic <- report_mig_interannual@data[report_mig_interannual@data$bjo_labelquantite ==
							"Effectif_total", ]
			datadic <-
					fun_date_extraction(
							datadic,
							nom_coldt = "bjo_jour",
							jour_an = TRUE,
							quinzaine = TRUE
					)
			datadic <- killfactor(datadic)
			# here this code avoids the following problem :Error: (list) object cannot be coerced to type 'double'
			# data is subsetted for columns not containing bjo, and apply is run on each of the column
			datadic[, colnames(datadic)[!grepl("bjo_", colnames(datadic))]] <-
					apply(
							X = datadic[, colnames(datadic)[!grepl("bjo_", colnames(datadic))]],
							MARGIN = 2,
							FUN = function(X)
								as.numeric(X)
					)
			fnquant <-
					function(data,
							timesplit = "jour_365",
							probs = c(0, .05, .5, .95, 1)) {
				# if there is just a single line, crashes, so reports exactly the same for all values
				if (nrow(data) == 1) {
					res <- c(
							"0%" = data[, timesplit],
							"5%" = data[, timesplit],
							"50%" = data[, timesplit],
							"95%" = data[, timesplit],
							"100%" = data[, timesplit]
					)
				} else {
					res <- Hmisc::wtd.quantile(
							x = data[, timesplit],
							weights = abs(data$bjo_valeur),
							probs = probs
					)
					return(res)
				}
			}
			#fnquant(datadic[datadic$bjo_annee==2012,],"mois")
			# for some reasons this code does not work : Error in x + weights : non-numeric argument to binary operator
			#			dat<-dplyr::select_(datadic,"bjo_annee","bjo_dis_identifiant","bjo_tax_code","bjo_std_code","bjo_valeur",timesplit)%>%
			#					dplyr::group_by_("bjo_annee","bjo_tax_code","bjo_std_code")
			#			dat2<-dat%>% do(res=fnquant(data=.,timesplit=timesplit,probs=c(0, .05, .5, .95, 1)))
			#			dat3<-dat2%>%summarize(bjo_annee,bjo_tax_code,bjo_std_code,Q0=res[[1]],Q5=res[[2]],
			#					Q50=res[[3]],Q95=res[[4]],Q100=res[[5]])
			# this simple code will do :
			dat <- list()
			for (i in unique(datadic$bjo_annee)) {
				dat[[i]] <-
						fnquant(data = datadic[datadic$bjo_annee == i, ], timesplit = timesplit)
			}
			dat <- as.data.frame(matrix(unlist(dat), ncol = 5, byrow = TRUE))
			colnames(dat) <- c("Q0", "Q5", "Q50", "Q95", "Q100")
			dat$d90 <- dat$Q95 - dat$Q5
			dat$year = unique(datadic$bjo_annee)
			dat$taxa = taxa
			dat$stage = stage
			dat$station = unique(station)
			dat$timesplit = timesplit
			dat <-
					dat[, c(
									"year",
									"station",
									"taxa",
									"stage",
									"Q0",
									"Q5",
									"Q50",
									"Q95",
									"Q100",
									"d90",
									"timesplit"
							)]
			report_mig_interannual@calcdata <- dat
			return(report_mig_interannual)
		}
)

#' statistics per time period
#'
#' function called for report_mig_mult objects renames columns
#' replaces nulls, and calculates reports with time period larger than day
#'
#' @param dat a data frame with columns ("bjo_annee","bjo_jour","bjo_labelquantite","bjo_valeur")
#' @param annee The year to exclude from the historical series (it will be plotted against the historical series)
#' @param timesplit "week" "2 week" "month" as provided to seq.POSIXt, default NULL
#' @return a data frame with mean, max, and min calculated for each timesplit
#' @export
fun_report_mig_interannual = function(dat,
		annee = NULL,
		timesplit = NULL)
{
	if (nrow(dat) > 0)
	{
		dat <- dat[dat$bjo_labelquantite == "Effectif_total", ]
		dat <-
				stacomirtools::chnames(
						dat,
						c(
								"bjo_annee",
								"bjo_jour",
								"bjo_labelquantite",
								"bjo_valeur"
						),
						c("annee", "jour", "labelquantite", "valeur")
				)
		dat <- dat[, c("annee", "jour", "valeur")]
		if (!is.null(annee)) {
			dat <- dat[dat$annee != annee, ]
		}
		dat$jour <- trunc.POSIXt(dat$jour, digits = 'days')
		dat$jour <- as.Date(strptime(strftime(dat$jour, '2000-%m-%d'), '%Y-%m-%d'))
		
		
		if (!is.null(timesplit)) {
			seq_timesplit <- seq.POSIXt(
					from = strptime("2000-01-01", format = '%Y-%m-%d'),
					to = strptime("2000-12-31", format = '%Y-%m-%d'),
					by = getvalue(new("ref_period"), timesplit)
			)
			seq_timesplit <- as.Date(trunc(seq_timesplit, digits = 'days'))
			dat[, timesplit] <- dat$jour #
			for (j in 1:(length(seq_timesplit) - 1)) {
				dat[dat$jour >= seq_timesplit[j] &
								dat$jour < seq_timesplit[j + 1], timesplit] <-
						seq_timesplit[j]
			}
			dat[dat$jour >= seq_timesplit[length(seq_timesplit)], timesplit] <-
					seq_timesplit[length(seq_timesplit)]
			dat[, "interv"] <- paste(dat[, "annee"], dat[, timesplit])
			res <- tapply(dat$valeur, dat[, "interv"], sum, na.rm = TRUE)
			datc <-
					data.frame(
							"annee" = substr(names(res), 1, 4),
							timesplit = substr(names(res), 5, 15),
							"valeur" = as.numeric(res)
					)
			colnames(datc)[2] <- timesplit
			dat <- datc
			rm(datc)
		} else {
			# if null default value is day
			timesplit <- "jour"
			jour2000 <- as.Date(seq.POSIXt(
							from = strptime("2000-01-01", format = '%Y-%m-%d'),
							to = strptime("2000-12-31", format = '%Y-%m-%d'),
							by = "day"
					))
			for (j in unique(dat$annee)) {
				# days without report are added with a zero
				jour2000restant <-
						jour2000[!jour2000 %in% dat[dat$annee == j, "jour"]]
				dat0 <- data.frame("jour" = jour2000restant,
						"annee" = j,
						"valeur" = NA)
				dat <- rbind(dat, dat0)
			} # end for
		}
		
		maxdat <-
				suppressWarnings(tapply(dat$valeur, as.character(dat[, timesplit]), max, na.rm =
										TRUE))
		mindat <-
				suppressWarnings(tapply(dat$valeur, as.character(dat[, timesplit]), min, na.rm =
										TRUE))
		meandat <-
				suppressWarnings(tapply(dat$valeur, as.character(dat[, timesplit]), mean, na.rm =
										TRUE))
		datsummary <-
				data.frame("maxtab" = maxdat,
						"mintab" = mindat,
						"moyenne" = meandat)
		datsummary <-
				datsummary[!is.infinite(datsummary$maxtab), ]# the minimum and max of empty set are -Inf and Inf respectively
		datsummary[, timesplit] <- names(maxdat)[!is.infinite(maxdat)]
		dat[, timesplit] <- as.character(dat[, timesplit])
		dat <- merge(dat, datsummary, by = timesplit)
		dat[, timesplit] <-
				as.POSIXct(strptime(dat[, timesplit], format = '%Y-%m-%d')) # le format Posixct est necessaire pour les ggplot
		rm(maxdat, mindat, meandat)
		dat <- dat[order(dat$annee, dat[, timesplit]), ]
		# this return the first occurence for each day,
		# for any day , min, max and mean are OK
		return(dat)
		
	} else {
		funout(
				gettext(
						"Attention : you have to complete a migration summary for at least one of the selected year before launching a inter-annual summary",
						domain = "R-stacomiR"
				),
				arret = TRUE
		)
	}# end else
}

#' Plot method for report_mig_interannual
#'
#' Several of these plots are scaled against the same year,i.e.the comparison is based on
#' year 2000, meaning that day 1 would correspond to the first date of 2000,  which is also a
#' saturday, the last day of the week.
#' @param x An object of class \link{report_mig_interannual-class}
#' @param plot.type Default standard
#' @param timesplit Used for plot.type barchart or dotplot, Default mois (month) other possible values are semaine (week), quinzaine (2 weeks),
#' English values within parenthesis are also accepted.
#' @param silent Stops displaying the messages.
#' \itemize{
#' 		\item{plot.type="line": one line per daily report_mig}
#' 		\item{plot.type="standard": the current year is displayed against a ribbon of historical values"}
#' 		\item{plot.type="density": creates density plot to compare seasonality, data computed by 15 days period}
#' 		\item{plot.type="step" : creates step plots to compare seasonality, the year chosen in the interface is the
#' latest if silent=TRUE, or it can be selected in the droplist. It is highlighted against the other with a dotted line}
#' 		\item{plot.type="barchart": comparison of daily migration of one year against periodic migration for the other years available in the chronicle,
#' 									different periods can be chosen with argument timesplit}
#' 		\item{plot.type="pointrange": Pointrange graphs, different periods can be chosen with argument timesplit}
#'      \item{plot.type="seasonal": plot to display summary statistics about the migration period}
#' }
#' @return Nothing, called for its side effect of plotting
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @aliases plot.report_mig_interannual
#' @export
setMethod(
		"plot",
		signature(x = "report_mig_interannual", y = "missing"),
		definition = function(x,
				plot.type = "standard",
				timesplit = "mois",
				silent = FALSE) {
			#report_mig_interannual<-r_mig_interannual
			report_mig_interannual <- x
			if (!timesplit %in% c(
					"jour",
					"day",
					"month",
					"mois",
					"week",
					"semaine",
					"month",
					"mois",
					"quinzaine",
					"2 weeks"
			))
				stop (
						stringr::str_c(
								"timesplit should be one of :",
								"jour ",
								"day ",
								"month ",
								"mois ",
								"week ",
								"semaine ",
								"month ",
								"mois ",
								"quinzaine ",
								"2 weeks "
						)
				)
			# back to French labels for consistency with fun_report_mig_interannual code
			timesplit <-
					switch(
							timesplit,
							"day" = "jour",
							"week" = "semaine",
							"month" = "mois",
							"2 weeks" = "quinzaine",
							timesplit
					)
			
			# plot.type="line";require(ggplot2)
			
			if (nrow(report_mig_interannual@data) > 0) {
				
				if (plot.type == "line") {
					dat <- report_mig_interannual@data
					dat <- dat[dat$bjo_labelquantite == "Effectif_total", ]
					dat <- stacomirtools::chnames(
							dat,
							c(
									"bjo_annee",
									"bjo_jour",
									"bjo_labelquantite",
									"bjo_valeur"
							),
							c("annee", "jour", "labelquantite", "valeur")
					)
					# we need to choose a date, every year brought back to 2000
					dat$jour <- as.POSIXct(strptime(strftime(dat$jour,
											'2000-%m-%d %H:%M:%S'),
									format = '%Y-%m-%d %H:%M:%S'), tz = "GMT")
					dat$annee <- as.factor(dat$annee)
					dat <- stacomirtools::killfactor(dat)
					titre = paste(
							gettext("Migration "),
							paste(min(dat$annee), max(dat$annee), collapse = "-"),
							", ",
							paste(report_mig_interannual@dc@data$dis_commentaires[report_mig_interannual@dc@data$dc %in%
													report_mig_interannual@dc@dc_selected], collapse="+"),
							sep=""
					)
					soustitre = paste(
							report_mig_interannual@taxa@data[
									report_mig_interannual@taxa@data$tax_code %in% 
											report_mig_interannual@taxa@taxa_selected,
									"tax_nom_latin"],
							", ",
							report_mig_interannual@stage@data[
									report_mig_interannual@stage@data$std_code %in% 
											report_mig_interannual@stage@stage_selected,
									"std_libelle"],
							", ",
							sep = ""
					)
					g <- ggplot(dat, aes(x = jour, y = valeur))
					g <-
							g + geom_line(aes(color = annee)) + labs(title = paste(titre, "\n", soustitre)) +
							scale_x_datetime(name = "date", date_breaks = "1 month",
									date_labels = "%b") +
							theme_bw()
					print(g)
					assign("g", g, envir = envir_stacomi)
					if (!silent)
						funout(
								gettext(
										"Writing the graphical object into envir_stacomi environment : write g=get('g',envir_stacomi)\n",
										domain = "R-stacomiR"
								)
						)
					#----------------------------------------------
				} else if (plot.type == "standard") {
					dat = report_mig_interannual@data
					if (silent == FALSE) {
						the_choice <-
								as.numeric(
										select.list(
												choices = as.character(unique(dat$bjo_annee)[order(unique(dat$bjo_annee))]),
												preselect = as.character(max(dat$bjo_annee)),
												"choice annee",
												multiple = FALSE
										)
								)
					} else {
						the_choice <- max(dat$bjo_annee)
					}
					# dataset for current year
					dat0 <-
							fun_report_mig_interannual(dat, annee = NULL, timesplit = NULL)
					dat <-
							fun_report_mig_interannual(dat, annee = the_choice, timesplit = NULL)
					dat <-
							dat[dat$moyenne != 0, ] # pour des raisons graphiques on ne garde pas les effectifs nuls generes par fun_report_mig_interannual
					newdat <-
							dat[match(unique(as.character(dat$jour)), as.character(dat$jour)), ]
					newdat <-
							newdat[order(newdat$jour), ] # pour avoir les range sur l'ensemble des valeurs dispo et pas seult l'annee en cours
					amplitude = paste(min(as.numeric(as.character(dat$annee))), "-", max(as.numeric(as.character(dat$annee))), sep =
									"")
					if (length(the_choice) > 0) {
						vplayout <-
								function(x, y) {
							grid::viewport(layout.pos.row = x,
									layout.pos.col = y)
						}
						grid::grid.newpage()
						grid::pushViewport(grid::viewport(layout = grid::grid.layout(length(the_choice), 1, just =
														"center")))
						amplitudechoice <- paste(the_choice, '/', amplitude)
						tmp <- dat0[as.numeric(as.character(dat0$annee)) == the_choice, ]
						tmp$annee <- as.character(tmp$annee)
						g <- ggplot(newdat, aes(x = jour))
						g <-
								g + geom_ribbon(
										aes(
												ymin = mintab,
												ymax = maxtab,
												fill = "amplitude"
										),
										color = "grey20",
										alpha = 0.5
								)
						g <-
								g + geom_bar(
										aes(y = valeur, fill = I("orange")),
										position = "dodge",
										stat = "identity",
										color = "grey20",
										alpha = 0.8,
										data = tmp
								)
						g <-
								g + scale_fill_manual(
										name = eval(amplitudechoice),
										values = c("#35789C", "orange"),
										labels = c(
												gettext("Historical amplitude", domain = "R-StacomiR"),
												the_choice
										)
								)
						#g <- g+geom_point(aes(y=valeur,col=annee),data=tmp,pch=16,size=1)
						# moyenne interannuelle
						
						g <- g +	geom_line(aes(y = moyenne, col = I("#002743")), data = newdat)
						g <-
								g + geom_point(aes(y = moyenne, col = I("#002743")),
										size = 1.2,
										data = newdat)
						g <-
								g + scale_colour_manual(
										name = eval(amplitudechoice),
										values = c("#002743"),
										labels = c(stringr::str_c(
														gettext("Interannual mean\n", domain = "R-stacomiR"),
														amplitude
												))
								) +
								guides(fill = guide_legend(reverse = TRUE))
						g <-
								g + labs(
										title = paste(
												paste(report_mig_interannual@dc@dc_selected,collapse="+"),
												report_mig_interannual@taxa@data[
														report_mig_interannual@taxa@data$tax_code %in% 
																report_mig_interannual@taxa@taxa_selected,
														"tax_nom_latin"],
												",",
												report_mig_interannual@stage@data[
														report_mig_interannual@stage@data$std_code %in% 
																report_mig_interannual@stage@stage_selected,
														"std_libelle"],
												",",
												paste(newdat$annee),
												"/",
												amplitude
										)
								)
						g <-
								g + scale_x_datetime(
										name = "date",
										date_breaks = "months",
										date_minor_breaks = "weeks",
										date_labels = "%d-%m"
								)
						g <- g + theme_bw() + theme(legend.key = element_blank())
						print(g, vp = vplayout(1, 1))
						assign(paste("g", 1, sep = ""), g, envir_stacomi)
						if (!silent)
							funout(
									gettextf(
											"Writing the graphical object into envir_stacomi environment : write g=get(\"gi\",envir_stacomi) with i=%s",
											paste(1:length(the_choice), collapse = ",")
									)
							)
						
						
					} # end if plot==standard
					#----------------------------------------------
				} else if (plot.type == "step") {
					dat <- report_mig_interannual@data
					dat <- fun_report_mig_interannual(dat)
					# runs the default with daily migration
					#dat=dat[order(dat$annee,dat$jour),]
					dat$valeur[is.na(dat$valeur)] <-0 
					# otherwise if only one line it may crash
					if (silent == FALSE) {
						the_choice <- select.list(
								choices = as.character(unique(dat$annee)),
								preselect = as.character(max(dat$annee)),
								multiple = FALSE,
								title = gettext("Choose year", domain = "R-StacomirR")
						)
					} else {
						the_choice <- max(as.numeric(as.character(dat$annee)))
					}
					amplitude <- paste(min(as.numeric(as.character(dat$annee))),
							"-", max(as.numeric(as.character(dat$annee))), sep = "")
					#################
					# calculation of cumsums
					###################
					
					for (an in unique(dat$annee)) {
						# an=as.character(unique(dat$annee)) ;an<-an[1]
						dat[dat$annee == an, "cumsum"] <-
								cumsum(dat[dat$annee == an, "valeur"])
						dat[dat$annee == an, "total_annuel"] <-
								max(dat[dat$annee == an, "cumsum"])
					}
					dat$cumsum <- dat$cumsum / dat$total_annuel
					dat$jour <- as.Date(dat$jour)
					dat$annee <- as.factor(dat$annee)
					
					#################
					# plot
					###################
					
					g <- ggplot(dat, aes(x = jour, y = cumsum))
					tmp <-
							dat[as.numeric(as.character(dat$annee)) == as.numeric(the_choice), ]
					g <- g + geom_step(aes(col = annee, size = total_annuel))
					g <- g + geom_step(data = tmp,
							col = "black",
							lty = 2)
					g <-
							g + labs(
									title = gettextf(
											"%s, %s, %s cum %s",
											paste(report_mig_interannual@dc@dc_selected, collapse="+"),
											report_mig_interannual@taxa@data[
													report_mig_interannual@taxa@data$tax_code %in% 
															report_mig_interannual@taxa@taxa_selected,
													"tax_nom_latin"],
											report_mig_interannual@stage@data[
													report_mig_interannual@stage@data$std_code %in% 
															report_mig_interannual@stage@stage_selected,
													"std_libelle"],
											amplitude
									)
							)
					g <-
							g + scale_y_continuous(name = gettext("Annual migration percentage", domain =
													"R-stacomiR"))
					g <-
							g + scale_x_date(
									name = gettext("date", domain = "R-stacomiR"),
									date_breaks = "months",
									date_minor_breaks = "weeks",
									date_labels = "%b",
									limits = range(dat[dat$valeur > 0 &
															dat$cumsum != 1, "jour"])
							)# date
					g <-
							g + scale_colour_hue(
									name = gettext("year", domain = "R-stacomiR"),
									l = 70,
									c = 150
							)# annee
					print(g)
					assign("g", g, envir_stacomi)
					if (!silent)
						funout(
								gettext(
										"Writing the graphical object into envir_stacomi environment : write g=get('g',envir_stacomi)\n",
										domain = "R-stacomiR"
								)
						)
					#----------------------------------------------
				} else if (plot.type == "barchart") {
					dat = report_mig_interannual@data
					if (silent == FALSE) {
						the_choice = select.list(
								choices = as.character(unique(dat$bjo_annee)),
								preselect = as.character(max(dat$bjo_annee)),
								multiple = FALSE,
								title = gettext("Choose year", domain = "R-StacomiR")
						)
					} else {
						the_choice = max(as.numeric(as.character(dat$bjo_annee)))
					}
					dat0 <- fun_report_mig_interannual(dat, timesplit = timesplit)
					dat <-
							fun_report_mig_interannual(dat, annee = the_choice, timesplit = timesplit)
					prepare_dat <- function(dat) {
						dat <- dat[order(dat$annee, dat[, timesplit]), ]
						dat$annee <- as.factor(dat$annee)
						dat$keeptimesplit <- dat[, timesplit]
						if (timesplit == "mois") {
							dat[, timesplit] <- strftime(dat[, timesplit], format = "%m")
						} else if (timesplit == "quinzaine") {
							dat[, timesplit] <- strftime(dat[, timesplit], format = "%m/%d")
						} else {
							dat[, timesplit] <- strftime(dat[, timesplit], format = "%W")
						}
						dat[, timesplit] <- as.factor(dat[, timesplit])
						# we only keep one per week
						newdat <- dat[match(unique(dat[, timesplit]), dat[, timesplit]), ]
						newdat <-
								newdat[order(newdat[, "keeptimesplit"]), ] # pour avoir les range sur l'ensemble des valeurs dispo et pas seult l'annee en cours
						# here change 12/2012 the geom_crossbar now needs a factor, label change according to timesplit
						newdat[, timesplit] <- as.factor(newdat[, timesplit])
						levels(newdat[, timesplit]) <-
								newdat[, timesplit] # to have the factor in the right order from january to dec
						return(newdat)
					}
					amplitude <- paste(min(as.numeric(as.character(dat$annee))),
							"-",
							max(as.numeric(as.character(dat$annee))),
							sep = "")
					
					newdat <- prepare_dat(dat)
					newdat0 <- prepare_dat(dat0)
					if (length(the_choice) > 0) {
						# le layout pour l'affichage des graphiques
						vplayout <-
								function(x, y) {
							grid::viewport(layout.pos.row = x,
									layout.pos.col = y)
						}
						grid::grid.newpage()
						grid::pushViewport(grid::viewport(layout =
												grid::grid.layout(length(the_choice), 1, just = "center")))
						selection <-
								as.numeric(as.character(dat0$annee)) == as.numeric(the_choice)
						tmp <- dat0[selection, ]
						tmp[tmp$valeur >= tmp$moyenne, "comp"] <- ">=moy"
						tmp[tmp$valeur < tmp$moyenne, "comp"] <- "<moy"
						suppressWarnings({
									tmp[tmp$valeur == tmp$maxtab, "comp"] <- "max"
									tmp[tmp$valeur == tmp$mintab, "comp"] <- "min"
								})
						tmp[tmp$moyenne == 0, "comp"] <- "0"
						
						tmp$annee <- as.factor(as.numeric(as.character(tmp$annee)))
						if (timesplit == "mois") {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%m")
						} else if (timesplit == "quinzaine") {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%m/%d")
						} else {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%W")
						}
						tmp[, timesplit] <- as.factor(tmp[, timesplit])
						tmp[!tmp[, timesplit] %in% newdat[, timesplit], "comp"] <- "?"
						newdat$comp <- NA
						
						g <- ggplot(tmp, aes_string(x = timesplit, y = "valeur"))
						g <- g + geom_crossbar(
								data = newdat,
								aes_string(
										x = timesplit,
										y = "moyenne",
										ymin = "mintab",
										ymax = "maxtab"
								),
								fill = "grey60",
								alpha = 0.5,
								size = 0.5,
								fatten = 3,
								col = "grey60"
						)
						g <-
								g + geom_bar(
										stat = "identity",
										aes_string(y = "valeur", col = "comp"),
										fill = NA,
										width = 0.6
								)
						g <-
								g + geom_bar(
										stat = "identity",
										aes_string(y = "valeur", fill = "comp"),
										alpha = 0.5,
										width = 0.6
								)
						#g <- g+scale_x_date(name=paste("mois"),breaks="month",minor_breaks=getvalue(new("ref_period"),label=date_format("%b"),timesplit))
						#lim=as.POSIXct(c(Hmisc::truncPOSIXt((min(tmp[tmp$com!="0",timesplit])),"month")-delai,
						#				Hmisc::ceil((max(tmp[tmp$com!="0",timesplit])),"month")+delai))
						# pb the limit truncs the value
						g <- g + ylab("effectif")
						cols <- c(
								"max" = "#000080",
								"min" = "#BF0000",
								">=moy" = "darkgreen",
								"<moy" = "darkorange",
								"hist_mean" = "black",
								"hist_range" = "grey",
								"?" = "darkviolet"
						)
						fills <- c(
								"max" = "blue",
								"min" = "red",
								">=moy" = "green",
								"<moy" = "orange",
								"hist_mean" = "black",
								"hist_range" = "grey",
								"?" = "violet"
						)
						
						g <- g + scale_colour_manual(
								name = the_choice,
								values = cols,
								limits = c(
										"min",
										"max",
										"<moy",
										">=moy",
										"hist_mean",
										"hist_range",
										"?"
								)
						)
						g <- g + scale_fill_manual(
								name = the_choice,
								values = fills,
								limits = c(
										"min",
										"max",
										"<moy",
										">=moy",
										"hist_mean",
										"hist_range",
										"?"
								)
						)
						
						g <-
								g + labs(
										title = paste(		report_mig_interannual@taxa@data[
														report_mig_interannual@taxa@data$tax_code %in% 
																report_mig_interannual@taxa@taxa_selected,
														"tax_nom_latin"],
												",",
												report_mig_interannual@stage@data[
														report_mig_interannual@stage@data$std_code %in% 
																report_mig_interannual@stage@stage_selected,
														"std_libelle"],
												", bilan par",
												timesplit,
												unique(as.character(tmp$annee)),
												"/",
												amplitude
										)
								)
						g <- g + theme_minimal()
						print(g, vp = vplayout(1, 1))
						assign(paste("g", 1, sep = ""), g, envir_stacomi)
						if (!silent)
							funout(
									gettextf(
											"\"Writing the graphical object into envir_stacomi environment : write g=get(\"gi\",envir_stacomi) with i=%s",
											paste(1:length(the_choice), collapse = ",")
									)
							)
						
					} # end if
					
					#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
				} else if (plot.type == "pointrange") {
					# below before several plots could be made, it's no longer the case
					# as I remove the chosen year from the observation (reference) set
					dat = report_mig_interannual@data
					
					if (silent == FALSE) {
						the_choice <-
								select.list(
										choices = as.character(unique(dat$bjo_annee)),
										preselect = as.character(max(dat$bjo_annee)),
										"choice annee",
										multiple = FALSE
								)
					} else {
						the_choice <- max(dat$bjo_annee)
					}
					dat0 <- fun_report_mig_interannual(dat, timesplit = timesplit)
					dat <-
							fun_report_mig_interannual(dat, annee = the_choice, timesplit = timesplit)
					dat$annee <- as.factor(dat$annee)
					dat <- dat[order(dat$annee, dat[, timesplit]), ]
					dat$keeptimesplit <- dat[, timesplit]
					if (timesplit == "mois") {
						dat[, timesplit] <- strftime(dat[, timesplit], format = "%m")
					} else if (timesplit == "quinzaine") {
						dat[, timesplit] <- strftime(dat[, timesplit], format = "%m/%d")
					} else {
						dat[, timesplit] <- strftime(dat[, timesplit], format = "%W")
					}
					dat[, timesplit] <- as.factor(dat[, timesplit])
					
					# dat=dat[dat$moyenne!=0,] # pour des raisons graphiques on ne garde pas les effectifs nuls generes par fun_report_mig_interannual
					newdat <- dat[match(unique(dat[, timesplit]), dat[, timesplit]), ]
					newdat <-
							newdat[order(newdat[, "keeptimesplit"]), ] # il peut y avoir des annees pour le calcul de range qui s'ajoutent
					# et viennent d'autres annees, il faut donc reordonner.
					
					
					amplitude <-
							paste(min(as.numeric(as.character(dat$annee))), "-", max(as.numeric(as.character(dat$annee))), sep =
											"")
					
					
					if (length(the_choice) > 0) {
						# le layout pour l'affichage des graphiques
						vplayout <-
								function(x, y) {
							grid::viewport(layout.pos.row = x,
									layout.pos.col = y)
						}
						grid::grid.newpage()
						grid::pushViewport(grid::viewport(layout = grid::grid.layout(length(the_choice), 1, just =
														"center")))
						
						selection <-
								as.numeric(as.character(dat0$annee)) == as.numeric(the_choice)
						tmp <- dat0[selection, ]
						tmp[tmp$valeur >= tmp$moyenne, "comp"] <- ">=moy"
						tmp[tmp$valeur < tmp$moyenne, "comp"] <- "<moy"
						suppressWarnings({
									tmp[tmp$valeur == tmp$maxtab, "comp"] <- "max"
									tmp[tmp$valeur == tmp$mintab, "comp"] <- "min"
								})
						tmp[tmp$moyenne == 0, "comp"] <- "0"
						tmp$annee = as.factor(as.numeric(as.character(tmp$annee)))
						if (timesplit == "mois") {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%m")
						} else if (timesplit == "quinzaine") {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%m/%d")
						} else {
							tmp[, timesplit] <- strftime(tmp[, timesplit], format = "%W")
						}
						tmp[, timesplit] <- as.factor(tmp[, timesplit])
						tmp[!tmp[, timesplit] %in% newdat[, timesplit], "comp"] <- "?"
						newdat$comp <- NA
						g <- ggplot(tmp, aes_string(x = timesplit, y = "valeur"))
						g <-
								g + geom_dotplot(
										aes_string(x = timesplit, y = "valeur"),
										data = dat,
										stackdir = "center",
										binaxis = "y",
										position = "dodge",
										dotsize = 0.5,
										fill = "wheat"
								) #position = "dodge",dotsize = 0.4,alpha=0.5,binwidth = 1.5
						g <-
								g + geom_pointrange(
										data = newdat,
										aes_string(
												x = timesplit,
												y = "moyenne",
												ymin = "mintab",
												ymax = "maxtab"
										),
										alpha = 1,
										size = 0.8
								)
						g <-
								g + geom_bar(stat = "identity",
										aes_string(y = "valeur", fill = "comp"),
										alpha = 0.6)
						g <- g + scale_y_continuous(name = "effectif")
						cols <-
								c(
										"max" = "blue",
										"min" = "red",
										">=moy" = "darkgreen",
										"<moy" = "darkorange",
										"0" = "grey10",
										"?" = "darkviolet"
								)
						g <- g + scale_fill_manual(name = the_choice, values = cols)
						g <-
								g + labs(
										title = paste(
												report_mig_interannual@taxa@data[
														report_mig_interannual@taxa@data$tax_code %in% 
																report_mig_interannual@taxa@taxa_selected,
														"tax_nom_latin"],
												",",
												report_mig_interannual@stage@data[
														report_mig_interannual@stage@data$std_code %in% 
																report_mig_interannual@stage@stage_selected,
														"std_libelle"],
												", report par",
												timesplit,
												unique(as.character(tmp$annee)),
												"/",
												amplitude
										)
								)
						g <- g + theme_minimal()
						print(g, vp = vplayout(1, 1))
						assign(paste("g", 1, sep = ""), g, envir_stacomi)
						if (!silent)
							funout(
									gettextf(
											"\"Writing the graphical object into envir_stacomi environment : write g=get(\"gi\",envir_stacomi) with i=%s",
											paste(1:length(the_choice), collapse = ",")
									)
							)
						
					} # end if
					#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
				} else if (plot.type == "density") {
					if (nrow(report_mig_interannual@data) > 0)
					{
						timesplit = "quinzaine"
						dat <- report_mig_interannual@data
						dat <- fun_report_mig_interannual(dat, annee = NULL, timesplit)
						dat$annee <- as.factor(dat$annee)
						sum_per_year <- tapply(dat$valeur, dat$annee, sum)
						sum_per_year <-
								data.frame(annee = names(sum_per_year),
										sum_per_year = sum_per_year)
						dat <- merge(dat, sum_per_year, by = "annee")
						dat$std_valeur <- dat$valeur / dat$sum_per_year
						all_15 <- unique(dat[, timesplit])
						# below I'm adding 0 instead of nothing for 15 days without value
						for (i in 1:length(unique(dat$annee))) {
							#i=5
							annee <- unique(dat$annee)[i]
							this_year_15 <- unique(dat[dat$annee == annee, timesplit])
							missing <- all_15[!all_15 %in% this_year_15]
							if (length(missing >= 1)) {
								missingdat <- data.frame(
										"annee" = annee,
										"quinzaine" = missing,
										"valeur" = 0,
										"maxtab" = 0,
										"mintab" = 0,
										"moyenne" = 0,
										"sum_per_year" = 0,
										"std_valeur" = 0
								)
								dat <- rbind(dat, missingdat)
							}
						}
						dat = dat[order(dat$annee, dat[, timesplit]), ]
						g <- ggplot(dat, aes_string(x = timesplit, y = "std_valeur"))
						g <-
								g + geom_area(aes_string(y = "std_valeur", fill = "annee"), position =
												"stack")
						g <-
								g + scale_x_datetime(
										name = paste("mois"),
										date_breaks = "month",
										date_minor_breaks = getvalue(new("ref_period"), timesplit),
										date_labels = "%b",
										limits = as.POSIXct(c(
														Hmisc::truncPOSIXt((min(dat[dat$valeur != 0, timesplit])), "month"),
														Hmisc::ceil((max(dat[dat$valeur != "0", timesplit])), "month")
												))
								)
						g <-
								g + scale_y_continuous(name = "Somme des pourcentages annuels de migration par quinzaine")
						cols <- grDevices::rainbow(length(levels(dat$annee)))
						g <- g + scale_fill_manual(name = "annee", values = cols)
						g <-
								g + labs(
										title = paste(
												paste(report_mig_interannual@dc@dc_selected,collapse=" + "),
												report_mig_interannual@taxa@data[
														report_mig_interannual@taxa@data$tax_code %in% 
																report_mig_interannual@taxa@taxa_selected,
														"tax_nom_latin"],
												",",
												report_mig_interannual@stage@data[
														report_mig_interannual@stage@data$std_code %in% 
																report_mig_interannual@stage@stage_selected,
														"std_libelle"],
												", saisonnalite de la migration"
										)
								)
						g <- g + theme_minimal()
						print(g)
						assign(paste("g", sep = ""), g, envir_stacomi)
						if (!silent)
							funout(
									gettext(
											"Writing the graphical object into envir_stacomi environment : write g=get('g',envir_stacomi)\n",
											domain = "R-stacomiR"
									)
							)
						
					}    else     {
						if (!silent)
							funout(
									gettext(
											"Warning : you have to complete a migration summary for at least one of the selected year before launching a inter-annual summary",
											domain = "R-stacomiR"
									)
							)
					}
					#####################################################################
				} else if (plot.type == "seasonal") {
					if (!silent)
						funout("Seasonal graph to show the phenology of migration")
					#report_mig_interannual<-r_mig_interannual_vichy;silent=FALSE;timesplit="mois";require(ggplot2)
					report_mig_interannual <-
							calcule(report_mig_interannual, timesplit = timesplit)
					#if (!silent& nrow(report_mig_interannual@calcdata)==0) stop("You should run calculation before plotting seasonal data")
					dat3 <- report_mig_interannual@calcdata
					datadic <- report_mig_interannual@data
					datadic <-
							fun_date_extraction(
									datadic,
									nom_coldt = "bjo_jour",
									jour_an = TRUE,
									quinzaine = TRUE
							)
					datadic <- chnames(datadic, "jour_365", "jour")
					datadic <- killfactor(datadic)
					#datadic[,timesplit]<-as.numeric(datadic[,timesplit])
					# to get nicer graphs we don't use a "numeric but transform our data into dates
					# this function takes a vector of column as argument (col), a timesplit argument
					# and a year. So far it does not handle quinzaine so will issue an error if quinzaine is selected
					dat3[, c("Q0", "Q5", "Q50", "Q95", "Q100", "d90")] <-
							round(dat3[, c("Q0", "Q5", "Q50", "Q95", "Q100", "d90")])
					fn_getbacktodate <- function(dat, col, timesplit_, year = 2000) {
						for (i in 1:length(col)) {
							dat[, col[i]] <- switch(
									timesplit_,
									"jour" = {
										as.Date(paste(year, "-", dat[, col[i]], sep = ""), "%Y-%j")
									},
									"semaine" = {
										as.Date(paste(year, "-", dat[, col[i]], "-", 6, sep = ""), "%Y-%U-%w")
									},
									"mois" = {
										as.Date(paste(year, "-", dat[, col[i]], "-", 1, sep = ""), "%Y-%m-%d")
									},
									stop(
											stringr::str_c(
													"Internal error, timesplit ",
													timesplit_,
													" not working for seasonal plot"
											)
									)
							)
						}
						return(dat)
					}
					datadic <- fn_getbacktodate(dat = datadic,
							col = timesplit,
							timesplit_ = timesplit)
					dat3 <- fn_getbacktodate(
							dat = dat3,
							col = c("Q0", "Q5", "Q50", "Q95", "Q100", "d90"),
							timesplit_ = timesplit
					)
					
					datadic1 <-
							dplyr::select(datadic,
									{{timesplit}},
									bjo_annee,
									bjo_valeur,
									bjo_labelquantite)
					datadic1 <-
							dplyr::group_by(datadic1, bjo_annee, dplyr::across(dplyr::all_of(timesplit)), bjo_labelquantite)
					datadic1 <- dplyr::summarize(datadic1, bjo_valeur = sum(bjo_valeur))
					datadic1 <-
							dplyr::ungroup(datadic1) %>% dplyr::filter(bjo_labelquantite == "Effectif_total")
					g <- ggplot(data = datadic1) +
							geom_rect(
									aes(
											xmin = Q0,
											xmax = Q100,
											ymin = year - 0.5,
											ymax = year + 0.5
									),
									fill = "grey90",
									data = dat3
							) +
							geom_tile(
									aes_string(x = timesplit, y = "bjo_annee", fill = "bjo_valeur"),
									color = ifelse(timesplit == "jour", "transparent", "grey80")
							) +
							scale_fill_distiller(palette = "Spectral", name = "Effectif") +
							geom_path(
									aes(x = Q50, y = year),
									col = "black",
									lty = 2,
									data = dat3
							) +
							geom_point(
									aes(x = Q50, y = year),
									col = "black",
									size = 2,
									data = dat3
							) +
							geom_errorbarh(
									aes(											
											y = year,
											xmin = Q5,
											xmax = Q95
									),
									height = 0,
									data = dat3,
									col = "black"
							) +
							ylab(Hmisc::capitalize(gettext("year", domain = "R-stacomiR"))) +
							xlab(Hmisc::capitalize({{timesplit}})) +
							scale_x_date(
									name = timesplit,
									date_breaks = "month",
									date_minor_breaks = getvalue(new("ref_period"), {{timesplit}}),
									date_labels = "%b"
							) +
							theme_bw()
					print(g)
					assign("g", g, envir = envir_stacomi)
					if (!silent)
						funout(
								gettext(
										"Writing the graphical object into envir_stacomi environment : write g=get('g',envir_stacomi)\n",
										domain = "R-stacomiR"
								)
						)
					
				}
				
				else {
					# end if
					stop ("plot.type argument invalid")
				}
				
			}    else     {
				if (!silent)
					funout(
							gettext(
									"Attention : you have to complete a migration summary for at least one of the selected year before launching a inter-annual summary",
									domain = "R-stacomiR"
							)
					)
			}
			return(invisible(NULL))	
		}
)



#' summary for report_mig_interannual
#' provides summary statistics for the latest year (if silent=TRUE), or the year selected in the interface,
#' if silent=FALSE. Mean, min and max are historical statistics with the selected year excluded from the
#' historical dataset.
#' @param object An object of class \code{\link{report_mig_interannual-class}}
#' @param year_choice The year chosen to calculate statistics which will be displayed beside the historical series, 
#' @param silent Should the program stay silent or display messages, default FALSE
#' @param ... Additional parameters (not used there)
#' @author Cedric Briand \email{cedric.briand@eptb-vilaine.fr}
#' @aliases summary.report_mig_interannual
#' @return A list, one element per DC
#' @export
setMethod(
		"summary",
		signature = signature(object = "report_mig_interannual"),
		definition = function(object, year_choice=NULL, silent = FALSE, ...) {
			# table generated with funtable
			# TODO traitement des poids
			#object<-r_mig_interannual
			dat = object@data
			dat <- dat[dat$bjo_labelquantite == "Effectif_total", ]
			dat <-
					stacomirtools::chnames(
							dat,
							c(
									"bjo_dis_identifiant",
									"bjo_tax_code",
									"bjo_std_code",
									"bjo_annee",
									"bjo_jour",
									"bjo_labelquantite",
									"bjo_valeur",
									"bjo_horodateexport"
							),
							c(
									"DC",
									"Taxon",
									"Stade",
									"Annee",
									"Jour",
									"Label_quantite",
									"Nombre",
									"Date d'export du report"
							)
					)
			dat$Annee <- as.factor(dat$Annee)
			dat <- dat[, -1]
			tmp <- dat$Jour
			DC <- object@dc@dc_selected
			dat <- chnames(dat, "Jour", "debut_pas")
			# debut_pas must be column name in tableau
			listDC <- list()
			for (i in 1:length(DC)) {
				# this table will write an html table of data
				funtable(
						tableau = dat[dat$bjo_dis_identifiant == DC, ],
						time.sequence = tmp,
						taxa = object@taxa@data[object@taxa@data$tax_code %in% object@taxa@taxa_selected, "tax_nom_latin"],
						stage = object@stage@data[object@stage@data$std_code %in% object@stage@stage_selected, "std_libelle"],
						DC[i],
						resum = NULL,
						silent = silent
				)
				# Summary statistics
				dat = object@data
				if (is.null(year_choice)){
					if (silent == FALSE) {
						the_choice <- as.numeric(
								select.list(
										choices = as.character(unique(dat$bjo_annee)[order(unique(dat$bjo_annee))]),
										preselect = as.character(max(dat$bjo_annee)),
										"choice annee",
										multiple = FALSE
								)
						)
					} else {
						the_choice <- max((dat$bjo_annee))
					}
				} else {
					if (!year_choice%in%unique(dat$bjo_annee)) {
						stop(paste("The chosen year",year_choice,"should be in available years : ", 
										paste(as.character(unique(dat$bjo_annee)[order(unique(dat$bjo_annee))]), collapse=",")))
					}
					the_choice <- as.numeric(year_choice)
				}
				# we use the function that split data per time stamp to generate the full sequence of monthly data
				dat <-
						fun_report_mig_interannual(dat[dat$bjo_dis_identifiant == DC[i], ], timesplit =
										"mois")
				# then we extract only current year for summary
				colnames(dat)[colnames(dat) == "maxtab"] <- "max"
				colnames(dat)[colnames(dat) == "mintab"] <- "min"
				dat <- dat[dat$annee == the_choice, ]
				dat$mois <- strftime(dat$mois, "%b")
				dat$moyenne <- round(dat$moyenne)
				dat <- dat[, c("annee", "mois", "min", "moyenne", "max", "valeur")]
				colnames(dat) <- c("annee", "mois", "min", "mean", "max", "valeur")
				listDC[[as.character(DC[i])]] <- dat
			}# end for
			return(listDC)
		}
)