[Stacomir-commits] r311 - in pkg/stacomir: R data inst/tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 17 15:58:02 CET 2017
Author: briand
Date: 2017-03-17 15:58:02 +0100 (Fri, 17 Mar 2017)
New Revision: 311
Modified:
pkg/stacomir/R/BilanAgedemer.r
pkg/stacomir/R/BilanAnnuels.r
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/BilanMigrationMult.r
pkg/stacomir/R/BilanOperation.r
pkg/stacomir/R/RefCoe.r
pkg/stacomir/data/bilA.rda
pkg/stacomir/data/bilAM.rda
pkg/stacomir/data/bmi_vichy.rda
pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R
pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R
Log:
correcting the numbers when split between years....
Modified: pkg/stacomir/R/BilanAgedemer.r
===================================================================
--- pkg/stacomir/R/BilanAgedemer.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/BilanAgedemer.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -201,8 +201,7 @@
return(bilan_adm)
})
-#' Calcule method for BilanAgedemer, this method will pass the data from long to wide format
-#' ( one line per individual) and calculate Durif silvering index and Pankhurst and Fulton's K.
+#' Calcule method for BilanAgedemer, this method will split the data according to cut
#'
#' @param object An object of class \code{\link{BilanAgedemer-class}}
#' @param silent Boolean, if TRUE, information messages are not displayed, only warnings and errors
@@ -266,9 +265,9 @@
if (plot.type=="1"){
- p<-ggplot(dat)+geom_histogram(aes(x=car_valeur_quantitatif,fill=factor(age)),alpha=0.8)+
+ p<-ggplot(dat)+geom_histogram(aes(x=car_valeur_quantitatif,fill=factor(age)),binwidth=10,alpha=0.8)+
geom_vline(xintercept=les_coupes,lty=2,lwd=1)+
- annotate("text",x=les_coupes,y=0,label=les_coupes,vjust=1)+
+ annotate("text",x=les_coupes,y=0,label=les_coupes,vjust=1,hjust=-0.2)+
theme_minimal()+
scale_fill_manual("Age",values=c("1"="#379ec6","2"="#173957","3"="#b09953"))+
xlab("Size in mm")+
@@ -281,8 +280,9 @@
######################################
# Migration according to stage, month and year
######################################
+ # todo see of anotation is possible
if (plot.type=="2"){
- p<-ggplot(dat)+geom_histogram(aes(x=car_valeur_quantitatif,fill=factor(age)),alpha=0.8)+
+ p<-ggplot(dat)+geom_histogram(aes(x=car_valeur_quantitatif,fill=factor(age)),binwidth=10,alpha=0.8)+
geom_vline(xintercept=les_coupes,lty=2,lwd=1)+
theme_minimal()+
scale_fill_manual("Age",values=c("1"="#379ec6","2"="#173957","3"="#b09953"))+
@@ -357,10 +357,13 @@
#' write_database(bilanMigration=bM_Arzal,silent=FALSE)
#' }
#' @export
- setMethod("write_database",signature=signature("BilanAgedemer"),definition=function(object,silent=TRUE,dbname="bd_contmig_nat",host="localhost",port=5432){
- # dbname="bd_contmig_nat";host="localhost";silent=FALSE;port=5432
- bilanMigration<-object
- if (class(bilanMigration)!="BilanMigration") stop("the bilanMigration should be of class BilanMigration")
+ setMethod("write_database",signature=signature("BilanAgedemer"),definition=function(object,silent=TRUE,dbname="bd_contmig_nat"){
+ # dbname="bd_contmig_nat"
+ bilan_adm<-object
+ host=get("sqldf.options",envir=envir_stacomi)["sqldf.host"]
+ port=get("sqldf.options",envir=envir_stacomi)["sqldf.port"]
+
+ if (class(bilan_adm)!="BilanAgedemer") stop("the bilanMigration should be of class BilanMigration")
if (class(silent)!="logical") stop("the silent argument should be a logical")
dc=as.numeric(bilanMigration at dc@dc_selectionne)[1]
data=bilanMigration at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
Modified: pkg/stacomir/R/BilanAnnuels.r
===================================================================
--- pkg/stacomir/R/BilanAnnuels.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/BilanAnnuels.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -108,7 +108,7 @@
FROM ",get("sch",envir=envir_stacomi),"t_operation_ope join ", get("sch",envir=envir_stacomi),"t_lot_lot on lot_ope_identifiant=ope_identifiant
where ope_dic_identifiant in ",dc,
" and extract(year from ope_date_debut)>=",anneedebut,
- " and extract(year from ope_date_fin)<=", anneefin,
+ " and extract(year from ope_date_debut)<=", anneefin,
" and ope_dic_identifiant in ", dc,
" and lot_tax_code in ",tax,
" and lot_std_code in ",std,
@@ -139,7 +139,7 @@
as.numeric(end_of_the_year)/as.numeric(operation_duration)
data_end_of_the_year$ope_date_fin<-round_years
final_data<-rbind(data_not_to_cut,data_beginning_of_the_year,data_end_of_the_year)
- sqldf(" select sum(lot_effectif) as effectif, annee_debut as annee,
+ bilA at data<-sqldf(" select sum(lot_effectif) as effectif, annee_debut as annee,
ope_dic_identifiant,
lot_tax_code,
lot_std_code
@@ -167,8 +167,9 @@
req at sql<-stringr::str_replace_all(req at sql,"[\r\n\t]" , "")
req<-stacomirtools::connect(req)
bilA at data=req at query
- return(bilA)
+
}
+ return(bilA)
})
#' command line interface for \link{BilanAnnuels-class}
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -128,119 +128,126 @@
#==========================================
# table with 3 columns : annee; effectif; effectif_bjo
compared_numbers<-fn_check()
- #-------------------------------------------------------------------------------------
- # First test, if missing data, the program will propose to load the data by running bilanMigration
- #-------------------------------------------------------------------------------------
- # 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_bilanjournalier_bjo table, loading them now !",domain="R-StacomiR"))
-
-
- for (y in 1:length(missing_years)){
- Y<-missing_years[y]
- bM=new("BilanMigration")
- funout(gettextf("Running Bilanmigration for year %s",Y,domain="R-StacomiR"))
- bM=choice_c(bM,
- dc=dic[i],
- taxons=object at taxons@data$tax_nom_latin,
- stades=object at stades@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 bilanMigration
- # uses the connect method from BilanMigrationInterAnnuelle and the
- # program runs in endless loops...
- write_database(bM,silent=silent,check_for_bjo=FALSE)
- }
- } # end for loop to write new bilans
- # reloading everything
- object at data<-fn_connect()
- compared_numbers<-fn_check()
- } # end if any...
-
- #-------------------------------------------------------------------------------------
- # Second test, for existing bilan 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 at 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 at taxons@data$tax_code==2038 & object at stades@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(compared_numbers$effectif!=compared_numbers$effectif_bjo)
- differing_years<-compared_numbers$annee[index_different_years]
- if (! silent) funout(gettextf("Years with values differing between t_bilanjournalier_bjo and bilanAnnuels : %s ",stringr::str_c(differing_years,collapse="; "),domain="R-StacomiR"))
- #==================================
- reload_years_with_error=function(h,...){
- bM=new("BilanMigration")
- for (Y in differing_years){
- # Y=differing_years[1]
- funout(gettextf("Running Bilanmigration to correct data for year %s",Y))
- bM=choice_c(bM,
- dc=dic[i],
- taxons=object at taxons@data$tax_nom_latin,
- stades=object at stades@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 bilan are deleted
- write_database(bM,silent=silent,check_for_bjo=TRUE)
- }
- } # end for loop to write new bilans
- # 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_bilanjournalier_bjo table, this means that they have been changed after the last bilanmigration was run,
- do you want to load them again for calculation ?"),
- 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 anneeDebut@annee_selectionnee:object at anneeFin@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 taxon and this stage (BilanMigrationInterAnnuelle.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"))
- }
+ # as we have changed the bilanAnnuel 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 anneeDebut@annee_selectionnee&
+ compared_numbers$annee<=object at anneeFin@annee_selectionnee,]
+
+#-------------------------------------------------------------------------------------
+# First test, if missing data, the program will propose to load the data by running bilanMigration
+#-------------------------------------------------------------------------------------
+# 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_bilanjournalier_bjo table, loading them now !",domain="R-StacomiR"))
+
+
+ for (y in 1:length(missing_years)){
+ Y<-missing_years[y]
+ bM=new("BilanMigration")
+ funout(gettextf("Running Bilanmigration for year %s",Y,domain="R-StacomiR"))
+ bM=choice_c(bM,
+ dc=dic[i],
+ taxons=object at taxons@data$tax_nom_latin,
+ stades=object at stades@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 bilanMigration
+ # uses the connect method from BilanMigrationInterAnnuelle and the
+ # program runs in endless loops...
+ write_database(bM,silent=silent,check_for_bjo=FALSE)
+ }
+ } # end for loop to write new bilans
+ # reloading everything
+ object at data<-fn_connect()
+ compared_numbers<-fn_check()
+} # end if any...
+
+#-------------------------------------------------------------------------------------
+# Second test, for existing bilan 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 at 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 at taxons@data$tax_code==2038 & object at stades@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_bilanjournalier_bjo and bilanAnnuels : %s ",stringr::str_c(differing_years,collapse="; "),domain="R-StacomiR"))
+ #==================================
+ reload_years_with_error=function(h,...){
+ bM=new("BilanMigration")
+ for (Y in differing_years){
+ # Y=differing_years[1]
+ funout(gettextf("Running Bilanmigration to correct data for year %s",Y))
+ bM=choice_c(bM,
+ dc=dic[i],
+ taxons=object at taxons@data$tax_nom_latin,
+ stades=object at stades@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 bilan are deleted
+ write_database(bM,silent=silent,check_for_bjo=TRUE)
}
- return(object)
- }
+ } # end for loop to write new bilans
+ # 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_bilanjournalier_bjo table, this means that they have been changed after the last bilanmigration was run,
+ do you want to load them again for calculation ?"),
+ 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 anneeDebut@annee_selectionnee:object at anneeFin@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 taxon and this stage (BilanMigrationInterAnnuelle.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 BilanMigrationInterannuelle class
Modified: pkg/stacomir/R/BilanMigrationMult.r
===================================================================
--- pkg/stacomir/R/BilanMigrationMult.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/BilanMigrationMult.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -824,6 +824,7 @@
#beginning of the year
########################
# initializing variable
+#browser()
overlapping_samples_between_year<-FALSE
imat3<-imat1[1,]
listei3<-intervals::interval_overlap(imat2,imat3)
@@ -847,7 +848,9 @@
#######################
#end of the year
#######################
- imat3<-imat1[dim(imat1)[1],]
+ le<-length(time.sequence)
+ mat3<-as.data.frame(cbind(as.numeric(time.sequence[le]+as.difftime(1,units="days")),as.numeric(time.sequence[le]+as.difftime(2,units="days"))))
+ imat3<-intervals::Intervals(mat3)
listei3<-intervals::interval_overlap(imat2,imat3)
# vector of samples (lot) wich are overlapping between two years
# vector of samples (lot) wich are overlapping between two years
Modified: pkg/stacomir/R/BilanOperation.r
===================================================================
--- pkg/stacomir/R/BilanOperation.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/BilanOperation.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -52,7 +52,8 @@
req at colonnefin="ope_date_debut"
req at order_by="ORDER BY ope_dic_identifiant, ope_date_debut"
req at datedebut<-object at horodatedebut@horodate
- req at datefin<-object at horodatefin@horodate
+ #below to be consistet with BIlanMigrationMult
+ req at datefin<-object at horodatefin@horodate+as.difftime("23:59:59")
req at select<-paste("SELECT * FROM ",get("sch",envir=envir_stacomi),"t_operation_ope ")
req at and=paste("AND ope_dic_identifiant in",stringr::str_c("(",stringr::str_c(lesdc,collapse=","),")"))
req<-stacomirtools::connect(req) # appel de la methode connect de l'object ODBCWHEREDATE
Modified: pkg/stacomir/R/RefCoe.r
===================================================================
--- pkg/stacomir/R/RefCoe.r 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/R/RefCoe.r 2017-03-17 14:58:02 UTC (rev 311)
@@ -42,6 +42,9 @@
requete at datefin=object at datefin
requete at colonnedebut="coe_date_debut"
requete at colonnefin="coe_date_fin"
+ # the coefficients are only loaded for bilanMigration
+ # to be consistent with current programming, we need to add it as a timestamp
+ requete at datefin=as.POSIXlt(DateFin(object at datefin)+as.difftime("23:59:59"))
requete at select=stringr::str_c("select * from ",
get("sch",envir=envir_stacomi),
"tj_coefficientconversion_coe")
Modified: pkg/stacomir/data/bilA.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/data/bilAM.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/data/bmi_vichy.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/inst/tests/testthat/test-02BilanMigration.R 2017-03-17 14:58:02 UTC (rev 311)
@@ -54,6 +54,36 @@
rm("envir_stacomi",envir =.GlobalEnv)
})
+test_that("Test another instance of BilanMigration, check that operations accross two years are split correcly",{
+ require(stacomiR)
+ stacomi(gr_interface=FALSE,login_window=FALSE,database_expected=FALSE)
+ # overriding user schema to point to iav
+ baseODBC<-get("baseODBC",envir=envir_stacomi)
+ baseODBC[c(2,3)]<-rep("iav",2)
+ assign("baseODBC",baseODBC,envir_stacomi)
+ sch<-get("sch",envir=envir_stacomi) # "iav."
+ assign("sch","iav.",envir_stacomi)
+
+ bilanMigration<-new("BilanMigration")
+ options(warn = -1)
+ bilanMigration<-choice_c(bilanMigration,
+ dc=c(6),
+ taxons=c("Anguilla anguilla"),
+ stades=c("AGJ"),
+ datedebut="2015-01-01",
+ datefin="2015-12-31")
+ options(warn = 0)
+ bilanMigration<-charge(bilanMigration,silent=TRUE)
+ bilanMigration<-connect(bilanMigration,silent=TRUE)
+ bilanMigration<-calcule(bilanMigration,silent=TRUE)
+ # before doing the split per year the sum was 8617
+ # now it is less, only one third of the 7 eel belong to 1997
+ # the rest are in 1998
+ expect_equal(round(sum(bilanMigration at calcdata[["dc_6"]][["data"]]$Effectif_total)),
+ 26454)
+ rm("envir_stacomi",envir =.GlobalEnv)
+ })
+
test_that("Test connect method",{
stacomi(gr_interface=FALSE,
login_window=FALSE,
Modified: pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R 2017-03-16 16:26:23 UTC (rev 310)
+++ pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R 2017-03-17 14:58:02 UTC (rev 311)
@@ -158,23 +158,24 @@
stades=bmM at stades@data$std_code,
datedebut=as.character(bmM at pasDeTemps@dateDebut),
datefin=as.character(as.POSIXlt(DateFin(bmM at pasDeTemps))))
- bmM<-charge(bmM)
- bmM<-connect(bmM)
+ bmM<-charge(bmM,silent=TRUE)
+ bmM<-connect(bmM,silent=TRUE)
+ bmM<-calcule(bmM,silent=TRUE)
expect_equal(
- sum(bmM at data[bmM at data$ope_dic_identifiant==6,"value"]),
- sum(bmi at data$bjo_valeur[bmi at data$bjo_labelquantite=="Effectif_total"])
+ round(sum(bmM at calcdata[["dc_6"]][["data"]]$Effectif_total)),
+ round(sum(bmi at data$bjo_valeur[bmi at data$bjo_labelquantite=="Effectif_total"]))
)
######################
# Test for BilanAnnuel
#####################
- bila=as(bmi,"BilanAnnuels")
- bila<-connect(bila)
+ bilA=as(bmi,"BilanAnnuels")
+ bilA<-connect(bilA)
# we test that the BilanAnnuel has the same number as
# BilanMigration
expect_equal(
- sum(bmM at data[bmM at data$ope_dic_identifiant==6,"value"]),
- bila at data$effectif,
+ round(sum(bmM at calcdata[["dc_6"]][["data"]]$Effectif_total)),
+ round(bilA at data$effectif[1]),
label="The sum of number in the BilanMigration are different to the
number in the BilanAnnuel class"
)
More information about the Stacomir-commits
mailing list