[Stacomir-commits] r501 - 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
Tue Sep 18 20:25:07 CEST 2018
Author: legrand
Date: 2018-09-18 20:25:06 +0200 (Tue, 18 Sep 2018)
New Revision: 501
Modified:
pkg/stacomir/R/report_ge_weight.R
pkg/stacomir/R/report_mig.R
pkg/stacomir/R/report_mig_mult.R
pkg/stacomir/R/report_sea_age.R
pkg/stacomir/R/stacomi.R
pkg/stacomir/R/utilities.R
pkg/stacomir/data/calcmig.rda
pkg/stacomir/data/r_mig_mult.rda
pkg/stacomir/inst/config/stacomi_manual_launch.r
pkg/stacomir/inst/examples/report_mig-example.R
pkg/stacomir/inst/examples/report_mig_interannual-example.R
pkg/stacomir/inst/examples/report_mig_mult-example.R
pkg/stacomir/inst/tests/testthat/test-00-stacomir.R
pkg/stacomir/inst/tests/testthat/test-02-report_mig.R
Log:
remove calls to test database and modifications of sqldf options
Modified: pkg/stacomir/R/report_ge_weight.R
===================================================================
--- pkg/stacomir/R/report_ge_weight.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/report_ge_weight.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -574,10 +574,10 @@
#' @export
setMethod("write_database",signature=signature("report_ge_weight"),definition=function(object,silent=FALSE){
#silent=FALSE;dbname="bd_contmig_nat";host="localhost";port=5432
- host=get("sqldf.options",envir=envir_stacomi)["sqldf.host"]
- port=get("sqldf.options",envir=envir_stacomi)["sqldf.port"]
+ host=get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.host"]
+ port=get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.port"]
# getting the database name
- dbname<-getdbname()
+ dbname <- get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.dbname"]
r_gew<-object
if (!"import_coe"%in% names(r_gew at calcdata)) funout(gettext("Attention, you must fit a model before trying to write the predictions in the database",domain="R-stacomiR"),arret=TRUE)
# first delete existing data from the database
Modified: pkg/stacomir/R/report_mig.R
===================================================================
--- pkg/stacomir/R/report_mig.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/report_mig.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -618,10 +618,10 @@
# object=bM
#host : the host for sqldf, defaults to "localhost"
#port : the port, defaults to 5432
- host=get("sqldf.options",envir=envir_stacomi)["sqldf.host"]
- port=get("sqldf.options",envir=envir_stacomi)["sqldf.port"]
+ host <- get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.host"]
+ port <- get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.port"]
# getting the database name
- dbname<-getdbname()
+ dbname <- get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.dbname"]
report_mig<-object
if (class(report_mig)!="report_mig") stop("the report_mig should be of class report_mig")
if (class(silent)!="logical") stop("the silent argument should be a logical")
Modified: pkg/stacomir/R/report_mig_mult.R
===================================================================
--- pkg/stacomir/R/report_mig_mult.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/report_mig_mult.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -205,7 +205,8 @@
#' @aliases calcule.report_mig_mult
#' @export
setMethod("calcule",signature=signature("report_mig_mult"),definition=function(object,negative=FALSE,silent=FALSE){
- # report_mig_mult<-r_mig_mult
+
+ # report_mig_mult<-r_mig_mult; negative=FALSE
if (!silent) funout(gettext("Starting migration summary ... be patient\n",domain="R-stacomiR"))
report_mig_mult<-object
debut=report_mig_mult at timestep@dateDebut
@@ -410,7 +411,6 @@
#' @aliases plot.report_mig_mult
#' @export
setMethod("plot",signature(x = "report_mig_mult", y = "missing"),definition=function(x, plot.type="standard",color=NULL, color_ope=NULL,silent=FALSE,...){
- #browser()
#print("entering plot function")
#report_mig_mult<-r_mig_mult;silent=FALSE
report_mig_mult<-x
@@ -792,6 +792,7 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
fun_report_mig_mult_overlaps <- function(time.sequence, datasub,negative=FALSE) {
+ #browser()
mat1<-as.data.frame(cbind(as.numeric(time.sequence),as.numeric(time.sequence+as.difftime(1,units="days"))))
mat2<-as.data.frame(cbind(as.numeric(datasub$ope_date_debut),as.numeric(datasub$ope_date_fin)))
rownames(mat1)<-as.character(time.sequence)
@@ -898,6 +899,7 @@
datasub1<-merge(dfts,datasub,by="lot_identifiant")
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
+ # below coef is the part of the operation within the current year
if (negative){
the_negative <- datasub1 %>% dplyr::select(debut_pas,
@@ -932,17 +934,17 @@
} else {
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))
+ 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,
@@ -974,8 +976,6 @@
#' @param time.sequence the time sequence to be filled in with new data
#' @param datasub the initial dataset
#' @param negative "boolean", default FALSE, TRUE indicates a separate sum for negative and positive migrations
-#' @note The method uses sqldf, configured to access a postgres database, and runs caclulations on a database called
-#' test (the username and password for test are set in the calcmig.csv configuration file).
#' @return A data.frame with number summed over over the time.sequence.
#' The function returns the same output than \link{fun_report_mig_mult_overlaps}
#' but is intended to work faster. In the data.frame, the total number is
@@ -984,53 +984,56 @@
#' @author Cedric Briand \email{cedric.briand"at"eptb-vilaine.fr}
#' @export
fun_report_mig_mult <- function(time.sequence, datasub,negative=FALSE) {
- sqldf.options<-get("sqldf.options",envir_stacomi)
+ #sqldf.options<-get("sqldf.options",envir_stacomi)
+ #browser()
df.ts=data.frame(debut_pas=time.sequence,
fin_pas=time.sequence+as.difftime(1,units="days"),
ts_id=strftime(time.sequence,format="%j"),stringsAsFactors =FALSE)
datasub$ts_id<-strftime(datasub$ope_date_debut,format="%j")
datasub1<-merge(df.ts,datasub,by="ts_id")
- # ci dessous pour faire du group by c'est quand meme bien de passer par sqldf
if (negative){
- datasub2<-sqldf::sqldf(x="SELECT debut_pas,
- fin_pas,
- sum(value) 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) 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,
+ 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))%>%
+ 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,
+ 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))%>%
+ 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) 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,
+ 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))%>%
+ dplyr::arrange(ope_dic_identifiant,debut_pas, lot_tax_code, lot_std_code,type_de_quantite))
+
}
stopifnot(all.equal(sum(datasub$value,na.rm=TRUE),sum(datasub2$value,na.rm=TRUE)))
datasub3<-reshape2::dcast(datasub2, debut_pas+fin_pas+ope_dic_identifiant+lot_tax_code+lot_std_code+type_de_quantite~lot_methode_obtention,value.var="value")
Modified: pkg/stacomir/R/report_sea_age.R
===================================================================
--- pkg/stacomir/R/report_sea_age.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/report_sea_age.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -365,10 +365,10 @@
setMethod("write_database",signature=signature("report_sea_age"),definition=function(object,silent=TRUE){
# dbname="bd_contmig_nat"
r_seaa<-object
- host=get("sqldf.options",envir=envir_stacomi)["sqldf.host"]
- port=get("sqldf.options",envir=envir_stacomi)["sqldf.port"]
+ host=get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.host"]
+ port=get("sqldf.options",envir=envir_stacomi)["sqldf.RPostgreSQL.port"]
# getting the database name
- dbname<-getdbname()
+ dbname=get("sqldf.options",envir=envir_stacomi)["sqldf.dbname"]
calcdata<-r_seaa at calcdata[["data"]]
data_in_base<-r_seaa at data
if (nrow(calcdata)==0) {
Modified: pkg/stacomir/R/stacomi.R
===================================================================
--- pkg/stacomir/R/stacomi.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/stacomi.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -370,20 +370,24 @@
sqldf.options=mylinks[["sqldf.options"]]
# values assigned in the envir_stacomi
assign("datawd",datawd,envir=envir_stacomi)
- assign("sqldf.options",sqldf.options,envir=envir_stacomi)
+
# default the usrname and usrpwd come from baseODBC
# the following values may be overridden later in load_stacomi()
assign("baseODBC",baseODBC,envir=envir_stacomi)
assign("sch",paste(baseODBC[2],".",sep=""),envir=envir_stacomi)
+ dbname<-getdbname()
+ #libraries()
+ # change 2018 the test database is no longer used, we use usernames and
+ # password from the local baseODBC string
+ options(sqldf.RPostgreSQL.user = unname(sqldf.options["sqldf.RPostgreSQL.user"]),
+ sqldf.RPostgreSQL.password = unname(sqldf.options["sqldf.RPostgreSQL.password"]),
+ sqldf.RPostgreSQL.dbname = unname(sqldf.options["sqldf.RPostgreSQL.dbname"]),
+ sqldf.RPostgreSQL.host = unname(sqldf.options["sqldf.RPostgreSQL.host"]),# 1.100.1.6
+ sqldf.RPostgreSQL.port = unname(sqldf.options["sqldf.RPostgreSQL.port"]))
- #libraries()
- options(sqldf.RPostgreSQL.user = sqldf.options["sqldf.uid"],
- sqldf.RPostgreSQL.password =sqldf.options["sqldf.pwd"],
- sqldf.RPostgreSQL.dbname = sqldf.options["sqldf.dbname"],
- sqldf.RPostgreSQL.host = sqldf.options["sqldf.host"],# 1.100.1.6
- sqldf.RPostgreSQL.port = sqldf.options["sqldf.port"])
+ assign("sqldf.options",sqldf.options,envir=envir_stacomi)
# loginWindow, will call the load_stacomi handler
# user login
if (gr_interface&login_window&database_expected){
@@ -547,18 +551,14 @@
## THESE LINES MUST BE UNCOMMENTED IN ORDER TO MAKE THE DOCUMENT METHOD FROM DEVTOOL WORK
#calcmig<-
-# structure(list(lienODBC = structure(1L, .Label = "bd_contmig_nat", class = "factor"),
-# uid = structure(1L, .Label = "iav", class = "factor"), pwd = structure(1L, .Label = "iav", class = "factor"),
-# sqldf.uid = structure(1L, .Label = "test", class = "factor"),
-# sqldf.pwd = structure(1L, .Label = "test", class = "factor"),
-# sqldf.dbname = structure(1L, .Label = "test", class = "factor"),
-# sqldf.host = structure(1L, .Label = "localhost", class = "factor"),
-# sqldf.port = 5432L, pgwd = structure(1L, .Label = "F:/workspace/stacomir/pkg/stacomir/R/", class = "factor"),
-# datawd = structure(1L, .Label = "~/CalcmigData", class = "factor"),
-# lang = structure(1L, .Label = "French", class = "factor")), .Names = c("lienODBC",
-# "uid", "pwd", "sqldf.uid", "sqldf.pwd", "sqldf.dbname", "sqldf.host",
-# "sqldf.port", "pgwd", "datawd", "lang"), class = "data.frame", row.names = c(NA,
-# -1L))
+# structure(list(lienODBC = structure(1L, .Label = "bd_contmig_nat", class = "factor"),
+# uid = structure(1L, .Label = "iav", class = "factor"), pwd = structure(1L, .Label = "iav", class = "factor"),
+# dbname = structure(1L, .Label = "bd_contmig_nat", class = "factor"),
+# host = structure(1L, .Label = "localhost", class = "factor"),
+# port = 5432L, pgwd = structure(1L, .Label = "C:/workspace/stacomir/pkg/stacomir/R/", class = "factor"),
+# datawd = structure(1L, .Label = "C:/Users/cedric.briand/Documents/CalcmigData", class = "factor"),
+# lang = structure(1L, .Label = "French", class = "factor")), class = "data.frame", row.names = c(NA,
+# -1L))
#' Working environment for stacomiR created when launching stacomi()
#'
#' This is where the graphical interface stores its objects
Modified: pkg/stacomir/R/utilities.R
===================================================================
--- pkg/stacomir/R/utilities.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/R/utilities.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -175,8 +175,15 @@
lang=tableau_config["lang",]
#pgwd=tableau_config["pgwd",]
baseODBC=c(tableau_config["lienODBC",],tableau_config["uid",],tableau_config["pwd",])
- sqldf.options=c(tableau_config["sqldf.uid",],tableau_config["sqldf.pwd",],tableau_config["sqldf.dbname",],tableau_config["sqldf.host",],tableau_config["sqldf.port",])
- return(list("datawd"=datawd,"baseODBC"=baseODBC,"lang"=lang,"sqldf.options"=sqldf.options))
+ if (!"dbname"%in%dimnames(tableau_config)[[1]])
+ stop("From version 0.5.4 you need to change C:/program files/calcmig.csv, rename
+ sqldf.dbname to dbname, sqldf.port to port and remove columns sqldf.uid and sqldf.pwd")
+ sqldf.options=c("sqldf.RPostgreSQL.user" = as.character(tableau_config["uid",]),
+ "sqldf.RPostgreSQL.password" = as.character(tableau_config["pwd",]),
+ "sqldf.RPostgreSQL.dbname" = as.character(tableau_config["dbname",]),
+ "sqldf.RPostgreSQL.host" = as.character(tableau_config["host",]),
+ "sqldf.RPostgreSQL.port" = as.character(tableau_config["port",]))
+ return(list("datawd" = datawd,"baseODBC"=baseODBC,"lang"=lang,"sqldf.options"=sqldf.options))
}
Modified: pkg/stacomir/data/calcmig.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/data/r_mig_mult.rda
===================================================================
(Binary files differ)
Modified: pkg/stacomir/inst/config/stacomi_manual_launch.r
===================================================================
--- pkg/stacomir/inst/config/stacomi_manual_launch.r 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/config/stacomi_manual_launch.r 2018-09-18 18:25:06 UTC (rev 501)
@@ -22,7 +22,7 @@
setwd(pgwd)
# pour voir apparaitre toutes les requetes dans R
# assign("showmerequest",1,envir=envir_stacomi)
-source ("C:/workspace/stacomir/pkg/stacomir/inst/config/libraries.R")
+source ("../inst/config/libraries.R")
@@ -100,7 +100,9 @@
source("interface_report_species.R")
source("stacomi.R")
# interface_report_species dans report_species
-setwd("C:/workspace/stacomir/pkg/stacomir")
+path0<-strsplit(pgwd,"/")$pgwd
+path0<- paste0(path0[-length(path0)],collapse="/")
+setwd(path0)
stacomi(gr_interface=TRUE,login_window=TRUE,database_expected=TRUE)
Modified: pkg/stacomir/inst/examples/report_mig-example.R
===================================================================
--- pkg/stacomir/inst/examples/report_mig-example.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/examples/report_mig-example.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -22,7 +22,6 @@
r_mig<-connect(r_mig)
########################
# calculations
-# note this requires to have a database test configured in postgres for use with sqldf
########################
r_mig<-calcule(r_mig,silent=TRUE)
}
Modified: pkg/stacomir/inst/examples/report_mig_interannual-example.R
===================================================================
--- pkg/stacomir/inst/examples/report_mig_interannual-example.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/examples/report_mig_interannual-example.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -18,8 +18,8 @@
assign("sch","pmp.",envir_stacomi)
# Note in some cases you will want to change host and port setting
# sqldf.options<-get("sqldf.options",envir=envir_stacomi)
-# sqldf.options["sqldf.host"]<-"www.myhostname.com"
-# sqldf.options["sqldf.port"]<-5433
+# sqldf.options["sqldf.RPostgreSQL.host"]<-"www.myhostname.com"
+# sqldf.options["sqldf.RPostgreSQL.port"]<-5433
# assign("sqldf.options",sqldf.options,envir_stacomi)
r_mig_interannual<-new("report_mig_interannual")
r_mig_interannual<-choice_c(r_mig_interannual,
Modified: pkg/stacomir/inst/examples/report_mig_mult-example.R
===================================================================
--- pkg/stacomir/inst/examples/report_mig_mult-example.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/examples/report_mig_mult-example.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -64,5 +64,5 @@
plot(r_mig_mult,plot.type="multiple",silent=TRUE)
# Data will be written in the data directory specified in
# the stacomi/calcmig.csv file
- summary(r_mig_mult,silent=TRUE)
+ summary(r_mig_mult,silent=FALSE)
}
Modified: pkg/stacomir/inst/tests/testthat/test-00-stacomir.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-00-stacomir.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/tests/testthat/test-00-stacomir.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -18,10 +18,8 @@
test_that("Test existence calcmig data within package",{
data("calcmig",package = "stacomiR")
calcmig<-calcmig
- expect_equal(length(calcmig),11)
-
+ expect_equal(length(calcmig),9)
}
-
)
test_that("Test that ODBC link exists and has the right length",{
Modified: pkg/stacomir/inst/tests/testthat/test-02-report_mig.R
===================================================================
--- pkg/stacomir/inst/tests/testthat/test-02-report_mig.R 2018-09-18 10:35:51 UTC (rev 500)
+++ pkg/stacomir/inst/tests/testthat/test-02-report_mig.R 2018-09-18 18:25:06 UTC (rev 501)
@@ -300,8 +300,8 @@
# password<-tclvalue(passVar);
# return(password);
# }
-# sqldf.options["sqldf.host"]<-getpassword()
-# sqldf.options["sqldf.port"]<-5432
+# sqldf.options["sqldf.RPostgreSQL.host"]<-getpassword()
+# sqldf.options["sqldf.RPostgreSQL.port"]<-5432
# assign("sqldf.options",sqldf.options,envir_stacomi)
# report_mig=new('report_mig')
# report_mig=choice_c(report_mig,
More information about the Stacomir-commits
mailing list