Commit ff069a5f authored by jml's avatar jml
Browse files

upgrade to friendlyts

parent 4247e6ff
Package: luftlyr
Type: Package
Version: 0.0.1
Version: 0.0.2
Authors@R: c(person("Jean-Marie", "Lepioufle", , "jml@nilu.no", role=c("aut","cre")),
person("NILU",role="cph"))
Title: luftlyr
Description: Make luftkvalitet dataset easy to manipulate.
The package provides:
1. libraries to access luftkvalitet
2. get friendly data.frame to work with
Description: Easy way to get the main luftkvalitet observations.
The package adapt friendlyr to luftkvalr:
1. authentication to the storage.
2. having timeserie dataset in a friendly format.
3. having metadata.
Depends:
R (>= 3.2.0)
Imports:
luftkvalr,
timelyr
friendlyts
Remotes: git::git@git.nilu.no:rdbnilu/luftkvalr.git,
git::git@git.nilu.no:rfriendlyr/timelyr.git
git::git@git.nilu.no:rfriendlyts/friendlyts.git
License: GPL-3
Encoding: UTF-8
LazyData: false
RoxygenNote: 5.0.1
RoxygenNote: 6.0.1
......@@ -11,16 +11,23 @@
#' }
luftlyr_df_data <- function(x,res){
tmp <- df_data(x=x,ugly_df=res)
if (x$dateStructObj$COL_DATE) {
# ..
} else if (!x$dateStructObj$COL_DATE){
tmp <- timelyr::checkDate(df = tmp, timeObj=x$timeObj, missingValues = NA,date_col="date",date_type="posixlt")
col_names <- get_name_date_col(x$timeObj$precision())
target <- setdiff(names(res), c(col_names,"ST_ID","ST_NAME","CO_NAME"))
tmp <- friendlyts::ts_spread(df=res, col_date=col_names,
col_key=c("CO_NAME","ST_ID"),col_target=target,
precision=x$timeObj$precision(),tzone=x$timeObj$tzone(),
date_type="df_yymmdd_hhmmss")
} else stop("COL_DATE in the right format")
df <- friendlyts::check_date(tbl_fts=tmp, fromDate=x$timeObj$fromDateTime(),toDate=x$timeObj$toDateTime(),timeResolution=x$timeObj$timeResolution(), v=x$timeObj$v(), precision=x$timeObj$precision(), tzone=x$timeObj$tzone(),missingValues=NA,date_type="posixlt")
if (x$dateStructObj$COL_DATE) {
stop("to be done")
}
return(df)
return(tmp)
}
#' luftlyr_df_qa
......@@ -35,64 +42,34 @@ luftlyr_df_data <- function(x,res){
#' luftlyr_df_qa()
#' }
luftlyr_df_qa <- function(x,res){
tmp <- df_data(x=x,ugly_df=res)
names(tmp) <- c(names(tmp)[1],paste0("qa_",names(tmp)[-1]))
if (x$dateStructObj$COL_DATE) {
# ..
} else if (!x$dateStructObj$COL_DATE){
tmp <- timelyr::checkDate(df = tmp, timeObj=x$timeObj, missingValues = NA, date_col="date",date_type="posixlt")
} else stop("COL_DATE in the right format")
return(tmp)
}
col_names <- get_name_date_col(x$timeObj$precision())
target <- setdiff(names(res), c(col_names,"ST_ID","ST_NAME","CO_NAME"))
df_data <- function(x,ugly_df){
tmp <- friendlyts::ts_spread(df=res, col_date=col_names,
col_key=c("CO_NAME","ST_ID"),col_target=target,
precision=x$timeObj$precision(),tzone=x$timeObj$tzone(),
date_type="df_yymmdd_hhmmss")
output <- data.frame(date = x$timeObj$seqPeriod())
target <- setdiff(names(ugly_df), c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC","ST_ID","ST_NAME","CO_NAME"))
for (i_e in 1:length(x$elementObj$element_id)) {
if (length(x$stationObj$station_id)>0) {
indice <- NULL
i_s <- 0
while ( (!length(indice)) && (i_s< length(x$stationObj$station_id))) {
i_s <- i_s+1
indice <- which( (ugly_df["ST_ID"] == x$stationObj$station_id[i_s]) & (ugly_df["CO_NAME"] == x$elementObj$element_id[i_e]))
}
stations_id <- x$stationObj$station_id[i_s]
tmp <- timelyr::checkDate(df=ugly_df[indice,],timeObj = x$timeObj, missingValues=NA,date_col=c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC"),date_type="df_yymmdd_hhmmss")[,target]
df <- tmp
if (length(x$stationObj$station_id)>1) {
while (i_s< length(x$stationObj$station_id)) {
indice <- NULL
while ( (!length(indice)) && (i_s< length(x$stationObj$station_id))) {
i_s <- i_s+1
indice <- which( (ugly_df["ST_ID"] == x$stationObj$station_id[i_s]) & (ugly_df["CO_NAME"] == x$elementObj$element_id[i_e]))
}
stations_id <- c(stations_id,x$stationObj$station_id[i_s])
tmp <- timelyr::checkDate(df=ugly_df[indice,],timeObj = x$timeObj, missingValues=NA,date_col=c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC"),date_type="df_yymmdd_hhmmss")[,target]
df <- cbind(df,tmp)
}
}
output$element <- data.frame(df)
colnames(output$element) <- (stations_id)
}
colnames(output) <- c("date",x$elementObj$element_id[1:i_e])
icol <- friendlyts::get_date_col(precision=x$timeObj$precision())
names(df) <- c(names(df)[icol],paste0("qa_",names(tmp)[-c(icol)]))
if (x$dateStructObj$COL_DATE) {
stop("to be done")
}
return(df)
}
# flatten the multi-data.frame
return(timelyr::flatten(output))
get_name_date_col <- function(precision){
res <- switch(precision,
"yearly" = "YEAR_UTC",
"monthly" = c("YEAR_UTC","MONTH_UTC"),
"daily" = c("YEAR_UTC","MONTH_UTC","DAY_UTC"),
"hourly" = c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC"),
"minute" = c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC","MINUTE_UTC"),
"second" = c("YEAR_UTC","MONTH_UTC","DAY_UTC","HOUR_UTC","MINUTE_UTC","SECOND_UTC"),
stop("precision not recognized"))
return(res)
}
......@@ -22,4 +22,3 @@ luftlyr_df_data()
}
}
\keyword{luftlyr}
......@@ -22,4 +22,3 @@ luftlyr_df_qa()
}
}
\keyword{luftlyr}
......@@ -22,4 +22,3 @@ luftlyr_friendly()
}
}
\keyword{luftlyr}
......@@ -24,4 +24,3 @@ luftlyr_get_data()
}
}
\keyword{luftlyr}
......@@ -24,4 +24,3 @@ luftlyr_get_meta()
}
}
\keyword{luftlyr}
......@@ -24,4 +24,3 @@ luftlyr_get_qa()
}
}
\keyword{luftlyr}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment