Diverse opprydning (#235)

* Inkludert docker-compose-fil til utvikling

* Oppdatert tester

* Github actions: byttet fra ubuntu-latest til ubuntu-22.04 og ubuntu-20.04; fjernet testing på windows og osx (kommer sikkert til å angre på dette senere...); fjernet testing på develop-versjonen av R (tester kun på release).

* Linting

.github/workflows/coverage.yml

@@ -12,7 +12,7 @@ name: test-coverage
 
 jobs:
   test-coverage:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
     steps:

.github/workflows/docker.yml

@@ -12,7 +12,7 @@ on:
 jobs:
   push_to_registries:
     name: Push Docker image to docker hub
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
     env:
       AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
       AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}

.github/workflows/lintr.yml

@@ -12,7 +12,7 @@ name: lint
 
 jobs:
   lint:
-    runs-on: ubuntu-latest
+    runs-on: ubuntu-22.04
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
     steps:

.github/workflows/r.yml

@@ -20,10 +20,8 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: windows-latest, r: 'release'}
-          - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-latest, r: 'release'}
-          - {os: ubuntu-latest, r: 'devel'}
+          - {os: ubuntu-20.04, r: 'release'}
+          - {os: ubuntu-22.04, r: 'release'}
 
     steps:
       - uses: actions/checkout@v3

R/functions.R

@@ -129,9 +129,11 @@ definer_valg_kol <- function(col_names, valgnr) {
       config$valg_behrhf$txt
     )
   }
-  if ("bosh_liggerate" %in% col_names &&
-    "bohf_liggerate" %in% col_names &&
-    "borhf_liggerate" %in% col_names) {
+  if (
+    "bosh_liggerate" %in% col_names &&
+      "bohf_liggerate" %in% col_names &&
+      "borhf_liggerate" %in% col_names
+  ) {
     valg_liggerate <- stats::setNames(
       config$valg_liggerate$variable,
       config$valg_liggerate$txt

R/get_data.R

@@ -1,40 +1,42 @@
-get_data <- function() {
-  if (exists("datasett")) {
-    return(datasett)
-  } else if (file.exists("fag.rds")) {
-    datasett <- readRDS("fag.rds")
-    return(datasett)
-  } else if (file.exists("fag.csv")) {
-    datasett <- read.table("fag.csv",
-      sep = ",",
-      header = TRUE,
-      encoding = "UTF-8",
-      stringsAsFactors = FALSE
-    )
-
-    names(datasett) <- tolower(names(datasett))
-    if (file.exists("fag2.csv")) {
-      datasett2 <- read.table("fag2.csv",
-                             sep = ",",
-                             header = TRUE,
-                             encoding = "UTF-8",
-                             stringsAsFactors = FALSE)
-
-      names(datasett2) <- tolower(names(datasett2))
-      datasett2$niva <- "Uten overf"
-      datasett$niva <- "Med overf"
-      datasett <- rbind(datasett2, datasett)
-    }
-    return(datasett)
-  } else if (file.exists("behandler.rds") && file.exists("justertoverf.rds")) {
-    uten_overf <- readRDS("behandler.rds")
-    med_overf <- readRDS("justertoverf.rds")
-
-    uten_overf$niva <- "Uten overf"
-    med_overf$niva <- "Med overf"
-
-    return(rbind(uten_overf, med_overf))
-  } else {
-    return(tmongr::testdata3)
-  }
-}
+get_data <- function() {
+  if (exists("datasett")) {
+    return(datasett)
+  } else if (file.exists("fag.rds")) {
+    datasett <- readRDS("fag.rds")
+    return(datasett)
+  } else if (file.exists("fag.csv")) {
+    datasett <- read.table("fag.csv",
+      sep = ",",
+      header = TRUE,
+      encoding = "UTF-8",
+      stringsAsFactors = FALSE
+    )
+
+    names(datasett) <- tolower(names(datasett))
+    if (file.exists("fag2.csv")) {
+      datasett2 <- read.table(
+        "fag2.csv",
+        sep = ",",
+        header = TRUE,
+        encoding = "UTF-8",
+        stringsAsFactors = FALSE
+      )
+
+      names(datasett2) <- tolower(names(datasett2))
+      datasett2$niva <- "Uten overf"
+      datasett$niva <- "Med overf"
+      datasett <- rbind(datasett2, datasett)
+    }
+    return(datasett)
+  } else if (file.exists("behandler.rds") && file.exists("justertoverf.rds")) {
+    uten_overf <- readRDS("behandler.rds")
+    med_overf <- readRDS("justertoverf.rds")
+
+    uten_overf$niva <- "Uten overf"
+    med_overf$niva <- "Med overf"
+
+    return(rbind(uten_overf, med_overf))
+  } else {
+    return(tmongr::testdata3)
+  }
+}

R/pivot.R

@@ -85,11 +85,11 @@ make_data_tabell <- function(input_dataset, # nolint: cyclocomp_linter
   # Burde vi legge inn snitt i steden for total for de to tilfellene index og liggedognindex?
   if (snitt || prosent) {
     if (!("drg_index" %in% verdi || "liggedognindex" %in% verdi) &&
-      !(verdi %in% c("rate", "drgrate", "liggedognrate") && length(rad) == 1)) {
+          !(verdi %in% c("rate", "drgrate", "liggedognrate") && length(rad) == 1)) {
       # ikke regn ut total på rater når en rad er bohf og den andre rad er bosh
       if (!((verdi %in% c("rate", "drgrate", "liggedognrate")) &&
-        ("boomr_hf" %in% rad) &&
-        ("boomr_sykehus" %in% rad))) {
+              ("boomr_hf" %in% rad) &&
+              ("boomr_sykehus" %in% rad))) {
         regnet_total <- TRUE
         pivot <- add_total(pivot, rad, kol)
       }

R/text.R

@@ -329,9 +329,11 @@ warning_text <- function(rad, verdi, bo, aar, alder, kjonn) {
     }
   }
 
-  if (("behandler" %in% rad ||
-    "behandlende_sykehus" %in% rad) &&
-    ("2016" %in% aar)) {
+  if (
+    ("behandler" %in% rad ||
+       "behandlende_sykehus" %in% rad) &&
+      ("2016" %in% aar)
+  ) {
     warn <- paste0(
       "<font color=#b94a48>", "ADVARSEL: Feil i rapportering ",
       "av behandlingssted for innlagte pasienter ved UNN i 2016!",

data-raw/test-run.R

@@ -2,20 +2,23 @@ rm(list = ls())
 
 getwd()
 
-datasett <- read.table("../tmongrdata/fag.csv",
-                       sep = ",",
-                       header = TRUE,
-                       encoding = "UTF-8",
-                       stringsAsFactors = FALSE
+datasett <- read.table(
+  "../tmongrdata/fag.csv",
+  sep = ",",
+  header = TRUE,
+  encoding = "UTF-8",
+  stringsAsFactors = FALSE
 )
 
 names(datasett) <- tolower(names(datasett))
 
-datasett2 <- read.table("../tmongrdata/fag2.csv",
-                        sep = ",",
-                        header = TRUE,
-                        encoding = "UTF-8",
-                        stringsAsFactors = FALSE)
+datasett2 <- read.table(
+  "../tmongrdata/fag2.csv",
+  sep = ",",
+  header = TRUE,
+  encoding = "UTF-8",
+  stringsAsFactors = FALSE
+)
 
 names(datasett2) <- tolower(names(datasett2))
 datasett2$niva <- "Uten overf"

docker-compose.yml

@@ -0,0 +1,34 @@
+version: '3.8'
+
+services:
+
+  dev:
+    image: hnskde/mongr-dev-rstudio:latest
+    restart: "no"
+    volumes:
+      - ~/.ssh:/home/rstudio/.ssh
+      - ~/.gitconfig:/home/rstudio/.gitconfig
+      - .:/home/rstudio/tmongr
+    ports:
+      - 8787:8787
+    environment:
+      DISABLE_AUTH: "true"
+
+  code-server:
+    image: hnskde/mongr-dev-code-server:latest
+    restart: "no"
+    volumes:
+      - ~/.ssh:/home/coder/.ssh
+      - ~/.gitconfig:/home/coder/.gitconfig
+      - .:/home/coder/tmongr
+    ports:
+      - 8080:8080
+    environment:
+      PASSWORD: password
+
+  app:
+    image: hnskde/tmongr:latest
+    ports:
+      - 3838:80
+
+

tests/testthat/test-button_modules.R

@@ -3,7 +3,7 @@ context("buttonModules")
 
 test_that("just_overf_server", {
   shiny::testServer(just_overf_server, args = list(colnames = c("niva")), {
-    expect_equal_to_reference(output$just_overf[["html"]], "data/just_overf_server.rds")
+    expect_equal_to_reference(strsplit(output$just_overf[["html"]], "\n")[[1]][1], "data/just_overf_server.rds")
   })
 
   shiny::testServer(just_overf_server, args = list(colnames = c("nivaa")), {

tests/testthat/test-checkbox_modules.R

@@ -226,7 +226,7 @@ test_that("prosent_server", {
 
   shiny::testServer(function_name, {
     expect_equal_to_reference(
-      output$prosent,
+      strsplit(output$prosent[["html"]], "\n")[[1]][1],
       paste0("data/module_", "prosent", "1.rds")
     )
   })
@@ -238,7 +238,7 @@ test_that("snitt_server", {
 
   shiny::testServer(function_name, {
     expect_equal_to_reference(
-      output$snitt,
+      strsplit(output$snitt[["html"]], "\n")[[1]][1],
       paste0("data/module_", "snitt", "1.rds")
     )
   })
@@ -250,7 +250,7 @@ test_that("keep_names_server", {
 
   shiny::testServer(function_name, {
     expect_equal_to_reference(
-      output$keep_names,
+      strsplit(output$keep_names[["html"]], "\n")[[1]][1],
       paste0("data/module_", "keep_names", "1.rds")
     )
   })

tests/testthat/test-selectInput_modules.R

@@ -6,21 +6,21 @@ test_that("rad1_server", {
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "def", "ijk", "lmn"), default = "abc"), {
     expect_equal_to_reference(
-      output$rad1[["html"]],
+      strsplit(output$rad1[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad1", "1.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "abc"), {
     expect_equal_to_reference(
-      output$rad1[["html"]],
+      strsplit(output$rad1[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad1", "2.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "lmn"), {
     expect_equal_to_reference(
-      output$rad1[["html"]],
+      strsplit(output$rad1[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad1", "3.rds")
     )
   })
@@ -36,21 +36,21 @@ test_that("rad2_server", {
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "def", "ijk", "lmn"), default = "abc"), {
     expect_equal_to_reference(
-      output$rad2[["html"]],
+      strsplit(output$rad2[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad2", "1.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "abc"), {
     expect_equal_to_reference(
-      output$rad2[["html"]],
+      strsplit(output$rad2[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad2", "2.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "lmn"), {
     expect_equal_to_reference(
-      output$rad2[["html"]],
+      strsplit(output$rad2[["html"]], "\n")[[1]][1],
       paste0("data/module_", "rad2", "3.rds")
     )
   })
@@ -66,21 +66,21 @@ test_that("kolonner_server", {
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "def", "ijk", "lmn"), default = "abc"), {
     expect_equal_to_reference(
-      output$kolonner[["html"]],
+      strsplit(output$kolonner[["html"]], "\n")[[1]][1],
       paste0("data/module_", "kolonner", "1.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "abc"), {
     expect_equal_to_reference(
-      output$kolonner[["html"]],
+      strsplit(output$kolonner[["html"]], "\n")[[1]][1],
       paste0("data/module_", "kolonner", "2.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "lmn"), {
     expect_equal_to_reference(
-      output$kolonner[["html"]],
+      strsplit(output$kolonner[["html"]], "\n")[[1]][1],
       paste0("data/module_", "kolonner", "3.rds")
     )
   })
@@ -96,21 +96,21 @@ test_that("verdi_server", {
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "def", "ijk", "lmn"), default = "abc"), {
     expect_equal_to_reference(
-      output$verdi[["html"]],
+      strsplit(output$verdi[["html"]], "\n")[[1]][1],
       paste0("data/module_", "verdi", "1.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "abc"), {
     expect_equal_to_reference(
-      output$verdi[["html"]],
+      strsplit(output$verdi[["html"]], "\n")[[1]][1],
       paste0("data/module_", "verdi", "2.rds")
     )
   })
 
   shiny::testServer(function_name, args = list(pickable = c("abc", "ijk"), default = "lmn"), {
     expect_equal_to_reference(
-      output$verdi[["html"]],
+      strsplit(output$verdi[["html"]], "\n")[[1]][1],
       paste0("data/module_", "verdi", "3.rds")
     )
   })
@@ -126,7 +126,7 @@ test_that("bo_server", {
 
   shiny::testServer(function_name, {
     expect_equal_to_reference(
-      output$bo[["html"]],
+      strsplit(output$bo[["html"]], "\n")[[1]][1],
       paste0("data/module_", "bo", "1.rds")
     )
   })
@@ -145,7 +145,7 @@ test_that("beh_server", {
     "Utenfor Helse Nord RHF" = 7
   ), default = 1), {
     expect_equal_to_reference(
-      output$beh[["html"]],
+      strsplit(output$beh[["html"]], "\n")[[1]][1],
       "data/module_beh1.rds"
     )
   })