[Stacomir-commits] r499 - in pkg/stacomir: R inst/examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 18 12:30:33 CEST 2018
Author: legrand
Date: 2018-09-18 12:30:32 +0200 (Tue, 18 Sep 2018)
New Revision: 499
Modified:
pkg/stacomir/R/report_mig_interannual.R
pkg/stacomir/R/report_mig_mult.R
pkg/stacomir/inst/examples/report_mig_interannual-example.R
Log:
removing calls to sqldf in non-database functions
Modified: pkg/stacomir/R/report_mig_interannual.R
===================================================================
--- pkg/stacomir/R/report_mig_interannual.R 2018-06-20 14:02:12 UTC (rev 498)
+++ pkg/stacomir/R/report_mig_interannual.R 2018-09-18 10:30:32 UTC (rev 499)
@@ -127,7 +127,7 @@
data21<-dplyr::select(data2,bjo_annee,bjo_valeur,bjo_labelquantite)
data22<-dplyr::group_by(data21,bjo_annee,bjo_labelquantite)
data23<-dplyr::summarize(data22,total=sum(bjo_valeur))
- data24<-dplyr::filter(ungroup(data23),bjo_labelquantite=="Effectif_total")
+ 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")
@@ -407,7 +407,8 @@
#' @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<-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 (
@@ -419,7 +420,7 @@
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")
- if(nrow(report_mig_interannual at data)==0) stop("No rows in report_mig_interannual at data, nothing to run calculations on")
+ if(nrow(report_mig_interannual at data)==0) stop("No rows in report_mig_interannual at data, nothing to run calculations on, you should run a report_mig_mult on this dc first")
datadic<-report_mig_interannual at data[
report_mig_interannual at data$bjo_labelquantite=="Effectif_total",]
Modified: pkg/stacomir/R/report_mig_mult.R
===================================================================
--- pkg/stacomir/R/report_mig_mult.R 2018-06-20 14:02:12 UTC (rev 498)
+++ pkg/stacomir/R/report_mig_mult.R 2018-09-18 10:30:32 UTC (rev 499)
@@ -188,9 +188,6 @@
#' @param silent Default FALSE, should messages be stopped
#' @note The class does not handle escapement rates, though structurally those are present in the database. If you
#' want to use those you will have to do the calculation manually from the data in \code{report_mig_mult at data}.
-#' Note also that running the calcule method requires to have a database called test in postgres, and empty
-#' database in which all sqldf group by queries are run. The user and password for the test database are taken
-#' from the calcmig.csv configuration file.
#' @return report_mig_mult with a list in slot calcdata. For each dc one will find a list with the following elements
#' \describe{
#' \item{method}{In the case of instantaneous periods (video counting) the sum of daily values is done by the \link{fun_report_mig_mult} method and the value indicated in method is "sum".
@@ -231,7 +228,7 @@
lestableaux[[stringr::str_c("dc_",dic)]][["method"]]<-"overlaps"
contient_poids<-"poids"%in%datasub$type_de_quantite
lestableaux[[stringr::str_c("dc_",dic)]][["contient_poids"]]<-contient_poids
-
+
lestableaux[[stringr::str_c("dc_",dic)]][["negative"]]<-negative
if (contient_poids){
coe<-report_mig_mult at coef_conversion[,c("coe_date_debut","coe_valeur_coefficient")]
@@ -430,11 +427,11 @@
for (dcnum in 1:length(lesdc)){
for (taxanum in 1:nrow(lestaxa)){
for (stagenum in 1:nrow(lesstage)){
-
- taxa=lestaxa[taxanum,"tax_nom_latin"]
- stage=lesstage[stagenum,"std_libelle"]
- dc=lesdc[dcnum]
- data<-report_mig_mult at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
+ #dcnum=1;taxnum=1;stagenum=1
+ taxa <- lestaxa[taxanum,"tax_nom_latin"]
+ stage <- lesstage[stagenum,"std_libelle"]
+ dc <- lesdc[dcnum]
+ data <- report_mig_mult at calcdata[[stringr::str_c("dc_",dc)]][["data"]]
data<-data[data$lot_tax_code==lestaxa[taxanum,"tax_code"] &
data$lot_std_code==lesstage[stagenum,"std_code"],]
@@ -521,13 +518,10 @@
grdata<-rbind(grdata,data)
}
names(grdata)<-tolower(names(grdata))
- grdata<-sqldf::sqldf(x="select sum(effectif_total) as effectif_total,
- \"no.pas\",
- debut_pas
- from grdata
- group by debut_pas,\"no.pas\"
- order by debut_pas",
- drv="PostgreSQL")
+ grdata <- as.data.frame(grdata %>%
+ dplyr::group_by(debut_pas,no.pas) %>%
+ dplyr::summarize(effectif_total=sum(effectif_total))%>%
+ dplyr::arrange(debut_pas))
grdata_without_hole<-merge(
data.frame(no.pas=as.numeric(strftime(report_mig_mult at time.sequence,format="%j"))-1,
debut_pas=report_mig_mult at time.sequence),
@@ -902,49 +896,54 @@
ts_id=as.numeric(strftime(time.sequence,format="%j")),stringsAsFactors =FALSE)
dfts<-merge(df.ts,df,by="ts_id")
datasub1<-merge(dfts,datasub,by="lot_identifiant")
-# to do a group by it is good to use sqldf
- datasub1$value<-as.numeric(datasub1$value) # sinon arrondis a des entiers
+ datasub1$value<-as.numeric(datasub1$value) # Otherwise rounded to integer
+ # If negative negative and positive are treated separately and return one row for each positive or negative value
if (negative){
- datasub2<-sqldf::sqldf(x="SELECT debut_pas,
- fin_pas,
- sum(value*coef) as value,
- type_de_quantite,
- ope_dic_identifiant,
- lot_tax_code,
- lot_std_code,
- lot_methode_obtention
- FROM datasub1
- where value<0
- GROUP BY ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite
- ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite
- UNION
- SELECT debut_pas,
- fin_pas,
- sum(value*coef) as value,
- type_de_quantite,
- ope_dic_identifiant,
- lot_tax_code,
- lot_std_code,
- lot_methode_obtention
- FROM datasub1
- where value>=0
- GROUP BY ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite
- ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite",
- drv="PostgreSQL"
- )
+
+ the_negative <- datasub1 %>% dplyr::select(debut_pas,
+ fin_pas,
+ value,
+ coef,
+ type_de_quantite,
+ ope_dic_identifiant,
+ lot_tax_code,
+ lot_std_code,
+ lot_methode_obtention) %>%
+ dplyr::filter(value<0) %>%
+ dplyr::group_by(ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite) %>%
+ dplyr::summarize(value=sum(value*coef))%>%
+ dplyr::arrange(ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite)
+
+ the_positive <- datasub1 %>% dplyr::select(debut_pas,
+ fin_pas,
+ value,
+ coef,
+ type_de_quantite,
+ ope_dic_identifiant,
+ lot_tax_code,
+ lot_std_code,
+ lot_methode_obtention) %>%
+ dplyr::filter(value>=0) %>%
+ dplyr::group_by(ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite) %>%
+ dplyr::summarize(value=sum(value*coef))%>%
+ dplyr::arrange(ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite)
+
+ datasub2 <- as.data.frame(rbind(the_negative,the_positive))
+
} else {
- datasub2<-sqldf::sqldf(x="SELECT debut_pas,
- fin_pas,
- sum(value*coef) as value,
- type_de_quantite,
- ope_dic_identifiant,
- lot_tax_code,
- lot_std_code,
- lot_methode_obtention
- FROM datasub1
- GROUP BY ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite
- ORDER BY ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite ",
- drv="PostgreSQL")
+ datasub2<- as.data.frame(datasub1 %>% dplyr::select(debut_pas,
+ fin_pas,
+ value,
+ coef,
+ type_de_quantite,
+ ope_dic_identifiant,
+ lot_tax_code,
+ lot_std_code,
+ lot_methode_obtention) %>%
+ dplyr::group_by(ope_dic_identifiant,lot_tax_code, lot_std_code, lot_methode_obtention, debut_pas,fin_pas,type_de_quantite) %>%
+ dplyr::summarize(value=sum(value*coef))%>%
+ dplyr::arrange(ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite))
+
}
# if some samples overlap between the current year and the year arround the current year,
# then the calculation will have hampered our numbers of a small amount
Modified: pkg/stacomir/inst/examples/report_mig_interannual-example.R
===================================================================
--- pkg/stacomir/inst/examples/report_mig_interannual-example.R 2018-06-20 14:02:12 UTC (rev 498)
+++ pkg/stacomir/inst/examples/report_mig_interannual-example.R 2018-09-18 10:30:32 UTC (rev 499)
@@ -29,11 +29,14 @@
anneedebut="1990",
anneefin="2015",
silent=TRUE)
- r_mig_interannual<-connect(r_mig_interannual,silent=TRUE)
+ r_mig_interannual<-charge(r_mig_interannual)
+ r_mig_interannual<-connect(r_mig_interannual,check=TRUE)
+ r_mig_interannual<-calcule(r_mig_interannual,silent=TRUE)
}
#############otherwise use this ######################
# load the dataset generated by previous lines
data("r_mig_interannual")
+
#######################################################
# the first plot is of little interest, it allows to see what data
# are available... simple lines
More information about the Stacomir-commits
mailing list