- In the parent directory of the project:
R CMD build sos4R; R CMD check --as-cran sos4R_<version number>.tar.gzshould have no errors, warnings, or notes -
-
revdepcheck::revdep_check()for checking reverse dependencies
+ -
devtools::check_win_release()anddevtools::check_win_devel()for testing Windows using CRAN infrastructure -
@@ -466,7 +466,7 @@
diff --git a/docs/articles/index.html b/docs/articles/index.html index fb66b78..db40fce 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -60,7 +60,7 @@ @@ -146,7 +146,7 @@
All vignettes
diff --git a/docs/articles/sos4R-vignette-01-quickstart.html b/docs/articles/sos4R-vignette-01-quickstart.html index ca9f91e..49b1e0f 100644 --- a/docs/articles/sos4R-vignette-01-quickstart.html +++ b/docs/articles/sos4R-vignette-01-quickstart.html @@ -30,7 +30,7 @@ @@ -98,7 +98,7 @@Daniel Nüst
Institute for Geoinformatics, University of Münster, Germany.
daniel.nuest@uni-muenster.de -2019-04-13
+2019-08-09
Source:vignettes/sos4R-vignette-01-quickstart.Rmd@@ -340,9 +340,9 @@sos4R-vignette-01-quickstart.Rmd#> http://sensorweb.demo.52north.org/sensorwebtestbed/service/kvp?service=SOS&version=1.0.0&request=GetObservation&offering=ws2500&observedProperty=AirTemperature&responseFormat=text%2Fxml%3Bsubtype%3D%22om%2F1.0.0%22&eventTime=2017-12-19T00%3A00%3A00%2F2017-12-20T00%3A00%3A00&procedure=ws2500 #> [.getObservation_1.0.0] RESPONSE DOC: #> {xml_document} -#> <ObservationCollection id="oc_1555162551516" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> +#> <ObservationCollection id="oc_1565356052976" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> #> [1] <gml:boundedBy>\n <gml:Envelope srsName="urn:ogc:def:crs:EPSG::4326 ... -#> [2] <om:member>\n <om:Observation gml:id="o_1555162551516">\n <om:sa ... +#> [2] <om:member>\n <om:Observation gml:id="o_1565356052976">\n <om:sa ... #> [sos4R] Finished getObservation to http://sensorweb.demo.52north.org/sensorwebtestbed/service/kvp #> --> received 1 observation(s) having 72 result values [ 72 ].
diff --git a/docs/articles/sos4R-vignette-02-ogc-sos.html b/docs/articles/sos4R-vignette-02-ogc-sos.html index 983febd..f423206 100644 --- a/docs/articles/sos4R-vignette-02-ogc-sos.html +++ b/docs/articles/sos4R-vignette-02-ogc-sos.html @@ -30,7 +30,7 @@ @@ -98,7 +98,7 @@getObservation(sos = mySOS, offering = off.1, @@ -416,9 +416,9 @@#> [.sosRequest_1.0.0] ... done. #> [.sosRequest_1.0.0] RESPONSE: #> {xml_document} -#> <ObservationCollection id="oc_1555162551773" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> +#> <ObservationCollection id="oc_1565356053149" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> #> [1] <gml:boundedBy>\n <gml:Envelope srsName="urn:ogc:def:crs:EPSG::4326 ... -#> [2] <om:member>\n <om:Observation gml:id="o_1555162551773">\n <om:sa ... +#> [2] <om:member>\n <om:Observation gml:id="o_1565356053149">\n <om:sa ... #> [sos4R] Received response (object size: 784 bytes), parsing ... #> [.getObservation_1.0.0] Got XML document as response. #> [.getObservation_1.0.0] Parsing with function function(obj, sos, verbose = FALSE) { @@ -439,7 +439,7 @@
#> #> return(.om) #> } -#> <bytecode: 0x4a6c148> +#> <bytecode: 0x55709bbcac60> #> <environment: namespace:sos4R> #> [parseOM] Matched name for parser is om:ObservationCollection #> [parseObservationCollection] with 1 element(s). @@ -447,7 +447,7 @@
#> [parseOM] Matched name for parser is om:member #> [parseObservationProperty] Parsing child of member: om:Observation #> [parseOM] Matched name for parser is om:Observation -#> [parseObservation] o_1555162551773 +#> [parseObservation] o_1565356053149 #> [parsePhenomenonProperty] with reference AthmosphericPressure #> [parseTime] Entering #> [parseTime] Found time period @@ -478,14 +478,14 @@
#> .t <- as.POSIXct(x = strptime(x = x, format = sosTimeFormat(sos = sos))) #> return(.t) #> } -#> <bytecode: 0x518eb68> +#> <bytecode: 0x55709c25d230> #> <environment: namespace:sos4R> #> [parseValues] Using converter function: #> function(x, sos) { #> .t <- as.POSIXct(x = strptime(x = x, format = sosTimeFormat(sos = sos))) #> return(.t) #> } -#> <bytecode: 0x518eb68> +#> <bytecode: 0x55709c25d230> #> <environment: namespace:sos4R> #> [parseValues] Binding additional data.frame for phenomenonTime -- value range 2018-01-01 00:30:00, 2018-01-03 00:00:00 #> [parseValues] Added column name: phenomenonTime @@ -505,7 +505,7 @@
#> function(x, sos) { #> return(as.double(x = x)) #> } -#> <bytecode: 0x53a02d8> +#> <bytecode: 0x55709c365a80> #> <environment: namespace:sos4R> #> [parseValues] Binding additional data.frame for AthmosphericPressure -- value range 989, 1003 #> [parseValues] Added column name: AthmosphericPressure @@ -531,7 +531,7 @@
#> [parseTime] Done: GmlTimePosition [ time: 2018-01-01 01:00:00 ] #> [parseOM] Done parsing #> [parseOM] Done parsing -#> [parseObservationCollection] Done. Processed 1 elements: ws2500_AthmosphericPressure_sf_C3C3285BCF1770CA697771FA167679B0895680C2 +#> [parseObservationCollection] Done. Processed 1 elements: ws2500_AthmosphericPressure_sf_C9037B369701DDFB4E61AED09643EAB11249B5D8 #> [parseOM] Done parsing #> [.getObservationById_1.0.0] Got OmObservationCollection ... calculating length with sosResult()[.getObservationById_1.0.0] result: list(phenomenonTime = c(1514763000, 1514763900, 1514764800, 1514766600, 1514767500, 1514768400, 1514770200, 1514771100, 1514772000, 1514773800, 1514774700, 1514775600, 1514777400, 1514778300, 1514779200, 1514781000, 1514781900, 1514783700, 1514784600, 1514785500, 1514786400, 1514788200, 1514789100, 1514790000, 1514791800, 1514792700, 1514793600, 1514795400, 1514796300, 1514797200, 1514799000, 1514799900, 1514800800, 1514802600, 1514803500, 1514804400, 1514806200, 1514807100, 1514808000, 1514809800, #> 1514810700, 1514811600, 1514813400, 1514814300, 1514815200, 1514817000, 1514817900, 1514818800, 1514820600, 1514821500, 1514822400, 1514824200, 1514825100, 1514826000, 1514827800, 1514828700, 1514829600, 1514831400, 1514832300, 1514833200, 1514835000, 1514835900, 1514836800, 1514838600, 1514839500, 1514840400, 1514842200, 1514843100, 1514844000, 1514845800, 1514846700, 1514847600, 1514849400, 1514850300, 1514851200, 1514853000, 1514853900, 1514854800, 1514856600, 1514857500, 1514858400, 1514860200, @@ -602,7 +602,7 @@
Daniel Nüst
Institute for Geoinformatics, University of Münster, Germany.
daniel.nuest@uni-muenster.de -2019-04-13
+2019-08-09
Source:vignettes/sos4R-vignette-02-ogc-sos.Rmd@@ -206,7 +206,7 @@sos4R-vignette-02-ogc-sos.Rmddiff --git a/docs/articles/sos4R-vignette-03-sos-operations.html b/docs/articles/sos4R-vignette-03-sos-operations.html index 976227b..df8b542 100644 --- a/docs/articles/sos4R-vignette-03-sos-operations.html +++ b/docs/articles/sos4R-vignette-03-sos-operations.html @@ -30,7 +30,7 @@ @@ -98,7 +98,7 @@
Daniel Nüst
Institute for Geoinformatics, University of Münster, Germany.
daniel.nuest@uni-muenster.de -2019-04-13
+2019-08-09
Source:vignettes/sos4R-vignette-03-sos-operations.Rmd@@ -462,20 +462,23 @@sos4R-vignette-03-sos-operations.Rmd+#> Checking rgeos availability: FALSE +#> Note: when rgeos is not available, polygon geometry computations in maptools depend on gpclib, +#> which has a restricted licence. It is disabled by default; +#> to enable gpclib, type gpclibPermit() +data(worldHiresMapEnv) +crs <- sosGetCRS(mySOS)[[1]] +worldHigh <- pruneMap( + map(database = "worldHires", + region = c("Germany", "Austria", "Netherlands"), + plot = FALSE)) +worldHigh.lines <- map2SpatialLines(worldHigh, proj4string = crs) + +# the plot: +plot(worldHigh.lines, col = "grey50") +plot(mySOS, add = TRUE, lwd = 3) +title(main = paste("Offerings by '", sosTitle(mySOS), "'", sep = ""), + sub = toString(names(sosOfferings(mySOS))))# background map: library("maps"); library("mapdata"); library("maptools") #> Loading required package: sp -#> Checking rgeos availability: TRUE -data(worldHiresMapEnv) -crs <- sosGetCRS(mySOS)[[1]] -worldHigh <- pruneMap( - map(database = "worldHires", - region = c("Germany", "Austria", "Netherlands"), - plot = FALSE)) -worldHigh.lines <- map2SpatialLines(worldHigh, proj4string = crs) - -# the plot: -plot(worldHigh.lines, col = "grey50") -plot(mySOS, add = TRUE, lwd = 3) -title(main = paste("Offerings by '", sosTitle(mySOS), "'", sep = ""), - sub = toString(names(sosOfferings(mySOS))))
@@ -897,7 +900,7 @@
#> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: AirTemperature -#> foi: sf_B6EC41A0E69F7A2AA24F2307944A6CAB5833E952 +#> foi: sf_70C6FE193D45B813FBDE00F54E29F691A25A58EC #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 @@ -938,11 +941,11 @@
cat("------\n") #> ------ myObservationData[index.obsProp] -#> $o_1555162558924 +#> $o_1565356068080 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: AirTemperature -#> foi: sf_B6EC41A0E69F7A2AA24F2307944A6CAB5833E952 +#> foi: sf_70C6FE193D45B813FBDE00F54E29F691A25A58EC #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 @@ -955,83 +958,83 @@
cat("------\n") #> ------ myObservationData[index.proc] -#> $o_1555162558924 +#> $o_1565356068080 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: AirTemperature -#> foi: sf_B6EC41A0E69F7A2AA24F2307944A6CAB5833E952 +#> foi: sf_70C6FE193D45B813FBDE00F54E29F691A25A58EC #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558928 +#> $o_1565356068081 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: RainfallAccumulated -#> foi: sf_ECE82997AE34E24608C5F65A0AF685998AB3E589 +#> foi: sf_C3378C4973BDD7786ADA2B2E5AECC25FC1045852 #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558929 +#> $o_1565356068082 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: Humidity -#> foi: sf_E9852B02E184F6FFC8983743045D6A2DFF4DE520 +#> foi: sf_39A1A9F2920D559BE060F0A75960813F5C94D71E #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558930 +#> $o_1565356068083 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: AthmosphericPressure -#> foi: sf_485D30222B1DA73909079C17A8C28BDF69AAA997 +#> foi: sf_F80B5EB3A550F862411E1327D6E09CCE5F191DF4 #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558931 +#> $o_1565356068084 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: WindDirection -#> foi: sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF8299 +#> foi: sf_63980E8519C24F68ECBA1130CA69C83675CE1C14 #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558932 +#> $o_1565356068102 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: Windchill -#> foi: sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF82991 +#> foi: sf_A517067DD435DBB494E33BC87A4BF547CF09E4B6 #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558933 +#> $o_1565356068103 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: Dewpoint -#> foi: sf_37D74410B385F30771C191630CA14E0B0C732E58 +#> foi: sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558934 +#> $o_1565356068104 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: Luminance -#> foi: sf_71DF230CC564A88481B0304D9CCA7E82A3A6DDD9 +#> foi: sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B1 #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 #> -#> $o_1555162558935 +#> $o_1565356068105 #> Object of class OmObservation; #> procedure: ws2500 #> observedProperty: WindSpeed -#> foi: sf_E9A612A92201ECA557D702B16B6F74CCF925AB89 +#> foi: sf_65B66DC8B5E532115D97C0A09C41214BD2A35ABC #> samplingTime: GmlTimePeriod: [ GmlTimePosition [ time: 2018-01-01 00:30:00 ] #> --> GmlTimePosition [ time: 2018-01-06 ] ] #> result dimensions: 360, 2 @@ -1041,24 +1044,24 @@
Result Extraction
Data Values can be extracted from observations, measurements and observation collections with the function
sosResult(). The function returns an object of classdata.frame. In the case of collections, it automatically binds the data frames (you can turn this off by addingbind = FALSEas a parameter).+#> o_1565356068080.proc_obsProp_foiID +#> "ws2500_AirTemperature_sf_70C6FE193D45B813FBDE00F54E29F691A25A58EC" +#> o_1565356068081.proc_obsProp_foiID +#> "ws2500_RainfallAccumulated_sf_C3378C4973BDD7786ADA2B2E5AECC25FC1045852" +#> o_1565356068082.proc_obsProp_foiID +#> "ws2500_Humidity_sf_39A1A9F2920D559BE060F0A75960813F5C94D71E" +#> o_1565356068083.proc_obsProp_foiID +#> "ws2500_AthmosphericPressure_sf_F80B5EB3A550F862411E1327D6E09CCE5F191DF4" +#> o_1565356068084.proc_obsProp_foiID +#> "ws2500_WindDirection_sf_63980E8519C24F68ECBA1130CA69C83675CE1C14" +#> o_1565356068102.proc_obsProp_foiID +#> "ws2500_Windchill_sf_A517067DD435DBB494E33BC87A4BF547CF09E4B6" +#> o_1565356068103.proc_obsProp_foiID +#> "ws2500_Dewpoint_sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B" +#> o_1565356068104.proc_obsProp_foiID +#> "ws2500_Luminance_sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B1" +#> o_1565356068105.proc_obsProp_foiID +#> "ws2500_WindSpeed_sf_65B66DC8B5E532115D97C0A09C41214BD2A35ABC"names(myObservationData) -#> o_1555162558924.proc_obsProp_foiID -#> "ws2500_AirTemperature_sf_B6EC41A0E69F7A2AA24F2307944A6CAB5833E952" -#> o_1555162558928.proc_obsProp_foiID -#> "ws2500_RainfallAccumulated_sf_ECE82997AE34E24608C5F65A0AF685998AB3E589" -#> o_1555162558929.proc_obsProp_foiID -#> "ws2500_Humidity_sf_E9852B02E184F6FFC8983743045D6A2DFF4DE520" -#> o_1555162558930.proc_obsProp_foiID -#> "ws2500_AthmosphericPressure_sf_485D30222B1DA73909079C17A8C28BDF69AAA997" -#> o_1555162558931.proc_obsProp_foiID -#> "ws2500_WindDirection_sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF8299" -#> o_1555162558932.proc_obsProp_foiID -#> "ws2500_Windchill_sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF82991" -#> o_1555162558933.proc_obsProp_foiID -#> "ws2500_Dewpoint_sf_37D74410B385F30771C191630CA14E0B0C732E58" -#> o_1555162558934.proc_obsProp_foiID -#> "ws2500_Luminance_sf_71DF230CC564A88481B0304D9CCA7E82A3A6DDD9" -#> o_1555162558935.proc_obsProp_foiID -#> "ws2500_WindSpeed_sf_E9A612A92201ECA557D702B16B6F74CCF925AB89"myObservationData.result.2 <- sosResult(myObservationData[[1]]) myObservationData.result.2 #> phenomenonTime AirTemperature @@ -1476,24 +1479,24 @@#> [1] "degC"
Spatial Information can be stored in an observation in several ways: (i) as a usual data attribute which is directly contained in the result
data.frame, (ii) within a feature collection in the observation. In the latter case the utility functionssosCoordinates()andsosFeatureIds()can be used to extract the coordinates respectively the identifiers fromOmObservationCollectionorOmObservationclasses. A variety of feature types gml:Point or sa:SamplingPoint are supported bysosCoordinates().+#> o_1565356068080 +#> "sf_70C6FE193D45B813FBDE00F54E29F691A25A58EC" +#> o_1565356068081 +#> "sf_C3378C4973BDD7786ADA2B2E5AECC25FC1045852" +#> o_1565356068082 +#> "sf_39A1A9F2920D559BE060F0A75960813F5C94D71E" +#> o_1565356068083 +#> "sf_F80B5EB3A550F862411E1327D6E09CCE5F191DF4" +#> o_1565356068084 +#> "sf_63980E8519C24F68ECBA1130CA69C83675CE1C14" +#> o_1565356068102 +#> "sf_A517067DD435DBB494E33BC87A4BF547CF09E4B6" +#> o_1565356068103 +#> "sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B" +#> o_1565356068104 +#> "sf_8F5DDF1A4F9D7E56507DAB2474988B3E9351373B1" +#> o_1565356068105 +#> "sf_65B66DC8B5E532115D97C0A09C41214BD2A35ABC"sosFeatureIds(myObservationData) -#> o_1555162558924 -#> "sf_B6EC41A0E69F7A2AA24F2307944A6CAB5833E952" -#> o_1555162558928 -#> "sf_ECE82997AE34E24608C5F65A0AF685998AB3E589" -#> o_1555162558929 -#> "sf_E9852B02E184F6FFC8983743045D6A2DFF4DE520" -#> o_1555162558930 -#> "sf_485D30222B1DA73909079C17A8C28BDF69AAA997" -#> o_1555162558931 -#> "sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF8299" -#> o_1555162558932 -#> "sf_B0E0F269253A30B1F22E9B0B5F6FFA0EE2AF82991" -#> o_1555162558933 -#> "sf_37D74410B385F30771C191630CA14E0B0C732E58" -#> o_1555162558934 -#> "sf_71DF230CC564A88481B0304D9CCA7E82A3A6DDD9" -#> o_1555162558935 -#> "sf_E9A612A92201ECA557D702B16B6F74CCF925AB89"An observation collection also contains a bounding box of the contained observations, which can be extracted with the function
@@ -1586,7 +1589,7 @@sosBoundedBy(). The optional attributebboxcan be used to obtain a bounding box matrix as used by packagesp.operator = SosSupportedTemporalOperators()[["TM_After"]]) print(lastDay.eventTime) #> Object of class SosEventTime: -#> TM_After: GmlTimePosition [ time: 2019-04-12 15:36:36 ] +#> TM_After: GmlTimePosition [ time: 2019-08-08 15:07:57 ]
Another example workflow, using a
KVP-based connection.diff --git a/docs/articles/sos4R-vignette-03-sos-operations_files/figure-html/sosPlot-1.png b/docs/articles/sos4R-vignette-03-sos-operations_files/figure-html/sosPlot-1.png index b9912f1..6e7c10c 100644 Binary files a/docs/articles/sos4R-vignette-03-sos-operations_files/figure-html/sosPlot-1.png and b/docs/articles/sos4R-vignette-03-sos-operations_files/figure-html/sosPlot-1.png differ diff --git a/docs/articles/sos4R-vignette-04-extensions.html b/docs/articles/sos4R-vignette-04-extensions.html index 51a5c3e..013dcae 100644 --- a/docs/articles/sos4R-vignette-04-extensions.html +++ b/docs/articles/sos4R-vignette-04-extensions.html @@ -30,7 +30,7 @@ @@ -98,7 +98,7 @@sept15.period <- sosCreateTimePeriod(sos = mySOS, begin = as.POSIXct("2015-09-01 00:00"), @@ -1775,7 +1778,7 @@Daniel Nüst
Institute for Geoinformatics, University of Münster, Germany.
daniel.nuest@uni-muenster.de -2019-04-13
+2019-08-09
Source:vignettes/sos4R-vignette-04-extensions.Rmd@@ -187,11 +187,11 @@sos4R-vignette-04-extensions.Rmd## obj="GmlDirectPosition", sos="SOS" ## obj="GmlEnvelope", sos="SOS" ## obj="GmlLineString", sos="SOS" -## obj="GmlPointProperty", sos="SOS" ## obj="GmlPoint", sos="SOS" +## obj="GmlPointProperty", sos="SOS" ## obj="GmlPolygon", sos="SOS" -## obj="GmlTimeInstantProperty", sos="SOS" ## obj="GmlTimeInstant", sos="SOS" +## obj="GmlTimeInstantProperty", sos="SOS" ## obj="GmlTimePeriod", sos="SOS" ## obj="GmlTimePosition", sos="SOS" ## obj="OgcBBOX", sos="SOS" @@ -441,9 +441,9 @@
## [3] <sos:responseFormat>text/xml;subtype="om/1.0.0"</sos:responseFormat> ## [.getObservation_1.0.0] RESPONSE DOC: ## {xml_document} -## <ObservationCollection id="oc_1555162614708" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> +## <ObservationCollection id="oc_1565356095618" schemaLocation="http://www.opengis.net/om/1.0 http://schemas.opengis.net/om/1.0.0/om.xsd http://www.opengis.net/sampling/1.0 http://schemas.opengis.net/sampling/1.0.0/sampling.xsd http://www.opengis.net/sos/1.0 http://schemas.opengis.net/sos/1.0.0/sosAll.xsd http://www.opengis.net/gml http://schemas.opengis.net/gml/3.1.1/base/gml.xsd http://www.opengis.net/swe/1.0.1 http://schemas.opengis.net/sweCommon/1.0.1/swe.xsd" xmlns:om="http://www.opengis.net/om/1.0" xmlns:gml="http://www.opengis.net/gml" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sa="http://www.opengis.net/sampling/1.0" xmlns:swe="http://www.opengis.net/swe/1.0.1"> ## [1] <gml:boundedBy>\n <gml:Envelope srsName="urn:ogc:def:crs:EPSG::4326 ... -## [2] <om:member>\n <om:Observation gml:id="o_1555162614708">\n <om:sa ... +## [2] <om:member>\n <om:Observation gml:id="o_1565356095619">\n <om:sa ...
## Warning in .valParser(values = xml2::xml_child(x = obj, search = sweValuesName, : No converter for the unit of measurement test_unit_1 with the definition http://www.52north.org/test/observableProperty/1 ! Trying a default, but you can add one when creating a SOS using SosDataFieldConvertingFunctions().
@@ -465,19 +465,19 @@## [sos4R] Finished getObservation to http://sensorweb.demo.52north.org/52n-sos-webapp/sos/pox ## --> received 1 observation(s) having 12 result values [ 12 ].Then retrieve the data with the correct type.
+## o_1565356095936.1 1.0 +## o_1565356095936.2 1.1 +## o_1565356095936.3 1.2 +## o_1565356095936.4 1.3 +## o_1565356095936.5 1.4 +## o_1565356095936.6 1.5## phenomenonTime -## o_1555162614958.1 2012-11-19 13:00:00 -## o_1555162614958.2 2012-11-19 13:01:00 -## o_1555162614958.3 2012-11-19 13:02:00 -## o_1555162614958.4 2012-11-19 13:03:00 -## o_1555162614958.5 2012-11-19 13:04:00 -## o_1555162614958.6 2012-11-19 13:05:00 +## o_1565356095936.1 2012-11-19 13:00:00 +## o_1565356095936.2 2012-11-19 13:01:00 +## o_1565356095936.3 2012-11-19 13:02:00 +## o_1565356095936.4 2012-11-19 13:03:00 +## o_1565356095936.5 2012-11-19 13:04:00 +## o_1565356095936.6 2012-11-19 13:05:00 ## http://www.52north.org/test/observableProperty/1 -## o_1555162614958.1 1.0 -## o_1555162614958.2 1.1 -## o_1555162614958.3 1.2 -## o_1555162614958.4 1.3 -## o_1555162614958.5 1.4 -## o_1555162614958.6 1.5The metadata of the observed property is also accessible.
diff --git a/docs/reference/GetDataAvailability.html b/docs/reference/GetDataAvailability.html index ae1ac46..85fbf69 100644 --- a/docs/reference/GetDataAvailability.html +++ b/docs/reference/GetDataAvailability.html @@ -63,7 +63,7 @@ @@ -230,7 +230,7 @@## $class @@ -624,7 +624,7 @@diff --git a/docs/authors.html b/docs/authors.html index 93c6931..dedbf3d 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -60,7 +60,7 @@ @@ -130,7 +130,7 @@
Citation
Nüst D, Stasch C, Pebesma EJ (2011). “Connecting R to the Sensor Web.” In Geertman S, Reinhardt W, Toppen F (eds.), Advancing Geoinformation Science for a Changing World, series Proceedings of AGILE, 227 - 246. -doi: 10.1007/978-3-642-19789-5_12. +doi: 10.1007/978-3-642-19789-5_12.
@InProceedings{, author = {Daniel Nüst and Christoph Stasch and Edzer J. Pebesma}, @@ -201,7 +201,7 @@+GmlTimePeriod(begin = aWeekAgo, end = now)Authors
diff --git a/docs/index.html b/docs/index.html index 0ce9581..558519f 100644 --- a/docs/index.html +++ b/docs/index.html @@ -5,16 +5,16 @@ -Client for accessing observations and sensor metadata from OGC Sensor Observation Services (<https:>) • sos4R</https:> - +Client for OGC Sensor Observation Services • sos4R - - + @@ -36,7 +36,7 @@ @@ -213,7 +213,7 @@Developers
diff --git a/docs/news/index.html b/docs/news/index.html index 27256a4..12b6a17 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -60,7 +60,7 @@ @@ -127,9 +127,17 @@Changelog
Source:NEWS.md++diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index cf98791..d3b9695 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,6 +1,6 @@ pandoc: 2.3.1 -pkgdown: 1.3.0.9000 -pkgdown_sha: 7e788c41d20ab28d4bf97556e18382391d359c9f +pkgdown: 1.3.0 +pkgdown_sha: ~ articles: sos4R-vignette-01-quickstart: sos4R-vignette-01-quickstart.html sos4R-vignette-02-ogc-sos: sos4R-vignette-02-ogc-sos.html diff --git a/docs/reference/Constants.html b/docs/reference/Constants.html index d3f34e3..6315369 100644 --- a/docs/reference/Constants.html +++ b/docs/reference/Constants.html @@ -63,7 +63,7 @@ @@ -223,7 +223,7 @@+sos4R 0.3.1 Unreleased +
+-
+
- Bugfix release: don’t set classes for
xml2(requires version1.2.2, see #148)
+
Contents
diff --git a/docs/reference/Defaults.html b/docs/reference/Defaults.html index d1cba8f..dd2f0d1 100644 --- a/docs/reference/Defaults.html +++ b/docs/reference/Defaults.html @@ -63,7 +63,7 @@ @@ -218,42 +218,37 @@Examp # }
# functions to disable all parsing SosDisabledParsers()#> $GetCapabilities -#> function (obj, sos) -#> { -#> if (sos@version == sos100_version) { -#> .caps <- parseSosCapabilities100(obj, sos) -#> } -#> else if (sos@version == sos200_version) { -#> .caps <- parseSosCapabilities200(obj, sos) -#> } +#> function(obj, sos) { +#> if (sos@version == sos100_version){ +#> .caps <- parseSosCapabilities100(obj, sos) +#> } +#> else if (sos@version == sos200_version){ +#> .caps <- parseSosCapabilities200(obj, sos) +#> } #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor -#> function (obj) -#> { -#> return(obj) +#> function(obj) { +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $GetObservation -#> function (obj) -#> { -#> return(obj) +#> function(obj) { +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById -#> function (obj) -#> { -#> return(obj) +#> function(obj) { +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` -#> function (obj) -#> { -#> return(obj) +#> function(obj) { +#> return(obj) #> } #> <environment: namespace:sos4R> #>@@ -262,893 +257,953 @@Examp return("EXCEPTION!!!11") } SosParsingFunctions("ExceptionReport" = myER)
#> $ExceptionReport -#> function (xml) -#> { -#> return("EXCEPTION!!!11") +#> function(xml) { +#> return("EXCEPTION!!!11") #> } -#> <environment: 0xa70fa50> +#> <environment: 0x564ebe6e8000> #> #> $GetCapabilities -#> function (obj, sos) -#> { -#> if (sos@version == sos100_version) { -#> .caps <- parseSosCapabilities100(obj, sos) -#> } -#> else if (sos@version == sos200_version) { -#> .caps <- parseSosCapabilities200(obj, sos) -#> } +#> function(obj, sos) { +#> if (sos@version == sos100_version){ +#> .caps <- parseSosCapabilities100(obj, sos) +#> } +#> else if (sos@version == sos200_version){ +#> .caps <- parseSosCapabilities200(obj, sos) +#> } #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseSensorML] Starting... \n") -#> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) -#> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) -#> .descrNode <- xml2::xml_find_first(x = obj, xpath = .smlXPathDescription, -#> ns = SosAllNamespaces()) -#> .description <- xml2::xml_text(x = .descrNode) -#> if (verbose) -#> cat("[parseSensorML] Got ID", .id, "and shortName", .shortName, -#> "and description", .description, "\n") -#> if (verbose) -#> cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, -#> "\n") -#> .observedBBox <- xml2::xml_find_first(x = obj, xpath = .smlXPathObservedBBox, -#> ns = SosAllNamespaces()) -#> if (!is.na(.observedBBox)) { -#> .referenceFrame <- xml2::xml_attr(x = .observedBBox, -#> attr = "referenceFrame", ns = SosAllNamespaces()) -#> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, -#> search = paste0(sweUpperCornerName, "/", sweVectorName), -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, -#> search = paste0(sweLowerCornerName, "/", sweVectorName), -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .bb <- matrix(c(.llVector[["x"]][["value"]], .llVector[["y"]][["value"]], -#> .uuVector[["x"]][["value"]], .uuVector[["y"]][["value"]]), -#> ncol = 2, dimnames = list(c("coords.lon", "coords.lat"), -#> c("min", "max"))) -#> .oldAttrs <- attributes(.bb) -#> attributes(.bb) <- c(.oldAttrs, list(referenceFrame = .referenceFrame)) -#> if (verbose) -#> cat("[parseSensorML] Parsed bounding box: ", toString(.bb), -#> "\n") -#> } -#> else { -#> .bb <- matrix() -#> if (verbose) -#> cat("[parseSensorML] No boundedBy element found, bbox is ", -#> .bb, "\n") +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseSensorML] Starting... \n") +#> +#> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) +#> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) +#> .descrNode <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathDescription, +#> ns = SosAllNamespaces()) +#> .description <- xml2::xml_text(x = .descrNode) +#> +#> if (verbose) cat("[parseSensorML] Got ID", .id, +#> "and shortName", .shortName, +#> "and description", .description, "\n") +#> +#> # bounded by +#> if (verbose) cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, "\n") +#> .observedBBox <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathObservedBBox, +#> ns = SosAllNamespaces()) +#> if (!is.na(.observedBBox)) { +#> .referenceFrame <- xml2::xml_attr(x = .observedBBox, attr = "referenceFrame", ns = SosAllNamespaces()) +#> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, +#> search = paste0(sweUpperCornerName, "/", sweVectorName), +#> ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, +#> search = paste0(sweLowerCornerName, "/", sweVectorName), +#> ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> .bb <- matrix(c(.llVector[["x"]][["value"]], +#> .llVector[["y"]][["value"]], +#> .uuVector[["x"]][["value"]], +#> .uuVector[["y"]][["value"]]), +#> ncol = 2, +#> dimnames = list(c("coords.lon", "coords.lat"), +#> c("min", "max"))) +#> .oldAttrs <- attributes(.bb) +#> attributes(.bb) <- c(.oldAttrs, +#> list(referenceFrame = .referenceFrame)) +#> +#> if (verbose) cat("[parseSensorML] Parsed bounding box: ", toString(.bb), "\n") +#> } +#> else { +#> .bb <- matrix() +#> if (verbose) cat("[parseSensorML] No boundedBy element found, bbox is ", .bb, "\n") +#> } +#> +#> # coordinates +#> if (verbose) cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, "\n") +#> .xmlPosition <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathPosition, +#> ns = SosAllNamespaces()) +#> if (!is.na(.xmlPosition)) { +#> .position <- parseSwePosition(.xmlPosition, +#> sos = sos, +#> verbose = verbose) +#> .referenceFrame = attributes(.position)[["referenceFrame"]] +#> .uom <- lapply(.position, "[[", "uomCode") +#> names(.uom) <- lapply(.position, "[[", "axisID") +#> .name <- lapply(.position, "[[", "name") +#> names(.name) <- lapply(.position, "[[", "axisID") +#> +#> .values <- lapply(.position, "[[", "value") +#> names(.values) <- lapply(.position, "[[", "axisID") +#> if (any(is.na(names(.values)))) { +#> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") +#> names(.values) <- lapply(.position, "[[", "name") #> } -#> if (verbose) -#> cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, -#> "\n") -#> .xmlPosition <- xml2::xml_find_first(x = obj, xpath = .smlXPathPosition, -#> ns = SosAllNamespaces()) -#> if (!is.na(.xmlPosition)) { -#> .position <- parseSwePosition(.xmlPosition, sos = sos, -#> verbose = verbose) -#> .referenceFrame = attributes(.position)[["referenceFrame"]] -#> .uom <- lapply(.position, "[[", "uomCode") -#> names(.uom) <- lapply(.position, "[[", "axisID") -#> .name <- lapply(.position, "[[", "name") -#> names(.name) <- lapply(.position, "[[", "axisID") -#> .values <- lapply(.position, "[[", "value") -#> names(.values) <- lapply(.position, "[[", "axisID") -#> if (any(is.na(names(.values)))) { -#> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") -#> names(.values) <- lapply(.position, "[[", "name") -#> } -#> if (verbose) { -#> cat("[parseSensorML] names: ", names(.values), "\n") -#> cat("[parseSensorML] values: ", toString(.values), -#> "\n") -#> } -#> .coords <- data.frame(.values) -#> .oldAttrs <- attributes(.coords) -#> attributes(.coords) <- c(as.list(.oldAttrs), list(referenceFrame = .referenceFrame, -#> uom = .uom, name = .name)) -#> if (!is.na(.id)) -#> row.names(.coords) <- .id -#> if (verbose) -#> cat("[parseSensorML] row names: ", row.names(.coords), -#> "\n") -#> } -#> else { -#> .coords <- data.frame() +#> +#> if (verbose) { +#> cat("[parseSensorML] names: ", names(.values), "\n") +#> cat("[parseSensorML] values: ", toString(.values), "\n") #> } -#> .sml = SensorML(xml = obj, coords = .coords, id = .id, name = .shortName, -#> description = .description, boundedBy = .bb) -#> if (verbose) -#> cat("[parseSensorML] Done: ", toString(.sml), "\n") -#> return(.sml) +#> +#> .coords <- data.frame(.values) +#> .oldAttrs <- attributes(.coords) +#> attributes(.coords) <- c(as.list(.oldAttrs), +#> list(referenceFrame = .referenceFrame, +#> uom = .uom, name = .name)) +#> +#> if (!is.na(.id)) +#> row.names(.coords) <- .id +#> if (verbose) cat("[parseSensorML] row names: ", row.names(.coords), +#> "\n") +#> } +#> else { +#> .coords <- data.frame() +#> } +#> +#> # create instance +#> .sml = SensorML(xml = obj, +#> coords = .coords, +#> id = .id, +#> name = .shortName, +#> description = .description, +#> boundedBy = .bb) +#> +#> if (verbose) cat("[parseSensorML] Done: ", toString(.sml), "\n") +#> +#> return(.sml) #> } #> <environment: namespace:sos4R> #> #> $GetObservation -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $GetObservationResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (sos@verboseOutput) { -#> cat("[parseGetObservationResponse] entering... \n") -#> print(obj) -#> } -#> .observationsXML <- xml2::xml_find_all(x = obj, xpath = "sos20:observationData", -#> ns = SosAllNamespaces(version = sos200_version)) -#> featureCache <- list() -#> .observations <- sapply(.observationsXML, parseObservation_2.0, -#> sos = sos, featureCache = featureCache) -#> return(.observations) +#> function(obj, sos, verbose = FALSE) { +#> if (sos@verboseOutput) { +#> cat("[parseGetObservationResponse] entering... \n") +#> print(obj) +#> } +#> +#> .observationsXML <- xml2::xml_find_all(x = obj, +#> xpath = "sos20:observationData", +#> ns = SosAllNamespaces(version = sos200_version)) +#> featureCache <- list() +#> .observations <- sapply(.observationsXML, +#> parseObservation_2.0, +#> sos = sos, +#> featureCache = featureCache) +#> +#> return(.observations) #> } #> <environment: namespace:sos4R> #> #> $GetFeatureOfInterestResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (sos@verboseOutput) { -#> cat("[parseGetFeatureOfInterestResponse] entering... \n") -#> print(obj) -#> } -#> .featureXML <- xml2::xml_find_all(x = obj, xpath = "sos20:featureMember", -#> SosAllNamespaces(version = sos200_version)) -#> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) -#> return(.foi) +#> function(obj, sos, verbose = FALSE) { +#> +#> if (sos@verboseOutput) { +#> cat("[parseGetFeatureOfInterestResponse] entering... \n") +#> print(obj) +#> } +#> +#> .featureXML <- xml2::xml_find_all(x = obj, +#> xpath = "sos20:featureMember", +#> SosAllNamespaces(version = sos200_version)) +#> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) +#> return(.foi) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` -#> function (obj, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseOwsExceptionReport] Starting ...\n") -#> .docRoot <- xml2::xml_root(x = obj) -#> .version <- xml2::xml_attr(x = .docRoot, attr = "version") -#> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) -#> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, xpath = paste0("//", -#> owsExceptionName), ns = SosAllNamespaces()) -#> .exceptions = sapply(.exceptionsXML, parseOwsException) -#> if (verbose) -#> cat("[parseOwsExceptionReport]", length(.exceptions), -#> "exceptions.") -#> .report <- OwsExceptionReport(version = .version, lang = .lang, -#> exceptions = .exceptions) -#> return(.report) +#> function(obj, verbose = FALSE) { +#> if (verbose) cat("[parseOwsExceptionReport] Starting ...\n") +#> .docRoot <- xml2::xml_root(x = obj) +#> +#> .version <- xml2::xml_attr(x = .docRoot, attr = "version") +#> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) +#> +#> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, +#> xpath = paste0("//", owsExceptionName), +#> ns = SosAllNamespaces()) +#> +#> .exceptions = sapply(.exceptionsXML, parseOwsException) +#> if (verbose) cat("[parseOwsExceptionReport]", length(.exceptions), "exceptions.") +#> +#> .report <- OwsExceptionReport(version = .version, lang = .lang, exceptions = .exceptions) +#> +#> return(.report) #> } #> <environment: namespace:sos4R> #> #> $GetDataAvailabilityResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse]") -#> if (sos@version != sos200_version) { -#> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", -#> sos@version, "'")) -#> } -#> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), -#> "element(s).\n") -#> phenTimeCache <- list() -#> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, -#> sos, phenTimeCache, verbose) -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse] Done. Processed", -#> length(.parsedGDAMembers), "elements") -#> return(.parsedGDAMembers) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseGetDataAvailabilityResponse]") +#> +#> if (sos@version != sos200_version) { +#> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", +#> sos@version, "'")) +#> } +#> +#> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), "element(s).\n") +#> phenTimeCache <- list() +#> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, sos, phenTimeCache, verbose) +#> if (verbose) cat("[parseGetDataAvailabilityResponse] Done. Processed", length(.parsedGDAMembers), +#> "elements") +#> return(.parsedGDAMembers) #> } #> <environment: namespace:sos4R> #> #> $`om:Measurement` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseMeasurement]\n") -#> .samplingTimeXml <- xml2::xml_child(x = obj, search = omSamplingTimeName, -#> ns = SosAllNamespaces()) -#> .samplingTime <- parseTime(obj = .samplingTimeXml, format = sosTimeFormat(sos), -#> verbose = verbose) -#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omProcedureName, ns = SosAllNamespaces()), attr = "href") -#> .observedProperty <- SwePhenomenonProperty(href = xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omObservedPropertyName, ns = SosAllNamespaces()), -#> attr = "href")) -#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, -#> ns = SosAllNamespaces())) -#> .measurement <- OmMeasurement(samplingTime = .samplingTime, -#> procedure = .procedure, observedProperty = .observedProperty, -#> featureOfInterest = .featureOfInterest, result = .result) -#> return(.measurement) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseMeasurement]\n") +#> +#> .samplingTimeXml <- xml2::xml_child(x = obj, +#> search = omSamplingTimeName, +#> ns = SosAllNamespaces()) +#> .samplingTime <- parseTime(obj = .samplingTimeXml, +#> format = sosTimeFormat(sos), +#> verbose = verbose) +#> +#> # 52N SOS only returns om:Measurements (!) with procedure ids and observed +#> # properties in xlink:href +#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, search = omProcedureName, ns = SosAllNamespaces()), attr = "href") +#> .observedProperty <- SwePhenomenonProperty( +#> href = xml2::xml_attr(x = xml2::xml_child(x = obj, search = omObservedPropertyName, ns = SosAllNamespaces()), attr = "href")) +#> +#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()), sos = sos, +#> verbose = verbose) +#> +#> # must be GmlMeasure +#> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, ns = SosAllNamespaces())) +#> +#> # TODO optionals elements for OmMeasurement +#> #.metadata +#> #.resultTime +#> #.resultQuality +#> #.parameter +#> +#> .measurement <- OmMeasurement(samplingTime = .samplingTime, +#> procedure = .procedure, observedProperty = .observedProperty, +#> featureOfInterest = .featureOfInterest, result = .result) +#> +#> return(.measurement) #> } #> <environment: namespace:sos4R> #> #> $`om:member` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (xml2::xml_length(x = obj) >= 1) { -#> .child <- xml2::xml_child(obj) -#> if (verbose) -#> cat("[parseObservationProperty] Parsing child of member:", -#> xml2::xml_name(x = .child, ns = SosAllNamespaces()), -#> "\n") -#> .mResult <- parseOM(.child, sos, verbose) +#> function(obj, sos, verbose = FALSE) { +#> # a member can only have one child element +#> if (xml2::xml_length(x = obj) >= 1) { +#> .child <- xml2::xml_child(obj) +#> if (verbose) cat("[parseObservationProperty] Parsing child of member:", +#> xml2::xml_name(x = .child, ns = SosAllNamespaces()), "\n") +#> .mResult <- parseOM(.child, sos, verbose) +#> } +#> else { +#> # no child, try href attribute +#> if (verbose) cat("[parseObservationProperty] Member has no direct child!\n") +#> +#> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) +#> if (!is.na(.href)) { +#> warning("Only reference was returned:", .href) +#> .mResult <- OmObservationProperty(href = .href) #> } #> else { -#> if (verbose) -#> cat("[parseObservationProperty] Member has no direct child!\n") -#> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) -#> if (!is.na(.href)) { -#> warning("Only reference was returned:", .href) -#> .mResult <- OmObservationProperty(href = .href) -#> } -#> else { -#> warning("No observation found!") -#> .mResult <- OmObservationProperty() -#> } +#> warning("No observation found!") +#> .mResult <- OmObservationProperty() #> } -#> return(.mResult) +#> } +#> +#> return(.mResult) #> } #> <environment: namespace:sos4R> #> #> $`om:Observation` -#> function (obj, sos, verbose = FALSE) -#> { -#> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) -#> if (verbose) -#> cat("[parseObservation]", .id, "\n") -#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omProcedureName, ns = SosAllNamespaces()), attr = "href", -#> default = NA_character_) -#> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, -#> search = omObservedPropertyName, ns = SosAllNamespaces()), -#> verbose = verbose) -#> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, -#> ns = SosAllNamespaces()))) { -#> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, -#> search = omSamplingTimeName, ns = SosAllNamespaces()), -#> format = sosTimeFormat(sos = sos), verbose = verbose) -#> } -#> else { -#> warning("om:samplingTime is mandatory in om:Observation, but is missing!") -#> .samplingTime <- NULL -#> } -#> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, -#> ns = SosAllNamespaces()))) { -#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, -#> search = omFeatureOfInterestName, ns = SosAllNamespaces()), -#> sos = sos, verbose = verbose) -#> } -#> else { -#> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") -#> .featureOfInterest <- NULL -#> } -#> .resultParsingFunction <- sosParsers(sos)[[omResultName]] -#> .result <- .resultParsingFunction(xml2::xml_child(x = obj, -#> search = omResultName, ns = SosAllNamespaces()), sos, -#> verbose) -#> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, -#> ns = SosAllNamespaces()))) { -#> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, -#> search = omResultTimeName, ns = SosAllNamespaces()), -#> format = sosTimeFormat(sos = sos), verbose = verbose) -#> } -#> else { -#> .resultTime <- NULL -#> } -#> .obs <- OmObservation(samplingTime = .samplingTime, procedure = .procedure, -#> observedProperty = .observedProperty, featureOfInterest = .featureOfInterest, -#> result = .result) -#> return(.obs) +#> function(obj, sos, verbose = FALSE) { +#> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) +#> if (verbose) cat("[parseObservation]", .id, "\n") +#> +#> # 52N SOS only returns om:Observation with procedure ids xlink:href +#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, +#> search = omProcedureName, +#> ns = SosAllNamespaces()), +#> attr = "href", +#> default = NA_character_) +#> +#> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, search = omObservedPropertyName, ns = SosAllNamespaces()), +#> verbose = verbose) +#> +#> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, ns = SosAllNamespaces()))) { +#> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, +#> search = omSamplingTimeName, +#> ns = SosAllNamespaces()), +#> format = sosTimeFormat(sos = sos), verbose = verbose) +#> } else { +#> warning("om:samplingTime is mandatory in om:Observation, but is missing!") +#> .samplingTime <- NULL +#> } +#> +#> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()))) { +#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> } else { +#> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") +#> .featureOfInterest <- NULL +#> } +#> +#> # result parser is exchangeable +#> .resultParsingFunction <- sosParsers(sos)[[omResultName]] +#> .result <- .resultParsingFunction(xml2::xml_child(x = obj, search = omResultName, ns = SosAllNamespaces()), sos, verbose) +#> +#> # optional elements +#> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, ns = SosAllNamespaces()))) { +#> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, search = omResultTimeName, ns = SosAllNamespaces()), +#> format = sosTimeFormat(sos = sos), verbose = verbose) +#> } +#> else { +#> .resultTime <- NULL +#> } +#> +#> # TODO optionals elements for OmObservation +#> #.metadata +#> #.resultQuality +#> #.parameter +#> #.metadata +#> +#> .obs <- OmObservation(samplingTime = .samplingTime, +#> procedure = .procedure, +#> observedProperty = .observedProperty, +#> featureOfInterest = .featureOfInterest, +#> result = .result) +#> +#> return(.obs) #> } #> <environment: namespace:sos4R> #> #> $`om:ObservationCollection` -#> function (obj, sos, verbose = FALSE) -#> { -#> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseObservationCollection] with ", length(.members), -#> "element(s).\n") -#> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, -#> "/", gmlEnvelopeName)) -#> if (!is.na(.env)) { -#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, -#> attr = "srsName", ns = SosAllNamespaces()), lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, -#> search = gmlLowerCornerName, ns = SosAllNamespaces())), -#> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, -#> search = gmlUpperCornerName, ns = SosAllNamespaces()))) -#> if (verbose) -#> cat("[parseObservationCollection] Parsed envelope:", -#> toString(.boundedBy), "\n") -#> if (sosSwitchCoordinates(sos)) { -#> warning("Switching coordinates in envelope of ObservationCollection!") -#> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], -#> split = " ") -#> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) -#> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], -#> split = " ") -#> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) -#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, -#> attr = "srsName"), lowerCorner = .lC, upperCorner = .uC) -#> } -#> } -#> else { -#> if (verbose) -#> cat("[parseObservationCollection] Empty envelope!\n") -#> .boundedBy <- list() -#> } -#> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, -#> verbose = verbose) -#> names(.resultList) <- lapply(X = .members, FUN = function(member) { -#> children <- xml2::xml_children(member) -#> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) -#> if (length(idOrName) < 1) { -#> xml2::xml_name(member) -#> } -#> else { -#> idOrName -#> } -#> }) -#> if (is.list(.resultList)) { -#> .obsColl <- OmObservationCollection(members = .resultList, -#> boundedBy = .boundedBy) -#> } -#> else { -#> .obsColl <- OmObservationCollection(members = list(.resultList), -#> boundedBy = .boundedBy) -#> } -#> if (verbose) -#> cat("[parseObservationCollection] Done. Processed", length(.obsColl), -#> "elements:", names(.obsColl), "\n") -#> return(.obsColl) +#> function(obj, sos, verbose = FALSE) { +#> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseObservationCollection] with ", length(.members), "element(s).\n") +#> +#> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, "/", gmlEnvelopeName)) +#> if (!is.na(.env)) { +#> .boundedBy <- list( +#> srsName = xml2::xml_attr(x = .env, attr = "srsName", ns = SosAllNamespaces()), +#> lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, search = gmlLowerCornerName, ns = SosAllNamespaces())), +#> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, search = gmlUpperCornerName, ns = SosAllNamespaces()))) +#> +#> if (verbose) cat("[parseObservationCollection] Parsed envelope:", toString(.boundedBy), "\n") +#> +#> if (sosSwitchCoordinates(sos)) { +#> warning("Switching coordinates in envelope of ObservationCollection!") +#> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], split = " ") +#> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) +#> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], split = " ") +#> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) +#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, attr = "srsName"), +#> lowerCorner = .lC, upperCorner = .uC) +#> } +#> } +#> else { +#> if (verbose) cat("[parseObservationCollection] Empty envelope!\n") +#> .boundedBy <- list() +#> } +#> +#> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, verbose = verbose) +#> names(.resultList) <- lapply(X = .members, FUN = function(member) { +#> children <- xml2::xml_children(member) +#> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) +#> if (length(idOrName) < 1) { +#> xml2::xml_name(member) +#> } else { +#> idOrName +#> } +#> }) +#> +#> if (is.list(.resultList)) { +#> .obsColl <- OmObservationCollection(members = .resultList, +#> boundedBy = .boundedBy) +#> } +#> else { +#> .obsColl <- OmObservationCollection(members = list(.resultList), +#> boundedBy = .boundedBy) +#> } +#> +#> if (verbose) +#> cat("[parseObservationCollection] Done. Processed", length(.obsColl), +#> "elements:", names(.obsColl), "\n") +#> +#> return(.obsColl) #> } #> <environment: namespace:sos4R> #> #> $`om:result` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseResult] Starting ...\n") -#> .result <- NULL +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseResult] Starting ...\n") +#> .result <- NULL +#> +#> .children <- xml2::xml_children(x = obj) +#> if (verbose) cat("[parseResult]", length(.children), " non-text nodes, names:", xml2::xml_name(.children), "\n") +#> +#> # Check if remaining element is there +#> if (length(.children) == 0) { #> .children <- xml2::xml_children(x = obj) -#> if (verbose) -#> cat("[parseResult]", length(.children), " non-text nodes, names:", -#> xml2::xml_name(.children), "\n") -#> if (length(.children) == 0) { -#> .children <- xml2::xml_children(x = obj) -#> stop("Continue implementation here: OM-methods-parsing.R") -#> cat("[parseResult] No non-text nodes in result, returning NULL.\n") -#> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, -#> default = NA_character_) -#> .typeWithQualifiedname <- strsplit(.typeAttributValue, -#> ":") -#> .type <- NA_character_ -#> if (length(.typeWithQualifiedname) > 0) { -#> if (length(.typeWithQualifiedname[[1]]) > 1) { -#> .type <- .typeWithQualifiedname[[1]][2] -#> } -#> } -#> if (!is.na(.type)) { -#> if (.type == om20ResultMeasureTypeName) { -#> return(xml2::xml_text(x = obj)) -#> } -#> } -#> return(NULL) -#> } -#> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) -#> if (.name == sweDataArrayName) { -#> if (verbose) -#> cat("[parseResult] Parsing result with swe:DataArray.\n") -#> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] -#> .result <- .dataArrayParsingFunction(.children[[1]], -#> sos, verbose) -#> } -#> else if (.name == xmlTextNodeName) { -#> .result <- as.numeric(xml2::xml_text(x = .children)) -#> if (is.na(.result)) { -#> .result <- xml2::xml_text(x = .children, trim = TRUE) -#> } +#> stop("Continue implementation here: OM-methods-parsing.R") +#> cat("[parseResult] No non-text nodes in result, returning NULL.\n") +#> +#> #in O&M 2.0 there can be (literal) results of type MeasurementType +#> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, default = NA_character_) +#> +#> .typeWithQualifiedname <- strsplit(.typeAttributValue, ":") +#> +#> .type <- NA_character_ +#> +#> if (length(.typeWithQualifiedname) > 0) { +#> +#> if (length(.typeWithQualifiedname[[1]]) > 1) { +#> .type <- .typeWithQualifiedname[[1]][2] +#> } #> } -#> else { -#> warning(paste("[parseResult] Parsing of given result is NOT supported:", -#> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), -#> "-- only", sweDataArrayName, " or text nodes containing strings or numbers can be parsed.")) +#> +#> if (!is.na(.type)) { +#> if (.type == om20ResultMeasureTypeName) { +#> return(xml2::xml_text(x = obj)) +#> } #> } -#> if (is.null(.result)) { -#> stop("[parseResult] result is null! Given result:\n") -#> print(obj) +#> +#> return(NULL) +#> } +#> +#> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) +#> if (.name == sweDataArrayName) { +#> if (verbose) cat("[parseResult] Parsing result with swe:DataArray.\n") +#> +#> # data array parser is exchangeable +#> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] +#> .result <- .dataArrayParsingFunction(.children[[1]], sos, verbose) +#> } +#> else if (.name == xmlTextNodeName) { +#> .result <- as.numeric(xml2::xml_text(x = .children)) +#> if (is.na(.result)) { +#> .result <- xml2::xml_text(x = .children, trim = TRUE) #> } -#> if (verbose) -#> cat("[parseResult] Done\n") -#> return(.result) +#> } +#> else { +#> warning(paste("[parseResult] Parsing of given result is NOT supported:", +#> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), +#> "-- only", sweDataArrayName, +#> " or text nodes containing strings or numbers can be parsed.")) +#> } +#> +#> if (is.null(.result)) { +#> stop("[parseResult] result is null! Given result:\n") +#> print(obj) +#> } +#> +#> if (verbose) cat("[parseResult] Done\n") +#> +#> return(.result) #> } #> <environment: namespace:sos4R> #> #> $`swe:DataArray` -#> function (obj, sos, verbose = FALSE) -#> { -#> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, -#> xpath = "./swe:elementCount/swe:Count/swe:value", ns = SosAllNamespaces())) -#> if (verbose) -#> cat("[parseDataArray] Parsing DataArray with", .elementCount, -#> "elements.\n") -#> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] -#> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, -#> ns = SosAllNamespaces()) -#> .fields <- .elementTypeParser(obj = .elementTypeXml, sos = sos, -#> verbose = verbose) -#> if (verbose) -#> cat("[parseDataArray] Parsed field descriptions:", toString(.fields), -#> "\n") -#> .encParser <- sosParsers(sos)[[sweEncodingName]] -#> .encodingXml <- xml2::xml_child(x = obj, search = sweEncodingName, -#> ns = SosAllNamespaces()) -#> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseDataArray] Parsed encoding description:", -#> toString(.encoding), "\n") -#> .valParser <- sosParsers(sos)[[sweValuesName]] -#> .values <- .valParser(values = xml2::xml_child(x = obj, search = sweValuesName, -#> ns = SosAllNamespaces()), fields = .fields, encoding = .encoding, -#> sos = sos, verbose = verbose) -#> return(.values) +#> function(obj, sos, verbose = FALSE) { +#> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, +#> xpath = "./swe:elementCount/swe:Count/swe:value", +#> ns = SosAllNamespaces()) +#> ) +#> if (verbose) cat("[parseDataArray] Parsing DataArray with", .elementCount, "elements.\n") +#> +#> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] +#> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, ns = SosAllNamespaces()) +#> .fields <- .elementTypeParser(obj = .elementTypeXml, +#> sos = sos, +#> verbose = verbose) +#> if (verbose) cat("[parseDataArray] Parsed field descriptions:", toString(.fields), "\n") +#> +#> .encParser <- sosParsers(sos)[[sweEncodingName]] +#> .encodingXml <- xml2::xml_child(x = obj, +#> search = sweEncodingName, +#> ns = SosAllNamespaces()) +#> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) +#> +#> if (verbose) cat("[parseDataArray] Parsed encoding description:", toString(.encoding), "\n") +#> +#> .valParser <- sosParsers(sos)[[sweValuesName]] +#> .values <- .valParser(values = xml2::xml_child(x = obj, +#> search = sweValuesName, +#> ns = SosAllNamespaces()), +#> fields = .fields, +#> encoding = .encoding, +#> sos = sos, verbose = verbose) +#> +#> return(.values) #> } #> <environment: namespace:sos4R> #> #> $`swe:elementType` -#> function (obj, sos, verbose = FALSE) -#> { -#> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, -#> attr = "href"), "#") -#> if (verbose) -#> cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), -#> "and id", elementTypeHref, "for object", xml2::xml_name(obj), -#> "\n") -#> if (is.na(elementTypeHref)) { -#> elementType <- obj -#> } -#> else { -#> root <- xml2::xml_root(obj) -#> elementType <- xml2::xml_parent(xml2::xml_find_first(x = root, -#> xpath = paste0("//*[@gml:id='", elementTypeHref, -#> "']"))) -#> if (is.na(elementType)) { -#> stop("Got ", sweElementTypeName, " with a reference (href) but cannot find definition - cannot parse!", -#> toString(obj)) -#> } -#> else { -#> if (verbose) -#> cat("[parseDataArray] Found elementType via reference", -#> elementTypeHref, "\n") -#> } -#> } -#> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, -#> ns = SosAllNamespaces()) -#> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, -#> ns = SosAllNamespaces()) -#> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { -#> if (!is.na(simpleDataRecord)) -#> dr <- simpleDataRecord -#> else dr <- dataRecord -#> fields <- xml2::xml_find_all(x = dr, xpath = sweFieldName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseElementType] Got data record with", length(fields), -#> "fields. \n") -#> parsedFields <- lapply(fields, parseField, sos = sos, -#> verbose = verbose) -#> names <- sapply(parsedFields, "[", "name") -#> names(parsedFields) <- names -#> if (verbose) -#> cat("[parseElementType] Names of parsed fields:", -#> names(fields), "\n") -#> return(parsedFields) -#> } -#> else { -#> stop(paste("Cannot parse swe:elementType, only children of type", -#> sweSimpleDataRecordName, "and", sweDataRecordName, -#> "are supported!")) +#> function(obj, sos, verbose = FALSE) { +#> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, attr = "href"), "#") +#> if (verbose) cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), +#> "and id", elementTypeHref, "for object", xml2::xml_name(obj), "\n") +#> +#> if (is.na(elementTypeHref)) { +#> elementType <- obj +#> } +#> else { +#> root <- xml2::xml_root(obj) +#> elementType <- xml2::xml_parent( +#> xml2::xml_find_first(x = root, xpath = paste0("//*[@gml:id='", elementTypeHref, "']")) +#> ) +#> +#> if (is.na(elementType)) { +#> stop("Got ", sweElementTypeName," with a reference (href) but cannot find definition - cannot parse!", +#> toString(obj)) +#> } else { +#> if (verbose) cat("[parseDataArray] Found elementType via reference", elementTypeHref, "\n") #> } +#> } +#> +#> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, ns = SosAllNamespaces()) +#> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, ns = SosAllNamespaces()) +#> +#> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { +#> # pick the existing one +#> if (!is.na(simpleDataRecord)) dr <- simpleDataRecord +#> else dr <- dataRecord +#> +#> fields <- xml2::xml_find_all(x = dr, +#> xpath = sweFieldName, +#> ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseElementType] Got data record with", length(fields), "fields. \n") +#> +#> # extract the fields, naming with attribute 'name' +#> parsedFields <- lapply(fields, parseField, sos = sos, verbose = verbose) +#> names <- sapply(parsedFields, "[", "name") +#> names(parsedFields) <- names +#> +#> if (verbose) cat("[parseElementType] Names of parsed fields:", names(fields), "\n") +#> +#> return(parsedFields) +#> } +#> else { +#> stop(paste("Cannot parse swe:elementType, only children of type", +#> sweSimpleDataRecordName, "and", sweDataRecordName, +#> "are supported!")) +#> } #> } #> <environment: namespace:sos4R> #> #> $`swe:encoding` -#> function (obj, sos, verbose = FALSE) -#> { -#> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, -#> ns = SosAllNamespaces()) -#> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, -#> ns = SosAllNamespaces()) -#> if (!(is.na(.textBlock))) { -#> .tb <- parseTextBlock(.textBlock) -#> return(.tb) -#> } -#> else if (!(is.na(.textEncoding))) { -#> .tb <- parseTextEncoding(.textEncoding) -#> return(.tb) -#> } -#> else { -#> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, -#> "and", sweTextEncodingName, "are supported!")) -#> } +#> function(obj, sos, verbose = FALSE) { +#> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, ns = SosAllNamespaces()) +#> +#> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, ns = SosAllNamespaces()) +#> +#> if (!(is.na(.textBlock))) { +#> .tb <- parseTextBlock(.textBlock) +#> return(.tb) +#> } +#> else if (!(is.na(.textEncoding))) { +#> .tb <- parseTextEncoding(.textEncoding) +#> return(.tb) +#> } +#> else { +#> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, "and", sweTextEncodingName, +#> "are supported!")) +#> } #> } #> <environment: namespace:sos4R> #> #> $`swe:values` -#> function (values, fields, encoding, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseValues] Parsing swe:values using", toString(encoding), -#> "and", length(fields), "fields:", toString(names(fields)), -#> "\n") -#> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, -#> "SweTextEncoding"))) { -#> stop("Handling for given encoding not implemented!") +#> function(values, fields, encoding, sos, verbose = FALSE) { +#> if (verbose) cat("[parseValues] Parsing swe:values using", toString(encoding), "and", +#> length(fields), "fields:", toString(names(fields)), "\n") +#> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, "SweTextEncoding"))) { +#> stop("Handling for given encoding not implemented!") +#> } +#> +#> .converters <- sosDataFieldConverters(sos) +#> +#> .blockLines <- strsplit(x = xml2::xml_text(x = values), +#> split = encoding@blockSeparator) +#> .tokenLines <- sapply(.blockLines, strsplit, +#> split = encoding@tokenSeparator) +#> +#> if (verbose) +#> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), "\n") +#> +#> # data frame of correct length to be able to use cbind for first column +#> .tempId = "tempID" +#> .data <- data.frame(seq(1,length(.tokenLines))) +#> names(.data) <- .tempId +#> +#> # do following for all fields +#> .fieldCount <- length(fields) +#> for (.currentFieldIdx in seq(1,.fieldCount)) { +#> if (verbose) cat("[parseValues] Processing field index", .currentFieldIdx , "of", .fieldCount,"\n") +#> +#> # create list for each variable +#> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) +#> if (verbose) +#> cat("[parseValues] Current values: ", toString(.currentValues), "\n") +#> .currentField <- fields[[.currentFieldIdx]] +#> +#> if (verbose) +#> cat("[parseValues] Parsing field", paste(.currentField), "\n") +#> +#> # convert values to the correct types +#> .fieldDefinition <- .currentField[["definition"]] +#> .method <- .converters[[.fieldDefinition]] +#> if (verbose) { +#> cat("[parseValues] Using converter:\n") +#> print(.method) #> } -#> .converters <- sosDataFieldConverters(sos) -#> .blockLines <- strsplit(x = xml2::xml_text(x = values), split = encoding@blockSeparator) -#> .tokenLines <- sapply(.blockLines, strsplit, split = encoding@tokenSeparator) -#> if (verbose) -#> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), -#> "\n") -#> .tempId = "tempID" -#> .data <- data.frame(seq(1, length(.tokenLines))) -#> names(.data) <- .tempId -#> .fieldCount <- length(fields) -#> for (.currentFieldIdx in seq(1, .fieldCount)) { -#> if (verbose) -#> cat("[parseValues] Processing field index", .currentFieldIdx, -#> "of", .fieldCount, "\n") -#> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) -#> if (verbose) -#> cat("[parseValues] Current values: ", toString(.currentValues), -#> "\n") -#> .currentField <- fields[[.currentFieldIdx]] -#> if (verbose) -#> cat("[parseValues] Parsing field", paste(.currentField), -#> "\n") -#> .fieldDefinition <- .currentField[["definition"]] -#> .method <- .converters[[.fieldDefinition]] -#> if (verbose) { -#> cat("[parseValues] Using converter:\n") -#> print(.method) -#> } +#> +#> if (is.null(.method)) { +#> # could still be a unit of measurement given, use as +#> if (!is.na(.currentField["uom"])) { +#> .method <- .converters[[.currentField[["uom"]]]] #> if (is.null(.method)) { -#> if (!is.na(.currentField["uom"])) { -#> .method <- .converters[[.currentField[["uom"]]]] -#> if (is.null(.method)) { -#> warning(paste("No converter for the unit of measurement ", -#> .currentField[["uom"]], " with the definition ", -#> .currentField[["definition"]], "! Trying a default, but you can add one when creating a SOS using", -#> "SosDataFieldConvertingFunctions().\n")) -#> .method <- .converters[["fallBack"]] -#> } -#> } -#> else { -#> warning(paste("No converter found for the given field", -#> toString(.currentField), "using fallBack converter.")) -#> .method <- .converters[["fallBack"]] -#> } +#> # fallback option +#> warning(paste("No converter for the unit of measurement ", +#> .currentField[["uom"]], +#> " with the definition ", +#> .currentField[["definition"]], +#> "! Trying a default, but you can add one when creating a SOS using", +#> "SosDataFieldConvertingFunctions().\n")) +#> +#> .method <- .converters[["fallBack"]] #> } -#> if (verbose) { -#> cat("[parseValues] Using converter function:\n") -#> show(.method) -#> } -#> .currentValues <- .method(x = .currentValues, sos = sos) -#> if (verbose) -#> cat("[parseValues] Binding additional data.frame for", -#> .currentField[["name"]], "-- value range", toString(range(.currentValues)), -#> "\n") -#> .newData <- data.frame(.currentValues) -#> .newDataName <- .currentField[["name"]] -#> names(.newData) <- .cleanupColumnName(.newDataName) -#> if (verbose) -#> cat("[parseValues] Added column name:", names(.newData), -#> "\n") -#> .data <- cbind(.data, .newData) -#> if (verbose) { -#> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") -#> str(.data) -#> } -#> .addAttrs <- as.list(.currentField) -#> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] -#> .lastColumn <- dim(.data)[[2]] -#> .oldAttrs <- attributes(.data[, .lastColumn]) -#> attributes(.data[, .lastColumn]) <- c(as.list(.oldAttrs), -#> .addAttrs) -#> if (verbose) -#> cat("[parseValues] Added attributes to new data:", -#> toString(.addAttrs), "[ names: ", toString(names(.addAttrs)), -#> "]", "\n[parseValues] Old attributes list is", -#> toString(.oldAttrs), "\n[parseValues] New attributes list is", -#> toString(attributes(.data[, .lastColumn])), "\n") +#> } +#> else { +#> warning(paste("No converter found for the given field", toString(.currentField), +#> "using fallBack converter.")) +#> .method <- .converters[["fallBack"]] +#> } +#> } +#> +#> if (verbose) { +#> cat("[parseValues] Using converter function:\n") +#> show(.method) #> } -#> if (verbose) -#> cat("[parseValues] Removing temporary first column\n") -#> .data <- .data[, !colnames(.data) %in% .tempId] +#> +#> # do the conversion +#> .currentValues <- .method(x = .currentValues, sos = sos) +#> +#> # bind new and existing data: +#> if (verbose) cat("[parseValues] Binding additional data.frame for", +#> .currentField[["name"]], +#> "-- value range", toString(range(.currentValues)), "\n") +#> .newData <- data.frame(.currentValues) +#> +#> # create the names of the new data: +#> .newDataName <- .currentField[["name"]] +#> names(.newData) <- .cleanupColumnName(.newDataName) +#> +#> if (verbose) cat("[parseValues] Added column name:", names(.newData), "\n") +#> +#> # bind existing and new data column +#> .data <- cbind(.data, .newData) +#> #> if (verbose) { -#> cat("[parseValues] returning final data frame:\n") -#> str(.data) +#> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") +#> str(.data) #> } -#> return(.data) +#> +#> # add field information as attributes to the new column using human +#> # readable names +#> .addAttrs <- as.list(.currentField) +#> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] +#> +#> .lastColumn <- dim(.data)[[2]] +#> .oldAttrs <- attributes(.data[,.lastColumn]) +#> +#> attributes(.data[,.lastColumn]) <- c(as.list(.oldAttrs), .addAttrs) +#> +#> if (verbose) cat("[parseValues] Added attributes to new data:", +#> toString(.addAttrs), +#> "[ names: ", toString(names(.addAttrs)), "]", +#> "\n[parseValues] Old attributes list is", +#> toString(.oldAttrs), +#> "\n[parseValues] New attributes list is", +#> toString(attributes(.data[,.lastColumn])), +#> "\n") +#> } +#> +#> # remove id column +#> if (verbose) cat("[parseValues] Removing temporary first column\n") +#> .data <- .data[,!colnames(.data) %in% .tempId] +#> +#> if (verbose) { +#> cat("[parseValues] returning final data frame:\n") +#> str(.data) +#> } +#> return(.data) #> } #> <environment: namespace:sos4R> #> #> $`swe:Position` -#> function (obj, sos, verbose = FALSE) -#> { -#> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseSwePosition] with referenceFrame", .rF, "\n") -#> .location <- xml2::xml_child(x = obj, search = sweLocationName, -#> ns = SosAllNamespaces()) -#> .parser <- sosParsers(sos)[[sweLocationName]] -#> .pos <- .parser(.location, sos = sos, verbose = verbose) -#> .oldAttrs <- attributes(.pos) -#> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) -#> return(.pos) +#> function(obj, sos, verbose = FALSE) { +#> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) +#> if (verbose) cat("[parseSwePosition] with referenceFrame", .rF, "\n") +#> +#> .location <- xml2::xml_child(x = obj, search = sweLocationName, ns = SosAllNamespaces()) +#> .parser <- sosParsers(sos)[[sweLocationName]] +#> +#> .pos <- .parser(.location, sos = sos, verbose = verbose) +#> +#> .oldAttrs <- attributes(.pos) +#> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) +#> +#> return(.pos) #> } #> <environment: namespace:sos4R> #> #> $`swe:location` -#> function (obj, sos, verbose = FALSE) -#> { -#> .vector <- xml2::xml_child(x = obj, search = sweVectorName, -#> ns = SosAllNamespaces()) -#> .id <- xml2::xml_attr(x = obj, attr = "id") -#> if (verbose) -#> cat("[parseSweLocation] with id", .id, "\n") -#> .parser <- sosParsers(sos)[[sweVectorName]] -#> location <- .parser(.vector, sos = sos, verbose = verbose) -#> return(location) +#> function(obj, sos, verbose = FALSE) { +#> .vector <- xml2::xml_child(x = obj, search = sweVectorName, ns = SosAllNamespaces()) +#> .id <- xml2::xml_attr(x = obj, attr = "id") +#> if (verbose) cat("[parseSweLocation] with id", .id, "\n") +#> +#> .parser <- sosParsers(sos)[[sweVectorName]] +#> location <- .parser(.vector, sos = sos, verbose = verbose) +#> +#> return(location) #> } #> <environment: namespace:sos4R> #> #> $`swe:Vector` -#> function (obj, sos, verbose = FALSE) -#> { -#> .children <- xml2::xml_find_all(x = obj, xpath = sweCoordinateName, -#> ns = SosAllNamespaces()) -#> .parser <- sosParsers(sos)[[sweCoordinateName]] -#> .vector <- lapply(X = .children, FUN = .parser, sos = sos, -#> verbose = verbose) -#> names(.vector) <- sapply(.vector, function(current) { -#> return(current$axisID) -#> }) -#> if (verbose) -#> cat("[parseSweVector] parsed vector with coordinates: ", -#> toString(names(.vector)), "\n") -#> return(.vector) +#> function(obj, sos, verbose = FALSE) { +#> .children <- xml2::xml_find_all(x = obj, +#> xpath = sweCoordinateName, +#> ns = SosAllNamespaces()) +#> +#> .parser <- sosParsers(sos)[[sweCoordinateName]] +#> .vector <- lapply(X = .children, FUN = .parser, sos = sos, verbose = verbose) +#> names(.vector) <- sapply(.vector, function(current) {return(current$axisID)}) +#> if (verbose) cat("[parseSweVector] parsed vector with coordinates: ", toString(names(.vector)), "\n") +#> +#> return(.vector) #> } #> <environment: namespace:sos4R> #> #> $`swe:coordinate` -#> function (obj, sos, verbose = FALSE) -#> { -#> .name <- xml2::xml_attr(x = obj, attr = "name") -#> if (verbose) -#> cat("[parseSweCoordinate] with name", .name, "\n") -#> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, -#> ns = SosAllNamespaces()) -#> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") -#> if (verbose) -#> cat("[parseSweCoordinate] axisID: ", .axisID, "\n") -#> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, -#> ns = SosAllNamespaces()) -#> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") -#> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, -#> ns = SosAllNamespaces()) -#> .value <- as.double(xml2::xml_text(x = .valueNode)) -#> if (verbose) -#> cat("[parseSweCoordinate] value: ", .value, "\n") -#> return(list(name = .name, axisID = .axisID, uomCode = .uomCode, -#> value = .value)) +#> function(obj, sos, verbose = FALSE) { +#> .name <- xml2::xml_attr(x = obj, attr = "name") +#> if (verbose) cat("[parseSweCoordinate] with name", .name, "\n") +#> +#> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, ns = SosAllNamespaces()) +#> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") +#> if (verbose) cat("[parseSweCoordinate] axisID: ", .axisID, "\n") +#> +#> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, ns = SosAllNamespaces()) +#> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) +#> if (verbose) cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") +#> +#> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, ns = SosAllNamespaces()) +#> .value <- as.double(xml2::xml_text(x = .valueNode)) +#> if (verbose) cat("[parseSweCoordinate] value: ", .value, "\n") +#> +#> return(list(name = .name, +#> axisID = .axisID, +#> uomCode = .uomCode, +#> value = .value)) #> } #> <environment: namespace:sos4R> #> #> $`om:GeometryObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:GeometryObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:GeometryObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CategoryObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:CategoryObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:CategoryObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CountObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:CountObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:CountObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TruthObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:TruthObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:TruthObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TemporalObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:TemporalObservatio is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:TemporalObservatio is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:ComplexObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:ComplexObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:ComplexObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`text/csv` -#> function (obj, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseCSV] Parsing CSV...\n") -#> if (inherits(x = obj, what = "data.frame")) { -#> if (verbose) -#> cat("[parseCSV] Already a data.frame, returning object\n") -#> return(obj) -#> } -#> .lines <- strsplit(x = obj, split = "\n")[[1]] -#> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) -#> .names <- .data[[1]] -#> .newNames <- c() -#> for (.n in .names) { -#> .newNames <- c(.newNames, gsub(pattern = "\"", replacement = "", -#> x = .n)) -#> } -#> .names <- .newNames -#> .rows <- length(.data) -#> if (verbose) -#> cat("[parseCSV] Got", .rows, "lines of data.\n") -#> .df <- NULL -#> for (.r in seq(2, .rows)) { -#> if (verbose) -#> cat("[parseCSV] Processing row in CSV:", .data[[.r]], -#> "\n") -#> .row.df <- as.data.frame(.data[[.r]][1]) -#> names(.row.df) <- .names[[1]] -#> for (i in seq(2, length(.names))) { -#> .df <- as.data.frame(.data[[.r]][i]) -#> names(.df) <- .names[[i]] -#> .row.df <- cbind(.row.df, .df) -#> } -#> if (is.null(.df)) -#> .df <- .row.df -#> else .df <- do.call(rbind, list(.df, .row.df)) +#> function(obj, verbose = FALSE) { +#> if (verbose) cat("[parseCSV] Parsing CSV...\n") +#> +#> if (inherits(x = obj, what = "data.frame")) { +#> if (verbose) cat("[parseCSV] Already a data.frame, returning object\n") +#> return(obj) +#> } +#> +#> .lines <- strsplit(x = obj, split = "\n")[[1]] +#> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) +#> +#> # clean up names (double quotes) +#> .names <- .data[[1]] +#> .newNames <- c() +#> for (.n in .names) { +#> .newNames <- c(.newNames, +#> gsub(pattern = "\"", replacement = "", x = .n)) +#> } +#> .names <- .newNames +#> +#> .rows <- length(.data) +#> if (verbose) cat("[parseCSV] Got", .rows, "lines of data.\n") +#> +#> .df <- NULL +#> for (.r in seq(2,.rows)) { +#> if (verbose) cat("[parseCSV] Processing row in CSV:", .data[[.r]], "\n") +#> +#> # initialize first column of the data frame so it can be bound in loop +#> .row.df <- as.data.frame(.data[[.r]][1]) +#> names(.row.df) <- .names[[1]] +#> +#> for (i in seq(2,length(.names))) { +#> .df <- as.data.frame(.data[[.r]][i]) +#> names(.df) <- .names[[i]] +#> .row.df <- cbind(.row.df, .df) #> } -#> if (verbose) -#> cat("[parseCSV] Done.\n") -#> return(.df) +#> +#> if (is.null(.df)) +#> .df <- .row.df +#> else +#> .df <- do.call(rbind, list(.df, .row.df)) +#> } +#> +#> if (verbose) cat("[parseCSV] Done.\n") +#> +#> return(.df) #> } #> <environment: namespace:sos4R> #> #> $`text/xml;subtype="om/1.0.0"` -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`application/vnd.google-earth.kml+xml` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseKML] Processing KML... returning raw object!\n") -#> return(obj) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseKML] Processing KML... returning raw object!\n") +#> +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $kml -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseKML] Processing KML... returning raw object!\n") -#> return(obj) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseKML] Processing KML... returning raw object!\n") +#> +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`text/xml` -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #>@@ -1156,892 +1211,952 @@Examp # be included manually! SosParsingFunctions("ExceptionReport" = myER, include = c("GetObservation", "DescribeSensor", "ExceptionReport"))
#> $GetObservation -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $DescribeSensor -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseSensorML] Starting... \n") -#> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) -#> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) -#> .descrNode <- xml2::xml_find_first(x = obj, xpath = .smlXPathDescription, -#> ns = SosAllNamespaces()) -#> .description <- xml2::xml_text(x = .descrNode) -#> if (verbose) -#> cat("[parseSensorML] Got ID", .id, "and shortName", .shortName, -#> "and description", .description, "\n") -#> if (verbose) -#> cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, -#> "\n") -#> .observedBBox <- xml2::xml_find_first(x = obj, xpath = .smlXPathObservedBBox, -#> ns = SosAllNamespaces()) -#> if (!is.na(.observedBBox)) { -#> .referenceFrame <- xml2::xml_attr(x = .observedBBox, -#> attr = "referenceFrame", ns = SosAllNamespaces()) -#> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, -#> search = paste0(sweUpperCornerName, "/", sweVectorName), -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, -#> search = paste0(sweLowerCornerName, "/", sweVectorName), -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .bb <- matrix(c(.llVector[["x"]][["value"]], .llVector[["y"]][["value"]], -#> .uuVector[["x"]][["value"]], .uuVector[["y"]][["value"]]), -#> ncol = 2, dimnames = list(c("coords.lon", "coords.lat"), -#> c("min", "max"))) -#> .oldAttrs <- attributes(.bb) -#> attributes(.bb) <- c(.oldAttrs, list(referenceFrame = .referenceFrame)) -#> if (verbose) -#> cat("[parseSensorML] Parsed bounding box: ", toString(.bb), -#> "\n") +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseSensorML] Starting... \n") +#> +#> .id <- .smlIdentifier(obj, "uniqueID", verbose = verbose) +#> .shortName <- .smlIdentifier(obj, "shortName", verbose = verbose) +#> .descrNode <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathDescription, +#> ns = SosAllNamespaces()) +#> .description <- xml2::xml_text(x = .descrNode) +#> +#> if (verbose) cat("[parseSensorML] Got ID", .id, +#> "and shortName", .shortName, +#> "and description", .description, "\n") +#> +#> # bounded by +#> if (verbose) cat("[parseSensorML] Parsing boundedBy from", .smlXPathObservedBBox, "\n") +#> .observedBBox <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathObservedBBox, +#> ns = SosAllNamespaces()) +#> if (!is.na(.observedBBox)) { +#> .referenceFrame <- xml2::xml_attr(x = .observedBBox, attr = "referenceFrame", ns = SosAllNamespaces()) +#> .llVector <- parseSweVector(xml2::xml_child(x = .observedBBox, +#> search = paste0(sweUpperCornerName, "/", sweVectorName), +#> ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> .uuVector <- parseSweVector(xml2::xml_child(x = .observedBBox, +#> search = paste0(sweLowerCornerName, "/", sweVectorName), +#> ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> .bb <- matrix(c(.llVector[["x"]][["value"]], +#> .llVector[["y"]][["value"]], +#> .uuVector[["x"]][["value"]], +#> .uuVector[["y"]][["value"]]), +#> ncol = 2, +#> dimnames = list(c("coords.lon", "coords.lat"), +#> c("min", "max"))) +#> .oldAttrs <- attributes(.bb) +#> attributes(.bb) <- c(.oldAttrs, +#> list(referenceFrame = .referenceFrame)) +#> +#> if (verbose) cat("[parseSensorML] Parsed bounding box: ", toString(.bb), "\n") +#> } +#> else { +#> .bb <- matrix() +#> if (verbose) cat("[parseSensorML] No boundedBy element found, bbox is ", .bb, "\n") +#> } +#> +#> # coordinates +#> if (verbose) cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, "\n") +#> .xmlPosition <- xml2::xml_find_first(x = obj, +#> xpath = .smlXPathPosition, +#> ns = SosAllNamespaces()) +#> if (!is.na(.xmlPosition)) { +#> .position <- parseSwePosition(.xmlPosition, +#> sos = sos, +#> verbose = verbose) +#> .referenceFrame = attributes(.position)[["referenceFrame"]] +#> .uom <- lapply(.position, "[[", "uomCode") +#> names(.uom) <- lapply(.position, "[[", "axisID") +#> .name <- lapply(.position, "[[", "name") +#> names(.name) <- lapply(.position, "[[", "axisID") +#> +#> .values <- lapply(.position, "[[", "value") +#> names(.values) <- lapply(.position, "[[", "axisID") +#> if (any(is.na(names(.values)))) { +#> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") +#> names(.values) <- lapply(.position, "[[", "name") #> } -#> else { -#> .bb <- matrix() -#> if (verbose) -#> cat("[parseSensorML] No boundedBy element found, bbox is ", -#> .bb, "\n") -#> } -#> if (verbose) -#> cat("[parseSensorML] Parsing coordinates from", .smlXPathPosition, -#> "\n") -#> .xmlPosition <- xml2::xml_find_first(x = obj, xpath = .smlXPathPosition, -#> ns = SosAllNamespaces()) -#> if (!is.na(.xmlPosition)) { -#> .position <- parseSwePosition(.xmlPosition, sos = sos, -#> verbose = verbose) -#> .referenceFrame = attributes(.position)[["referenceFrame"]] -#> .uom <- lapply(.position, "[[", "uomCode") -#> names(.uom) <- lapply(.position, "[[", "axisID") -#> .name <- lapply(.position, "[[", "name") -#> names(.name) <- lapply(.position, "[[", "axisID") -#> .values <- lapply(.position, "[[", "value") -#> names(.values) <- lapply(.position, "[[", "axisID") -#> if (any(is.na(names(.values)))) { -#> warning("[parseSensorML] No axisID given, cannot name data.frame with them, trying 'name'.") -#> names(.values) <- lapply(.position, "[[", "name") -#> } -#> if (verbose) { -#> cat("[parseSensorML] names: ", names(.values), "\n") -#> cat("[parseSensorML] values: ", toString(.values), -#> "\n") -#> } -#> .coords <- data.frame(.values) -#> .oldAttrs <- attributes(.coords) -#> attributes(.coords) <- c(as.list(.oldAttrs), list(referenceFrame = .referenceFrame, -#> uom = .uom, name = .name)) -#> if (!is.na(.id)) -#> row.names(.coords) <- .id -#> if (verbose) -#> cat("[parseSensorML] row names: ", row.names(.coords), -#> "\n") -#> } -#> else { -#> .coords <- data.frame() +#> +#> if (verbose) { +#> cat("[parseSensorML] names: ", names(.values), "\n") +#> cat("[parseSensorML] values: ", toString(.values), "\n") #> } -#> .sml = SensorML(xml = obj, coords = .coords, id = .id, name = .shortName, -#> description = .description, boundedBy = .bb) -#> if (verbose) -#> cat("[parseSensorML] Done: ", toString(.sml), "\n") -#> return(.sml) +#> +#> .coords <- data.frame(.values) +#> .oldAttrs <- attributes(.coords) +#> attributes(.coords) <- c(as.list(.oldAttrs), +#> list(referenceFrame = .referenceFrame, +#> uom = .uom, name = .name)) +#> +#> if (!is.na(.id)) +#> row.names(.coords) <- .id +#> if (verbose) cat("[parseSensorML] row names: ", row.names(.coords), +#> "\n") +#> } +#> else { +#> .coords <- data.frame() +#> } +#> +#> # create instance +#> .sml = SensorML(xml = obj, +#> coords = .coords, +#> id = .id, +#> name = .shortName, +#> description = .description, +#> boundedBy = .bb) +#> +#> if (verbose) cat("[parseSensorML] Done: ", toString(.sml), "\n") +#> +#> return(.sml) #> } #> <environment: namespace:sos4R> #> #> $ExceptionReport -#> function (xml) -#> { -#> return("EXCEPTION!!!11") +#> function(xml) { +#> return("EXCEPTION!!!11") #> } -#> <environment: 0xa70fa50> +#> <environment: 0x564ebe6e8000> #>#> $GetCapabilities -#> function (obj, sos) -#> { -#> if (sos@version == sos100_version) { -#> .caps <- parseSosCapabilities100(obj, sos) -#> } -#> else if (sos@version == sos200_version) { -#> .caps <- parseSosCapabilities200(obj, sos) -#> } +#> function(obj, sos) { +#> if (sos@version == sos100_version){ +#> .caps <- parseSosCapabilities100(obj, sos) +#> } +#> else if (sos@version == sos200_version){ +#> .caps <- parseSosCapabilities200(obj, sos) +#> } #> } #> <environment: namespace:sos4R> #> #> $GetObservationResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (sos@verboseOutput) { -#> cat("[parseGetObservationResponse] entering... \n") -#> print(obj) -#> } -#> .observationsXML <- xml2::xml_find_all(x = obj, xpath = "sos20:observationData", -#> ns = SosAllNamespaces(version = sos200_version)) -#> featureCache <- list() -#> .observations <- sapply(.observationsXML, parseObservation_2.0, -#> sos = sos, featureCache = featureCache) -#> return(.observations) +#> function(obj, sos, verbose = FALSE) { +#> if (sos@verboseOutput) { +#> cat("[parseGetObservationResponse] entering... \n") +#> print(obj) +#> } +#> +#> .observationsXML <- xml2::xml_find_all(x = obj, +#> xpath = "sos20:observationData", +#> ns = SosAllNamespaces(version = sos200_version)) +#> featureCache <- list() +#> .observations <- sapply(.observationsXML, +#> parseObservation_2.0, +#> sos = sos, +#> featureCache = featureCache) +#> +#> return(.observations) #> } #> <environment: namespace:sos4R> #> #> $GetFeatureOfInterestResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (sos@verboseOutput) { -#> cat("[parseGetFeatureOfInterestResponse] entering... \n") -#> print(obj) -#> } -#> .featureXML <- xml2::xml_find_all(x = obj, xpath = "sos20:featureMember", -#> SosAllNamespaces(version = sos200_version)) -#> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) -#> return(.foi) +#> function(obj, sos, verbose = FALSE) { +#> +#> if (sos@verboseOutput) { +#> cat("[parseGetFeatureOfInterestResponse] entering... \n") +#> print(obj) +#> } +#> +#> .featureXML <- xml2::xml_find_all(x = obj, +#> xpath = "sos20:featureMember", +#> SosAllNamespaces(version = sos200_version)) +#> .foi = sapply(.featureXML, .parseFeatureMember, sos = sos) +#> return(.foi) #> } #> <environment: namespace:sos4R> #> #> $GetObservationById -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`ows:ExceptionReport` -#> function (obj, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseOwsExceptionReport] Starting ...\n") -#> .docRoot <- xml2::xml_root(x = obj) -#> .version <- xml2::xml_attr(x = .docRoot, attr = "version") -#> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) -#> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, xpath = paste0("//", -#> owsExceptionName), ns = SosAllNamespaces()) -#> .exceptions = sapply(.exceptionsXML, parseOwsException) -#> if (verbose) -#> cat("[parseOwsExceptionReport]", length(.exceptions), -#> "exceptions.") -#> .report <- OwsExceptionReport(version = .version, lang = .lang, -#> exceptions = .exceptions) -#> return(.report) +#> function(obj, verbose = FALSE) { +#> if (verbose) cat("[parseOwsExceptionReport] Starting ...\n") +#> .docRoot <- xml2::xml_root(x = obj) +#> +#> .version <- xml2::xml_attr(x = .docRoot, attr = "version") +#> .lang <- xml2::xml_attr(x = .docRoot, attr = "lang", default = NA_character_) +#> +#> .exceptionsXML <- xml2::xml_find_all(x = .docRoot, +#> xpath = paste0("//", owsExceptionName), +#> ns = SosAllNamespaces()) +#> +#> .exceptions = sapply(.exceptionsXML, parseOwsException) +#> if (verbose) cat("[parseOwsExceptionReport]", length(.exceptions), "exceptions.") +#> +#> .report <- OwsExceptionReport(version = .version, lang = .lang, exceptions = .exceptions) +#> +#> return(.report) #> } #> <environment: namespace:sos4R> #> #> $GetDataAvailabilityResponse -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse]") -#> if (sos@version != sos200_version) { -#> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", -#> sos@version, "'")) -#> } -#> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), -#> "element(s).\n") -#> phenTimeCache <- list() -#> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, -#> sos, phenTimeCache, verbose) -#> if (verbose) -#> cat("[parseGetDataAvailabilityResponse] Done. Processed", -#> length(.parsedGDAMembers), "elements") -#> return(.parsedGDAMembers) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseGetDataAvailabilityResponse]") +#> +#> if (sos@version != sos200_version) { +#> stop(paste0("[parseGetDataAvailabilityResponse] SOS version 2.0 required! Received '", +#> sos@version, "'")) +#> } +#> +#> .gdaMembers <- xml2::xml_find_all(x = obj, xpath = sosGDAMemberName, ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseGetDataAvailabilityResponse] with", length(.gdaMembers), "element(s).\n") +#> phenTimeCache <- list() +#> .parsedGDAMembers <- lapply(.gdaMembers, .parseGDAMember, sos, phenTimeCache, verbose) +#> if (verbose) cat("[parseGetDataAvailabilityResponse] Done. Processed", length(.parsedGDAMembers), +#> "elements") +#> return(.parsedGDAMembers) #> } #> <environment: namespace:sos4R> #> #> $`om:Measurement` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseMeasurement]\n") -#> .samplingTimeXml <- xml2::xml_child(x = obj, search = omSamplingTimeName, -#> ns = SosAllNamespaces()) -#> .samplingTime <- parseTime(obj = .samplingTimeXml, format = sosTimeFormat(sos), -#> verbose = verbose) -#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omProcedureName, ns = SosAllNamespaces()), attr = "href") -#> .observedProperty <- SwePhenomenonProperty(href = xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omObservedPropertyName, ns = SosAllNamespaces()), -#> attr = "href")) -#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, -#> ns = SosAllNamespaces()), sos = sos, verbose = verbose) -#> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, -#> ns = SosAllNamespaces())) -#> .measurement <- OmMeasurement(samplingTime = .samplingTime, -#> procedure = .procedure, observedProperty = .observedProperty, -#> featureOfInterest = .featureOfInterest, result = .result) -#> return(.measurement) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseMeasurement]\n") +#> +#> .samplingTimeXml <- xml2::xml_child(x = obj, +#> search = omSamplingTimeName, +#> ns = SosAllNamespaces()) +#> .samplingTime <- parseTime(obj = .samplingTimeXml, +#> format = sosTimeFormat(sos), +#> verbose = verbose) +#> +#> # 52N SOS only returns om:Measurements (!) with procedure ids and observed +#> # properties in xlink:href +#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, search = omProcedureName, ns = SosAllNamespaces()), attr = "href") +#> .observedProperty <- SwePhenomenonProperty( +#> href = xml2::xml_attr(x = xml2::xml_child(x = obj, search = omObservedPropertyName, ns = SosAllNamespaces()), attr = "href")) +#> +#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()), sos = sos, +#> verbose = verbose) +#> +#> # must be GmlMeasure +#> .result <- parseMeasure(xml2::xml_child(x = obj, search = omResultName, ns = SosAllNamespaces())) +#> +#> # TODO optionals elements for OmMeasurement +#> #.metadata +#> #.resultTime +#> #.resultQuality +#> #.parameter +#> +#> .measurement <- OmMeasurement(samplingTime = .samplingTime, +#> procedure = .procedure, observedProperty = .observedProperty, +#> featureOfInterest = .featureOfInterest, result = .result) +#> +#> return(.measurement) #> } #> <environment: namespace:sos4R> #> #> $`om:member` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (xml2::xml_length(x = obj) >= 1) { -#> .child <- xml2::xml_child(obj) -#> if (verbose) -#> cat("[parseObservationProperty] Parsing child of member:", -#> xml2::xml_name(x = .child, ns = SosAllNamespaces()), -#> "\n") -#> .mResult <- parseOM(.child, sos, verbose) +#> function(obj, sos, verbose = FALSE) { +#> # a member can only have one child element +#> if (xml2::xml_length(x = obj) >= 1) { +#> .child <- xml2::xml_child(obj) +#> if (verbose) cat("[parseObservationProperty] Parsing child of member:", +#> xml2::xml_name(x = .child, ns = SosAllNamespaces()), "\n") +#> .mResult <- parseOM(.child, sos, verbose) +#> } +#> else { +#> # no child, try href attribute +#> if (verbose) cat("[parseObservationProperty] Member has no direct child!\n") +#> +#> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) +#> if (!is.na(.href)) { +#> warning("Only reference was returned:", .href) +#> .mResult <- OmObservationProperty(href = .href) #> } #> else { -#> if (verbose) -#> cat("[parseObservationProperty] Member has no direct child!\n") -#> .href <- xml2::xml_attr(x = obj, attr = "href", default = NA_character_) -#> if (!is.na(.href)) { -#> warning("Only reference was returned:", .href) -#> .mResult <- OmObservationProperty(href = .href) -#> } -#> else { -#> warning("No observation found!") -#> .mResult <- OmObservationProperty() -#> } +#> warning("No observation found!") +#> .mResult <- OmObservationProperty() #> } -#> return(.mResult) +#> } +#> +#> return(.mResult) #> } #> <environment: namespace:sos4R> #> #> $`om:Observation` -#> function (obj, sos, verbose = FALSE) -#> { -#> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) -#> if (verbose) -#> cat("[parseObservation]", .id, "\n") -#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, -#> search = omProcedureName, ns = SosAllNamespaces()), attr = "href", -#> default = NA_character_) -#> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, -#> search = omObservedPropertyName, ns = SosAllNamespaces()), -#> verbose = verbose) -#> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, -#> ns = SosAllNamespaces()))) { -#> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, -#> search = omSamplingTimeName, ns = SosAllNamespaces()), -#> format = sosTimeFormat(sos = sos), verbose = verbose) -#> } -#> else { -#> warning("om:samplingTime is mandatory in om:Observation, but is missing!") -#> .samplingTime <- NULL -#> } -#> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, -#> ns = SosAllNamespaces()))) { -#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, -#> search = omFeatureOfInterestName, ns = SosAllNamespaces()), -#> sos = sos, verbose = verbose) -#> } -#> else { -#> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") -#> .featureOfInterest <- NULL -#> } -#> .resultParsingFunction <- sosParsers(sos)[[omResultName]] -#> .result <- .resultParsingFunction(xml2::xml_child(x = obj, -#> search = omResultName, ns = SosAllNamespaces()), sos, -#> verbose) -#> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, -#> ns = SosAllNamespaces()))) { -#> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, -#> search = omResultTimeName, ns = SosAllNamespaces()), -#> format = sosTimeFormat(sos = sos), verbose = verbose) -#> } -#> else { -#> .resultTime <- NULL -#> } -#> .obs <- OmObservation(samplingTime = .samplingTime, procedure = .procedure, -#> observedProperty = .observedProperty, featureOfInterest = .featureOfInterest, -#> result = .result) -#> return(.obs) +#> function(obj, sos, verbose = FALSE) { +#> .id <- xml2::xml_attr(x = obj, attr = "id", default = NA_character_) +#> if (verbose) cat("[parseObservation]", .id, "\n") +#> +#> # 52N SOS only returns om:Observation with procedure ids xlink:href +#> .procedure <- xml2::xml_attr(x = xml2::xml_child(x = obj, +#> search = omProcedureName, +#> ns = SosAllNamespaces()), +#> attr = "href", +#> default = NA_character_) +#> +#> .observedProperty <- parsePhenomenonProperty(xml2::xml_child(x = obj, search = omObservedPropertyName, ns = SosAllNamespaces()), +#> verbose = verbose) +#> +#> if (!is.na(xml2::xml_child(x = obj, search = omSamplingTimeName, ns = SosAllNamespaces()))) { +#> .samplingTime <- parseTime(obj = xml2::xml_child(x = obj, +#> search = omSamplingTimeName, +#> ns = SosAllNamespaces()), +#> format = sosTimeFormat(sos = sos), verbose = verbose) +#> } else { +#> warning("om:samplingTime is mandatory in om:Observation, but is missing!") +#> .samplingTime <- NULL +#> } +#> +#> if (!is.na(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()))) { +#> .featureOfInterest <- parseFOI(xml2::xml_child(x = obj, search = omFeatureOfInterestName, ns = SosAllNamespaces()), +#> sos = sos, verbose = verbose) +#> } else { +#> warning("om:featureOfInterest is mandatory in om:Observation, but is missing!") +#> .featureOfInterest <- NULL +#> } +#> +#> # result parser is exchangeable +#> .resultParsingFunction <- sosParsers(sos)[[omResultName]] +#> .result <- .resultParsingFunction(xml2::xml_child(x = obj, search = omResultName, ns = SosAllNamespaces()), sos, verbose) +#> +#> # optional elements +#> if (!is.na(xml2::xml_child(x = obj, search = omResultTimeName, ns = SosAllNamespaces()))) { +#> .resultTime <- parseTime(obj = xml2::xml_child(x = obj, search = omResultTimeName, ns = SosAllNamespaces()), +#> format = sosTimeFormat(sos = sos), verbose = verbose) +#> } +#> else { +#> .resultTime <- NULL +#> } +#> +#> # TODO optionals elements for OmObservation +#> #.metadata +#> #.resultQuality +#> #.parameter +#> #.metadata +#> +#> .obs <- OmObservation(samplingTime = .samplingTime, +#> procedure = .procedure, +#> observedProperty = .observedProperty, +#> featureOfInterest = .featureOfInterest, +#> result = .result) +#> +#> return(.obs) #> } #> <environment: namespace:sos4R> #> #> $`om:ObservationCollection` -#> function (obj, sos, verbose = FALSE) -#> { -#> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseObservationCollection] with ", length(.members), -#> "element(s).\n") -#> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, -#> "/", gmlEnvelopeName)) -#> if (!is.na(.env)) { -#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, -#> attr = "srsName", ns = SosAllNamespaces()), lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, -#> search = gmlLowerCornerName, ns = SosAllNamespaces())), -#> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, -#> search = gmlUpperCornerName, ns = SosAllNamespaces()))) -#> if (verbose) -#> cat("[parseObservationCollection] Parsed envelope:", -#> toString(.boundedBy), "\n") -#> if (sosSwitchCoordinates(sos)) { -#> warning("Switching coordinates in envelope of ObservationCollection!") -#> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], -#> split = " ") -#> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) -#> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], -#> split = " ") -#> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) -#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, -#> attr = "srsName"), lowerCorner = .lC, upperCorner = .uC) -#> } -#> } -#> else { -#> if (verbose) -#> cat("[parseObservationCollection] Empty envelope!\n") -#> .boundedBy <- list() -#> } -#> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, -#> verbose = verbose) -#> names(.resultList) <- lapply(X = .members, FUN = function(member) { -#> children <- xml2::xml_children(member) -#> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) -#> if (length(idOrName) < 1) { -#> xml2::xml_name(member) -#> } -#> else { -#> idOrName -#> } -#> }) -#> if (is.list(.resultList)) { -#> .obsColl <- OmObservationCollection(members = .resultList, -#> boundedBy = .boundedBy) -#> } -#> else { -#> .obsColl <- OmObservationCollection(members = list(.resultList), -#> boundedBy = .boundedBy) -#> } -#> if (verbose) -#> cat("[parseObservationCollection] Done. Processed", length(.obsColl), -#> "elements:", names(.obsColl), "\n") -#> return(.obsColl) +#> function(obj, sos, verbose = FALSE) { +#> .members <- xml2::xml_find_all(x = obj, xpath = omMemberName, ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseObservationCollection] with ", length(.members), "element(s).\n") +#> +#> .env <- xml2::xml_child(x = obj, search = paste0(gmlBoundedByName, "/", gmlEnvelopeName)) +#> if (!is.na(.env)) { +#> .boundedBy <- list( +#> srsName = xml2::xml_attr(x = .env, attr = "srsName", ns = SosAllNamespaces()), +#> lowerCorner = xml2::xml_text(x = xml2::xml_child(x = .env, search = gmlLowerCornerName, ns = SosAllNamespaces())), +#> upperCorner = xml2::xml_text(x = xml2::xml_child(x = .env, search = gmlUpperCornerName, ns = SosAllNamespaces()))) +#> +#> if (verbose) cat("[parseObservationCollection] Parsed envelope:", toString(.boundedBy), "\n") +#> +#> if (sosSwitchCoordinates(sos)) { +#> warning("Switching coordinates in envelope of ObservationCollection!") +#> .origLC <- strsplit(x = .boundedBy[["lowerCorner"]], split = " ") +#> .lC <- paste(.origLC[[1]][[2]], .origLC[[1]][[1]]) +#> .origUC <- strsplit(x = .boundedBy[["upperCorner"]], split = " ") +#> .uC <- paste(.origUC[[1]][[2]], .origUC[[1]][[1]]) +#> .boundedBy <- list(srsName = xml2::xml_attr(x = .env, attr = "srsName"), +#> lowerCorner = .lC, upperCorner = .uC) +#> } +#> } +#> else { +#> if (verbose) cat("[parseObservationCollection] Empty envelope!\n") +#> .boundedBy <- list() +#> } +#> +#> .resultList <- lapply(X = .members, FUN = parseOM, sos = sos, verbose = verbose) +#> names(.resultList) <- lapply(X = .members, FUN = function(member) { +#> children <- xml2::xml_children(member) +#> idOrName <- xml2::xml_attr(children, attr = "id", default = xml2::xml_name(children)) +#> if (length(idOrName) < 1) { +#> xml2::xml_name(member) +#> } else { +#> idOrName +#> } +#> }) +#> +#> if (is.list(.resultList)) { +#> .obsColl <- OmObservationCollection(members = .resultList, +#> boundedBy = .boundedBy) +#> } +#> else { +#> .obsColl <- OmObservationCollection(members = list(.resultList), +#> boundedBy = .boundedBy) +#> } +#> +#> if (verbose) +#> cat("[parseObservationCollection] Done. Processed", length(.obsColl), +#> "elements:", names(.obsColl), "\n") +#> +#> return(.obsColl) #> } #> <environment: namespace:sos4R> #> #> $`om:result` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseResult] Starting ...\n") -#> .result <- NULL +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseResult] Starting ...\n") +#> .result <- NULL +#> +#> .children <- xml2::xml_children(x = obj) +#> if (verbose) cat("[parseResult]", length(.children), " non-text nodes, names:", xml2::xml_name(.children), "\n") +#> +#> # Check if remaining element is there +#> if (length(.children) == 0) { #> .children <- xml2::xml_children(x = obj) -#> if (verbose) -#> cat("[parseResult]", length(.children), " non-text nodes, names:", -#> xml2::xml_name(.children), "\n") -#> if (length(.children) == 0) { -#> .children <- xml2::xml_children(x = obj) -#> stop("Continue implementation here: OM-methods-parsing.R") -#> cat("[parseResult] No non-text nodes in result, returning NULL.\n") -#> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, -#> default = NA_character_) -#> .typeWithQualifiedname <- strsplit(.typeAttributValue, -#> ":") -#> .type <- NA_character_ -#> if (length(.typeWithQualifiedname) > 0) { -#> if (length(.typeWithQualifiedname[[1]]) > 1) { -#> .type <- .typeWithQualifiedname[[1]][2] -#> } -#> } -#> if (!is.na(.type)) { -#> if (.type == om20ResultMeasureTypeName) { -#> return(xml2::xml_text(x = obj)) -#> } -#> } -#> return(NULL) -#> } -#> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) -#> if (.name == sweDataArrayName) { -#> if (verbose) -#> cat("[parseResult] Parsing result with swe:DataArray.\n") -#> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] -#> .result <- .dataArrayParsingFunction(.children[[1]], -#> sos, verbose) -#> } -#> else if (.name == xmlTextNodeName) { -#> .result <- as.numeric(xml2::xml_text(x = .children)) -#> if (is.na(.result)) { -#> .result <- xml2::xml_text(x = .children, trim = TRUE) -#> } +#> stop("Continue implementation here: OM-methods-parsing.R") +#> cat("[parseResult] No non-text nodes in result, returning NULL.\n") +#> +#> #in O&M 2.0 there can be (literal) results of type MeasurementType +#> .typeAttributValue <- xml2::xml_attr(x = obj, attr = om20ResultTypeAttributeName, default = NA_character_) +#> +#> .typeWithQualifiedname <- strsplit(.typeAttributValue, ":") +#> +#> .type <- NA_character_ +#> +#> if (length(.typeWithQualifiedname) > 0) { +#> +#> if (length(.typeWithQualifiedname[[1]]) > 1) { +#> .type <- .typeWithQualifiedname[[1]][2] +#> } #> } -#> else { -#> warning(paste("[parseResult] Parsing of given result is NOT supported:", -#> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), -#> "-- only", sweDataArrayName, " or text nodes containing strings or numbers can be parsed.")) +#> +#> if (!is.na(.type)) { +#> if (.type == om20ResultMeasureTypeName) { +#> return(xml2::xml_text(x = obj)) +#> } #> } -#> if (is.null(.result)) { -#> stop("[parseResult] result is null! Given result:\n") -#> print(obj) +#> +#> return(NULL) +#> } +#> +#> .name <- xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()) +#> if (.name == sweDataArrayName) { +#> if (verbose) cat("[parseResult] Parsing result with swe:DataArray.\n") +#> +#> # data array parser is exchangeable +#> .dataArrayParsingFunction <- sosParsers(sos)[[sweDataArrayName]] +#> .result <- .dataArrayParsingFunction(.children[[1]], sos, verbose) +#> } +#> else if (.name == xmlTextNodeName) { +#> .result <- as.numeric(xml2::xml_text(x = .children)) +#> if (is.na(.result)) { +#> .result <- xml2::xml_text(x = .children, trim = TRUE) #> } -#> if (verbose) -#> cat("[parseResult] Done\n") -#> return(.result) +#> } +#> else { +#> warning(paste("[parseResult] Parsing of given result is NOT supported:", +#> xml2::xml_name(x = .children[[1]], ns = SosAllNamespaces()), +#> "-- only", sweDataArrayName, +#> " or text nodes containing strings or numbers can be parsed.")) +#> } +#> +#> if (is.null(.result)) { +#> stop("[parseResult] result is null! Given result:\n") +#> print(obj) +#> } +#> +#> if (verbose) cat("[parseResult] Done\n") +#> +#> return(.result) #> } #> <environment: namespace:sos4R> #> #> $`swe:DataArray` -#> function (obj, sos, verbose = FALSE) -#> { -#> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, -#> xpath = "./swe:elementCount/swe:Count/swe:value", ns = SosAllNamespaces())) -#> if (verbose) -#> cat("[parseDataArray] Parsing DataArray with", .elementCount, -#> "elements.\n") -#> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] -#> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, -#> ns = SosAllNamespaces()) -#> .fields <- .elementTypeParser(obj = .elementTypeXml, sos = sos, -#> verbose = verbose) -#> if (verbose) -#> cat("[parseDataArray] Parsed field descriptions:", toString(.fields), -#> "\n") -#> .encParser <- sosParsers(sos)[[sweEncodingName]] -#> .encodingXml <- xml2::xml_child(x = obj, search = sweEncodingName, -#> ns = SosAllNamespaces()) -#> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseDataArray] Parsed encoding description:", -#> toString(.encoding), "\n") -#> .valParser <- sosParsers(sos)[[sweValuesName]] -#> .values <- .valParser(values = xml2::xml_child(x = obj, search = sweValuesName, -#> ns = SosAllNamespaces()), fields = .fields, encoding = .encoding, -#> sos = sos, verbose = verbose) -#> return(.values) +#> function(obj, sos, verbose = FALSE) { +#> .elementCount <- xml2::xml_text(xml2::xml_find_first(x = obj, +#> xpath = "./swe:elementCount/swe:Count/swe:value", +#> ns = SosAllNamespaces()) +#> ) +#> if (verbose) cat("[parseDataArray] Parsing DataArray with", .elementCount, "elements.\n") +#> +#> .elementTypeParser <- sosParsers(sos)[[sweElementTypeName]] +#> .elementTypeXml <- xml2::xml_child(x = obj, search = sweElementTypeName, ns = SosAllNamespaces()) +#> .fields <- .elementTypeParser(obj = .elementTypeXml, +#> sos = sos, +#> verbose = verbose) +#> if (verbose) cat("[parseDataArray] Parsed field descriptions:", toString(.fields), "\n") +#> +#> .encParser <- sosParsers(sos)[[sweEncodingName]] +#> .encodingXml <- xml2::xml_child(x = obj, +#> search = sweEncodingName, +#> ns = SosAllNamespaces()) +#> .encoding <- .encParser(obj = .encodingXml, sos = sos, verbose = verbose) +#> +#> if (verbose) cat("[parseDataArray] Parsed encoding description:", toString(.encoding), "\n") +#> +#> .valParser <- sosParsers(sos)[[sweValuesName]] +#> .values <- .valParser(values = xml2::xml_child(x = obj, +#> search = sweValuesName, +#> ns = SosAllNamespaces()), +#> fields = .fields, +#> encoding = .encoding, +#> sos = sos, verbose = verbose) +#> +#> return(.values) #> } #> <environment: namespace:sos4R> #> #> $`swe:elementType` -#> function (obj, sos, verbose = FALSE) -#> { -#> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, -#> attr = "href"), "#") -#> if (verbose) -#> cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), -#> "and id", elementTypeHref, "for object", xml2::xml_name(obj), -#> "\n") -#> if (is.na(elementTypeHref)) { -#> elementType <- obj -#> } -#> else { -#> root <- xml2::xml_root(obj) -#> elementType <- xml2::xml_parent(xml2::xml_find_first(x = root, -#> xpath = paste0("//*[@gml:id='", elementTypeHref, -#> "']"))) -#> if (is.na(elementType)) { -#> stop("Got ", sweElementTypeName, " with a reference (href) but cannot find definition - cannot parse!", -#> toString(obj)) -#> } -#> else { -#> if (verbose) -#> cat("[parseDataArray] Found elementType via reference", -#> elementTypeHref, "\n") -#> } -#> } -#> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, -#> ns = SosAllNamespaces()) -#> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, -#> ns = SosAllNamespaces()) -#> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { -#> if (!is.na(simpleDataRecord)) -#> dr <- simpleDataRecord -#> else dr <- dataRecord -#> fields <- xml2::xml_find_all(x = dr, xpath = sweFieldName, -#> ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseElementType] Got data record with", length(fields), -#> "fields. \n") -#> parsedFields <- lapply(fields, parseField, sos = sos, -#> verbose = verbose) -#> names <- sapply(parsedFields, "[", "name") -#> names(parsedFields) <- names -#> if (verbose) -#> cat("[parseElementType] Names of parsed fields:", -#> names(fields), "\n") -#> return(parsedFields) -#> } -#> else { -#> stop(paste("Cannot parse swe:elementType, only children of type", -#> sweSimpleDataRecordName, "and", sweDataRecordName, -#> "are supported!")) +#> function(obj, sos, verbose = FALSE) { +#> elementTypeHref <- stringr::str_remove_all(xml2::xml_attr(x = obj, attr = "href"), "#") +#> if (verbose) cat("[parseElementType] Got child", xml2::xml_name(xml2::xml_children(obj)), +#> "and id", elementTypeHref, "for object", xml2::xml_name(obj), "\n") +#> +#> if (is.na(elementTypeHref)) { +#> elementType <- obj +#> } +#> else { +#> root <- xml2::xml_root(obj) +#> elementType <- xml2::xml_parent( +#> xml2::xml_find_first(x = root, xpath = paste0("//*[@gml:id='", elementTypeHref, "']")) +#> ) +#> +#> if (is.na(elementType)) { +#> stop("Got ", sweElementTypeName," with a reference (href) but cannot find definition - cannot parse!", +#> toString(obj)) +#> } else { +#> if (verbose) cat("[parseDataArray] Found elementType via reference", elementTypeHref, "\n") #> } +#> } +#> +#> simpleDataRecord <- xml2::xml_child(x = elementType, search = sweSimpleDataRecordName, ns = SosAllNamespaces()) +#> dataRecord <- xml2::xml_child(x = elementType, search = sweDataRecordName, ns = SosAllNamespaces()) +#> +#> if (!is.na(simpleDataRecord) || !is.na(dataRecord)) { +#> # pick the existing one +#> if (!is.na(simpleDataRecord)) dr <- simpleDataRecord +#> else dr <- dataRecord +#> +#> fields <- xml2::xml_find_all(x = dr, +#> xpath = sweFieldName, +#> ns = SosAllNamespaces()) +#> +#> if (verbose) cat("[parseElementType] Got data record with", length(fields), "fields. \n") +#> +#> # extract the fields, naming with attribute 'name' +#> parsedFields <- lapply(fields, parseField, sos = sos, verbose = verbose) +#> names <- sapply(parsedFields, "[", "name") +#> names(parsedFields) <- names +#> +#> if (verbose) cat("[parseElementType] Names of parsed fields:", names(fields), "\n") +#> +#> return(parsedFields) +#> } +#> else { +#> stop(paste("Cannot parse swe:elementType, only children of type", +#> sweSimpleDataRecordName, "and", sweDataRecordName, +#> "are supported!")) +#> } #> } #> <environment: namespace:sos4R> #> #> $`swe:encoding` -#> function (obj, sos, verbose = FALSE) -#> { -#> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, -#> ns = SosAllNamespaces()) -#> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, -#> ns = SosAllNamespaces()) -#> if (!(is.na(.textBlock))) { -#> .tb <- parseTextBlock(.textBlock) -#> return(.tb) -#> } -#> else if (!(is.na(.textEncoding))) { -#> .tb <- parseTextEncoding(.textEncoding) -#> return(.tb) -#> } -#> else { -#> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, -#> "and", sweTextEncodingName, "are supported!")) -#> } +#> function(obj, sos, verbose = FALSE) { +#> .textBlock <- xml2::xml_child(x = obj, search = sweTextBlockName, ns = SosAllNamespaces()) +#> +#> .textEncoding <- xml2::xml_child(x = obj, search = sweTextEncodingName, ns = SosAllNamespaces()) +#> +#> if (!(is.na(.textBlock))) { +#> .tb <- parseTextBlock(.textBlock) +#> return(.tb) +#> } +#> else if (!(is.na(.textEncoding))) { +#> .tb <- parseTextEncoding(.textEncoding) +#> return(.tb) +#> } +#> else { +#> stop(paste("Cannot parse swe:encoding, only", sweTextBlockName, "and", sweTextEncodingName, +#> "are supported!")) +#> } #> } #> <environment: namespace:sos4R> #> #> $`swe:values` -#> function (values, fields, encoding, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseValues] Parsing swe:values using", toString(encoding), -#> "and", length(fields), "fields:", toString(names(fields)), -#> "\n") -#> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, -#> "SweTextEncoding"))) { -#> stop("Handling for given encoding not implemented!") +#> function(values, fields, encoding, sos, verbose = FALSE) { +#> if (verbose) cat("[parseValues] Parsing swe:values using", toString(encoding), "and", +#> length(fields), "fields:", toString(names(fields)), "\n") +#> if (!(inherits(encoding, "SweTextBlock") || inherits(encoding, "SweTextEncoding"))) { +#> stop("Handling for given encoding not implemented!") +#> } +#> +#> .converters <- sosDataFieldConverters(sos) +#> +#> .blockLines <- strsplit(x = xml2::xml_text(x = values), +#> split = encoding@blockSeparator) +#> .tokenLines <- sapply(.blockLines, strsplit, +#> split = encoding@tokenSeparator) +#> +#> if (verbose) +#> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), "\n") +#> +#> # data frame of correct length to be able to use cbind for first column +#> .tempId = "tempID" +#> .data <- data.frame(seq(1,length(.tokenLines))) +#> names(.data) <- .tempId +#> +#> # do following for all fields +#> .fieldCount <- length(fields) +#> for (.currentFieldIdx in seq(1,.fieldCount)) { +#> if (verbose) cat("[parseValues] Processing field index", .currentFieldIdx , "of", .fieldCount,"\n") +#> +#> # create list for each variable +#> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) +#> if (verbose) +#> cat("[parseValues] Current values: ", toString(.currentValues), "\n") +#> .currentField <- fields[[.currentFieldIdx]] +#> +#> if (verbose) +#> cat("[parseValues] Parsing field", paste(.currentField), "\n") +#> +#> # convert values to the correct types +#> .fieldDefinition <- .currentField[["definition"]] +#> .method <- .converters[[.fieldDefinition]] +#> if (verbose) { +#> cat("[parseValues] Using converter:\n") +#> print(.method) #> } -#> .converters <- sosDataFieldConverters(sos) -#> .blockLines <- strsplit(x = xml2::xml_text(x = values), split = encoding@blockSeparator) -#> .tokenLines <- sapply(.blockLines, strsplit, split = encoding@tokenSeparator) -#> if (verbose) -#> cat("[parseValues] Parsing values from lines: ", toString(.tokenLines), -#> "\n") -#> .tempId = "tempID" -#> .data <- data.frame(seq(1, length(.tokenLines))) -#> names(.data) <- .tempId -#> .fieldCount <- length(fields) -#> for (.currentFieldIdx in seq(1, .fieldCount)) { -#> if (verbose) -#> cat("[parseValues] Processing field index", .currentFieldIdx, -#> "of", .fieldCount, "\n") -#> .currentValues <- sapply(.tokenLines, "[[", .currentFieldIdx) -#> if (verbose) -#> cat("[parseValues] Current values: ", toString(.currentValues), -#> "\n") -#> .currentField <- fields[[.currentFieldIdx]] -#> if (verbose) -#> cat("[parseValues] Parsing field", paste(.currentField), -#> "\n") -#> .fieldDefinition <- .currentField[["definition"]] -#> .method <- .converters[[.fieldDefinition]] -#> if (verbose) { -#> cat("[parseValues] Using converter:\n") -#> print(.method) -#> } +#> +#> if (is.null(.method)) { +#> # could still be a unit of measurement given, use as +#> if (!is.na(.currentField["uom"])) { +#> .method <- .converters[[.currentField[["uom"]]]] #> if (is.null(.method)) { -#> if (!is.na(.currentField["uom"])) { -#> .method <- .converters[[.currentField[["uom"]]]] -#> if (is.null(.method)) { -#> warning(paste("No converter for the unit of measurement ", -#> .currentField[["uom"]], " with the definition ", -#> .currentField[["definition"]], "! Trying a default, but you can add one when creating a SOS using", -#> "SosDataFieldConvertingFunctions().\n")) -#> .method <- .converters[["fallBack"]] -#> } -#> } -#> else { -#> warning(paste("No converter found for the given field", -#> toString(.currentField), "using fallBack converter.")) -#> .method <- .converters[["fallBack"]] -#> } +#> # fallback option +#> warning(paste("No converter for the unit of measurement ", +#> .currentField[["uom"]], +#> " with the definition ", +#> .currentField[["definition"]], +#> "! Trying a default, but you can add one when creating a SOS using", +#> "SosDataFieldConvertingFunctions().\n")) +#> +#> .method <- .converters[["fallBack"]] #> } -#> if (verbose) { -#> cat("[parseValues] Using converter function:\n") -#> show(.method) -#> } -#> .currentValues <- .method(x = .currentValues, sos = sos) -#> if (verbose) -#> cat("[parseValues] Binding additional data.frame for", -#> .currentField[["name"]], "-- value range", toString(range(.currentValues)), -#> "\n") -#> .newData <- data.frame(.currentValues) -#> .newDataName <- .currentField[["name"]] -#> names(.newData) <- .cleanupColumnName(.newDataName) -#> if (verbose) -#> cat("[parseValues] Added column name:", names(.newData), -#> "\n") -#> .data <- cbind(.data, .newData) -#> if (verbose) { -#> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") -#> str(.data) -#> } -#> .addAttrs <- as.list(.currentField) -#> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] -#> .lastColumn <- dim(.data)[[2]] -#> .oldAttrs <- attributes(.data[, .lastColumn]) -#> attributes(.data[, .lastColumn]) <- c(as.list(.oldAttrs), -#> .addAttrs) -#> if (verbose) -#> cat("[parseValues] Added attributes to new data:", -#> toString(.addAttrs), "[ names: ", toString(names(.addAttrs)), -#> "]", "\n[parseValues] Old attributes list is", -#> toString(.oldAttrs), "\n[parseValues] New attributes list is", -#> toString(attributes(.data[, .lastColumn])), "\n") +#> } +#> else { +#> warning(paste("No converter found for the given field", toString(.currentField), +#> "using fallBack converter.")) +#> .method <- .converters[["fallBack"]] +#> } #> } -#> if (verbose) -#> cat("[parseValues] Removing temporary first column\n") -#> .data <- .data[, !colnames(.data) %in% .tempId] +#> #> if (verbose) { -#> cat("[parseValues] returning final data frame:\n") -#> str(.data) +#> cat("[parseValues] Using converter function:\n") +#> show(.method) #> } -#> return(.data) +#> +#> # do the conversion +#> .currentValues <- .method(x = .currentValues, sos = sos) +#> +#> # bind new and existing data: +#> if (verbose) cat("[parseValues] Binding additional data.frame for", +#> .currentField[["name"]], +#> "-- value range", toString(range(.currentValues)), "\n") +#> .newData <- data.frame(.currentValues) +#> +#> # create the names of the new data: +#> .newDataName <- .currentField[["name"]] +#> names(.newData) <- .cleanupColumnName(.newDataName) +#> +#> if (verbose) cat("[parseValues] Added column name:", names(.newData), "\n") +#> +#> # bind existing and new data column +#> .data <- cbind(.data, .newData) +#> +#> if (verbose) { +#> cat("[parseValues] The new bound data frame (one variable the a temp id):\n") +#> str(.data) +#> } +#> +#> # add field information as attributes to the new column using human +#> # readable names +#> .addAttrs <- as.list(.currentField) +#> names(.addAttrs) <- .sosParseFieldReadable[names(.currentField)] +#> +#> .lastColumn <- dim(.data)[[2]] +#> .oldAttrs <- attributes(.data[,.lastColumn]) +#> +#> attributes(.data[,.lastColumn]) <- c(as.list(.oldAttrs), .addAttrs) +#> +#> if (verbose) cat("[parseValues] Added attributes to new data:", +#> toString(.addAttrs), +#> "[ names: ", toString(names(.addAttrs)), "]", +#> "\n[parseValues] Old attributes list is", +#> toString(.oldAttrs), +#> "\n[parseValues] New attributes list is", +#> toString(attributes(.data[,.lastColumn])), +#> "\n") +#> } +#> +#> # remove id column +#> if (verbose) cat("[parseValues] Removing temporary first column\n") +#> .data <- .data[,!colnames(.data) %in% .tempId] +#> +#> if (verbose) { +#> cat("[parseValues] returning final data frame:\n") +#> str(.data) +#> } +#> return(.data) #> } #> <environment: namespace:sos4R> #> #> $`swe:Position` -#> function (obj, sos, verbose = FALSE) -#> { -#> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseSwePosition] with referenceFrame", .rF, "\n") -#> .location <- xml2::xml_child(x = obj, search = sweLocationName, -#> ns = SosAllNamespaces()) -#> .parser <- sosParsers(sos)[[sweLocationName]] -#> .pos <- .parser(.location, sos = sos, verbose = verbose) -#> .oldAttrs <- attributes(.pos) -#> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) -#> return(.pos) +#> function(obj, sos, verbose = FALSE) { +#> .rF <- xml2::xml_attr(x = obj, attr = "referenceFrame", ns = SosAllNamespaces()) +#> if (verbose) cat("[parseSwePosition] with referenceFrame", .rF, "\n") +#> +#> .location <- xml2::xml_child(x = obj, search = sweLocationName, ns = SosAllNamespaces()) +#> .parser <- sosParsers(sos)[[sweLocationName]] +#> +#> .pos <- .parser(.location, sos = sos, verbose = verbose) +#> +#> .oldAttrs <- attributes(.pos) +#> attributes(.pos) <- c(.oldAttrs, list(referenceFrame = .rF)) +#> +#> return(.pos) #> } #> <environment: namespace:sos4R> #> #> $`swe:location` -#> function (obj, sos, verbose = FALSE) -#> { -#> .vector <- xml2::xml_child(x = obj, search = sweVectorName, -#> ns = SosAllNamespaces()) -#> .id <- xml2::xml_attr(x = obj, attr = "id") -#> if (verbose) -#> cat("[parseSweLocation] with id", .id, "\n") -#> .parser <- sosParsers(sos)[[sweVectorName]] -#> location <- .parser(.vector, sos = sos, verbose = verbose) -#> return(location) +#> function(obj, sos, verbose = FALSE) { +#> .vector <- xml2::xml_child(x = obj, search = sweVectorName, ns = SosAllNamespaces()) +#> .id <- xml2::xml_attr(x = obj, attr = "id") +#> if (verbose) cat("[parseSweLocation] with id", .id, "\n") +#> +#> .parser <- sosParsers(sos)[[sweVectorName]] +#> location <- .parser(.vector, sos = sos, verbose = verbose) +#> +#> return(location) #> } #> <environment: namespace:sos4R> #> #> $`swe:Vector` -#> function (obj, sos, verbose = FALSE) -#> { -#> .children <- xml2::xml_find_all(x = obj, xpath = sweCoordinateName, -#> ns = SosAllNamespaces()) -#> .parser <- sosParsers(sos)[[sweCoordinateName]] -#> .vector <- lapply(X = .children, FUN = .parser, sos = sos, -#> verbose = verbose) -#> names(.vector) <- sapply(.vector, function(current) { -#> return(current$axisID) -#> }) -#> if (verbose) -#> cat("[parseSweVector] parsed vector with coordinates: ", -#> toString(names(.vector)), "\n") -#> return(.vector) +#> function(obj, sos, verbose = FALSE) { +#> .children <- xml2::xml_find_all(x = obj, +#> xpath = sweCoordinateName, +#> ns = SosAllNamespaces()) +#> +#> .parser <- sosParsers(sos)[[sweCoordinateName]] +#> .vector <- lapply(X = .children, FUN = .parser, sos = sos, verbose = verbose) +#> names(.vector) <- sapply(.vector, function(current) {return(current$axisID)}) +#> if (verbose) cat("[parseSweVector] parsed vector with coordinates: ", toString(names(.vector)), "\n") +#> +#> return(.vector) #> } #> <environment: namespace:sos4R> #> #> $`swe:coordinate` -#> function (obj, sos, verbose = FALSE) -#> { -#> .name <- xml2::xml_attr(x = obj, attr = "name") -#> if (verbose) -#> cat("[parseSweCoordinate] with name", .name, "\n") -#> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, -#> ns = SosAllNamespaces()) -#> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") -#> if (verbose) -#> cat("[parseSweCoordinate] axisID: ", .axisID, "\n") -#> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, -#> ns = SosAllNamespaces()) -#> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) -#> if (verbose) -#> cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") -#> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, -#> ns = SosAllNamespaces()) -#> .value <- as.double(xml2::xml_text(x = .valueNode)) -#> if (verbose) -#> cat("[parseSweCoordinate] value: ", .value, "\n") -#> return(list(name = .name, axisID = .axisID, uomCode = .uomCode, -#> value = .value)) +#> function(obj, sos, verbose = FALSE) { +#> .name <- xml2::xml_attr(x = obj, attr = "name") +#> if (verbose) cat("[parseSweCoordinate] with name", .name, "\n") +#> +#> .quantity <- xml2::xml_child(x = obj, search = sweQuantityName, ns = SosAllNamespaces()) +#> .axisID <- xml2::xml_attr(x = .quantity, attr = "axisID") +#> if (verbose) cat("[parseSweCoordinate] axisID: ", .axisID, "\n") +#> +#> .uomNode <- xml2::xml_child(x = .quantity, search = sweUomName, ns = SosAllNamespaces()) +#> .uomCode <- xml2::xml_attr(x = .uomNode, attr = "code", ns = SosAllNamespaces()) +#> if (verbose) cat("[parseSweCoordinate] uomCode: ", .uomCode, "\n") +#> +#> .valueNode <- xml2::xml_child(x = .quantity, search = sweValueName, ns = SosAllNamespaces()) +#> .value <- as.double(xml2::xml_text(x = .valueNode)) +#> if (verbose) cat("[parseSweCoordinate] value: ", .value, "\n") +#> +#> return(list(name = .name, +#> axisID = .axisID, +#> uomCode = .uomCode, +#> value = .value)) #> } #> <environment: namespace:sos4R> #> #> $`om:GeometryObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:GeometryObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:GeometryObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CategoryObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:CategoryObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:CategoryObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:CountObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:CountObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:CountObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TruthObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:TruthObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:TruthObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:TemporalObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:TemporalObservatio is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:TemporalObservatio is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`om:ComplexObservation` -#> function (obj, sos, verbose = FALSE) -#> { -#> warning("Parsing of om:ComplexObservation is not implemented!") -#> return(NA) +#> function(obj, sos, verbose = FALSE) { +#> warning("Parsing of om:ComplexObservation is not implemented!") +#> return(NA) #> } #> <environment: namespace:sos4R> #> #> $`text/csv` -#> function (obj, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseCSV] Parsing CSV...\n") -#> if (inherits(x = obj, what = "data.frame")) { -#> if (verbose) -#> cat("[parseCSV] Already a data.frame, returning object\n") -#> return(obj) -#> } -#> .lines <- strsplit(x = obj, split = "\n")[[1]] -#> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) -#> .names <- .data[[1]] -#> .newNames <- c() -#> for (.n in .names) { -#> .newNames <- c(.newNames, gsub(pattern = "\"", replacement = "", -#> x = .n)) -#> } -#> .names <- .newNames -#> .rows <- length(.data) -#> if (verbose) -#> cat("[parseCSV] Got", .rows, "lines of data.\n") -#> .df <- NULL -#> for (.r in seq(2, .rows)) { -#> if (verbose) -#> cat("[parseCSV] Processing row in CSV:", .data[[.r]], -#> "\n") -#> .row.df <- as.data.frame(.data[[.r]][1]) -#> names(.row.df) <- .names[[1]] -#> for (i in seq(2, length(.names))) { -#> .df <- as.data.frame(.data[[.r]][i]) -#> names(.df) <- .names[[i]] -#> .row.df <- cbind(.row.df, .df) -#> } -#> if (is.null(.df)) -#> .df <- .row.df -#> else .df <- do.call(rbind, list(.df, .row.df)) +#> function(obj, verbose = FALSE) { +#> if (verbose) cat("[parseCSV] Parsing CSV...\n") +#> +#> if (inherits(x = obj, what = "data.frame")) { +#> if (verbose) cat("[parseCSV] Already a data.frame, returning object\n") +#> return(obj) +#> } +#> +#> .lines <- strsplit(x = obj, split = "\n")[[1]] +#> .data <- do.call(what = "strsplit", args = list(.lines, split = ",")) +#> +#> # clean up names (double quotes) +#> .names <- .data[[1]] +#> .newNames <- c() +#> for (.n in .names) { +#> .newNames <- c(.newNames, +#> gsub(pattern = "\"", replacement = "", x = .n)) +#> } +#> .names <- .newNames +#> +#> .rows <- length(.data) +#> if (verbose) cat("[parseCSV] Got", .rows, "lines of data.\n") +#> +#> .df <- NULL +#> for (.r in seq(2,.rows)) { +#> if (verbose) cat("[parseCSV] Processing row in CSV:", .data[[.r]], "\n") +#> +#> # initialize first column of the data frame so it can be bound in loop +#> .row.df <- as.data.frame(.data[[.r]][1]) +#> names(.row.df) <- .names[[1]] +#> +#> for (i in seq(2,length(.names))) { +#> .df <- as.data.frame(.data[[.r]][i]) +#> names(.df) <- .names[[i]] +#> .row.df <- cbind(.row.df, .df) #> } -#> if (verbose) -#> cat("[parseCSV] Done.\n") -#> return(.df) +#> +#> if (is.null(.df)) +#> .df <- .row.df +#> else +#> .df <- do.call(rbind, list(.df, .row.df)) +#> } +#> +#> if (verbose) cat("[parseCSV] Done.\n") +#> +#> return(.df) #> } #> <environment: namespace:sos4R> #> #> $`text/xml;subtype="om/1.0.0"` -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #> #> $`application/vnd.google-earth.kml+xml` -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseKML] Processing KML... returning raw object!\n") -#> return(obj) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseKML] Processing KML... returning raw object!\n") +#> +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $kml -#> function (obj, sos, verbose = FALSE) -#> { -#> if (verbose) -#> cat("[parseKML] Processing KML... returning raw object!\n") -#> return(obj) +#> function(obj, sos, verbose = FALSE) { +#> if (verbose) cat("[parseKML] Processing KML... returning raw object!\n") +#> +#> return(obj) #> } #> <environment: namespace:sos4R> #> #> $`text/xml` -#> function (obj, sos, verbose = FALSE) -#> { -#> .om <- NULL -#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) -#> .parsingFunction <- sosParsers(sos)[[.name]] -#> if (!is.null(.parsingFunction)) { -#> if (verbose) -#> cat("[parseOM] Matched name for parser is", .name, -#> "\n") -#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) -#> if (verbose) -#> cat("[parseOM] Done parsing\n") -#> } -#> else { -#> warning(paste("[parseOM] No parsing function for given element", -#> .name)) -#> } -#> return(.om) +#> function(obj, sos, verbose = FALSE) { +#> .om <- NULL +#> +#> # switch submethods based on name (needs prefix) +#> .name <- xml2::xml_name(x = obj, ns = SosAllNamespaces()) +#> +#> .parsingFunction <- sosParsers(sos)[[.name]] +#> if (!is.null(.parsingFunction)) { +#> if (verbose) cat("[parseOM] Matched name for parser is", .name, "\n") +#> .om <- .parsingFunction(obj = obj, sos = sos, verbose = verbose) +#> if (verbose) cat("[parseOM] Done parsing\n") +#> } +#> else { +#> warning(paste("[parseOM] No parsing function for given element", .name)) +#> } +#> +#> return(.om) #> } #> <environment: namespace:sos4R> #>@@ -2153,7 +2268,7 @@diff --git a/docs/reference/DescribeSensor.html b/docs/reference/DescribeSensor.html index 2990089..32401da 100644 --- a/docs/reference/DescribeSensor.html +++ b/docs/reference/DescribeSensor.html @@ -65,7 +65,7 @@ @@ -264,7 +264,7 @@Contents
Author
diff --git a/docs/reference/Foi.html b/docs/reference/Foi.html index 7571cfe..1f596fc 100644 --- a/docs/reference/Foi.html +++ b/docs/reference/Foi.html @@ -63,7 +63,7 @@ @@ -181,7 +181,7 @@Contents
diff --git a/docs/reference/GML.html b/docs/reference/GML.html index 36fd908..f9fc3c4 100644 --- a/docs/reference/GML.html +++ b/docs/reference/GML.html @@ -63,7 +63,7 @@ @@ -697,8 +697,8 @@Examp aWeekAgo <- GmlTimeInstantProperty(time = GmlTimeInstant(time = timePos)) timePos <- GmlTimePosition(time = Sys.time()) now <- GmlTimeInstantProperty(time = GmlTimeInstant(time = timePos)) -GmlTimePeriod(begin = aWeekAgo, end = now)
#> GmlTimePeriod: [ Object of class GmlTimeInstantProperty; href: NA; time: GmlTimePosition [ time: 2019-04-06 15:35:41 ] -#> --> Object of class GmlTimeInstantProperty; href: NA; time: GmlTimePosition [ time: 2019-04-13 15:35:41 ] ]#> GmlTimePeriod: [ Object of class GmlTimeInstantProperty; href: NA; time: GmlTimePosition [ time: 2019-08-02 15:07:23 ] +#> --> Object of class GmlTimeInstantProperty; href: NA; time: GmlTimePosition [ time: 2019-08-09 15:07:23 ] ]Author
diff --git a/docs/reference/GetObservation.html b/docs/reference/GetObservation.html index 33d47aa..0c6a40c 100644 --- a/docs/reference/GetObservation.html +++ b/docs/reference/GetObservation.html @@ -63,7 +63,7 @@ @@ -375,7 +375,7 @@Author
diff --git a/docs/reference/KML.html b/docs/reference/KML.html index 77aa689..28d4a5e 100644 --- a/docs/reference/KML.html +++ b/docs/reference/KML.html @@ -64,7 +64,7 @@ @@ -170,7 +170,7 @@Author
diff --git a/docs/reference/MonitoringPoint.html b/docs/reference/MonitoringPoint.html index e6b97eb..e42ddb2 100644 --- a/docs/reference/MonitoringPoint.html +++ b/docs/reference/MonitoringPoint.html @@ -63,7 +63,7 @@ @@ -209,7 +209,7 @@Contents
diff --git a/docs/reference/OGC.html b/docs/reference/OGC.html index 158b10f..c6498e1 100644 --- a/docs/reference/OGC.html +++ b/docs/reference/OGC.html @@ -63,7 +63,7 @@ @@ -349,7 +349,7 @@Author
diff --git a/docs/reference/OWS.html b/docs/reference/OWS.html index 8ce0261..283966a 100644 --- a/docs/reference/OWS.html +++ b/docs/reference/OWS.html @@ -63,7 +63,7 @@ @@ -149,11 +149,11 @@Classes and Construction Functions for Elements of the OWS Namespace
OwsOperation(name, DCPs, parameters = list(NA), constraints = list(NA), metadata = list(NA)) OwsOperationsMetadata(operations, parameters = list(NA), constraints = list(NA), - extendedCapabilities = xml2::xml_missing()) + extendedCapabilities = xml2::xml_missing()) OwsRange(minimumValue = as.character(NA), maximumValue = as.character(NA), rangeClosure = as.character(NA), spacing = as.character(NA)) OwsServiceProvider(providerName, providerSite = as.character(NA), - serviceContact = xml2::xml_missing()) + serviceContact = xml2::xml_missing()) OwsServiceIdentification(serviceType, serviceTypeVersion, profile = c(NA), title, abstract = c(NA), keywords = c(NA), fees = as.character(NA), accessConstraints = c(NA)) @@ -637,7 +637,7 @@Author
diff --git a/docs/reference/OmMeasurement.html b/docs/reference/OmMeasurement.html index 0b7e1b7..78440b4 100644 --- a/docs/reference/OmMeasurement.html +++ b/docs/reference/OmMeasurement.html @@ -63,7 +63,7 @@ @@ -300,7 +300,7 @@Author
diff --git a/docs/reference/OmOM_Observation.html b/docs/reference/OmOM_Observation.html index 0344924..f6413a5 100644 --- a/docs/reference/OmOM_Observation.html +++ b/docs/reference/OmOM_Observation.html @@ -63,7 +63,7 @@ @@ -227,7 +227,7 @@Contents
diff --git a/docs/reference/OmObservation.html b/docs/reference/OmObservation.html index 89674bd..947bcf4 100644 --- a/docs/reference/OmObservation.html +++ b/docs/reference/OmObservation.html @@ -63,7 +63,7 @@ @@ -333,7 +333,7 @@Author
diff --git a/docs/reference/OmObservationCollection.html b/docs/reference/OmObservationCollection.html index 39e39d6..182910f 100644 --- a/docs/reference/OmObservationCollection.html +++ b/docs/reference/OmObservationCollection.html @@ -63,7 +63,7 @@ @@ -202,7 +202,7 @@Author
diff --git a/docs/reference/SA.html b/docs/reference/SA.html index 89fb5d2..d35eea7 100644 --- a/docs/reference/SA.html +++ b/docs/reference/SA.html @@ -63,7 +63,7 @@ @@ -259,7 +259,7 @@Author
diff --git a/docs/reference/SAMS.html b/docs/reference/SAMS.html index b991b13..d38e171 100644 --- a/docs/reference/SAMS.html +++ b/docs/reference/SAMS.html @@ -64,7 +64,7 @@ @@ -247,7 +247,7 @@Author
diff --git a/docs/reference/SML.html b/docs/reference/SML.html index d23fa6f..1f0a6f1 100644 --- a/docs/reference/SML.html +++ b/docs/reference/SML.html @@ -64,7 +64,7 @@ @@ -236,7 +236,7 @@Author
diff --git a/docs/reference/SOS.html b/docs/reference/SOS.html index d74b467..88a007b 100644 --- a/docs/reference/SOS.html +++ b/docs/reference/SOS.html @@ -63,7 +63,7 @@ @@ -453,7 +453,7 @@Author
diff --git a/docs/reference/SWE.html b/docs/reference/SWE.html index 30d2699..c43868b 100644 --- a/docs/reference/SWE.html +++ b/docs/reference/SWE.html @@ -63,7 +63,7 @@ @@ -324,7 +324,7 @@Author
diff --git a/docs/reference/SosBindings.html b/docs/reference/SosBindings.html index 1cfe140..623653f 100644 --- a/docs/reference/SosBindings.html +++ b/docs/reference/SosBindings.html @@ -63,7 +63,7 @@ @@ -187,7 +187,7 @@Contents
diff --git a/docs/reference/SosCapabilities.html b/docs/reference/SosCapabilities.html index 6a74af6..f0a82ac 100644 --- a/docs/reference/SosCapabilities.html +++ b/docs/reference/SosCapabilities.html @@ -63,7 +63,7 @@ @@ -290,7 +290,7 @@Author
diff --git a/docs/reference/SosContents.html b/docs/reference/SosContents.html index e48305c..745d684 100644 --- a/docs/reference/SosContents.html +++ b/docs/reference/SosContents.html @@ -63,7 +63,7 @@ @@ -238,7 +238,7 @@Author
diff --git a/docs/reference/SosEventTime.html b/docs/reference/SosEventTime.html index 6d2584f..a2ab850 100644 --- a/docs/reference/SosEventTime.html +++ b/docs/reference/SosEventTime.html @@ -63,7 +63,7 @@ @@ -242,7 +242,7 @@Author
diff --git a/docs/reference/SosFeatureOfInterest.html b/docs/reference/SosFeatureOfInterest.html index 97a5b52..dc474b9 100644 --- a/docs/reference/SosFeatureOfInterest.html +++ b/docs/reference/SosFeatureOfInterest.html @@ -63,7 +63,7 @@ @@ -237,7 +237,7 @@Author
diff --git a/docs/reference/SosFilter_Capabilities.html b/docs/reference/SosFilter_Capabilities.html index 9045978..26d8918 100644 --- a/docs/reference/SosFilter_Capabilities.html +++ b/docs/reference/SosFilter_Capabilities.html @@ -63,7 +63,7 @@ @@ -248,7 +248,7 @@Author
diff --git a/docs/reference/SosGetFeatureOfInterest.html b/docs/reference/SosGetFeatureOfInterest.html index 66e27f3..76cb8ef 100644 --- a/docs/reference/SosGetFeatureOfInterest.html +++ b/docs/reference/SosGetFeatureOfInterest.html @@ -63,7 +63,7 @@ @@ -198,7 +198,7 @@Contents
diff --git a/docs/reference/SosObservationOffering.html b/docs/reference/SosObservationOffering.html index 38eb620..aff2d0e 100644 --- a/docs/reference/SosObservationOffering.html +++ b/docs/reference/SosObservationOffering.html @@ -63,7 +63,7 @@ @@ -325,7 +325,7 @@Author
diff --git a/docs/reference/Supported.html b/docs/reference/Supported.html index 73f74b2..da9063d 100644 --- a/docs/reference/Supported.html +++ b/docs/reference/Supported.html @@ -63,7 +63,7 @@ @@ -245,7 +245,7 @@Author
diff --git a/docs/reference/SweTextEncoding.html b/docs/reference/SweTextEncoding.html index bf4ac30..b87f0b5 100644 --- a/docs/reference/SweTextEncoding.html +++ b/docs/reference/SweTextEncoding.html @@ -63,7 +63,7 @@ @@ -186,7 +186,7 @@Contents
diff --git a/docs/reference/TM_Operators.html b/docs/reference/TM_Operators.html index ce14d7f..08d7cec 100644 --- a/docs/reference/TM_Operators.html +++ b/docs/reference/TM_Operators.html @@ -63,7 +63,7 @@ @@ -285,7 +285,7 @@Author
diff --git a/docs/reference/checkRequest-methods.html b/docs/reference/checkRequest-methods.html index 283fb9a..e277fa7 100644 --- a/docs/reference/checkRequest-methods.html +++ b/docs/reference/checkRequest-methods.html @@ -63,7 +63,7 @@ @@ -173,7 +173,7 @@Contents
diff --git a/docs/reference/describeSensor-methods.html b/docs/reference/describeSensor-methods.html index 800d3f7..05ca244 100644 --- a/docs/reference/describeSensor-methods.html +++ b/docs/reference/describeSensor-methods.html @@ -63,7 +63,7 @@ @@ -162,7 +162,7 @@Contents
diff --git a/docs/reference/encodeKVP-methods.html b/docs/reference/encodeKVP-methods.html index b87fd4f..b3cc972 100644 --- a/docs/reference/encodeKVP-methods.html +++ b/docs/reference/encodeKVP-methods.html @@ -63,7 +63,7 @@ @@ -170,7 +170,7 @@Contents
diff --git a/docs/reference/encodeRequestKVP-methods.html b/docs/reference/encodeRequestKVP-methods.html index 51ac276..39671f7 100644 --- a/docs/reference/encodeRequestKVP-methods.html +++ b/docs/reference/encodeRequestKVP-methods.html @@ -63,7 +63,7 @@ @@ -167,7 +167,7 @@Contents
diff --git a/docs/reference/encodeRequestSOAP-methods.html b/docs/reference/encodeRequestSOAP-methods.html index c3d1336..63fdf71 100644 --- a/docs/reference/encodeRequestSOAP-methods.html +++ b/docs/reference/encodeRequestSOAP-methods.html @@ -63,7 +63,7 @@ @@ -171,7 +171,7 @@Contents
diff --git a/docs/reference/encodeRequestXML-methods.html b/docs/reference/encodeRequestXML-methods.html index eb370b4..457a11e 100644 --- a/docs/reference/encodeRequestXML-methods.html +++ b/docs/reference/encodeRequestXML-methods.html @@ -63,7 +63,7 @@ @@ -177,7 +177,7 @@Contents
diff --git a/docs/reference/encodeXML-methods.html b/docs/reference/encodeXML-methods.html index d24fb08..7ba4bd1 100644 --- a/docs/reference/encodeXML-methods.html +++ b/docs/reference/encodeXML-methods.html @@ -63,7 +63,7 @@ @@ -196,7 +196,7 @@Contents
diff --git a/docs/reference/getCapabilities-methods.html b/docs/reference/getCapabilities-methods.html index 038b229..cea2366 100644 --- a/docs/reference/getCapabilities-methods.html +++ b/docs/reference/getCapabilities-methods.html @@ -63,7 +63,7 @@ @@ -165,7 +165,7 @@Contents
diff --git a/docs/reference/getFeatureOfInterest.html b/docs/reference/getFeatureOfInterest.html index 1ed3d64..d987768 100644 --- a/docs/reference/getFeatureOfInterest.html +++ b/docs/reference/getFeatureOfInterest.html @@ -63,7 +63,7 @@ @@ -196,7 +196,7 @@Contents
diff --git a/docs/reference/getObservation-methods.html b/docs/reference/getObservation-methods.html index 8f2b324..40a1c1f 100644 --- a/docs/reference/getObservation-methods.html +++ b/docs/reference/getObservation-methods.html @@ -63,7 +63,7 @@ @@ -192,7 +192,7 @@Contents
diff --git a/docs/reference/index.html b/docs/reference/index.html index 6081832..7e6f8d8 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -60,7 +60,7 @@ @@ -448,7 +448,7 @@Contents
diff --git a/docs/reference/parse.html b/docs/reference/parse.html index fd51c54..43362cf 100644 --- a/docs/reference/parse.html +++ b/docs/reference/parse.html @@ -63,7 +63,7 @@ @@ -256,7 +256,7 @@See a
Examples
# parsing a XML string to an exception report object -er.doc <- xml2::read_xml(paste0("<ows:ExceptionReport xmlns:ows=\"http://www.opengis.net/ows/1.1\"", +er.doc <- xml2::read_xml(paste0("<ows:ExceptionReport xmlns:ows=\"http://www.opengis.net/ows/1.1\"", " xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" version=\"1.0.0\"", " xsi:schemaLocation=\"http://schemas.opengis.net/ows/1.1.0/owsExceptionReport.xsd\">", "<ows:Exception exceptionCode=\"VersionNegotiationFailed\" locator=\"AcceptVersions\">", @@ -314,7 +314,7 @@diff --git a/docs/reference/sos4R-package.html b/docs/reference/sos4R-package.html index 0764b08..3337802 100644 --- a/docs/reference/sos4R-package.html +++ b/docs/reference/sos4R-package.html @@ -63,7 +63,7 @@ @@ -145,8 +145,8 @@Author
Details
sos4R Type: Package Version: 0.3.0 Date: 2019-03-30 0.3.1 Date: 2019-07-09 License: GPL-2 LazyLoad: yes Author
diff --git a/docs/reference/sosConvert.html b/docs/reference/sosConvert.html index b91236e..e424e48 100644 --- a/docs/reference/sosConvert.html +++ b/docs/reference/sosConvert.html @@ -63,7 +63,7 @@ @@ -213,7 +213,7 @@Author
diff --git a/docs/reference/sosCreate.html b/docs/reference/sosCreate.html index 29563e9..48a7d66 100644 --- a/docs/reference/sosCreate.html +++ b/docs/reference/sosCreate.html @@ -63,7 +63,7 @@ @@ -342,7 +342,7 @@Author
diff --git a/docs/reference/sosObservableProperties-methods.html b/docs/reference/sosObservableProperties-methods.html index ebf5428..dc0864f 100644 --- a/docs/reference/sosObservableProperties-methods.html +++ b/docs/reference/sosObservableProperties-methods.html @@ -63,7 +63,7 @@ @@ -168,7 +168,7 @@Contents
diff --git a/docs/reference/sosRequest-methods.html b/docs/reference/sosRequest-methods.html index 35207b0..cbd3db7 100644 --- a/docs/reference/sosRequest-methods.html +++ b/docs/reference/sosRequest-methods.html @@ -64,7 +64,7 @@ @@ -164,7 +164,7 @@Contents
diff --git a/docs/reference/xml.html b/docs/reference/xml.html index b62dc3c..891acf1 100644 --- a/docs/reference/xml.html +++ b/docs/reference/xml.html @@ -63,7 +63,7 @@ @@ -156,7 +156,7 @@Author
- Bugfix release: don’t set classes for
revdepcheck::revdep_check() for checking reverse dependencies