[Stacomir-commits] r285 - in pkg/stacomir: R data inst/config inst/examples inst/tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 5 22:31:41 CET 2017
Author: briand
Date: 2017-02-05 22:31:40 +0100 (Sun, 05 Feb 2017)
New Revision: 285
Added:
pkg/stacomir/inst/tests/testthat/test-09Bilan_MigrationAnnuelle.R
Modified:
pkg/stacomir/R/BilanAnnuels.r
pkg/stacomir/R/BilanMigration.r
pkg/stacomir/R/BilanMigrationInterAnnuelle.r
pkg/stacomir/R/RefAnnee.r
pkg/stacomir/R/setAs.r
pkg/stacomir/data/bmi.rda
pkg/stacomir/inst/config/generate_data.R
pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R
pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R
Log:
Modified: pkg/stacomir/R/BilanAnnuels.r
===================================================================
--- pkg/stacomir/R/BilanAnnuels.r 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/R/BilanAnnuels.r 2017-02-05 21:31:40 UTC (rev 285)
@@ -277,7 +277,7 @@
#' @seealso \link{BilanAnnuels-class} for examples
#' @export
setMethod("barplot",signature(height = "BilanAnnuels"),definition=function(height,legend.text=NULL,...){
- #bilanMigrationInterAnnuelle<-bmi
+
bilA<-height
# require(ggplot2)
if(nrow(bilA at data)>0){
@@ -453,7 +453,7 @@
} else if (length(lestax)==1){
g<-ggplot(dat,aes(x=annee,y=effectif))+geom_point(aes(col=dc,shape=stade))+
- geom_line(aes(col=dc,shape=stade))+
+ geom_line(aes(col=dc,linetype=stade))+
theme_bw()
print(g)
assign("g",g,envir_stacomi)
Modified: pkg/stacomir/R/BilanMigration.r
===================================================================
--- pkg/stacomir/R/BilanMigration.r 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/R/BilanMigration.r 2017-02-05 21:31:40 UTC (rev 285)
@@ -184,9 +184,7 @@
# the object are assigned to the envir_stacomi for later use by the connect method
assign("bilanFonctionnementDF",bilanFonctionnementDF,envir=envir_stacomi)
assign("bilanFonctionnementDC",bilanFonctionnementDC,envir=envir_stacomi)
- assign("bilanOperation",bilanOperation,envir=envir_stacomi)
-
-
+ assign("bilanOperation",bilanOperation,envir=envir_stacomi)
return(bilanMigration)
})
@@ -566,6 +564,8 @@
#' @param dbname : the name of the database, defaults to "bd_contmig_nat"
#' @param host : the host for sqldf, defaults to "localhost"
#' @param port : the port, defaults to 5432
+#' @param check_for_bjo : do you want to check if data are already present in the bjo table, and delete them,
+#' this param was added otherwise connect method when called from BilanMigrationInterAnnuelle runs in loops
#' @note the user is asked whether or not he wants to overwrite data, if no
#' data are present in the database, the import is done anyway. The name of the database
#' is not passed in odbc link, here defaults to "bd_contmig_nat"
@@ -578,7 +578,7 @@
#' write_database(bilanMigration=bM_Arzal,silent=FALSE)
#' }
#' @export
-setMethod("write_database",signature=signature("BilanMigration"),definition=function(object,silent=TRUE,dbname="bd_contmig_nat",host="localhost",port=5432){
+setMethod("write_database",signature=signature("BilanMigration"),definition=function(object,silent=TRUE,dbname="bd_contmig_nat",host="localhost",port=5432,check_for_bjo=TRUE){
# dbname="bd_contmig_nat";host="localhost";silent=FALSE;port=5432
bilanMigration<-object
if (class(bilanMigration)!="BilanMigration") stop("the bilanMigration should be of class BilanMigration")
@@ -611,12 +611,16 @@
# Ci dessous conversion de la classe vers migration Interannuelle pour utiliser
# les methodes de cette classe
bil=as(bilanMigration,"BilanMigrationInterAnnuelle")
- bil=connect(bil,silent=silent)
+ # the argument check_for_bjo ensures that we don't re-run the connect method
+ # in loop when the write_database is called from within the bilanMigrationInterAnnuelle connect method
+ # check = FALSE tells the method not to check for missing data (we don't want that check when the
+ # write database is called from the bilanMigration class
+ if (check_for_bjo) bil=connect(bil,silent=silent,check=FALSE)
hconfirm=function(h,...){
# suppression des donnees actuellement presentes dans la base
# bilanjournalier et bilanmensuel
- supprime(bil)
+ if (check_for_bjo) supprime(bil)
baseODBC<-get("baseODBC",envir=envir_stacomi)
sql<-stringr::str_c("INSERT INTO ",get("sch",envir=envir_stacomi),"t_bilanmigrationjournalier_bjo (",
"bjo_dis_identifiant,bjo_tax_code,bjo_std_code,bjo_annee,bjo_jour,bjo_valeur,bjo_labelquantite,bjo_horodateexport,bjo_org_code)",
Modified: pkg/stacomir/R/BilanMigrationInterAnnuelle.r
===================================================================
--- pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/R/BilanMigrationInterAnnuelle.r 2017-02-05 21:31:40 UTC (rev 285)
@@ -39,46 +39,194 @@
calcdata=list()
)
)
+setValidity("BilanMigrationInterAnnuelle",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 developped accordingly
+ rep1=ifelse(length(object at taxons@data$tax_code)==1,TRUE,gettext("BilanMigrationInterannuelle can only take one taxa", domain="R-stacomiR"))
+ # same for stage
+ rep2=ifelse(length(object at stades@data$std_code)==1,TRUE,gettext("BilanMigrationInterannuelle 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 BilanMigrationInterannuelle class
+#'
+#' This method will check if the data in the t_bilanjournalier_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_bilanjournalier_bjo differ from those in the database,
+#' and propose to re-run the bilanmigration (which has a write_database methode to write daily bilans) for those years.
+#' @note We expect different results between daily bilans from the t_bilanjournalier_bjo table and the annual sums
+#' from bilanAnnuels for glass eels as those may have been weighted and not only counted. The t_bilanjournalier_bjo table used by BilanMigrationInterAnnuelle
+#' contains the sum of glass eel numbers converted from weights and those directly counted. The bilanAnnuels does not.
#' @param object An object of class \link{BilanMigrationInterAnnuelle-class}
#' @param silent Stops messages from being displayed if silent=TRUE, default FALSE
+#' @param check Checks that data are corresponding between BilanAnnuels and BilanMigration
#' @return bilanMigrationInterAnnuelle an instantianted object with values filled with user choice
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("connect",signature=signature("BilanMigrationInterAnnuelle"),
- definition=function(object,silent=FALSE)
+ definition=function(object,silent=FALSE,check=TRUE)
{
- # tableau contenant toutes les annees
- les_annees = (object at anneeDebut@annee_selectionnee):(object at anneeFin@annee_selectionnee)
- tax = object at taxons@data$tax_code
- std = object at stades@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=",dic,sep="")
- requete at select=paste("SELECT * FROM ",get("sch",envir=envir_stacomi),"t_bilanmigrationjournalier_bjo",sep="")
- requete at order_by=" ORDER BY bjo_jour "
- requete<-stacomirtools::connect(requete)
-
- # resultat de la requete
- object at data<- stacomirtools::killfactor(requete at query)
-
- # recuperation des indices des annees presentes dans la base
+ # object<-bmi
+ # object<-bmi_cha
+ #---------------------------------------------------------------------------------------
+ # 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 anneeDebut@annee_selectionnee):(object at anneeFin@annee_selectionnee)
+ tax = object at taxons@data$tax_code
+ std = object at stades@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=",dic,sep="")
+ requete at select=paste("SELECT * FROM ",get("sch",envir=envir_stacomi),"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()
+ #browser()
+ if (check){
+ #----------------------------------------------------------------------
+ # Loading a bilan Annuel to compare numbers
+ #----------------------------------------------------------------------
+ bilanAnnuel<-as(object,"BilanAnnuels")
+ bilanAnnuel<-connect(bilanAnnuel)
+
+ #----------------------------------------------------------------------
+ # MAIN LOOP, there can be several dic
+ #----------------------------------------------------------------------
+ for (i in 1:length(dic)){
+ #i=1
+ ############################################
+ # function creating a table to compare actual counts with those stored in
+ # in the t_bilanjournalier_bjo table
+ ###########################################
+ #==========================================
+ fn_check<-function(){
+ data1<-bilanAnnuel at data[bilanAnnuel at data$ope_dic_identifiant==dic[i],c("effectif","annee")]
+ # data from bilanMigrationInterannuel
+ data2<-object at data[object at data$bjo_dis_identifiant==dic[i],]
+ data21<-dplyr::select(data2,bjo_annee,bjo_valeur,bjo_labelquantite)
+ data22<-group_by(data21,bjo_annee,bjo_labelquantite)
+ data23<-summarize(data22,total=sum(bjo_valeur))
+ data24<-filter(ungroup(data23),bjo_labelquantite=="Effectif_total")
+ data24<-select(data24,bjo_annee,total)
+ data24<-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()
+ #-------------------------------------------------------------------------------------
+ # 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) 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 Bilanmigraton for year %s",Y,domain="R-StacomiR"))
+ bM=choice_c(bM,
+ dc=dic,
+ 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){
+ funout(gettextf("Running Bilanmigraton to correct data for year %s",Y))
+ bM=choice_c(bM,
+ dc=dic,
+ 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 probably 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
+ #-------------------------------------------------------------------------------------
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))
+ 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)){
+ if (length(les_annees[index])>0){
funout(paste(gettext("Annual migrations query completed",domain="R-stacomiR"),
paste(les_annees[index],collapse=","), "\n"))
}
@@ -125,7 +273,7 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
setMethod("charge",signature=signature("BilanMigrationInterAnnuelle"),
- definition=function(object,silent)
+ definition=function(object,silent=FALSE)
{
bilanMigrationInterAnnuelle<-object
if (exists("refDC",envir_stacomi)) {
@@ -154,8 +302,11 @@
} 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(bilanMigrationInterAnnuelle)
assign("bilanMigrationInterAnnuelle",bilanMigrationInterAnnuelle,envir_stacomi)
- funout(gettext("Writing bilanMigrationInterannuelle in the environment envir_stacomi : write bmi=get('bilanMigrationInterannuelle',envir_stacomi) ",domain="R-stacomiR"))
+ if (!silent) funout(gettext("Writing bilanMigrationInterannuelle in the environment envir_stacomi : write bmi=get('bilanMigrationInterannuelle',envir_stacomi) ",domain="R-stacomiR"))
+
return(bilanMigrationInterAnnuelle)
}
)
@@ -192,7 +343,8 @@
bilanMigrationInterAnnuelle at taxons<-choice_c(bilanMigrationInterAnnuelle at taxons,taxons)
bilanMigrationInterAnnuelle at stades<-charge_avec_filtre(object=bilanMigrationInterAnnuelle at stades,bilanMigrationInterAnnuelle at dc@dc_selectionne,bilanMigrationInterAnnuelle at taxons@data$tax_code)
bilanMigrationInterAnnuelle at stades<-choice_c(bilanMigrationInterAnnuelle at stades,stades)
-
+ # depending on objetBilan 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
bilanMigrationInterAnnuelle at anneeDebut<-charge(object=bilanMigrationInterAnnuelle at anneeDebut,
objectBilan="BilanMigrationInterAnnuelle")
bilanMigrationInterAnnuelle at anneeDebut<-choice_c(object=bilanMigrationInterAnnuelle at anneeDebut,
Modified: pkg/stacomir/R/RefAnnee.r
===================================================================
--- pkg/stacomir/R/RefAnnee.r 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/R/RefAnnee.r 2017-02-05 21:31:40 UTC (rev 285)
@@ -155,8 +155,9 @@
})
-#' choice method for RefAnnee referential from the command line
+#' choice_c method for RefAnnee referential from the command line
#'
+#' The choice_c method will issue a warning if the year is not present in the database
#' Allows the selection of year and the assignment in environment envir_stacomi
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @param object An object of class \link{RefAnnee-class}
@@ -183,12 +184,15 @@
if (length(annee)>1) stop("horodate should be a vector of length 1")
if (class (annee)=="character") annee<-as.numeric(annee)
# the charge method must be performed before
+ gettext("no year",domain="R-stacomiR")
+ if ( !annee %in% object at data[,1] ) {
+
+ warning(stringr::str_c("Attention, year ",annee," is not available in the database, available years :",
+ ifelse(length(object at data$bjo_annee)==0,gettext(" none, were you lazy?",domain="R-stacomiR"),
+ stringr::str_c(object at data$bjo_annee,collapse=","))))
+ }
+ object at annee_selectionnee<-annee
- if ( !annee %in% object at data$bjo_annee & !annee %in% object at data$year) {
- warning(stringr::str_c("year,",annee," not available in the database, available years",stringr::str_c(object at data$bjo_annee,collapse=",")))
- } else {
- object at annee_selectionnee<-annee
- }
assign(nomassign,object,envir_stacomi)
if (! silent) funout(funoutlabel)
return(object)
Modified: pkg/stacomir/R/setAs.r
===================================================================
--- pkg/stacomir/R/setAs.r 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/R/setAs.r 2017-02-05 21:31:40 UTC (rev 285)
@@ -24,4 +24,14 @@
bMM at time.sequence=from at time.sequence
bMM at calcdata=from at calcdata
return(bMM)
+ })
+
+setAs("BilanMigrationInterAnnuelle","BilanAnnuels",function(from){
+ bilA=new("BilanAnnuels")
+ bilA at dc=from at dc
+ bilA at taxons=from at taxons
+ bilA at stades=from at stades
+ bilA at anneedebut=from at anneeDebut
+ bilA at anneefin=from at anneeFin
+ return(bilA)
})
\ No newline at end of file
Modified: pkg/stacomir/data/bmi.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/inst/config/generate_data.R
===================================================================
--- pkg/stacomir/inst/config/generate_data.R 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/inst/config/generate_data.R 2017-02-05 21:31:40 UTC (rev 285)
@@ -286,6 +286,8 @@
anneedebut=1984,
anneefin=2015,
silent=TRUE)
+# this will just test that the object is valid... not really a necessary step for this class
+bmi<-charge(bmi,silent=TRUE)
bmi<-connect(bmi,silent=TRUE)
@@ -480,6 +482,7 @@
anneedebut="1997",
anneefin="2012",
silent=FALSE)
+bmi_vichy<-charge(bmi_vichy)
bmi_vichy<-connect(bmi_vichy)
bmi_vichy at dc@data[,"ouv_libelle"]<-iconv(bmi_vichy at dc@data[,"ouv_libelle"],from="latin1",to="UTF8")
bmi_vichy at dc@data[,"dis_commentaires"]<-iconv(bmi_vichy at dc@data[,"dis_commentaires"],from="latin1",to="UTF8")
Modified: pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R
===================================================================
--- pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/inst/examples/bilanMigrationInterannuelle_example.R 2017-02-05 21:31:40 UTC (rev 285)
@@ -23,7 +23,8 @@
anneedebut="1990",
anneefin="2015",
silent=FALSE)
- bmi<-connect(bmi)
+ bmi<-charge(bmi,silent=TRUE)
+ bmi<-connect(bmi,silent=TRUE)
}
# load the dataset generated by previous lines
data("bmi")
@@ -97,15 +98,15 @@
}
}
data("bmi_vichy")
+# statistics for seaonal migration, daily values
bmi_vichy<-calcule(bmi_vichy,timesplit="jour")
-#bmi_vichy at calcdata
-
+#bmi_vichy at calcdata #check this to see the results
+# statistics for seaonal migration, weekly values
bmi_vichy<-calcule(bmi_vichy,timesplit="semaine")
#bmi_vichy at calcdata
-bmi_vichy<-calcule(bmi_vichy,timesplit="jour_365")
-#bmi_vichy at calcdata
+# the plot method also runs calcule
plot(bmi_vichy,plot.type="seasonal",timesplit="semaine")
plot(bmi_vichy,plot.type="seasonal",timesplit="mois")
plot(bmi_vichy,plot.type="seasonal",timesplit="jour")
@@ -126,30 +127,12 @@
anneedebut="2007",
anneefin="2014",
silent=FALSE)
+ bmi_des<-charge(bmi_des)
bmi_des<-connect(bmi_des)
bmi_des<-calcule(bmi_des,timesplit="semaine")
plot(bmi_des,plot.type="seasonal",timesplit="semaine")
plot(bmi_des,plot.type="seasonal",timesplit="jour")
}
-\dontrun{
- # A test with lampreys in the Descarte DF (Vienne)
- baseODBC<-get("baseODBC",envir=envir_stacomi)
- baseODBC[c(2,3)]<-rep("iav",2)
- assign("baseODBC",baseODBC,envir_stacomi)
- sch<-get("sch",envir=envir_stacomi)
- assign("sch","iav.",envir_stacomi)
- bmi_arz<-new("BilanMigrationInterAnnuelle")
- bmi_arz<-choice_c(bmi_arz,
- dc=c(6),
- taxons=c("Anguilla anguilla"),
- stades=c("CIV"),
- anneedebut="1996",
- anneefin="2015",
- silent=FALSE)
- bmi_arz<-connect(bmi_arz)
- bmi_arz<-calcule(bmi_arz,timesplit="semaine")
- plot(bmi_arz,plot.type="seasonal",timesplit="semaine")
- plot(bmi_arz,plot.type="seasonal",timesplit="jour")
-}
+
Modified: pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R 2017-02-03 20:23:48 UTC (rev 284)
+++ pkg/stacomir/inst/tests/testthat/test-06Bilan_MigrationInterAnnuelle.R 2017-02-05 21:31:40 UTC (rev 285)
@@ -70,5 +70,50 @@
})
+test_that("Test that loading two taxa will fail",
+ {
+ 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)
+ bmi<-new("BilanMigrationInterAnnuelle")
+ # the following will load data for size,
+ # parameters 1786 (total size) C001 (size at video control)
+ # dc 5 and 6 are fishways located on the Arzal dam
+ # two stages are selected
+ bmi<-suppressWarnings(choice_c(bmi,
+ dc=5,
+ taxons=c("Anguilla anguilla","Petromyzon marinus"),
+ stades=c("AGJ"),
+ anneedebut="1996",
+ anneefin=2015,
+ silent=TRUE))
+ expect_error(charge(bmi))
+
+ })
+test_that("Test that bilanMigrationInterannuelle loads missing data with correct warning",
+ {
+baseODBC<-get("baseODBC",envir=envir_stacomi)
+baseODBC[c(2,3)]<-rep("logrami",2)
+assign("baseODBC",baseODBC,envir_stacomi)
+sch<-get("sch",envir=envir_stacomi)
+assign("sch","logrami.",envir_stacomi)
+
+bmi_cha<-new("BilanMigrationInterAnnuelle") #châtelrault
+bmi_cha<-suppressWarnings(choice_c(bmi_cha,
+ dc=c(21),
+ taxons=c("Salmo salar"),
+ stades=c("5"),
+ anneedebut="2004",
+ anneefin="2014",
+ silent=TRUE))
+bmi_cha<-charge(bmi_cha,silent=TRUE)
+bmi_cha<-connect(bmi_cha)
+
+})
Added: pkg/stacomir/inst/tests/testthat/test-09Bilan_MigrationAnnuelle.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-09Bilan_MigrationAnnuelle.R (rev 0)
+++ pkg/stacomir/inst/tests/testthat/test-09Bilan_MigrationAnnuelle.R 2017-02-05 21:31:40 UTC (rev 285)
@@ -0,0 +1,63 @@
+context("Bilan_MigrationAnnuelle")
+
+
+test_that("Test an instance of BilanAnnuels loaded with choice_c",{
+ 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)
+ assign("sch","iav.",envir_stacomi)
+ bilA<-new("BilanAnnuels")
+ bilA<-choice_c(bilA,
+ dc=c(5,6,12),
+ taxons=c("Anguilla anguilla"),
+ stades=c("AGJ","AGG"),
+ anneedebut="1996",
+ anneefin="2015",
+ silent=FALSE)
+ bilA<-connect(bilA,silent=TRUE)
+ expect_s4_class(bilA,"BilanAnnuels")
+ rm("envir_stacomi",envir =.GlobalEnv)
+ })
+
+
+test_that("Test methods in BilanAnnuels",{
+ 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)
+ assign("sch","iav.",envir_stacomi)
+ bilA<-new("BilanAnnuels")
+ bilA<-choice_c(bilA,
+ dc=c(5,6,12),
+ taxons=c("Anguilla anguilla"),
+ stades=c("AGJ","AGG"),
+ anneedebut="1996",
+ anneefin="2015",
+ silent=FALSE)
+ bilA<-connect(bilA,silent=TRUE)
+ plot(bilA)
+ barplot(bilA)
+ rm("envir_stacomi",envir =.GlobalEnv)
+ })
+
+test_that("Test example bilanMigrationInterAnnuelle_example",
+ {
+ # check if built with examples (Rtools install --example)
+ # the file is generate it examples but later loaded to examples from the class using @example
+ # be sure you have built Roxygen documentation before running
+ example_path<-file.path(.libPaths(),"stacomiR","R-ex","BilanAnnuels-class.R")
+ test<-file.access(example_path,0)
+ if (test[1]!=0) warnings("Package example dir not created ?") else
+ suppressWarnings(source(example_path))
+
+ })
+
+
+
More information about the Stacomir-commits
mailing list