Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Rfriendlyr
luftlyr
Commits
ff069a5f
Commit
ff069a5f
authored
Jun 18, 2018
by
jml
Browse files
upgrade to friendlyts
parent
4247e6ff
Changes
8
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
ff069a5f
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:rfriendly
r/timelyr
.git
git::git@git.nilu.no:rfriendly
ts/friendlyts
.git
License: GPL-3
Encoding: UTF-8
LazyData: false
RoxygenNote:
5
.0.1
RoxygenNote:
6
.0.1
R/luftlyr_df.R
View file @
ff069a5f
...
...
@@ -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
)
}
man/luftlyr_df_data.Rd
View file @
ff069a5f
...
...
@@ -22,4 +22,3 @@ luftlyr_df_data()
}
}
\keyword{luftlyr}
man/luftlyr_df_qa.Rd
View file @
ff069a5f
...
...
@@ -22,4 +22,3 @@ luftlyr_df_qa()
}
}
\keyword{luftlyr}
man/luftlyr_friendly.Rd
View file @
ff069a5f
...
...
@@ -22,4 +22,3 @@ luftlyr_friendly()
}
}
\keyword{luftlyr}
man/luftlyr_get_data.Rd
View file @
ff069a5f
...
...
@@ -24,4 +24,3 @@ luftlyr_get_data()
}
}
\keyword{luftlyr}
man/luftlyr_get_meta.Rd
View file @
ff069a5f
...
...
@@ -24,4 +24,3 @@ luftlyr_get_meta()
}
}
\keyword{luftlyr}
man/luftlyr_get_qa.Rd
View file @
ff069a5f
...
...
@@ -24,4 +24,3 @@ luftlyr_get_qa()
}
}
\keyword{luftlyr}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment