major upgrade

DESCRIPTION

 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

NAMESPACE

@@ -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)

R/frostr.R

@@ -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)
     }

R/get_data.R

+#' 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)
+}

R/get_meta.R

+
+#' 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)
+}

man/get_short_data.Rd

+% 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}
+

man/get_short_meta_element.Rd

+% 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}
+

man/get_short_meta_station.Rd

+% 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}
+

man/get_short_meta_station_with_element.Rd

+% 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}
+

vignettes/core_api.Rmd

+---
+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')
+
+```

vignettes/get_data.Rmd

+---
+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)')
+
+```

vignettes/get_meta.Rmd

+---
+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)
+
+```