Commit efe03917 authored by Jean-Marie Lepioufle's avatar Jean-Marie Lepioufle
Browse files

minimize dependencies to dplyr

parent d3402e19
Package: basicr
Type: Package
Version: 0.0.3
Version: 0.0.4
Authors@R: c(person("Jean-Marie", "Lepioufle", , "jml@nilu.no", role=c("aut","cre")))
Title: basicr
Description: Basic information from a tbl_friendlyts data.frame.
Description: Basic information from a timeseries data.frame.
- Mean, standard-deviation, IQR. min, max,... on different groups: year, month, weekday, hour, minute, second.
- Timeseries of basic information.
- L-moments.
......@@ -11,20 +11,21 @@ Description: Basic information from a tbl_friendlyts data.frame.
Depends:
R (>= 3.4.1)
Imports:
tibble,
dplyr,
lmom,
ggplot2,
grDevices,
friendlyts
friendlyts,
plotfts
Suggests:
knitr,friendlyr, tidyr, d.luft.oslyr, nycflights13
knitr,glow, tidyr, d.luft.oslyr, nycflights13
Remotes:
git::https://git.nilu.no/rfriendlyts/friendlyts.git,
git::https://git.nilu.no/rfriendlyts/plotfts.git,
git::https://git.nilu.no/rfriendlyr/d.luft.oslyr.git,
git::https://git.nilu.no/rfriendlyr/friendlyr.git
git::https://git.nilu.no/rglow/glow.git
VignetteBuilder: knitr
License: GPL-3
License: MIT + file LICENSE
Encoding: UTF-8
LazyData: false
RoxygenNote: 6.1.1
The MIT License (MIT)
Copyright © 2020 NILU
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# Generated by roxygen2: do not edit by hand
export(basic_)
export(basic_group)
export(basic_info)
export(basic_ts)
export(plot_boxwhisk_ts)
export(plot_coverage_ts)
export(plot_lmrd)
export(plot_notna_ts)
export(plot_qq)
export(plot_qqRes)
export(plot_tbl_basic)
......
......@@ -12,30 +12,53 @@
#' basic_info()
#' }
basic_info <- function(df,target,group="none"){
if ((length(group)==1) && (group =="none")) {
res <- basic_(df,target)
} else if ( (length(group)>=1) && (prod(group %in% c("YEAR","MONTH","WDAY","DAY","HOUR","MINUTE","SECOND"))==1) && (sum(duplicated(group),na.rm=TRUE)==0) ){
res <- basic_group(df,target,group)
} else stop("group must refer to: 'none', 'YEAR', 'MONTH', 'WDAY', 'DAY','HOUR','MINUTE','SECOND'")
class(res) <- c(class(res),"tbl_basic")
return(res)
}
if (is.null(df) || (!inherits(df,"tbl_friendlyts")) ) {
stop("need non-null tbl_friendlyts df")
}
if ( (length(group)>=1) && (prod(group %in% c("YEAR","MONTH","WDAY","HOUR","MINUTE","SECOND"))==1) && (sum(duplicated(group),na.rm=TRUE)==0) ){
res <- df %>% group_by_(.dots=group) %>% basic_(target=target)
} else if ((length(group)==1) && (group =="none")) {
res <- df %>% basic_(target=target)
} else stop("group must refer to: 'none', 'YEAR', 'MONTH', 'WDAY', 'HOUR','MINUTE','SECOND'")
#' basic_group
res <- tibble::as_tibble(res)
class(res) <- c(class(res),"tbl_basic")
#' basic_group
#' @param df data.frame
#' @param target target
#' @param group "none","YEAR","MONTH","WDAY","HOUR","MINUTE","SECOND" or several
#' @keywords basicr
#' @export
#' @examples
#' \dontrun{
#' basic_group()
#' }
basic_group <- function(df,target,group){
split_v <- lapply(group,function(x){df[[x]]})
names(split_v) <- group
tmp <- split(df,split_v)
tmp2 <- lapply(tmp,function(x){basic_(x,target)})
tmp2 <- do.call("rbind",tmp2)
names_tmp2 <- names(tmp2)
tmp3 <- as.data.frame(do.call("rbind",strsplit(names(tmp),"[.]")),row.names=NULL)
names(tmp3) <- group
tmp4 <- cbind(tmp3,tmp2)
order_v <- lapply(group,function(x){as.integer(as.character(tmp4[[x]]))})
indice <- do.call("order",order_v)
res <- tmp4[indice,]
row.names(res) <- NULL
names(res) <- c(group, names_tmp2)
return(res)
}
#' basic_
#' basic_
#' @param df tbl_friendlyts object
#' @param x data.frame
#' @param target character
#' @keywords basicr
#' @export
......@@ -43,34 +66,20 @@ basic_info <- function(df,target,group="none"){
#' \dontrun{
#' basic_()
#' }
basic_ <- function(df,target){
names(df)[names(df)==target] <- "targ"
res <- df %>% summarise(
n = n(),
n_na = as.numeric(length(which(is.na(targ)))),
q_0 = as.numeric(stats::quantile(targ,probs=0,na.rm=TRUE)),
q_0_05 = as.numeric(stats::quantile(targ,probs=0.05,na.rm=TRUE)),
q_0_25 = as.numeric(stats::quantile(targ,probs=0.25,na.rm=TRUE)),
q_0_5 = as.numeric(stats::quantile(targ,probs=0.50,na.rm=TRUE)),
q_0_75 = as.numeric(stats::quantile(targ,probs=0.75,na.rm=TRUE)),
q_0_95 = as.numeric(stats::quantile(targ,probs=0.95,na.rm=TRUE)),
q_1 = as.numeric(stats::quantile(targ,probs=1,na.rm=TRUE)),
IQR = as.numeric(stats::quantile(targ,probs=0.75,na.rm=TRUE)) - as.numeric(stats::quantile(targ,probs=0.25,na.rm=TRUE)),
m = mean(targ, na.rm = TRUE),
sd = stats::sd(targ, na.rm = TRUE),
cv = stats::sd(targ, na.rm = TRUE)/mean(targ, na.rm = TRUE)
)
indice <- which(is.na(res$m))
if (length(indice)>0) {
res$m[indice] <- mean(res$m,na.rm=TRUE)
res$sd[indice] <- mean(res$sd,na.rm=TRUE)
return(res)
} else {
return(res)
}
basic_ <- function(x,target){
data.frame(ID = target,
n = length(x[[target]]),
n_na = as.numeric(length(which(is.na(x[[target]])))),
q_0 = as.numeric(stats::quantile(x[[target]],probs=0,na.rm=TRUE)),
q_0_05 = as.numeric(stats::quantile(x[[target]],probs=0.05,na.rm=TRUE)),
q_0_25 = as.numeric(stats::quantile(x[[target]],probs=0.25,na.rm=TRUE)),
q_0_5 = as.numeric(stats::quantile(x[[target]],probs=0.50,na.rm=TRUE)),
q_0_75 = as.numeric(stats::quantile(x[[target]],probs=0.75,na.rm=TRUE)),
q_0_95 = as.numeric(stats::quantile(x[[target]],probs=0.95,na.rm=TRUE)),
q_1 = as.numeric(stats::quantile(x[[target]],probs=1,na.rm=TRUE)),
IQR = as.numeric(stats::quantile(x[[target]],probs=0.75,na.rm=TRUE)) - as.numeric(stats::quantile(x[[target]],probs=0.25,na.rm=TRUE)),
m = mean(x[[target]], na.rm = TRUE), #l-1
sd = stats::sd(x[[target]], na.rm = TRUE),
cv = stats::sd(x[[target]], na.rm = TRUE)/mean(x[[target]], na.rm = TRUE),
samlmu2(x,target))
}
#' samlur
#' samlur
#' @param df tbl_friendlyts data.frame
#' @param x tbl_friendlyts data.frame
#' @param target target in character
#' @keywords basicr
#' @export
......@@ -9,13 +9,13 @@
#' \dontrun{
#' samlmu2()
#' }
samlmu2 <- function(df,target) {
samlmu2 <- function(x,target) {
res <- lapply(target,function(x){
tmp <- as.matrix(as.data.frame(df)[,x])
res <- lapply(target,function(y){
tmp <- as.matrix(as.data.frame(x)[,y])
res <- lmom::samlmu(tmp)
})
res <- dplyr::bind_cols(tibble::as_tibble(data.frame(ID=target)), dplyr::bind_rows(lapply(res, function(x) as.data.frame(t(x)))))
class(res) <- c(class(res),"tbl_lmom")
res <- do.call("rbind",lapply(res, function(y) as.data.frame(t(y))))
class(res) <- c(class(res),"tbl_lmom")
return(res)
}
......@@ -21,10 +21,11 @@
#' }
plot_boxwhisk_ts <- function(x,fromDate=NULL,toDate=NULL,timeResolution=NULL,tzone="UTC",path=tempdir(),name=NULL,width_mm=200,height_mm=200,y_name="Y-axis",DESKTOP=TRUE){
warning("Function plot_boxwhisk_ts() works w/ ggplot2 version 3.1.1, and will crash for more recent version ")
# sub-period
if (!is.null(fromDate) && !is.null(toDate) && !is.null(timeResolution)) {
df <- friendlyts::sub_period(tbl_fts=x,fromDate=fromDate,toDate=toDate,timeResolution=timeResolution,tzone=tzone)
df <- plotfts::sub_period(tbl_fts=x,fromDate=fromDate,toDate=toDate,timeResolution=timeResolution,tzone=tzone)
} else df <- x
df <- friendlyts::dfts(tbl_fts=df,timeResolution=timeResolution,tzone=tzone)
......
#' plot_notna_ts
#' plot_coverage_ts
#' plot_notna_ts
#' plot_coverage_ts
#' @param x object of class tbl_friendlyts
#' @param fromDate fromDate
#' @param toDate toDate
......@@ -16,14 +16,14 @@
#' @export
#' @examples
#' \dontrun{
#' plot_notna_ts()
#' plot_coverage_ts()
#' }
plot_notna_ts <- function(x,fromDate=NULL,toDate=NULL,timeResolution=NULL,tzone="UTC",path=tempdir(),name=NULL,width_mm=200,height_mm=200,DESKTOP=TRUE){
plot_coverage_ts <- function(x,fromDate=NULL,toDate=NULL,timeResolution=NULL,tzone="UTC",path=tempdir(),name=NULL,width_mm=200,height_mm=200,DESKTOP=TRUE){
# sub-period
if (!is.null(fromDate) && !is.null(toDate) && !is.null(timeResolution)) {
tmp <- friendlyts::sub_period(tbl_fts=x,fromDate=fromDate,toDate=toDate,timeResolution=timeResolution,tzone=tzone)
tmp <- plotfts::sub_period(tbl_fts=x,fromDate=fromDate,toDate=toDate,timeResolution=timeResolution,tzone=tzone)
} else tmp <- x
df <- friendlyts::dfts(tbl_fts=tmp,timeResolution=timeResolution,tzone=tzone)
......@@ -34,19 +34,19 @@ plot_notna_ts <- function(x,fromDate=NULL,toDate=NULL,timeResolution=NULL,tzone=
tmp <- lapply(target,function(y) {
res <- rep(1,length(df[[y]]))
res[is.na(df[[y]])] <- NA
res <- data.frame(date=df[["date"]],notna=res,target=y,stringsAsFactors=FALSE)
res <- data.frame(date=df[["date"]],available=res,target=y,stringsAsFactors=FALSE)
return(res)
})
tmp <- do.call("rbind",tmp)
tmp <- data.frame(date=tmp[,"date"],notna=tmp[,"notna"]*as.integer(as.factor(tmp[,"target"])),target = as.factor(tmp[,"target"]))
tmp <- data.frame(date=tmp[,"date"],available=tmp[,"available"]*as.integer(as.factor(tmp[,"target"])),target = as.factor(tmp[,"target"]))
#start plot
if (!(DESKTOP)) {
if(is.null(name)) {
filename <- normalizePath(file.path(path,paste0("na_ts.tiff")),mustWork = FALSE)
} else filename <-normalizePath(file.path(path,paste0("na_ts_",name,".tiff")),mustWork = FALSE)
filename <- normalizePath(file.path(path,paste0("available_ts.tiff")),mustWork = FALSE)
} else filename <-normalizePath(file.path(path,paste0("available_ts_",name,".tiff")),mustWork = FALSE)
grDevices::tiff(filename = filename, width = width_mm, height = height_mm,
units = "mm", pointsize = 12,
......@@ -58,15 +58,15 @@ plot_notna_ts <- function(x,fromDate=NULL,toDate=NULL,timeResolution=NULL,tzone=
# plot
p <- ggplot2::ggplot(tmp, ggplot2::aes(x=date,y=notna,colour=target)) +
p <- ggplot2::ggplot(tmp, ggplot2::aes(x=date,y=available,colour=target)) +
ggplot2::geom_point() +
ggplot2::labs(x = "date",y = "non-missing values") +
#ggplot2::labs(x = "date",y = "non-missing values") #+
ggplot2::theme(
axis.line.y=ggplot2::element_blank(),
axis.text.y=ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
axis.text.y=ggplot2::element_blank()
#panel.grid.major = ggplot2::element_blank(),
#panel.grid.minor = ggplot2::element_blank()
)
print(p)
if (!(DESKTOP)) {
......
......@@ -7,6 +7,7 @@
#' @param path path
#' @param name name
#' @param DESKTOP boolean
#' @param LEGEND boolean
#' @param width_mm width_mm
#' @param height_mm height_mm
#' @keywords basicr
......@@ -15,9 +16,9 @@
#' \dontrun{
#' plot_lmrd()
#' }
plot_lmrd<-function(x, path=tempdir(),name=NULL,DESKTOP=TRUE,width_mm=200,height_mm=200) {
plot_lmrd<-function(x, path=tempdir(),name=NULL,DESKTOP=TRUE,LEGEND=TRUE,width_mm=200,height_mm=200) {
if (inherits(x,"tbl_lmom")) {
if (inherits(x,"tbl_lmom") || inherits(x,"tbl_basic")) {
#start plot
if (!(DESKTOP)) {
......@@ -54,10 +55,12 @@ plot_lmrd<-function(x, path=tempdir(),name=NULL,DESKTOP=TRUE,width_mm=200,height
ggplot2::scale_shape_discrete(name ="2-par distribution") +
ggplot2::scale_linetype_discrete(name ="3-par distribution") +
ggplot2::geom_point( data=x, ggplot2::aes(x=t_3,y=t_4,colour=ID),size=2,shape=8) +
#ggplot2::guides(colour=LEGEND) +
ggplot2::labs(x = expression(italic(L) * "-skewness"),y = expression(italic(L) * "-kurtosis")) +
ggplot2::xlim(x_min,x_max) +
ggplot2::ylim(y_min,y_max)
print(p)
if (!(DESKTOP)) {
......
......@@ -34,8 +34,8 @@ plot_qq <- function(x,reference,client,path=tempdir(),name=NULL,width_mm=200,hei
names(x)[names(x)==client] <- "clie"
p <- ggplot2::ggplot(x, ggplot2::aes(x = refe, y = clie)) +
ggplot2::geom_abline(lty = "dashed", col = "red") +
ggplot2::geom_point() +
ggplot2::geom_abline(lty = "dashed", col = "red") +
ggplot2::theme(plot.title = ggplot2::element_text(hjust = 0.5)) +
ggplot2::coord_fixed(ratio = 1) +
ggplot2::labs(
......
......@@ -19,7 +19,7 @@
#' }
plot_tbl_basic <- function(x,target,group,path=tempdir(),name=NULL,DESKTOP=TRUE,width_mm=200,height_mm=200,y_name="Y-axis"){
if ( (length(group)==1) && (prod(group %in% c("YEAR","MONTH","WDAY","HOUR","MINUTE","SECOND"))==1) ){
if ( (length(group)==1) && (prod(group %in% c("YEAR","MONTH","WDAY","DAY","HOUR","MINUTE","SECOND"))==1) ){
if (!DESKTOP) {
if(is.null(name)) {
......@@ -39,6 +39,7 @@ plot_tbl_basic <- function(x,target,group,path=tempdir(),name=NULL,DESKTOP=TRUE,
"YEAR" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = YEAR, y = targ)) + ggplot2::labs(x = group, y = y_name),
"MONTH" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = MONTH, y = targ)) + ggplot2::labs(x = group, y = y_name),
"WDAY" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = WDAY, y = targ)) + ggplot2::labs(x = group, y = y_name),
"DAY" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = DAY, y = targ)) + ggplot2::labs(x = group, y = y_name),
"HOUR" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = HOUR, y = targ)) + ggplot2::labs(x = group, y = y_name),
"MINUTE" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = MINUTE, y = targ)) + ggplot2::labs(x = group, y = y_name),
"SECOND" = ggplot2::ggplot(x) + ggplot2::geom_boxplot(ggplot2::aes(x = SECOND, y = targ)) + ggplot2::labs(x = group, y = y_name),
......@@ -53,7 +54,7 @@ plot_tbl_basic <- function(x,target,group,path=tempdir(),name=NULL,DESKTOP=TRUE,
return(TRUE)
} else stop("group must be of length 1 and refer to: 'YEAR', 'MONTH', 'WDAY', 'HOUR','MINUTE','SECOND'")
} else stop("group must be of length 1 and refer to: 'YEAR', 'MONTH', 'WDAY', 'DAY', 'HOUR','MINUTE','SECOND'")
}
......@@ -16,6 +16,12 @@ Basic information from a tbl_friendlyts data.frame:
```R
library("devtools")
devtools::install_git("https://git.nilu.no/rdiagnosis/basicr.git")
# remarks
# basicr requires ggplot2 version 3.1.1
remove.packages("ggplot2")
install.packages("https://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_3.1.1.tar.gz", repo=NULL, type="source")
```
## Usage
......
......@@ -5,10 +5,10 @@
\title{basic_
basic_}
\usage{
basic_(df, target)
basic_(x, target)
}
\arguments{
\item{df}{tbl_friendlyts object}
\item{x}{data.frame}
\item{target}{character}
}
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/basicr.R
\name{basic_group}
\alias{basic_group}
\title{basic_group
basic_group}
\usage{
basic_group(df, target, group)
}
\arguments{
\item{df}{data.frame}
\item{target}{target}
\item{group}{"none","YEAR","MONTH","WDAY","HOUR","MINUTE","SECOND" or several}
}
\description{
basic_group
basic_group
}
\examples{
\dontrun{
basic_group()
}
}
\keyword{basicr}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plot_na_ts.R
\name{plot_notna_ts}
\alias{plot_notna_ts}
\title{plot_notna_ts
plot_notna_ts}
% Please edit documentation in R/plot_coverage_ts.R
\name{plot_coverage_ts}
\alias{plot_coverage_ts}
\title{plot_coverage_ts
plot_coverage_ts}
\usage{
plot_notna_ts(x, fromDate = NULL, toDate = NULL,
plot_coverage_ts(x, fromDate = NULL, toDate = NULL,
timeResolution = NULL, tzone = "UTC", path = tempdir(),
name = NULL, width_mm = 200, height_mm = 200, DESKTOP = TRUE)
}
......@@ -31,12 +31,12 @@ plot_notna_ts(x, fromDate = NULL, toDate = NULL,
\item{DESKTOP}{boolean}
}
\description{
plot_notna_ts
plot_notna_ts
plot_coverage_ts
plot_coverage_ts
}
\examples{
\dontrun{
plot_notna_ts()
plot_coverage_ts()
}
}
\keyword{friendlyts}
......@@ -6,7 +6,7 @@
plot_lmrd}
\usage{
plot_lmrd(x, path = tempdir(), name = NULL, DESKTOP = TRUE,
width_mm = 200, height_mm = 200)
LEGEND = TRUE, width_mm = 200, height_mm = 200)
}
\arguments{
\item{x}{tbl_lmom data.frame}
......@@ -17,6 +17,8 @@ plot_lmrd(x, path = tempdir(), name = NULL, DESKTOP = TRUE,
\item{DESKTOP}{boolean}
\item{LEGEND}{boolean}
\item{width_mm}{width_mm}
\item{height_mm}{height_mm}
......
......@@ -5,10 +5,10 @@
\title{samlur
samlur}
\usage{
samlmu2(df, target)
samlmu2(x, target)
}
\arguments{
\item{df}{tbl_friendlyts data.frame}
\item{x}{tbl_friendlyts data.frame}
\item{target}{target in character}
}
......
......@@ -14,30 +14,12 @@ knitr::opts_chunk$set(collapse = T, comment = "#>")
## Basic analysis on 'data.luftkval.oslo10' df.
### install
```R
library("devtools")
devtools::install_git("https://git.nilu.no/rfriendlyr/friendlyr.git")
devtools::install_git("https://git.nilu.no/rfriendlyr/d.luft.oslyr.git")
devtools::install_git("https://git.nilu.no/rdiagnosis/basicr.git")
# remarks
# basicr requires ggplot2 version 3.1.1
remove.packages("ggplot2")
install.packages("https://cran.r-project.org/src/contrib/Archive/ggplot2/ggplot2_3.1.1.tar.gz", repo=NULL, type="source")
```
### Get the 'data.luftkval.oslo10' dataset with friendlyr.
The dataset represents real observations, meaning that it contains errors.
It is possible to know the quality of the value by requesting the qa flags with 'friendlyr::qa()', cf this [vignette](https://git.nilu.no/rfriendlyr/friendlyr/blob/master/vignettes/data.luftkval.oslo10.Rmd)
### Get 'data.luftkval.oslo10' dataset.
```R
fromDate <- "2004/01/01 00:00:00"
fromDate <- "2015/01/01 00:00:00"
toDate <- "2018/12/31 23:00:00"
timeResolution <- "hourly"
precision <- "hourly"
......@@ -45,23 +27,42 @@ precision <- "hourly"
element_id <- c("NO2")
# station ids
station_id <- c("7","848","464","827","665","9","11","163","504","809")
station_id <- c("7","848","827","665","9","11","163","504","809")
# luft
luft <- friendlyr::ts(service="d.luft.oslyr",
luft <- glow::ts(service="d.luft.oslyr",
fromDate=fromDate,toDate=toDate,precision=timeResolution,timeResolution=timeResolution,
element_id=element_id,station_id=station_id)
# filter values equal to -9900 used as NA
varnames <- setdiff(names(luft), friendlyts::get_name_date_col(precision))
library(dplyr)
library(tidyr)
tmp <- luft %>% select(names(luft)) %>%
gather(variable, value, -c(friendlyts::get_name_date_col(precision))) %>%
mutate(value = replace(value, value == -9900, NA)) %>%
spread(variable, value) %>% friendlyts::as_tbl_friendlyts(precision=precision,date_type="friendlyts")
# qa indicator
luft_qa <- glow::qa(service="d.luft.oslyr",
fromDate=fromDate,toDate=toDate,precision=timeResolution,timeResolution=timeResolution,
element_id=element_id,station_id=station_id)
study <- friendlyts::bind_cols_fts(luft,luft_qa,precision="hourly")
study <- stats::na.omit(study)
head(study)
```
## Focus on valid data
```r
# read qcflag nilu meta
path <- try(normalizePath(file.path(.libPaths()[1],"data.luftkval.oslo10","data","qcflag_meta.rda"),mustWork=TRUE))
tmp <- load(file=path)
qcflag_meta <- get(tmp)
known_ok <- qcflag_meta %>% filter(FlagType=="OK") %>% select(ID)
all <- paste0(element_id,"_",station_id)
qa_all <- paste0("qa_",element_id,"_",station_id)
cond <- paste(qa_all, "%in%", known_ok,collapse=" & ")
# valid data on train/test dataset
study <- study %>% filter(eval(parse(text=cond))) %>% select(c("WDAY","YEAR","MONTH","DAY","HOUR"),tidyselect::all_of(all),tidyselect::all_of(qa_all)) %>% friendlyts::as_tbl_friendlyts(precision=precision,date_type="friendlyts",CHECKNAS=FALSE)
study <- stats::na.omit(study)
```
......@@ -69,7 +70,7 @@ tmp <- luft %>% select(names(luft)) %>%
```R
basicr::plot_notna_ts(x=tmp,timeResolution=timeResolution,DESKTOP=TRUE)
basicr::plot_coverage_ts(x=study,timeResolution=timeResolution,DESKTOP=TRUE)
```
......@@ -77,17 +78,17 @@ basicr::plot_notna_ts(x=tmp,timeResolution=timeResolution,DESKTOP=TRUE)
```R
basicr::basic_info(df=tmp,target="NO2_7",group="none")
basicr::basic_info(df=tmp,target="NO2_7",group="YEAR")
basicr::basic_info(df=tmp,target="NO2_7",group="MONTH")
basicr::basic_info(df=tmp,target="NO2_7",group="WDAY")
basicr::basic_info(df=tmp,target="NO2_7",group="HOUR")
basicr::basic_info(df=tmp,target="NO2_7",group=c("YEAR","MONTH"))
res <- basicr::basic_info(df=tmp,target="NO2_7",group=c("MONTH","WDAY","HOUR"))
basicr::basic_info(df=study,target="NO2_7",group="none")
basicr::basic_info(df=study,target="NO2_7",group="YEAR")
basicr::basic_info(df=study,target="NO2_7",group="MONTH")
basicr::basic_info(df=study,target="NO2_7",group="WDAY")
basicr::basic_info(df=study,target="NO2_7",group="HOUR")
basicr::basic_info(df=study,target="NO2_7",group=c("YEAR","MONTH"))
basicr::basic_info(df=study,target="NO2_7",group=c("WDAY","HOUR"))
basicr::plot_tbl_basic(tmp,target="NO2_7",group="HOUR",y_name="[ug/m3]")
basicr::plot_tbl_basic(tmp,target="NO2_7",group="WDAY",y_name="[ug/m3]")
basicr::plot_tbl_basic(tmp,target="NO2_7",group="MONTH",y_name="[ug/m3]")