[Stacomir-commits] r553 - pkg/stacomir/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 25 16:12:56 CEST 2019
Author: briand
Date: 2019-10-25 16:12:56 +0200 (Fri, 25 Oct 2019)
New Revision: 553
Modified:
pkg/stacomir/R/report_mig.R
pkg/stacomir/R/report_mig_interannual.R
Log:
Now having just one month creates problems when calculating quantiles. Handled here !
Modified: pkg/stacomir/R/report_mig.R
===================================================================
--- pkg/stacomir/R/report_mig.R 2019-10-25 13:46:13 UTC (rev 552)
+++ pkg/stacomir/R/report_mig.R 2019-10-25 14:12:56 UTC (rev 553)
@@ -628,8 +628,7 @@
dc=as.numeric(report_mig at dc@dc_selectionne)[1]
data=report_mig at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
# keep one line if there is one species in one day with as much up as down...
- if (nrow(data)>1)
- data=data[data$Effectif_total!=0,]
+ if (nrow(data)>1) data=data[data$Effectif_total!=0,]
jour_dans_lannee_non_nuls=data$debut_pas
col_a_retirer=match(c("No.pas","type_de_quantite","debut_pas","fin_pas"),colnames(data))
col_a_retirer=col_a_retirer[!is.na(col_a_retirer)] # as in the case of glass eel and weight
@@ -643,7 +642,7 @@
data$coe_valeur_coefficient[data$"coe_valeur_coefficient"==1]<-NA
}else {data$coe_valeur_coefficient<-NA}
cannotbenull=match(c("taux_d_echappement","coe_valeur_coefficient"),colnames(data))
- data[,-cannotbenull][data[,-cannotbenull]==0]<-NA
+ if (nrow(data)>1) data[,-cannotbenull][data[,-cannotbenull]==0]<-NA
annee<-as.numeric(unique(strftime(as.POSIXlt(report_mig at time.sequence),"%Y"))[1])
if ("Poids_total"%in%colnames(data)){
aat_reportmigrationjournalier_bjo=cbind(
Modified: pkg/stacomir/R/report_mig_interannual.R
===================================================================
--- pkg/stacomir/R/report_mig_interannual.R 2019-10-25 13:46:13 UTC (rev 552)
+++ pkg/stacomir/R/report_mig_interannual.R 2019-10-25 14:12:56 UTC (rev 553)
@@ -28,34 +28,34 @@
#' @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()
- )
+ 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 at taxa@data$tax_code)==1,TRUE,gettext("report_mig_interannual can only take one taxa", domain="R-stacomiR"))
- # same for stage
- rep2=ifelse(length(object at stage@data$std_code)==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)]))
- }
+ {
+ # 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 at taxa@data$tax_code)==1,TRUE,gettext("report_mig_interannual can only take one taxa", domain="R-stacomiR"))
+ # same for stage
+ rep2=ifelse(length(object at stage@data$std_code)==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)]))
+ }
)
@@ -76,118 +76,118 @@
#' @aliases connect.report_mig_interannual
#' @export
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)
- #---------------------------------------------------------------------------------------
- fn_connect<-function(){
- les_annees = (object at start_year@annee_selectionnee):(object at end_year@annee_selectionnee)
- tax = object at taxa@data$tax_code
- std = object at stage@data$std_code
- dic= object at dc@dc_selectionne
- requete=new("RequeteODBCwhere")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at 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 at select=paste("SELECT * FROM ",rlang::env_get(envir_stacomi, "sch"),"t_bilanmigrationjournalier_bjo",sep="")
- requete at order_by=" ORDER BY bjo_jour "
- requete<-stacomirtools::connect(requete)
- data<- stacomirtools::killfactor(requete at query)
- }
- object at data<-fn_connect()
- if (nrow(object at 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 at dc@dc_selectionne
- 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 at data[report_annual at data$ope_dic_identifiant==dic[i],c("effectif","annee")]
- # data from report_migInterannuel
- data2<-object at data[object at 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 at start_year@annee_selectionnee&
- compared_numbers$annee<=object at end_year@annee_selectionnee,]
-
+ 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)
+ #---------------------------------------------------------------------------------------
+ fn_connect<-function(){
+ les_annees = (object at start_year@annee_selectionnee):(object at end_year@annee_selectionnee)
+ tax = object at taxa@data$tax_code
+ std = object at stage@data$std_code
+ dic= object at dc@dc_selectionne
+ requete=new("RequeteODBCwhere")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ requete at 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 at select=paste("SELECT * FROM ",rlang::env_get(envir_stacomi, "sch"),"t_bilanmigrationjournalier_bjo",sep="")
+ requete at order_by=" ORDER BY bjo_jour "
+ requete<-stacomirtools::connect(requete)
+ data<- stacomirtools::killfactor(requete at query)
+ }
+ object at data<-fn_connect()
+ if (nrow(object at 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 at dc@dc_selectionne
+ 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 at data[report_annual at data$ope_dic_identifiant==dic[i],c("effectif","annee")]
+ # data from report_migInterannuel
+ data2<-object at data[object at 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 at start_year@annee_selectionnee&
+ compared_numbers$annee<=object at end_year@annee_selectionnee,]
+
#-------------------------------------------------------------------------------------
# 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 at taxa@data$tax_nom_latin,
- stage=object at stage@data$std_code,
- 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 at 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 at data<-fn_connect()
- compared_numbers<-fn_check()
-
- } # end if any...
-
+ 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 at taxa@data$tax_nom_latin,
+ stage=object at stage@data$std_code,
+ 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 at 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 at 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
@@ -195,74 +195,74 @@
# 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 at taxa@data$tax_code==2038 & object at stage@data$std_code=="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(compared_numbers$effectif==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(h,...){
- 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 at taxa@data$tax_nom_latin,
- stage=object at stage@data$std_code,
- 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 at data)>0 ){
- # check for bjo will ensure that previous report are deleted
- write_database(bM,silent=silent,check_for_bjo=TRUE)
- }
- } # end for loop to write new reports
- # the data are loaded again
- object at 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 h confirm function
- #==================================
-
- if (!silent){
- choice2<-gWidgets::gconfirm(gettextf("Some data differ between t_reportjournalier_bjo table, this means that they have been changed after the last report_mig was run,
- do you want to load them again for calculation ?",domain="R-StacomiR"),
- handler=reload_years_with_error)
- } else {
- reload_years_with_error(h=NULL)
- }
- } # secondary check
- } # end for
- } # end check
+
+ if (object at taxa@data$tax_code==2038 & object at stage@data$std_code=="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(compared_numbers$effectif==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(h,...){
+ 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 at taxa@data$tax_nom_latin,
+ stage=object at stage@data$std_code,
+ 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 at data)>0 ){
+ # check for bjo will ensure that previous report are deleted
+ write_database(bM,silent=silent,check_for_bjo=TRUE)
+ }
+ } # end for loop to write new reports
+ # the data are loaded again
+ object at 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 h confirm function
+ #==================================
+
+ if (!silent){
+ choice2<-gWidgets::gconfirm(gettextf("Some data differ between t_reportjournalier_bjo table, this means that they have been changed after the last report_mig was run,
+ do you want to load them again for calculation ?",domain="R-StacomiR"),
+ handler=reload_years_with_error)
+ } else {
+ reload_years_with_error(h=NULL)
+ }
+ } # secondary check
+ } # end for
+ } # end check
#-------------------------------------------------------------------------------------
# Final check for data
# index of data already present in the database
#-------------------------------------------------------------------------------------
- les_annees=object at start_year@annee_selectionnee:object at end_year@annee_selectionnee
- index=unique(object at data$bjo_annee) %in% les_annees
+ les_annees=object at start_year@annee_selectionnee:object at end_year@annee_selectionnee
+ index=unique(object at 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 this 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("Annual migrations query completed",domain="R-stacomiR"),
- paste(les_annees[index],collapse=","), "\n"))
- }
- }
- return(object)
- }
+ if (!silent){
+ if (length(les_annees[!index])>0)
+ {
+ funout(paste(gettext("Attention, there is no migration summary for this 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("Annual migrations query completed",domain="R-stacomiR"),
+ paste(les_annees[index],collapse=","), "\n"))
+ }
+ }
+ return(object)
+ }
)
#' supprime method for report_mig_interannual class
@@ -273,27 +273,27 @@
#' @export
setMethod("supprime",signature=signature("report_mig_interannual"),
- definition=function(object)
- {
- # recuperation des annees taxa et stage concernes
- les_annees = (object at start_year@annee_selectionnee):(object at end_year@annee_selectionnee)
- tax = object at taxa@data$tax_code
- std = object at stage@data$std_code
- dic= object at dc@dc_selectionne
- requete=new("RequeteODBCwhere")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at select=stringr::str_c("DELETE from ",rlang::env_get(envir_stacomi, "sch"),"t_bilanmigrationjournalier_bjo ")
- requete at where=paste("WHERE bjo_annee IN (",paste(les_annees,collapse=","),") AND bjo_tax_code='",tax,"' AND bjo_std_code='",std,"' AND bjo_dis_identifiant=",dic,sep="")
- invisible(utils::capture.output(requete<-stacomirtools::connect(requete)))
-
- requete=new("RequeteODBCwhere")
- requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
- requete at select=stringr::str_c("DELETE from ",rlang::env_get(envir_stacomi, "sch"),"t_reportmigrationmensuel_bme ")
- requete at where=paste("WHERE bme_annee IN (",paste(les_annees,collapse=","),") AND bme_tax_code='",tax,"' AND bme_std_code='",std,"' AND bme_dis_identifiant=",dic,sep="")
- invisible(utils::capture.output(requete<-stacomirtools::connect(requete)))
-
- return(invisible(NULL))
- }
+ definition=function(object)
+ {
+ # recuperation des annees taxa et stage concernes
+ les_annees = (object at start_year@annee_selectionnee):(object at end_year@annee_selectionnee)
+ tax = object at taxa@data$tax_code
+ std = object at stage@data$std_code
+ dic= object at dc@dc_selectionne
+ requete=new("RequeteODBCwhere")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ requete at select=stringr::str_c("DELETE from ",rlang::env_get(envir_stacomi, "sch"),"t_bilanmigrationjournalier_bjo ")
+ requete at where=paste("WHERE bjo_annee IN (",paste(les_annees,collapse=","),") AND bjo_tax_code='",tax,"' AND bjo_std_code='",std,"' AND bjo_dis_identifiant=",dic,sep="")
+ invisible(utils::capture.output(requete<-stacomirtools::connect(requete)))
+
+ requete=new("RequeteODBCwhere")
+ requete at baseODBC<-get("baseODBC",envir=envir_stacomi)
+ requete at select=stringr::str_c("DELETE from ",rlang::env_get(envir_stacomi, "sch"),"t_reportmigrationmensuel_bme ")
+ requete at where=paste("WHERE bme_annee IN (",paste(les_annees,collapse=","),") AND bme_tax_code='",tax,"' AND bme_std_code='",std,"' AND bme_dis_identifiant=",dic,sep="")
+ invisible(utils::capture.output(requete<-stacomirtools::connect(requete)))
+
+ return(invisible(NULL))
+ }
)
@@ -306,42 +306,42 @@
#' @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 at 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 at 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 at 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 at 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 at 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)
- }
+ definition=function(object,silent=FALSE)
+ {
+ report_mig_interannual<-object
+ if (exists("ref_dc",envir_stacomi)) {
+ report_mig_interannual at 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 at 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 at 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 at 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 at 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
@@ -359,40 +359,40 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("choice_c",signature=signature("report_mig_interannual"),definition=function(object,
- dc,
- taxa,
- stage,
- anneedebut,
- anneefin,
- silent=FALSE){
- # code for debug using example
- #report_mig_interannual<-r_mig_interannual;dc=c(16);taxa="Anguilla anguilla";stage=c("AGJ");anneedebut="1984";anneefin="2016"
- report_mig_interannual<-object
- report_mig_interannual at dc=charge(report_mig_interannual at dc)
- # loads and verifies the dc
- # this will set dc_selectionne slot
- report_mig_interannual at dc<-choice_c(object=report_mig_interannual at dc,dc)
- # only taxa present in the report_mig are used
- report_mig_interannual at taxa<-charge_with_filter(object=report_mig_interannual at taxa,report_mig_interannual at dc@dc_selectionne)
- report_mig_interannual at taxa<-choice_c(report_mig_interannual at taxa,taxa)
- report_mig_interannual at stage<-charge_with_filter(object=report_mig_interannual at stage,report_mig_interannual at dc@dc_selectionne,report_mig_interannual at taxa@data$tax_code)
- report_mig_interannual at stage<-choice_c(report_mig_interannual at 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 at start_year<-charge(object=report_mig_interannual at start_year,
- objectreport="report_mig_interannual")
- report_mig_interannual at start_year<-choice_c(object=report_mig_interannual at start_year,
- nomassign="start_year",
- annee=anneedebut,
- silent=silent)
- report_mig_interannual at end_year@data<-report_mig_interannual at start_year@data
- report_mig_interannual at end_year<-choice_c(object=report_mig_interannual at end_year,
- nomassign="end_year",
- annee=anneefin,
- silent=silent)
- assign("report_mig_interannual",report_mig_interannual,envir=envir_stacomi)
- return(report_mig_interannual)
- })
+ dc,
+ taxa,
+ stage,
+ anneedebut,
+ anneefin,
+ silent=FALSE){
+ # code for debug using example
+ #report_mig_interannual<-r_mig_interannual;dc=c(16);taxa="Anguilla anguilla";stage=c("AGJ");anneedebut="1984";anneefin="2016"
+ report_mig_interannual<-object
+ report_mig_interannual at dc=charge(report_mig_interannual at dc)
+ # loads and verifies the dc
+ # this will set dc_selectionne slot
+ report_mig_interannual at dc<-choice_c(object=report_mig_interannual at dc,dc)
+ # only taxa present in the report_mig are used
+ report_mig_interannual at taxa<-charge_with_filter(object=report_mig_interannual at taxa,report_mig_interannual at dc@dc_selectionne)
+ report_mig_interannual at taxa<-choice_c(report_mig_interannual at taxa,taxa)
+ report_mig_interannual at stage<-charge_with_filter(object=report_mig_interannual at stage,report_mig_interannual at dc@dc_selectionne,report_mig_interannual at taxa@data$tax_code)
+ report_mig_interannual at stage<-choice_c(report_mig_interannual at 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 at start_year<-charge(object=report_mig_interannual at start_year,
+ objectreport="report_mig_interannual")
+ report_mig_interannual at start_year<-choice_c(object=report_mig_interannual at start_year,
+ nomassign="start_year",
+ annee=anneedebut,
+ silent=silent)
+ report_mig_interannual at end_year@data<-report_mig_interannual at start_year@data
+ report_mig_interannual at end_year<-choice_c(object=report_mig_interannual at end_year,
+ nomassign="end_year",
+ annee=anneefin,
+ silent=silent)
+ assign("report_mig_interannual",report_mig_interannual,envir=envir_stacomi)
+ return(report_mig_interannual)
+ })
#' calcule method for report_mig_interannual
@@ -413,58 +413,67 @@
#' @author Marion Legrand
#' @export
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 at dc@station
- taxa<-report_mig_interannual at taxa@data$tax_code
- stage<-report_mig_interannual at stage@data$std_code
- if(length(unique(report_mig_interannual at dc@station))!=1) stop("You have more than one station in the report, the dc from the report should belong to the same station")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/stacomir -r 553
More information about the Stacomir-commits
mailing list