├── .gitignore ├── LICENSE ├── tests ├── testthat.R └── testthat │ └── test-iri.R ├── vignettes ├── README-iri_from_random_profile-1.png ├── publish.sh └── RoadFeatures.Rmd ├── .gitmodules ├── NAMESPACE ├── .Rbuildignore ├── man ├── IRI_COEF_100.Rd ├── IRI_COEF_250.Rd ├── CalculateIRIperSegments.Rd ├── CalculateIRIContinuously.Rd └── CalculateIRIperSegmentsOverlapping.Rd ├── .lintr ├── rroad.Rproj ├── .travis.yml ├── CONTRIBUTING.md ├── DESCRIPTION ├── R ├── rroad-package.R └── iri.R ├── README.md ├── README.Rmd └── CODE_OF_CONDUCT.md /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | vignettes/*_cache 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016-2017 2 | COPYRIGHT HOLDER: Viliam Simko and Kevin Laubis 3 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(rroad) 3 | 4 | test_check("rroad") 5 | -------------------------------------------------------------------------------- /vignettes/README-iri_from_random_profile-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/vsimko/rroad/HEAD/vignettes/README-iri_from_random_profile-1.png -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "vignettes/gh-pages"] 2 | path = vignettes/gh-pages 3 | url = https://github.com/vsimko/rroad.git 4 | branch = gh-pages 5 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(CalculateIRIContinuously) 4 | export(CalculateIRIperSegments) 5 | export(CalculateIRIperSegmentsOverlapping) 6 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis\.yml$ 4 | ^\.lintr$ 5 | ^README 6 | ^CODE_OF_CONDUCT.md$ 7 | ^CONTRIBUTING.md$ 8 | ^vignettes/gh-pages$ 9 | ^vignettes/publish.sh$ 10 | ^vignettes/README 11 | -------------------------------------------------------------------------------- /tests/testthat/test-iri.R: -------------------------------------------------------------------------------- 1 | context("IRI computation") 2 | 3 | # Tests ========== 4 | 5 | test_that("First test", { 6 | profile <- rnorm(10000) 7 | iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 8 | expect_equal(length(iri), 50) 9 | }) 10 | -------------------------------------------------------------------------------- /man/IRI_COEF_100.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rroad-package.R 3 | \name{IRI_COEF_100} 4 | \alias{IRI_COEF_100} 5 | \title{precomputed coeficients 100 mm segments (lazily evaluated promise)} 6 | \description{ 7 | precomputed coeficients 100 mm segments (lazily evaluated promise) 8 | } 9 | -------------------------------------------------------------------------------- /man/IRI_COEF_250.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rroad-package.R 3 | \name{IRI_COEF_250} 4 | \alias{IRI_COEF_250} 5 | \title{precomputed coeficients 250 mm segments (lazily evaluated promise)} 6 | \description{ 7 | precomputed coeficients 250 mm segments (lazily evaluated promise) 8 | } 9 | -------------------------------------------------------------------------------- /vignettes/publish.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # we run this script manually to generate new version of the vignette 4 | 5 | cp RoadFeatures.Rmd gh-pages/index.Rmd 6 | cd gh-pages 7 | 8 | Rscript -e "library(knitr); knit('index.Rmd')" 9 | 10 | git add . 11 | git commit -a 12 | git push 13 | 14 | echo "appears shortly at: https://vsimko.github.io/rroad/" 15 | -------------------------------------------------------------------------------- /.lintr: -------------------------------------------------------------------------------- 1 | exclusions: list() 2 | exclude: "# Exclude Linting" 3 | exclude_start: "# Begin Exclude Linting" 4 | exclude_end: "# End Exclude Linting" 5 | linters: with_defaults( 6 | spaces_left_parentheses_linter = NULL, 7 | commented_code_linter = NULL, 8 | multiple_dots_linter = NULL, 9 | commas_linter = NULL, 10 | open_curly_linter = NULL, 11 | camel_case_linter = NULL, 12 | NULL 13 | ) 14 | -------------------------------------------------------------------------------- /rroad.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --as-cran 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # see also https://docs.travis-ci.com/user/languages/r 2 | language: r 3 | 4 | # Using the package cache to store R package dependencies can significantly 5 | # speed up build times and is recommended for most builds. 6 | cache: 7 | - apt 8 | - packages 9 | 10 | # You will need to set sudo: false in order to use the container based builds 11 | # and package caching. 12 | sudo: false 13 | 14 | warnings_are_errors: false 15 | 16 | notifications: 17 | email: 18 | on_success: change 19 | on_failure: change 20 | 21 | addons: 22 | apt: 23 | packages: 24 | - libsndfile1-dev 25 | - libfftw3-dev 26 | 27 | r_binary_packages: 28 | - covr 29 | - lintr 30 | 31 | after_success: 32 | - Rscript -e 'library(covr);codecov()' 33 | - Rscript -e 'devtools::install();lintr::lint_package()' 34 | -------------------------------------------------------------------------------- /man/CalculateIRIperSegments.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iri.R 3 | \name{CalculateIRIperSegments} 4 | \alias{CalculateIRIperSegments} 5 | \title{Computes the IRI for fixed length segments (e.g. 100m segments) given a road 6 | profile.} 7 | \usage{ 8 | CalculateIRIperSegments(profile, iri_coef, segment.length = 100) 9 | } 10 | \arguments{ 11 | \item{profile}{Road profile (as numeric vector in mm) whose IRI is to be calculated.} 12 | 13 | \item{iri_coef}{Set of coefficients for specific sample size (e. g. IRI_COEF_100).} 14 | 15 | \item{segment.length}{Distance (in m) for which the IRI is to be calculated. Default is 100 m.} 16 | } 17 | \value{ 18 | Calculated IRI (m/km) per segment (as numeric) of the given profile. 19 | } 20 | \description{ 21 | Computes the IRI for fixed length segments (e.g. 100m segments) given a road 22 | profile. 23 | } 24 | \examples{ 25 | profile <- rnorm(10000) 26 | iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 27 | par(mfrow = c(1,2)) 28 | plot(profile, type="l", 29 | xlab="Distance [dm]", ylab="Profile [m]", 30 | main="Read profile (Laser measurement)") 31 | plot(iri, type="s", 32 | xlab="Segment", ylab="IRI [m/km]", 33 | main="International Roughness Index (IRI)\\nsample = 10cm, segment = 20m") 34 | } 35 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | Interested in contributing to **rroad**? We'd love your help. 4 | The package **rroad** is an open source project, built one 5 | contribution at a time by users just like you. 6 | 7 | ## How to contribute 8 | - Fork, clone, edit, commit, push, create pull request 9 | - Use RStudio 10 | - Unit-testing: press `CTRL+SHIFT+T` in RStudio 11 | 12 | Use git rebase (not git merge) to sync your work from time to time. 13 | 14 | ``` 15 | $ git fetch upstream 16 | $ git rebase upstream/master 17 | ``` 18 | 19 | ## Reporting bugs and other issues 20 | If you encounter a clear bug, please file a minimal reproducible example on github [issue tracker]. 21 | If you have a suggestion for improvement or a new feature, create 22 | a [pull request] so it can be discussed and reviewed by the 23 | community and project committers. Even the project committers 24 | submit their code this way. 25 | 26 | ## How to perform static code analysis and style checks 27 | We use `lintr` which also performs the analysis on Travis-CI. 28 | Configuration for `lintr` is in `.lintr` file. 29 | Lints are treated as warnings, but we strive to be lint-free. 30 | 31 | In RStudio, you can run lintr from the console as follows: 32 | ```r 33 | > lintr::lint_package() 34 | ``` 35 | 36 | [issue tracker]: https://github.com/vsimko/rroad/issues 37 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: rroad 2 | Type: Package 3 | Title: Road Condition Analysis 4 | Version: 0.0.5 5 | Date: 2018-02-20 6 | Authors@R: c( 7 | person("Viliam", "Simko", email = "viliam.simko@gmail.com", role = c("cre", "aut")), 8 | person("Kevin", "Laubis", email = "laubis@fzi.de", role = "aut")) 9 | Description: Computation of the International Roughness Index (IRI) given a 10 | longitudinal road profile. The IRI can be calculated for a single road segment 11 | or for a sequence of segments with a fixed length (e. g. 100m). For the latter, 12 | an overlap of the segments can be selected. The IRI and likewise the algorithms 13 | for its determination are defined in Sayers, Michael W; Gillespie, Thomas D; 14 | Queiroz, Cesar A.V. 1986. The International Road Roughness Experiment (IRRE) : 15 | establishing correlation and a calibration standard for measurements. World 16 | Bank technical paper; no. WTP 45. Washington, DC : The World Bank. (ISBN 17 | 0-8213-0589-1) available from . 18 | License: MIT + file LICENSE 19 | URL: http://github.com/vsimko/rroad 20 | BugReports: http://github.com/vsimko/rroad/issues 21 | LazyData: yes 22 | Suggests: 23 | testthat, 24 | knitr, 25 | zoo, 26 | biwavelet 27 | VignetteBuilder: knitr 28 | RoxygenNote: 6.0.1 29 | -------------------------------------------------------------------------------- /man/CalculateIRIContinuously.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iri.R 3 | \name{CalculateIRIContinuously} 4 | \alias{CalculateIRIContinuously} 5 | \title{Computes the IRI for a continuously increasing segment given a road profile} 6 | \usage{ 7 | CalculateIRIContinuously(profile, iri_coef) 8 | } 9 | \arguments{ 10 | \item{profile}{Road profile (as numeric vector in mm) whose IRIs are to be 11 | calculated.} 12 | 13 | \item{iri_coef}{Set of coefficients for specific sample size (e. g. 14 | IRI_COEF_250).} 15 | } 16 | \value{ 17 | Calculated IRIs (m/km) for increasing segments (as numeric vector) of 18 | the given profile. 19 | } 20 | \description{ 21 | Depending on the sample size a certain buffer has to be attached to the 22 | profile for calculation the slope at the end. 23 | } 24 | \examples{ 25 | generate_test_profile <- function (x) { 26 | if (x < 1) return(0) 27 | if (x >= 1 && x < 3) return(x - 1) 28 | if (x >= 3 && x < 5) return(5 - x) 29 | if (x >= 5) return(0) 30 | } 31 | x <- seq(.25, 30, by = .25) 32 | test_profile <- data.frame(x = x, profile=sapply(x, generate_test_profile)) 33 | test_profile$iri <- CalculateIRIContinuously( 34 | test_profile$profile, IRI_COEF_250) 35 | plot(x = test_profile$x, y = test_profile$profile, ylim = c(0, 8), 36 | xlim = c(0,25), type = "l") 37 | lines(x = test_profile$x, y = test_profile$iri*10) 38 | } 39 | -------------------------------------------------------------------------------- /R/rroad-package.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | 3 | # just to show a startup message 4 | message <- paste("rroad", utils::packageVersion("rroad"), "loaded.") 5 | packageStartupMessage(message, appendLF = TRUE) 6 | 7 | # lazily evaluated promise 8 | delayedAssign("IRI_COEF_100", list( 9 | dx = 0.1, 10 | st = matrix(nrow = 4, ncol = 4, byrow = TRUE, 11 | c(.9994014, 4.442351E-03, 2.188854E-04, 5.72179E-05, 12 | -.2570548, .975036, 7.966216E-03, 2.458427E-02, 13 | 3.960378E-03, 3.814527E-04, .9548048, 4.055587E-03, 14 | 1.687312, .1638951, -19.34264, .7948701)), 15 | pr = c(3.793992E-04, .2490886, 4.123478E-02, 17.65532) 16 | ), assign.env = as.environment("package:rroad")) 17 | 18 | # lazily evaluated promise 19 | delayedAssign("IRI_COEF_250", list( 20 | dx = 0.25, 21 | st = matrix(nrow = 4, ncol = 4, byrow = TRUE, 22 | c(.9966071, 1.091514E-02, -2.083274E-03, 3.190145E-04, 23 | -.5563044, .9438768, -.8324718, 5.064701E-02, 24 | 2.153176E-02, 2.126763E-03, .7508714, 8.221888E-03, 25 | 3.335013, .3376467, -39.12762, .4347564)), 26 | pr = c(5.476107E-03, 1.388776, .2275968, 35.79262) 27 | ), assign.env = as.environment("package:rroad")) 28 | 29 | } 30 | 31 | #' precomputed coeficients 100 mm segments (lazily evaluated promise) 32 | #' @name IRI_COEF_100 33 | NULL 34 | 35 | #' precomputed coeficients 250 mm segments (lazily evaluated promise) 36 | #' @name IRI_COEF_250 37 | NULL 38 | -------------------------------------------------------------------------------- /man/CalculateIRIperSegmentsOverlapping.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/iri.R 3 | \name{CalculateIRIperSegmentsOverlapping} 4 | \alias{CalculateIRIperSegmentsOverlapping} 5 | \title{Computes the IRI for fixed length overlapping segments (e.g. 100 m segments) with an 6 | offset (e.g. 20 m) given a road profile} 7 | \usage{ 8 | CalculateIRIperSegmentsOverlapping(profile, iri_coef, segment.length = 100, 9 | segment.offset = 20) 10 | } 11 | \arguments{ 12 | \item{profile}{Road profile (as numeric vector in mm) whose IRI is to be calculated.} 13 | 14 | \item{iri_coef}{Set of coefficients for specific sample size (e. g. IRI_COEF_100).} 15 | 16 | \item{segment.length}{Distance (in m) for which the IRI is to be calculated. Default is 100 m.} 17 | 18 | \item{segment.offset}{Offset (in m) for which the segments will not overlap. Default is 20 m.} 19 | } 20 | \value{ 21 | Calculated IRI (m/km) per segment (as numeric) of the given profile. 22 | } 23 | \description{ 24 | Computes the IRI for fixed length overlapping segments (e.g. 100 m segments) with an 25 | offset (e.g. 20 m) given a road profile 26 | } 27 | \examples{ 28 | profile <- rnorm(10000) 29 | iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 30 | par(mfrow = c(1,2)) 31 | plot(profile, type="l", 32 | xlab="Distance [dm]", ylab="Profile [m]", 33 | main="Read profile (Laser measurement)") 34 | plot(iri, type="s", 35 | xlab="Segment (with 20 m offset)", ylab="IRI [m/km]", 36 | main="International Roughness Index (IRI)\\nsample = 10cm, segment = 20m") 37 | } 38 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | rroad R package 3 | =============== 4 | 5 | Set of tools for monitoring road condition. 6 | 7 | Currently, the following features are supported: 8 | 9 | - International Roughness Index (IRI) computation 10 | - continuously increasing segment 11 | - fixed length overlapping segments with an offset 12 | 13 | [![Build Status](https://travis-ci.org/vsimko/rroad.svg)](https://travis-ci.org/vsimko/rroad) [![codecov.io](https://codecov.io/github/vsimko/rroad/coverage.svg?branch=master)](https://codecov.io/github/vsimko/rroad?branch=master) [![CRAN Status](http://www.r-pkg.org/badges/version/rroad)](http://cran.r-project.org/package=rroad) [![Rdoc](http://www.rdocumentation.org/badges/version/rroad)](http://www.rdocumentation.org/packages/rroad) 14 | 15 | Download and Install 16 | -------------------- 17 | 18 | To download the development version of the package, type the following at the R command line: 19 | 20 | ``` r 21 | install.packages("devtools") 22 | devtools::install_github("vsimko/rroad") 23 | ``` 24 | 25 | To download the release version of the package on CRAN, type the following at the R command line: 26 | 27 | ``` r 28 | install.packages("rroad") 29 | ``` 30 | 31 | Examples 32 | -------- 33 | 34 | ``` r 35 | profile <- rnorm(10000) 36 | iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 37 | par(mfrow = c(1,2)) # space for two diagrams 38 | plot(profile, type = "l", 39 | xlab = "Distance [dm]", ylab = "Profile [mm]", 40 | main = "Read profile (Laser measurement)") 41 | plot(iri, type = "s", 42 | xlab = "Segment", ylab = "IRI [m/km]", 43 | main = "International Roughness Index (IRI)\nsample = 10cm, segment = 20m") 44 | ``` 45 | 46 | ![](vignettes/README-iri_from_random_profile-1.png) 47 | 48 | References 49 | ---------- 50 | 51 | Sayers, Michael W; Gillespie, Thomas D; Queiroz, Cesar A.V. 1986 **The International Road Roughness Experiment (IRRE) : establishing correlation and a calibration standard for measurements**. World Bank technical paper ; no. WTP 45. Washington, DC : The World Bank. [Link](http://documents.worldbank.org/curated/en/326081468740204115/The-International-Road-Roughness-Experiment-IRRE-establishing-correlation-and-a-calibration-standard-for-measurements) 52 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: markdown_github 5 | --- 6 | 7 | ```{r Setup, include=FALSE} 8 | library(rroad) 9 | knitr::opts_chunk$set( 10 | collapse = TRUE, 11 | comment = "#>", 12 | fig.path = "vignettes/README-" 13 | ) 14 | set.seed(1) 15 | ``` 16 | 17 | # rroad R package 18 | Set of tools for monitoring road condition. 19 | 20 | Currently, the following features are supported: 21 | 22 | - International Roughness Index (IRI) computation 23 | - continuously increasing segment 24 | - fixed length overlapping segments with an offset 25 | 26 | [![Build Status](https://travis-ci.org/vsimko/rroad.svg)](https://travis-ci.org/vsimko/rroad) 27 | [![codecov.io](https://codecov.io/github/vsimko/rroad/coverage.svg?branch=master)](https://codecov.io/github/vsimko/rroad?branch=master) 28 | [![CRAN Status](http://www.r-pkg.org/badges/version/rroad)](http://cran.r-project.org/package=rroad) 29 | [![Rdoc](http://www.rdocumentation.org/badges/version/rroad)](http://www.rdocumentation.org/packages/rroad) 30 | [![Dependency Status](https://dependencyci.com/github/vsimko/rroad/badge)](https://dependencyci.com/github/vsimko/rroad) 31 | 32 | ## Download and Install 33 | 34 | To download the development version of the package, type the following at the R command line: 35 | ```{r Install latest, eval=FALSE} 36 | install.packages("devtools") 37 | devtools::install_github("vsimko/rroad") 38 | ``` 39 | 40 | To download the release version of the package on CRAN, type the following at the R command line: 41 | ```{r Install from CRAN, eval=FALSE} 42 | install.packages("rroad") 43 | ``` 44 | 45 | 46 | ## Examples 47 | 48 | ```{r iri_from_random_profile, fig.width=8, fig.height=4} 49 | profile <- rnorm(10000) 50 | iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 51 | par(mfrow = c(1,2)) # space for two diagrams 52 | plot(profile, type = "l", 53 | xlab = "Distance [dm]", ylab = "Profile [mm]", 54 | main = "Read profile (Laser measurement)") 55 | plot(iri, type = "s", 56 | xlab = "Segment", ylab = "IRI [m/km]", 57 | main = "International Roughness Index (IRI)\nsample = 10cm, segment = 20m") 58 | ``` 59 | 60 | ## References 61 | 62 | 63 | Sayers, Michael W; Gillespie, Thomas D; Queiroz, Cesar A.V. 1986 64 | **The International Road Roughness Experiment (IRRE) : establishing correlation and a calibration standard for measurements**. 65 | World Bank technical paper ; no. WTP 45. Washington, DC : The World Bank. [Link] 66 | 67 | [Link]: http://documents.worldbank.org/curated/en/326081468740204115/The-International-Road-Roughness-Experiment-IRRE-establishing-correlation-and-a-calibration-standard-for-measurements 68 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation. 6 | 7 | ## Our Standards 8 | 9 | Examples of behavior that contributes to creating a positive environment include: 10 | 11 | * Using welcoming and inclusive language 12 | * Being respectful of differing viewpoints and experiences 13 | * Gracefully accepting constructive criticism 14 | * Focusing on what is best for the community 15 | * Showing empathy towards other community members 16 | 17 | Examples of unacceptable behavior by participants include: 18 | 19 | * The use of sexualized language or imagery and unwelcome sexual attention or advances 20 | * Trolling, insulting/derogatory comments, and personal or political attacks 21 | * Public or private harassment 22 | * Publishing others' private information, such as a physical or electronic address, without explicit permission 23 | * Other conduct which could reasonably be considered inappropriate in a professional setting 24 | 25 | ## Our Responsibilities 26 | 27 | Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. 28 | 29 | Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. 30 | 31 | ## Scope 32 | 33 | This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. 34 | 35 | ## Enforcement 36 | 37 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at viliam.simko@gmail.com. The project team will review and investigate all complaints, and will respond in a way that it deems appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. 38 | 39 | Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. 40 | 41 | ## Attribution 42 | 43 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version] 44 | 45 | [homepage]: http://contributor-covenant.org 46 | [version]: http://contributor-covenant.org/version/1/4/ 47 | -------------------------------------------------------------------------------- /vignettes/RoadFeatures.Rmd: -------------------------------------------------------------------------------- 1 | 5 | 6 | An Introduction to **rroad** Package 7 | ======================================= 8 | 9 | ```{r Setup, include=FALSE} 10 | set.seed(0) # we need reproducible results 11 | knitr::opts_chunk$set( 12 | out.extra = 'style="display:block; margin: auto"', 13 | fig.align = "center", 14 | # fig.path = "webimg/", 15 | dev = "png") 16 | ``` 17 | 18 | ```{r, include=FALSE} 19 | if (requireNamespace("zoo", quietly = TRUE) && 20 | requireNamespace("biwavelet", quietly = TRUE) 21 | ) { 22 | library("zoo") 23 | library("biwavelet") 24 | } else { 25 | knitr::knit_exit(" 26 | Suggested packages not installed: biwavelet, zoo, dplyr 27 | 28 | Try installing from CRAN: 29 | install.packages('zoo') 30 | install.packages('biwavelet') 31 | 32 | Alternatively try installing 'biwavelet' from github: 33 | install.packages('devtools') 34 | devtools::install_github('tgouhier/biwavelet') 35 | ") 36 | } 37 | ``` 38 | 39 | First, some assumptions about the road and our car: 40 | ```{r} 41 | road_len_m <- 1000 # road length 42 | speed_kmh <- 80 # car speed in km/h 43 | sample_rate_hz <- 200 # sampling rate of the 3D accelerometer 44 | speed_ms <- speed_kmh / 3.6 # car speed in m/s 45 | sample_len <- round(speed_ms / sample_rate_hz, digits = 2) # sample size 46 | num_samples <- round(road_len_m / sample_len) # how many samples we collected 47 | GRAVITY_ACCEL <- 9.80665 # ms^-2 48 | 49 | print(sample_len) 50 | print(num_samples) 51 | ``` 52 | 53 | First, we use some sample data obrained from a 3D-accelerometer. We need to trim 54 | NA valued from the signal, because there might be gaps (NA values) and the 55 | interpolation doesn't work with NAs. 56 | 57 | ```{r cache=TRUE} 58 | # random signal with simulated gravity 59 | random_accz <- (rnorm(num_samples) - GRAVITY_ACCEL) 60 | 61 | # random gaps in the signal to later demonstrate gaps interpolation 62 | random_gaps <- sapply(rnorm(num_samples), 63 | function(x){ifelse(abs(x) > .7, 1, NA)}) 64 | 65 | signal <- data.frame( 66 | sampleid = seq_len(num_samples), 67 | dist_meters = seq(from = 0, to = road_len_m, by = sample_len), 68 | accZ = random_accz * random_gaps 69 | ) 70 | head(signal$accZ, num_samples) -> signal$accZ_orig 71 | 72 | plot(signal$dist_meters, signal$accZ, type = "o", pch = "+", cex = .5, 73 | main = "Accelerometer signal (original)", 74 | xlab = "Distance traveled [m]", 75 | ylab = expression( paste("Z-acceleration [", m * s ^ -2, "]") )) 76 | 77 | # signal without the standard gravity acceleration 78 | (signal$accZ_orig - GRAVITY_ACCEL) -> signal$accZ_nogravity 79 | 80 | # z-score normalization (subtracting mean and dividing by sd) 81 | scale(signal$accZ_orig) -> signal$accZ 82 | 83 | # removing leading and trailing NAs in the whole matrix 84 | na.trim(signal) -> signal 85 | 86 | plot(signal$dist_meters, signal$accZ, type = "o", pch = "+", cex = .5, 87 | main = "Accelerometer signal (z-score normalized)", 88 | xlab = "Distance traveled [m]", 89 | ylab = expression( paste("Z-acceleration [", m * s ^ -2, "]") )) 90 | ``` 91 | 92 | Now, we look at the gaps closely: 93 | ```{r} 94 | head(signal, 500) -> signal_head 95 | plot(signal_head$dist_meters, signal_head$accZ, 96 | type = "o", xlab = NA, ylab = NA, pch = "+", cex = .5, 97 | main = paste("First", nrow(signal_head), "samples with gaps")) 98 | ``` 99 | 100 | We need to interpolate the values between the gaps: 101 | ```{r} 102 | na.approx(signal$accZ, na.rm = FALSE) -> signal$accZ_approx 103 | 104 | head(signal, 500) -> signal_head 105 | plot(signal_head$dist_meters, signal_head$accZ, 106 | type = "p", pch = "+", cex = .5, xlab = NA, ylab = NA, 107 | main = paste("First", nrow(signal_head), "samples interpolated")) 108 | 109 | lines(signal_head$dist_meters, signal_head$accZ_approx, 110 | col = "red", pch = ".", xlab = NA, ylab = NA) 111 | ``` 112 | 113 | We can also analyze frequency content of the signal by using **Continuous 114 | Wavelet Transform (CWT)**. The following plot is called "scaleogram". 115 | 116 | ```{r cache=TRUE} 117 | w <- wt(cbind(signal$sampleid, signal$accZ_approx), dj = 1/2) 118 | plot(w) 119 | ``` 120 | 121 | We can extract the CWT coeficients representing certaing frequency bands. 122 | The `power.corr` matrix represents bias-correction version. 123 | ```{r} 124 | nscales <- nrow(w$power.corr) 125 | signal$cwt_mid <- w$power.corr[floor(.5 * nscales),] 126 | signal$cwt_high <- w$power.corr[floor(.2 * nscales),] 127 | signal$cwt_low <- w$power.corr[floor(.8 * nscales),] 128 | 129 | plot(signal$cwt_high, type = "l") 130 | lines(signal$cwt_mid, col = "blue", lw = 4) 131 | lines(signal$cwt_low, col = "red", lw = 4) 132 | ``` 133 | 134 | Here, we compute moving average and root mean squared value: 135 | 136 | ```{r} 137 | rollmean(signal$accZ_approx, k = 10, fill = NA) -> signal$rollmean10 138 | rollmean(signal$accZ_approx, k = 20, fill = NA) -> signal$rollmean20 139 | 140 | rms <- function(x) sqrt(mean(x^2)) # same as `rms` from `seewave` package 141 | rollapply(signal$accZ_approx, width = 20, fill = NA, FUN = rms ) -> signal$rms20 142 | ``` 143 | 144 | ```{r} 145 | head(signal, 3000) -> signal_head 146 | 147 | plot(signal_head$dist_meters, 148 | signal_head$accZ_approx, 149 | type = "l", xlab = NA, ylab = NA, 150 | main = paste("First", nrow(signal_head), "samples interpolated")) 151 | 152 | lines(signal_head$dist_meters, signal_head$rollmean10, col = "red", lw = 3) 153 | lines(signal_head$dist_meters, signal_head$rollmean20, col = "blue", lw = 3) 154 | lines(signal_head$dist_meters, signal_head$rms20, col = "green", lw = 3) 155 | ``` 156 | -------------------------------------------------------------------------------- /R/iri.R: -------------------------------------------------------------------------------- 1 | # This file provides a function for calculation the international roughness 2 | # index (IRI) given a road profile. 3 | 4 | #' Computes the IRI for fixed length segments (e.g. 100m segments) given a road 5 | #' profile. 6 | #' 7 | #' @param profile Road profile (as numeric vector in mm) whose IRI is to be calculated. 8 | #' @param iri_coef Set of coefficients for specific sample size (e. g. IRI_COEF_100). 9 | #' @param segment.length Distance (in m) for which the IRI is to be calculated. Default is 100 m. 10 | #' @return Calculated IRI (m/km) per segment (as numeric) of the given profile. 11 | #' @examples 12 | #' profile <- rnorm(10000) 13 | #' iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 14 | #' par(mfrow = c(1,2)) 15 | #' plot(profile, type="l", 16 | #' xlab="Distance [dm]", ylab="Profile [m]", 17 | #' main="Read profile (Laser measurement)") 18 | #' plot(iri, type="s", 19 | #' xlab="Segment", ylab="IRI [m/km]", 20 | #' main="International Roughness Index (IRI)\nsample = 10cm, segment = 20m") 21 | #' @export 22 | CalculateIRIperSegments <- function(profile, iri_coef, segment.length = 100) { 23 | CalculateIRIperSegmentsOverlapping( 24 | profile, iri_coef, segment.length, segment.length) 25 | } 26 | 27 | 28 | #' Computes the IRI for fixed length overlapping segments (e.g. 100 m segments) with an 29 | #' offset (e.g. 20 m) given a road profile 30 | #' 31 | #' @param profile Road profile (as numeric vector in mm) whose IRI is to be calculated. 32 | #' @param iri_coef Set of coefficients for specific sample size (e. g. IRI_COEF_100). 33 | #' @param segment.length Distance (in m) for which the IRI is to be calculated. Default is 100 m. 34 | #' @param segment.offset Offset (in m) for which the segments will not overlap. Default is 20 m. 35 | #' @return Calculated IRI (m/km) per segment (as numeric) of the given profile. 36 | #' @examples 37 | #' profile <- rnorm(10000) 38 | #' iri <- CalculateIRIperSegments(profile, IRI_COEF_100, 20) 39 | #' par(mfrow = c(1,2)) 40 | #' plot(profile, type="l", 41 | #' xlab="Distance [dm]", ylab="Profile [m]", 42 | #' main="Read profile (Laser measurement)") 43 | #' plot(iri, type="s", 44 | #' xlab="Segment (with 20 m offset)", ylab="IRI [m/km]", 45 | #' main="International Roughness Index (IRI)\nsample = 10cm, segment = 20m") 46 | #' @export 47 | CalculateIRIperSegmentsOverlapping <- function(profile, iri_coef, 48 | segment.length = 100, 49 | segment.offset = 20) { 50 | 51 | # check that segment.offset is samller than segment.length 52 | stopifnot(segment.length >= segment.offset) 53 | 54 | # initialize costants 55 | DX <- iri_coef$dx # sample interval (m) 56 | 57 | # number of profile points used to compute mvg avg slope input (window) 58 | K <- max(2, as.integer(.5 + .25 / DX) + 1) 59 | 60 | # split profile into segments by defining starting and ending indices 61 | # (e.g. per 100m segment considering offsets) 62 | num_samples_per_segment <- segment.length / DX 63 | num_samples_per_offset <- segment.offset / DX 64 | buffer_look_ahead <- K - 2 65 | starts <- seq(1, length(profile) - buffer_look_ahead, 66 | by = num_samples_per_offset) 67 | 68 | # if there is exactly one sample missing for calculating initial IRI for next 69 | # segment, delete last segment 70 | if ( (length(profile) - buffer_look_ahead - 1) %% 71 | num_samples_per_offset == 0) { 72 | starts <- starts[-length(starts)] 73 | } 74 | ends <- sapply(starts, function(x) { 75 | min(length(profile), x + num_samples_per_segment - 1 + buffer_look_ahead) 76 | }) 77 | 78 | profile_segments <- list() 79 | for (i in seq_along(starts)) { 80 | new_segment <- profile[starts[i]:ends[i]] 81 | profile_segments[[i]] <- new_segment 82 | } 83 | 84 | # vector for collecting return value 85 | iris <- numeric() 86 | 87 | # loop trough segments and calculate avg iri per segment 88 | for (profile_segment in profile_segments) { 89 | segm_iri_cont <- CalculateIRIContinuously(profile_segment, iri_coef) 90 | iris <- c(iris, segm_iri_cont[length(segm_iri_cont)]) 91 | } 92 | 93 | # return iri vector 94 | return(iris) 95 | } 96 | 97 | 98 | #' Computes the IRI for a continuously increasing segment given a road profile 99 | #' 100 | #' Depending on the sample size a certain buffer has to be attached to the 101 | #' profile for calculation the slope at the end. 102 | #' 103 | #' @param profile Road profile (as numeric vector in mm) whose IRIs are to be 104 | #' calculated. 105 | #' @param iri_coef Set of coefficients for specific sample size (e. g. 106 | #' IRI_COEF_250). 107 | #' @return Calculated IRIs (m/km) for increasing segments (as numeric vector) of 108 | #' the given profile. 109 | #' 110 | #' @examples 111 | #' generate_test_profile <- function (x) { 112 | #' if (x < 1) return(0) 113 | #' if (x >= 1 && x < 3) return(x - 1) 114 | #' if (x >= 3 && x < 5) return(5 - x) 115 | #' if (x >= 5) return(0) 116 | #' } 117 | #' x <- seq(.25, 30, by = .25) 118 | #' test_profile <- data.frame(x = x, profile=sapply(x, generate_test_profile)) 119 | #' test_profile$iri <- CalculateIRIContinuously( 120 | #' test_profile$profile, IRI_COEF_250) 121 | #' plot(x = test_profile$x, y = test_profile$profile, ylim = c(0, 8), 122 | #' xlim = c(0,25), type = "l") 123 | #' lines(x = test_profile$x, y = test_profile$iri*10) 124 | #' @export 125 | CalculateIRIContinuously <- function(profile, iri_coef) { 126 | # initialize costants 127 | DX <- iri_coef$dx # sample interval (m) 128 | 129 | # number of profile points used to compute mvg avg slope input (window) 130 | K <- max(2, as.integer(.5 + .25 / DX) + 1) 131 | BL <- (K - 1) * DX # baselength 132 | ST <- iri_coef$st # coefficients of the iri equations (state transition) 133 | PR <- iri_coef$pr # coefficients of the iri equations 134 | 135 | # vector for collecting return value 136 | iris <- numeric() 137 | 138 | # sliding window of profil elevations for calculating mvg avg slope (buffer of 139 | # length K) 140 | y <- rep(0, 26) 141 | y[K] <- profile[K] # elevation 11 m from start 142 | y[1] <- profile[1] # elevation at beginning 143 | 144 | # vehicle variables (1 to 4) containing values from former profile point 145 | z_last <- vector() 146 | z_last[1] <- (y[K] - y[1]) / 11 147 | z_last[2] <- 0 148 | z_last[3] <- z_last[1] 149 | z_last[4] <- z_last[2] 150 | 151 | rs <- 0 # rectified slope / accumulated slope 152 | ix <- 1 # index within sliding window 153 | 154 | # calculate IRI for each new profile point; loop through profile points 155 | for (i in 1:length(profile)) { 156 | 157 | # stop if there are no more point left for building the slope 158 | if (length(profile) < ix) { 159 | break 160 | } 161 | 162 | # filling window; loop through slope calculation window 163 | y[K] <- profile[ix] 164 | ix <- ix + 1 165 | while (ix < K) { 166 | y[ix] <- y[K] 167 | y[K] <- profile[ix] 168 | ix <- ix + 1 169 | } 170 | 171 | # compute slope input 172 | yp <- (y[K] - y[1]) / BL 173 | for (j in 2:K) { 174 | y[j - 1] <- y[j] 175 | } 176 | 177 | # simulate vehicle response for determining accumulated rs 178 | z <- vector() # vehicle variables (1 to 4) 179 | for (j in 1:4) { 180 | z[j] <- PR[j] * yp 181 | for (jj in 1:4) { 182 | z[j] <- z[j] + ST[j, jj] * z_last[jj] 183 | } 184 | } 185 | rs <- rs + abs(z[1] - z[3]) 186 | 187 | # store vehicle variables (1 to 4) for next profile input 188 | z_last <- z 189 | 190 | # determine avg rs by dividing by number of considered samples and attach to 191 | # result vector 192 | current_iri <- rs / i 193 | iris <- c(iris, current_iri) 194 | } 195 | 196 | # return iri vector 197 | return(iris) 198 | } 199 | --------------------------------------------------------------------------------