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

major upgrade

parent 260ce198
Package: frostr
Type: Package
Version: 0.0.1
Version: 0.1.0
Authors@R: c(person("Jean-Marie", "Lepioufle", , "jml@nilu.no", role=c("aut","cre")))
Title: frostr
Description: Extracting data from frostAPI.
......@@ -9,6 +9,7 @@ Depends:
R (>= 3.2.3)
Imports:
utils,
glue,
dplyr,
httr,
rapiclient
......
......@@ -2,3 +2,7 @@
S3method(print,api)
export(api)
export(get_short_data)
export(get_short_meta_element)
export(get_short_meta_station)
export(get_short_meta_station_with_element)
......@@ -98,7 +98,6 @@ api_object <- function(...){
res <- operations$observations(...)
if (res$status_code==200L) {
res <- httr::content(res)
res <- dplyr::bind_rows(lapply(res$data,data.frame))
} else res <- NULL
return(res)
}
......
#' get_short_data
#' get_short_data
#' @param frostObj frostObj
#' @param stations station ids
#' @param referencetime referencetime
#' @param elements elements
#' @param ... other parameters suich as levels in the case of temperature
#' @keywords frostr
#' @export
get_short_data <- function(frostObj,stations,referencetime,elements,...) {
tmp <- frostObj$observations(sources=paste(stations,collapse=","),
referencetime=referencetime,
elements=paste(elements,collapse=","),
...,
format='jsonld')
if(!is.null(tmp)) {
nrows <- tmp$totalItemCount
res <- short_data_init()
for ( i in 1:nrows) {
df <- short_data_df(tmp=tmp,indice=i)
res <- rbind(res,df)
}
}
return(res)
}
short_data_init <- function(){
df <- data.frame(sourceId = character(0),
referenceTime = character(0),
elementId = character(0),
value = numeric(0),
unit = character(0),
levelType = character(0),
levelUnit = character(0),
levelValue = character(0),
timeOffset = character(0),
timeResolution = character(0),
timeSeriesId = character(0),
performanceCategory = character(0),
exposureCategory = character(0),
qualityCode = character(0)
)
return(df)
}
short_data_df <- function(tmp,indice){
df <- data.frame(sourceId = ifelse(is.null(tmp$data[[indice]]$sourceId),NA,tmp$data[[indice]]$sourceId),
referenceTime = ifelse(is.null(tmp$data[[indice]]$referenceTime),NA,tmp$data[[indice]]$referenceTime),
elementId = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$elementId),NA,tmp$data[[indice]]$observations[[1]]$elementId),
value = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$value),NA,tmp$data[[indice]]$observations[[1]]$value),
unit = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$unit),NA,tmp$data[[indice]]$observations[[1]]$unit),
levelType = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$level$levelType),NA,tmp$data[[indice]]$observations[[1]]$level$levelType),
levelUnit = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$level$unit),NA,tmp$data[[indice]]$observations[[1]]$level$unit),
levelValue = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$level$value),NA,tmp$data[[indice]]$observations[[1]]$level$value),
timeOffset = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$timeOffset),NA,tmp$data[[indice]]$observations[[1]]$timeOffset),
timeResolution = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$timeResolution),NA,tmp$data[[indice]]$observations[[1]]$timeResolution),
timeSeriesId = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$timeSeriesId),NA,tmp$data[[indice]]$observations[[1]]$timeSeriesId),
performanceCategory = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$performanceCategory),NA,tmp$data[[indice]]$observations[[1]]$performanceCategory),
exposureCategory = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$exposureCategory),NA,tmp$data[[indice]]$observations[[1]]$exposureCategory),
qualityCode = ifelse(is.null(tmp$data[[indice]]$observations[[1]]$qualityCode),NA,tmp$data[[indice]]$observations[[1]]$qualityCode)
)
return(df)
}
#' get_short_meta_element
#' get_short_meta_element
#' @param frostObj frostObj
#' @param elements elements ids
#' @keywords frostr
#' @export
get_short_meta_element <- function(frostObj,elements) {
if (length(elements)>0) {
res <- data.frame(ID = character(0),CO_NAME=character(0))
for ( i in 1:length(elements)) {
tmp <- frostObj$timeSeries(elements=elements[i],format='jsonld')
if (!is.null(tmp)) {
stnr <-gsub(":.*","",tmp[,"sourceId"])
df <- data.frame(ID = stnr,CO_NAME = tmp[,"elementId"])
res <- rbind(res,df)
}
}
} else {
res <- NULL
}
return(unique(res))
}
#' get_short_meta_station
#' get_short_meta_station
#' @param frostObj frostObj
#' @param stations station ids
#' @param west west
#' @param south south
#' @param east east
#' @param north north
#' @keywords frostr
#' @export
get_short_meta_station <- function(frostObj,stations=NULL,west=NULL,south=NULL,east=NULL,north=NULL) {
if (!is.null(stations)) {
res <- data.frame(ALT= numeric(0), LON= numeric(0), NAME = character(0), ID = character(0))
for ( i in 1:length(stations)) {
tmp <- frostObj$getSources(ids=stations[i],format='jsonld')
if(!is.null(tmp)) {
df <- short_meta_df(tmp=tmp,indice=1)
res <- rbind(res,df)
}
}
} else if ((!is.null(west)) && (!is.null(south)) && (!is.null(east)) && (!is.null(north))){
geom <- glue::glue('POLYGON(({west} {south},{west} {north},{east} {north},{west} {south}))')
tmp <- frostObj$getSources(type="SensorSystem",geometry=geom,format='jsonld')
if(!is.null(tmp)) {
nbs <- tmp$totalItemCount
res <- data.frame(ALT= numeric(0), LON= numeric(0), NAME = character(0), ID = character(0))
for ( i in 1:nbs) {
df <- short_meta_df(tmp=tmp,indice=i)
res <- rbind(res,df)
}
}
} else {
res <- NULL
}
return(res)
}
#' get_short_meta_station_with_element
#' get_short_meta_station_with_element
#' @param frostObj frostObj
#' @param stations station ids
#' @param west west
#' @param south south
#' @param east east
#' @param north north
#' @param elements elements
#' @keywords frostr
#' @export
get_short_meta_station_with_element <- function(frostObj,stations=NULL,west=NULL,south=NULL,east=NULL,north=NULL,elements) {
ele_meta <- get_short_meta_element(frostObj=frostObj,elements=elements)
stn_meta <- get_short_meta_station(frostObj=frostObj,stations=stations,west=west,south=south,east=east,north=north)
res <- dplyr::inner_join(stn_meta,ele_meta)
return(res)
}
short_meta_df <- function(tmp,indice){
df <- data.frame(ALT = ifelse(is.null(tmp$data[[indice]]$masl),NA,tmp$data[[indice]]$masl),
LAT = ifelse(is.null(tmp$data[[indice]]$geometry$coordinates[[2]]),NA,tmp$data[[indice]]$geometry$coordinates[[2]]),
LON = ifelse(is.null(tmp$data[[indice]]$geometry$coordinates[[1]]),NA,tmp$data[[indice]]$geometry$coordinates[[1]]),
NAME = ifelse(is.null(tmp$data[[indice]]$name),NA,tmp$data[[indice]]$name),
ID = ifelse(is.null(tmp$data[[indice]]$id),NA,tmp$data[[indice]]$id))
return(df)
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_data.R
\name{get_short_data}
\alias{get_short_data}
\title{get_short_data
get_short_data}
\usage{
get_short_data(frostObj, stations, referencetime, elements, ...)
}
\arguments{
\item{frostObj}{frostObj}
\item{stations}{station ids}
\item{referencetime}{referencetime}
\item{elements}{elements}
\item{...}{other parameters suich as levels in the case of temperature}
}
\description{
get_short_data
get_short_data
}
\keyword{frostr}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_meta.R
\name{get_short_meta_element}
\alias{get_short_meta_element}
\title{get_short_meta_element
get_short_meta_element}
\usage{
get_short_meta_element(frostObj, elements)
}
\arguments{
\item{frostObj}{frostObj}
\item{elements}{elements ids}
}
\description{
get_short_meta_element
get_short_meta_element
}
\keyword{frostr}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_meta.R
\name{get_short_meta_station}
\alias{get_short_meta_station}
\title{get_short_meta_station
get_short_meta_station}
\usage{
get_short_meta_station(frostObj, stations = NULL, west = NULL,
south = NULL, east = NULL, north = NULL)
}
\arguments{
\item{frostObj}{frostObj}
\item{stations}{station ids}
\item{west}{west}
\item{south}{south}
\item{east}{east}
\item{north}{north}
}
\description{
get_short_meta_station
get_short_meta_station
}
\keyword{frostr}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/get_meta.R
\name{get_short_meta_station_with_element}
\alias{get_short_meta_station_with_element}
\title{get_short_meta_station_with_element
get_short_meta_station_with_element}
\usage{
get_short_meta_station_with_element(frostObj, stations = NULL, west = NULL,
south = NULL, east = NULL, north = NULL, elements)
}
\arguments{
\item{frostObj}{frostObj}
\item{stations}{station ids}
\item{west}{west}
\item{south}{south}
\item{east}{east}
\item{north}{north}
\item{elements}{elements}
}
\description{
get_short_meta_station_with_element
get_short_meta_station_with_element
}
\keyword{frostr}
---
title: "core_api"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{core_api}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include = FALSE}
library(frostr)
knitr::opts_chunk$set(collapse = T, comment = "#>")
```
## Play with the core api
```R
#get an id
frostr <- frostr::api()
frostr$register()
# restart with your id
id <- "your id"
frostr <- frostr::api(httpauth = 1,userpwd=paste0(id,":"))
# get some raw help
frostr$help()
# elements
frostr$help("getElements")
res <- frostr$getElements(format='jsonld')
# get the new name of the element RR_1
res <- frostr$getElements(oldElementCodes="RR_1",
format='jsonld')
#>sum(precipitation_amount PT1H)
# get the new name of the element TA
res <- frostr$getElements(oldElementCodes="TA",
format='jsonld')
#>air_temperature
# information about a timeseries
frostr$help("timeSeries")
res <- frostr$timeSeries(elements="sum(precipitation_amount PT1H)",
format='jsonld')
res <- frostr$timeSeries(sources="SN50540",
format='jsonld')
# information about a source
frostr$help("getSources")
res <- frostr$getSources(ids="SN50540:0",
format='jsonld')
west <- 10
south <- 60
north <- 65
east <- 11
geom <- glue::glue('POLYGON(({west} {south},{west} {north},{east} {north},{west} {south}))')
res <- frostr$getSources(type="SensorSystem",geometry=geom,
format='jsonld')
# observations
frostr$help("observations")
res <- frostr$observations(sources='SN18700',
referencetime='2017-01-01T00:00:00Z/2017-01-02T12:00:00',
elements='sum(precipitation_amount PT1H)',
format='jsonld')
res <- frostr$observations(sources='SN18700,SN19932',
referencetime='2017-01-01T00:00:00Z/2017-01-02T12:00:00',
elements='sum(precipitation_amount PT1H)',
format='jsonld')
res <- frostr$observations(sources='SN18700,SN19932',
referencetime='2017-01-01T00:00:00Z',
elements='air_temperature',
format='jsonld')
res <- frostr$observations(sources='SN18700,SN19932',
referencetime='2017-01-01T00:00:00Z',
elements='sum(precipitation_amount PT1H)',
format='jsonld')
res <- frostr$observations(sources='SN18700,SN19932',
referencetime='2017-01-01T00:00:00Z',
elements='sum(precipitation_amount PT1H),air_temperature',
format='jsonld')
# code table
frostr$help("getCodeTables")
res <- frostr$getCodeTables(format='jsonld')
res <- frostr$getCodeTables(ids="weather_symbol",format='jsonld')
# available timeseries
frostr$help("getAvailable")
res <- frostr$getAvailable(elements="accumulated(precipitation_amount)",
format='jsonld')
```
---
title: "get_data"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{get_data}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include = FALSE}
library(frostr)
knitr::opts_chunk$set(collapse = T, comment = "#>")
```
## Get easily data
```R
tmp <- frostr::get_short_data(frostObj=frostr,stations="SN18700",referencetime='2017-01-01T00:00:00Z',elements='sum(precipitation_amount PT1H)')
tmp <- frostr::get_short_data(frostObj=frostr,stations="SN18700",referencetime='2017-01-01T00:00:00Z',elements="air_temperature",levels=2)
tmp <- frostr::get_short_data(frostObj=frostr,stations="SN18700",referencetime='2017-01-01T00:00:00Z/2017-01-02T12:00:00',elements='sum(precipitation_amount PT1H)')
west <- 10
south <- 60
north <- 65
east <- 11
res <- frostr::get_short_meta_station_with_element(frostObj=frostr,west=10,south=60,east=11,north=65,elements='sum(precipitation_amount PT1H)')
tmp <- frostr::get_short_data(frostObj=frostr,stations=res$ID,referencetime='2017-01-01T00:00:00Z',elements='sum(precipitation_amount PT1H)')
```
---
title: "get_meta"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{get_meta}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r setup, include = FALSE}
library(frostr)
knitr::opts_chunk$set(collapse = T, comment = "#>")
```
## Get easily metadata
```R
stations <- "SN18700"
stn_meta <- frostr::get_short_meta_station(frostObj=frostr,stations=stations)
west <- 10
south <- 60
north <- 65
east <- 11
stn_meta <- frostr::get_short_meta_station(frostObj=frostr,stations=stations,west=west,south=south,east=east,north=north)
elements <- c("sum(precipitation_amount PT1H)")
ele_meta <- get_short_meta_element(frostObj=frostr,elements=elements)
res <- dplyr::inner_join(stn_meta,ele_meta)
# or quicker
res <- frostr::get_short_meta_station_with_element(frostObj=frostr,west=west,south=south,east=east,north=north,elements=elements)
```
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