Skip to contents

Validation

2023-11-03

Source: vignettes/articles/Validation.Rmd
Validation.Rmd

Preface

This document compares the results for ten spectra across the Spectral Analysis Shiny application, the online app luox by Manuel Spitschan, and the free CIE S 026 alpha-opic Toolbox. The main goal of this document is to validate the Spectral Analysis application against the methods the CIE has provided or already validated. We will look at results for illuminance, α-opic irradiance, and α-opic equivalent daylight (D65) illuminance. We will also compare the irradiance (only with the toolbox) and Correlated Color Temperature (CCT) and Color-Rendering Index (CRI) (only with the luox app), which are only available in one of the two validated sources. All three sources offer more parameters, but those are either not part of both the shiny application and a validated source or are derivatives of the above-mentioned parameters. Some spectral data files had negative input values (coming straight from the spectrometer export after measurement). The Shiny app replaces these values with zero, whereas the CIE toolbox gives an error for these values. Here, the values were manually set to zero in the toolbox user input mask. The luox app gives no error for negative values, but it is not exactly known how the app deals with those values (see below under @sec-conclusion for more on that).

The results for the CIE Toolbox and luox were taken on 21 October 2022 with their respective current version at that date.

Table Preparation

The following code chunks prepare the tables shown below. The first chunk loads the necessary libraries:

Setup 

#Setup code, data import, initial data selection to get to one comparison file
#read all libraries
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(purrr)
library(ggplot2)
library(tibble)
library(readr)
library(stringr)
library(tidyr)
library(readxl)
library(magick)
#> Linking to ImageMagick 6.9.11.60
#> Enabled features: fontconfig, freetype, fftw, heic, lcms, pango, webp, x11
#> Disabled features: cairo, ghostscript, raw, rsvg
#> Using 4 threads
library(gt)
library(here)
#> here() starts at /home/runner/work/Spectran/Spectran
library(cowplot)
#> 
#> Attaching package: 'cowplot'
#> The following object is masked from 'package:gt':
#> 
#>     as_gtable

#Plottheme
theme_set(theme_cowplot(font_size = 10, font_family = "sans"))

The following chunk loads all data:

Data Import 
#Data Import -------------------

##read all filenames and paths of spectra
spectra <- 
  tibble(
    file_names = list.files("./Original_Spectra"),
    file_path = paste0("./Original_Spectra/", list.files("./Original_Spectra"))
    )

##read the csv-files to that spectra
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(Spectrum = list(read_csv(file_path)))
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 401 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> dbl (2): Wellenlaenge (nm), Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

##create a name column 
spectra <- 
  spectra %>% 
  mutate(spectrum_name = str_replace(file_names, ".csv", ""))

##read the results from the luox app
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(
    luox = list(
      read_csv(
        paste0("./Results_Luox_2022-10-21/", spectrum_name, 
               "/download-calc.csv")
        )
      )
    )
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
#> Rows: 35 Columns: 2
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (1): Condition
#> dbl (1): Bestrahlungsstaerke (W/m^2)
#> 
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

##read the results from the shiny app
###filepath
excel_file_path <- function(spectrum_name) {
  paste0(
    "./Results_ShinyApp/",
    {{ spectrum_name }}, 
    "/",
    {{ spectrum_name }}, 
    "_9_2022-10-20.xlsx"
    )
}
###list for each worksheet in the excel-file
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(
    shiny = list(
      list(
        Radiometrie = read_xlsx(
          excel_file_path(spectrum_name), 
          sheet = "Radiometrie"
          ),
        Photometrie = read_xlsx(
          excel_file_path(spectrum_name), 
          sheet = "Photometrie"
          ),
        Alpha = read_xlsx(
          excel_file_path(spectrum_name), 
          sheet = "Alpha-opisch"
          )
        )
      )
    ) 

##read the results from the CIE toolbox
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(
    toolbox = list(
      read_xlsx(
        paste0(
          "./Results_CIE_Toolbox/", 
          spectrum_name, 
          "/CIE S 026 alpha-opic Toolbox.xlsx"
          ), 
        sheet = "Outputs"
        )
      )
    )
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> New names:
#> • `` -> `...2`
#> • `` -> `...3`
#> • `` -> `...4`
#> • `` -> `...5`

The following chunk takes the relevant data for comparison out from the sources and puts them into one table per comparison spectrum:

Initial Data wrangling 

#Initial Data wrangling -------------------
##take the relevant datapoints from the luox results
### the relevant data in the luox results are in column 2, rows 1, 6 to 15, 22, 
### and 24
locations_luox <- c(1, 6:15, 22, 24)
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(
    excerpt = list(
      tibble(
        Name = luox %>% pull(1) %>% .[locations_luox],
        Results_luox = luox %>% pull(2) %>% .[locations_luox]
        )
      )
    )

###Add a row for irradiance, which is missing in the luox output
spectra <- 
  spectra %>% 
  mutate(
    excerpt = list(
      rbind(
        excerpt[1:11,], 
        c("Irradiance (mW ⋅ m⁻²)", NA), 
        excerpt[12:13,]
        )
      ),
    excerpt = list(
      excerpt %>% mutate(Results_luox = as.numeric(Results_luox))
    )
    )

##extract the relevant datapoints from the shiny app
### the relevant data in the shiny app results are in the list 
### - "Photometrie", column 3, row 1, 
### - "Alpha", column 3 to 7, row 1 to 2 (the order has to be adjusted in order 
###to match the luox data frame)
### - "Radiometrie, column 3, row 1, 
### - "Photometrie", column 3, row 4 to 5
shiny_extract <- function(data, sheet, column = Wert, rows) {
  data %>% .[[sheet]] %>% pull({{ column }}) %>% .[rows]
}
spectra <- 
  spectra %>% 
  rowwise() %>% 
  mutate(
    excerpt = list(
      cbind(
        excerpt[1],
        tibble(
        Results_shiny = as.numeric(
          c(
            shiny_extract(
              data = shiny, sheet = "Photometrie", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Cyanopsin", rows = 2),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Chloropsin", rows = 2),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Erythropsin", rows = 2),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Rhodopsin", rows = 2),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Melanopsin", rows = 2),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Cyanopsin", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Chloropsin", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Erythropsin", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Rhodopsin", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Alpha", column = "Melanopsin", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Radiometrie", rows = 1),
            shiny_extract(
              data = shiny, sheet = "Photometrie", rows = c(4, 5))
            )
          )
        ),
        excerpt[2]
        )
      )
  )

##extract the relevant datapoints from the CIE Toolbox
### the relevant data in the toolbox are in 
### column 3, row 14
### column 1 to 5, row 20-> needs to be multiplied by a factor of 1000 to be in 
### mW, to which the other sources are scaled.
### column 1 to 5, row 32
### column 1, row 14 -> needs to be multiplied by a factor of 1000 to be in mW, 
### to which the other sources are scaled.
spectra <- 
  spectra %>% 
  mutate(
    excerpt = list(
      cbind(
        excerpt,
        tibble(
          Results_toolbox = as.numeric(
            c(
              toolbox %>% pull(3) %>% .[14],
              toolbox %>% {as.vector(.[20,])} %>% as.numeric %>% 
                magrittr::multiply_by(1000),
              toolbox %>% {as.vector(.[32,])},
              toolbox %>% pull(1) %>% .[14] %>% as.numeric %>% 
                magrittr::multiply_by(1000),
              NA, NA
              )
            )
          )
        )
      )
    )

The following chunk transforms the comparison tables for all spectra into one comprehensive table.

Putting the table together 
#Putting the table together -------------------
##create a function that calculates the relative difference between the shiny 
##app-results, and another source
Deviation <- function(Results, Results2){
  if(!is.na({{ Results }}) & !is.na({{ Results2 }})){
  res <- 1- {{ Results }} / {{ Results2 }}
  res2 <- vec_fmt_scientific(res)
  if(res < 0) {
    paste0('<div style="color:red">', res2, '</div>')
  }
  else if(res == 0 ) {
    paste0('<div style="color:green">', res2, '</div>')
  }
  else {
    paste0('<div style="color:blue">', res2, '</div>')
  }

  }
  else NA
}

##new dataframe, unnested data, columns for relative difference
Results <- 
  spectra %>% 
  select(spectrum_name, excerpt) %>% 
  unnest(excerpt) %>% 
  rowwise() %>% 
  mutate(Dev_luox = Deviation(Results_luox, Results_shiny),
         Dev_toolbox = Deviation(Results_toolbox, Results_shiny)
         )

##pivoting the dataframe wider, so that each spectrum has only one row
Results <- 
  Results %>% 
  pivot_wider(
    id_cols = spectrum_name, 
    names_from = Name, 
    values_from = c(Results_shiny:Dev_toolbox),
    names_sep = "."
    )

##adding a placeholder for the spectrum picture, with the filepath
###filepath
pdf_file_path <- function(spectrum_name) {
  paste0("<img src='Results_ShinyApp/",
    {{ spectrum_name }}, 
    "/",
    {{ spectrum_name }}, 
    "_1_Radiometrie_2022-10-20.png' style=\'height:80px;\'>"
    )
}
###splicing the dataframes together
Results <- cbind(Results[,1], as_tibble_col(
  pdf_file_path(spectra$spectrum_name), column_name = "Picture"), Results[,-1])

The next chunk prepares the table output in a flexible way:

Setting the Table up 
#setting the table up -------------------

##names for the merging
merging_names <- spectra$excerpt[[1]]$Name
merging_names2 <- spectra$excerpt[[1]]$Name %>% str_replace("\\(", "<br>\\(")

##column names for renaming
col_names <- paste0("Results_shiny.", merging_names)
##creating a list with one entry per variable, named after the column name (to 
##be renamed later)
renaming <- rbind(merging_names2)
names(renaming) <- col_names
renaming <- renaming %>% as.list()
renaming <- map(renaming, md)

#creating a list with cells not to format by decimals
number_fmt_col <- 
  Results %>% select(!starts_with("Dev") & !Picture & !spectrum_name) %>% 
  names()

##function that does the merging
merging <- function(data, Name, condition = "difference") {
  if(condition == "difference"){
  data %>% cols_merge(columns = ends_with(Name, ignore.case = FALSE),
             pattern = "<div style='color:lightgrey'>shiny:</div>{1}<div
             style='color:lightgrey'>luox:</div>{4}<div style='color:lightgrey'>
             toolbox:</div>{5}")
  }
  else {
      data %>% cols_merge(columns = ends_with(Name, ignore.case = FALSE),
             pattern = "<div style='color:lightgrey'>shiny:</div>{1}<div
             style='color:lightgrey'>luox:</div>{2}<div style='color:lightgrey'>
             toolbox:</div>{3}")
  }
}

#creating a function for the gt table
comparison_table <- function(tt_text, fn_text, condition) {
gtobj <- Results %>% 
  gt(rowname_col = c("spectrum_name")) %>% 
  tab_header(title = md(paste0("**Validation Results: ",tt_text , "**"))) %>% 
  tab_footnote(footnote = fn_text)

for(i in seq_along(merging_names)) {
  gtobj <- gtobj %>% merging(merging_names[i], condition = condition)
}

gtobj <- gtobj %>%   
  fmt_markdown(columns = everything()) %>%
  fmt_number(
    columns = all_of(number_fmt_col),
    decimals = 3,
    sep_mark = "",
    pattern = "{x}<br>"
    ) %>%
  cols_align(align = "center") %>% 
  cols_label(.list = renaming) %>%
  sub_missing(missing_text = md("---<br>")) %>% 
  cols_width(
    Picture ~px(150),
    everything() ~ px(80)
  ) %>% 
  opt_align_table_header(align = "left") %>% 
  tab_options(table.font.size = "9px")

gtobj

}

Results

This section shows the validation results in two tables. The first table shows the results for the Shiny App per spectrum and parameter alongside the relative difference of the respective results from the luox app and the CIE Toolbox. The second table shows all results per spectrum and parameter. Note that the Shiny App does not provide a CRI [Ra] for the artificial EE_Spektrum and the LED_4000K_2, because they exceed the CIE limits for calculation.

Creating the gt Table 
#creating the gtable -------------------

#text for the subtitle
fn_text <- 
  md(paste0(
    "The first number in every cell shows the Result from the *Shiny* app, ",
    "<br>the second number the **relative** difference of the respective ",
    "result from the *luox* app, <br>whereas the third number shows the same ",
    "for the result from the *CIE S026 Toolbox*. <br><a style='color:green'>",
    "green</a> values indicate a zero difference, <a style='color:red'>red</a>",
    " a negative difference, and <a style='color:blue'>blue</a> a positive ",
    "difference. <br>All *Shiny* values are rounded to three decimals. <br>", 
    "Missing values or pairwise comparisons are indicated by a ---."))

tt_text <- "Relative Differences"
comparison_table(tt_text, fn_text, condition = "difference")
Validation Results: Relative Differences
Picture Illuminance
(lx)		 S-cone-opic irradiance
(mW ⋅ m⁻²)		 M-cone-opic irradiance
(mW ⋅ m⁻²)		 L-cone-opic irradiance
(mW ⋅ m⁻²)		 Rhodopic irradiance
(mW ⋅ m⁻²)		 Melanopic irradiance
(mW ⋅ m⁻²)		 S-cone-opic EDI
(lx)		 M-cone-opic EDI
(lx)		 L-cone-opic EDI
(lx)		 Rhodopic EDI
(lx)		 Melanopic EDI
(lx)		 Irradiance
(mW ⋅ m⁻²)		 CCT
(K) - Robertson, 1968		 Colour Rendering Index [Ra]
EE_Spektrum
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
75.641
luox:
0.00
toolbox:
4.88 × 10−15
shiny:
139.676
luox:
0.00
toolbox:
7.33 × 10−15
shiny:
163.891
luox:
2.51 × 10−9
toolbox:
3.77 × 10−15
shiny:
133.005
luox:
0.00
toolbox:
3.00 × 10−15
shiny:
120.131
luox:
0.00
toolbox:
4.66 × 10−15
shiny:
92.550
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
95.945
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
100.614
luox:
4.77 × 10−6
toolbox:
4.77 × 10−6
shiny:
91.747
luox:
2.47 × 10−6
toolbox:
2.47 × 10−6
shiny:
90.583
luox:
9.94 × 10−6
toolbox:
9.94 × 10−6
shiny:
549.443
luox:
—
toolbox:
7.44 × 10−15
shiny:
5453.666
luox:
−1.78 × 10−15
toolbox:
—
shiny:
—
luox:
—
toolbox:
—
Fluoreszenz_NW
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
40.235
luox:
0.00
toolbox:
5.55 × 10−16
shiny:
125.328
luox:
0.00
toolbox:
3.33 × 10−16
shiny:
161.847
luox:
4.62 × 10−10
toolbox:
3.89 × 10−15
shiny:
90.644
luox:
4.46 × 10−8
toolbox:
1.55 × 10−15
shiny:
71.312
luox:
8.36 × 10−8
toolbox:
1.44 × 10−15
shiny:
49.229
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
86.089
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
99.360
luox:
4.77 × 10−6
toolbox:
4.77 × 10−6
shiny:
62.526
luox:
2.51 × 10−6
toolbox:
2.47 × 10−6
shiny:
53.772
luox:
1.00 × 10−5
toolbox:
9.94 × 10−6
shiny:
293.442
luox:
—
toolbox:
1.89 × 10−15
shiny:
3759.099
luox:
7.57 × 10−8
toolbox:
—
shiny:
83.077
luox:
9.21 × 10−4
toolbox:
—
Fluoreszenz_WW
shiny:
100.000
luox:
−2.90 × 10−6
toolbox:
−2.27 × 10−6
shiny:
23.471
luox:
0.00
toolbox:
2.78 × 10−15
shiny:
111.528
luox:
1.84 × 10−9
toolbox:
5.11 × 10−15
shiny:
164.806
luox:
1.78 × 10−8
toolbox:
3.33 × 10−15
shiny:
65.329
luox:
4.15 × 10−7
toolbox:
8.88 × 10−16
shiny:
44.754
luox:
9.02 × 10−7
toolbox:
1.11 × 10−15
shiny:
28.718
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
76.610
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
101.176
luox:
4.79 × 10−6
toolbox:
4.77 × 10−6
shiny:
45.064
luox:
2.88 × 10−6
toolbox:
2.47 × 10−6
shiny:
33.746
luox:
1.08 × 10−5
toolbox:
9.94 × 10−6
shiny:
284.770
luox:
—
toolbox:
2.22 × 10−15
shiny:
2676.108
luox:
2.20 × 10−7
toolbox:
—
shiny:
82.394
luox:
2.29 × 10−4
toolbox:
—
Halogen
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
22.648
luox:
0.00
toolbox:
−2.22 × 10−16
shiny:
115.192
luox:
0.00
toolbox:
3.33 × 10−16
shiny:
166.103
luox:
4.51 × 10−9
toolbox:
3.11 × 10−15
shiny:
78.883
luox:
0.00
toolbox:
2.33 × 10−15
shiny:
61.492
luox:
0.00
toolbox:
2.00 × 10−15
shiny:
27.711
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
79.126
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
101.973
luox:
4.77 × 10−6
toolbox:
4.77 × 10−6
shiny:
54.413
luox:
2.47 × 10−6
toolbox:
2.47 × 10−6
shiny:
46.367
luox:
9.94 × 10−6
toolbox:
9.94 × 10−6
shiny:
671.237
luox:
—
toolbox:
1.33 × 10−15
shiny:
2714.135
luox:
0.00
toolbox:
—
shiny:
99.784
luox:
−2.16 × 10−3
toolbox:
—
LED_2200K
shiny:
100.000
luox:
−2.71 × 10−6
toolbox:
−2.27 × 10−6
shiny:
15.044
luox:
2.38 × 10−4
toolbox:
7.77 × 10−16
shiny:
109.249
luox:
1.88 × 10−6
toolbox:
−1.78 × 10−15
shiny:
167.526
luox:
1.28 × 10−6
toolbox:
2.00 × 10−15
shiny:
66.304
luox:
1.23 × 10−5
toolbox:
4.44 × 10−16
shiny:
48.778
luox:
2.14 × 10−5
toolbox:
2.00 × 10−15
shiny:
18.407
luox:
2.26 × 10−4
toolbox:
−1.27 × 10−5
shiny:
75.044
luox:
2.00 × 10−5
toolbox:
1.81 × 10−5
shiny:
102.846
luox:
6.05 × 10−6
toolbox:
4.77 × 10−6
shiny:
45.736
luox:
1.48 × 10−5
toolbox:
2.47 × 10−6
shiny:
36.780
luox:
3.13 × 10−5
toolbox:
9.94 × 10−6
shiny:
329.187
luox:
—
toolbox:
1.55 × 10−15
shiny:
2410.988
luox:
4.61 × 10−6
toolbox:
—
shiny:
87.665
luox:
4.62 × 10−4
toolbox:
—
LED_4000K_1
shiny:
100.000
luox:
−2.92 × 10−6
toolbox:
−2.27 × 10−6
shiny:
39.460
luox:
2.61 × 10−6
toolbox:
2.66 × 10−15
shiny:
126.303
luox:
4.87 × 10−8
toolbox:
3.44 × 10−15
shiny:
162.057
luox:
4.40 × 10−8
toolbox:
6.66 × 10−15
shiny:
93.656
luox:
3.64 × 10−7
toolbox:
2.89 × 10−15
shiny:
74.836
luox:
6.17 × 10−7
toolbox:
3.00 × 10−15
shiny:
48.281
luox:
−1.01 × 10−5
toolbox:
−1.27 × 10−5
shiny:
86.759
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
99.489
luox:
4.81 × 10−6
toolbox:
4.77 × 10−6
shiny:
64.603
luox:
2.83 × 10−6
toolbox:
2.47 × 10−6
shiny:
56.429
luox:
1.06 × 10−5
toolbox:
9.94 × 10−6
shiny:
300.094
luox:
—
toolbox:
5.44 × 10−15
shiny:
3811.887
luox:
5.90 × 10−7
toolbox:
—
shiny:
82.085
luox:
−4.92 × 10−4
toolbox:
—
LED_4000K_2
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
54.816
luox:
6.77 × 10−7
toolbox:
2.44 × 10−15
shiny:
127.856
luox:
1.76 × 10−8
toolbox:
4.77 × 10−15
shiny:
164.399
luox:
1.66 × 10−8
toolbox:
4.11 × 10−15
shiny:
106.315
luox:
8.93 × 10−8
toolbox:
4.66 × 10−15
shiny:
90.404
luox:
1.32 × 10−7
toolbox:
2.33 × 10−15
shiny:
67.069
luox:
−1.20 × 10−5
toolbox:
−1.27 × 10−5
shiny:
87.825
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
100.926
luox:
4.78 × 10−6
toolbox:
4.77 × 10−6
shiny:
73.336
luox:
2.56 × 10−6
toolbox:
2.47 × 10−6
shiny:
68.168
luox:
1.01 × 10−5
toolbox:
9.94 × 10−6
shiny:
338.823
luox:
—
toolbox:
2.33 × 10−15
shiny:
3899.370
luox:
1.72 × 10−7
toolbox:
—
shiny:
—
luox:
—
toolbox:
—
LED_6900K
shiny:
100.000
luox:
−2.92 × 10−6
toolbox:
−2.27 × 10−6
shiny:
93.998
luox:
2.39 × 10−7
toolbox:
1.67 × 10−15
shiny:
145.326
luox:
9.31 × 10−9
toolbox:
3.66 × 10−15
shiny:
161.924
luox:
1.03 × 10−8
toolbox:
4.55 × 10−15
shiny:
144.972
luox:
2.07 × 10−7
toolbox:
3.11 × 10−15
shiny:
131.440
luox:
3.24 × 10−7
toolbox:
6.66 × 10−16
shiny:
115.010
luox:
−1.24 × 10−5
toolbox:
−1.27 × 10−5
shiny:
99.826
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
99.407
luox:
4.78 × 10−6
toolbox:
4.77 × 10−6
shiny:
100.001
luox:
2.67 × 10−6
toolbox:
2.47 × 10−6
shiny:
99.110
luox:
1.03 × 10−5
toolbox:
9.94 × 10−6
shiny:
351.290
luox:
—
toolbox:
2.11 × 10−15
shiny:
7418.690
luox:
1.36 × 10−6
toolbox:
—
shiny:
93.878
luox:
3.68 × 10−5
toolbox:
—
Nordhimmel
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
108.054
luox:
−9.33 × 10−15
toolbox:
−2.00 × 10−15
shiny:
153.329
luox:
0.00
toolbox:
4.44 × 10−15
shiny:
163.589
luox:
1.91 × 10−9
toolbox:
2.11 × 10−15
shiny:
166.521
luox:
0.00
toolbox:
5.44 × 10−15
shiny:
157.556
luox:
0.00
toolbox:
6.66 × 10−16
shiny:
132.209
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
105.323
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
100.429
luox:
4.77 × 10−6
toolbox:
4.77 × 10−6
shiny:
114.866
luox:
2.47 × 10−6
toolbox:
2.47 × 10−6
shiny:
118.802
luox:
9.94 × 10−6
toolbox:
9.94 × 10−6
shiny:
528.454
luox:
—
toolbox:
3.44 × 10−15
shiny:
9317.532
luox:
9.99 × 10−16
toolbox:
—
shiny:
97.943
luox:
−5.81 × 10−4
toolbox:
—
Norm_TL_6500K
shiny:
100.000
luox:
−2.93 × 10−6
toolbox:
−2.27 × 10−6
shiny:
81.711
luox:
0.00
toolbox:
−4.44 × 10−16
shiny:
145.575
luox:
0.00
toolbox:
7.77 × 10−16
shiny:
162.890
luox:
2.06 × 10−9
toolbox:
2.11 × 10−15
shiny:
144.953
luox:
0.00
toolbox:
9.99 × 10−16
shiny:
132.602
luox:
0.00
toolbox:
3.44 × 10−15
shiny:
99.976
luox:
−1.27 × 10−5
toolbox:
−1.27 × 10−5
shiny:
99.996
luox:
1.81 × 10−5
toolbox:
1.81 × 10−5
shiny:
100.000
luox:
4.77 × 10−6
toolbox:
4.77 × 10−6
shiny:
99.988
luox:
2.47 × 10−6
toolbox:
2.47 × 10−6
shiny:
99.986
luox:
9.94 × 10−6
toolbox:
9.94 × 10−6
shiny:
488.200
luox:
—
toolbox:
−4.44 × 10−16
shiny:
6499.265
luox:
0.00
toolbox:
—
shiny:
99.991
luox:
−8.92 × 10−5
toolbox:
—
The first number in every cell shows the Result from the Shiny app,
the second number the relative difference of the respective result from the luox app,
whereas the third number shows the same for the result from the CIE S026 Toolbox.
green values indicate a zero difference, red a negative difference, and blue a positive difference.
All Shiny values are rounded to three decimals.
Missing values or pairwise comparisons are indicated by a —.
Creating the gt Table 

#creating the gtable -------------------

#text for the subtitle
fn_text <- md("The first number in every cell shows the Result from the *Shiny* 
              app, <br>the second number the result from the *luox* app, <br>
              whereas the third number shows the result from the *CIE S026 
              Toolbox*. <br>All values are rounded to three decimals. <br>
              Missing values are indicated by a ---.")

tt_text <- "All Results"
comparison_table(tt_text, fn_text, condition = "")
Validation Results: All Results
Picture Illuminance
(lx)		 S-cone-opic irradiance
(mW ⋅ m⁻²)		 M-cone-opic irradiance
(mW ⋅ m⁻²)		 L-cone-opic irradiance
(mW ⋅ m⁻²)		 Rhodopic irradiance
(mW ⋅ m⁻²)		 Melanopic irradiance
(mW ⋅ m⁻²)		 S-cone-opic EDI
(lx)		 M-cone-opic EDI
(lx)		 L-cone-opic EDI
(lx)		 Rhodopic EDI
(lx)		 Melanopic EDI
(lx)		 Irradiance
(mW ⋅ m⁻²)		 CCT
(K) - Robertson, 1968		 Colour Rendering Index [Ra]
EE_Spektrum
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
75.641
luox:
75.641
toolbox:
75.641
shiny:
139.676
luox:
139.676
toolbox:
139.676
shiny:
163.891
luox:
163.891
toolbox:
163.891
shiny:
133.005
luox:
133.005
toolbox:
133.005
shiny:
120.131
luox:
120.131
toolbox:
120.131
shiny:
92.550
luox:
92.551
toolbox:
92.551
shiny:
95.945
luox:
95.943
toolbox:
95.943
shiny:
100.614
luox:
100.614
toolbox:
100.614
shiny:
91.747
luox:
91.747
toolbox:
91.747
shiny:
90.583
luox:
90.582
toolbox:
90.582
shiny:
549.443
luox:
—
toolbox:
549.443
shiny:
5453.666
luox:
5453.666
toolbox:
—
shiny:
—
luox:
95.250
toolbox:
—
Fluoreszenz_NW
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
40.235
luox:
40.235
toolbox:
40.235
shiny:
125.328
luox:
125.328
toolbox:
125.328
shiny:
161.847
luox:
161.847
toolbox:
161.847
shiny:
90.644
luox:
90.644
toolbox:
90.644
shiny:
71.312
luox:
71.312
toolbox:
71.312
shiny:
49.229
luox:
49.230
toolbox:
49.230
shiny:
86.089
luox:
86.087
toolbox:
86.087
shiny:
99.360
luox:
99.359
toolbox:
99.359
shiny:
62.526
luox:
62.526
toolbox:
62.526
shiny:
53.772
luox:
53.771
toolbox:
53.771
shiny:
293.442
luox:
—
toolbox:
293.442
shiny:
3759.099
luox:
3759.099
toolbox:
—
shiny:
83.077
luox:
83.000
toolbox:
—
Fluoreszenz_WW
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
23.471
luox:
23.471
toolbox:
23.471
shiny:
111.528
luox:
111.528
toolbox:
111.528
shiny:
164.806
luox:
164.806
toolbox:
164.806
shiny:
65.329
luox:
65.329
toolbox:
65.329
shiny:
44.754
luox:
44.754
toolbox:
44.754
shiny:
28.718
luox:
28.718
toolbox:
28.718
shiny:
76.610
luox:
76.608
toolbox:
76.608
shiny:
101.176
luox:
101.176
toolbox:
101.176
shiny:
45.064
luox:
45.064
toolbox:
45.064
shiny:
33.746
luox:
33.746
toolbox:
33.746
shiny:
284.770
luox:
—
toolbox:
284.770
shiny:
2676.108
luox:
2676.108
toolbox:
—
shiny:
82.394
luox:
82.375
toolbox:
—
Halogen
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
22.648
luox:
22.648
toolbox:
22.648
shiny:
115.192
luox:
115.192
toolbox:
115.192
shiny:
166.103
luox:
166.103
toolbox:
166.103
shiny:
78.883
luox:
78.883
toolbox:
78.883
shiny:
61.492
luox:
61.492
toolbox:
61.492
shiny:
27.711
luox:
27.711
toolbox:
27.711
shiny:
79.126
luox:
79.125
toolbox:
79.125
shiny:
101.973
luox:
101.972
toolbox:
101.972
shiny:
54.413
luox:
54.413
toolbox:
54.413
shiny:
46.367
luox:
46.366
toolbox:
46.366
shiny:
671.237
luox:
—
toolbox:
671.237
shiny:
2714.135
luox:
2714.135
toolbox:
—
shiny:
99.784
luox:
100.000
toolbox:
—
LED_2200K
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
15.044
luox:
15.040
toolbox:
15.044
shiny:
109.249
luox:
109.249
toolbox:
109.249
shiny:
167.526
luox:
167.526
toolbox:
167.526
shiny:
66.304
luox:
66.303
toolbox:
66.304
shiny:
48.778
luox:
48.777
toolbox:
48.778
shiny:
18.407
luox:
18.403
toolbox:
18.407
shiny:
75.044
luox:
75.042
toolbox:
75.042
shiny:
102.846
luox:
102.845
toolbox:
102.846
shiny:
45.736
luox:
45.736
toolbox:
45.736
shiny:
36.780
luox:
36.779
toolbox:
36.780
shiny:
329.187
luox:
—
toolbox:
329.187
shiny:
2410.988
luox:
2410.977
toolbox:
—
shiny:
87.665
luox:
87.625
toolbox:
—
LED_4000K_1
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
39.460
luox:
39.460
toolbox:
39.460
shiny:
126.303
luox:
126.303
toolbox:
126.303
shiny:
162.057
luox:
162.057
toolbox:
162.057
shiny:
93.656
luox:
93.656
toolbox:
93.656
shiny:
74.836
luox:
74.836
toolbox:
74.836
shiny:
48.281
luox:
48.282
toolbox:
48.282
shiny:
86.759
luox:
86.757
toolbox:
86.757
shiny:
99.489
luox:
99.488
toolbox:
99.488
shiny:
64.603
luox:
64.603
toolbox:
64.603
shiny:
56.429
luox:
56.428
toolbox:
56.428
shiny:
300.094
luox:
—
toolbox:
300.094
shiny:
3811.887
luox:
3811.885
toolbox:
—
shiny:
82.085
luox:
82.125
toolbox:
—
LED_4000K_2
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
54.816
luox:
54.816
toolbox:
54.816
shiny:
127.856
luox:
127.856
toolbox:
127.856
shiny:
164.399
luox:
164.399
toolbox:
164.399
shiny:
106.315
luox:
106.315
toolbox:
106.315
shiny:
90.404
luox:
90.404
toolbox:
90.404
shiny:
67.069
luox:
67.070
toolbox:
67.070
shiny:
87.825
luox:
87.824
toolbox:
87.824
shiny:
100.926
luox:
100.926
toolbox:
100.926
shiny:
73.336
luox:
73.336
toolbox:
73.336
shiny:
68.168
luox:
68.167
toolbox:
68.167
shiny:
338.823
luox:
—
toolbox:
338.823
shiny:
3899.370
luox:
3899.370
toolbox:
—
shiny:
—
luox:
94.625
toolbox:
—
LED_6900K
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
93.998
luox:
93.998
toolbox:
93.998
shiny:
145.326
luox:
145.326
toolbox:
145.326
shiny:
161.924
luox:
161.924
toolbox:
161.924
shiny:
144.972
luox:
144.972
toolbox:
144.972
shiny:
131.440
luox:
131.440
toolbox:
131.440
shiny:
115.010
luox:
115.012
toolbox:
115.012
shiny:
99.826
luox:
99.824
toolbox:
99.824
shiny:
99.407
luox:
99.406
toolbox:
99.406
shiny:
100.001
luox:
100.001
toolbox:
100.001
shiny:
99.110
luox:
99.109
toolbox:
99.109
shiny:
351.290
luox:
—
toolbox:
351.290
shiny:
7418.690
luox:
7418.680
toolbox:
—
shiny:
93.878
luox:
93.875
toolbox:
—
Nordhimmel
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
108.054
luox:
108.054
toolbox:
108.054
shiny:
153.329
luox:
153.329
toolbox:
153.329
shiny:
163.589
luox:
163.589
toolbox:
163.589
shiny:
166.521
luox:
166.521
toolbox:
166.521
shiny:
157.556
luox:
157.556
toolbox:
157.556
shiny:
132.209
luox:
132.210
toolbox:
132.210
shiny:
105.323
luox:
105.321
toolbox:
105.321
shiny:
100.429
luox:
100.429
toolbox:
100.429
shiny:
114.866
luox:
114.866
toolbox:
114.866
shiny:
118.802
luox:
118.801
toolbox:
118.801
shiny:
528.454
luox:
—
toolbox:
528.454
shiny:
9317.532
luox:
9317.532
toolbox:
—
shiny:
97.943
luox:
98.000
toolbox:
—
Norm_TL_6500K
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
81.711
luox:
81.711
toolbox:
81.711
shiny:
145.575
luox:
145.575
toolbox:
145.575
shiny:
162.890
luox:
162.890
toolbox:
162.890
shiny:
144.953
luox:
144.953
toolbox:
144.953
shiny:
132.602
luox:
132.602
toolbox:
132.602
shiny:
99.976
luox:
99.978
toolbox:
99.978
shiny:
99.996
luox:
99.995
toolbox:
99.995
shiny:
100.000
luox:
100.000
toolbox:
100.000
shiny:
99.988
luox:
99.988
toolbox:
99.988
shiny:
99.986
luox:
99.985
toolbox:
99.985
shiny:
488.200
luox:
—
toolbox:
488.200
shiny:
6499.265
luox:
6499.265
toolbox:
—
shiny:
99.991
luox:
100.000
toolbox:
—
The first number in every cell shows the Result from the Shiny app,
the second number the result from the luox app,
whereas the third number shows the result from the CIE S026 Toolbox.
All values are rounded to three decimals.
Missing values are indicated by a —.

A quick overview of the previous table show that the Shiny app produces results that are either identical, or at least very similar to the luox app or the CIE Toolbox. The next two sections will provide a more concise overview of how those sources compare.

Preparing Data 
#extract the relative difference differentiated by spectrum and variable
Discussion <- 
  spectra %>% 
  select(spectrum_name, excerpt) %>% 
  unnest(excerpt) %>% 
  rowwise() %>% 
  mutate(Dev_luox = 1 - Results_luox/Results_shiny,
         Dev_toolbox = 1 - Results_toolbox/Results_shiny
         ) %>% 
  ungroup()

#throwing the units out for visualization
Discussion <- 
  Discussion %>% mutate(Name = str_replace(Name, "\\(mW ⋅ m⁻²\\)", ""),
                        Name = str_replace(Name, "\\(lx\\)", ""))

Pairwise comparison to the luox app

luox data 
#creating a subframe for the luox-data, filtered by removing all non-comparisons
Data <- Discussion %>% dplyr::filter(!is.na(Dev_luox))
#number of comparisons made
n <- Data %>% count() %>% pull(1)
#number of comparisons split by difference
n2 <- Data %>% group_by(Dev_luox == 0, Dev_luox > 0, Dev_luox < 0) %>% 
  count() %>% pull(n)
n2[3] <- ifelse(is.na(n2[3]), "none",  n2[3])
#median difference when disregarding sign
n3 <- Data %>% filter(Dev_luox != 0) %>% 
  dplyr::summarise(median = median(abs(Dev_luox))) %>% pull(1)
#maximum difference
n4 <- Data %>% pull(Dev_luox) %>% abs() %>% max()
#where did this difference occur
n4_2 <- Data$Name[abs(Data$Dev_luox) == n4]

Of 128 comparisons, 20 were identical, 25 were smaller, and 83 were larger, using the luox results as a basis. The median relative difference was 2.93 × 10−6 (disregarding sign), i.e., 0.00029%. The highest relative difference (again disregarding sign) was 2.16 × 10−3 or 0.22%, which occured for Colour Rendering Index [Ra]. The following figure provides a histogram of all relative differences (excluding zero difference), colored by variable.

histogram 
#make a histogram of the values and calculate relevant values

breaks <- c(10^-15, 10^-10, 10^-5, 1)

Base_Plot <- 
  Data %>% filter(Dev_luox !=0) %>% 
  ggplot(aes(x=abs(Dev_luox))) +
  geom_histogram(aes(fill = Name))+
  xlab("relative difference (irregarding sign)")+
  expand_limits(x= 1)
Base_Plot +
  scale_x_log10(breaks = breaks, labels = c(vec_fmt_number(breaks*100, 
                                                           n_sigfig = 1, 
                                                           pattern = "{x}%"))) +
  ylab("no. of spectra")

Base_Plot +
  scale_x_log10(breaks = breaks)+
  ylab("no. of spectra")+
  facet_wrap("Name")


Base_Plot +
  scale_x_log10(breaks = breaks)+
  ylab("no. of variables")+
  facet_wrap("spectrum_name")

Pairwise comparison to the CIE Toolbox

CIE prep 
#creating a subframe for the luox-data, filtered by removing all non-comparisons
Data <- Discussion %>% dplyr::filter(!is.na(Dev_toolbox))
#number of comparisons made
n <- Data %>% count() %>% pull(1)
#number of comparisons split by difference
n2 <- Data %>% group_by(Dev_toolbox == 0, Dev_toolbox > 0, Dev_toolbox < 0) %>% 
  count() %>% pull(n)
n2[3] <- ifelse(is.na(n2[3]), "none",  n2[3])
#median difference when disregarding sign
n3 <- Data %>% filter(Dev_toolbox != 0) %>% 
  dplyr::summarise(median = median(abs(Dev_toolbox))) %>% pull(1)
#maximum difference
n4 <- Data %>% pull(Dev_toolbox) %>% abs() %>% max()
#where did this difference occur
n4_2 <- Data$Name[abs(Data$Dev_toolbox) == n4]

Of 120 comparisons, none were identical, 25 were smaller, and 95 were larger, using the CIE Toolbox results as a basis. The median relative difference was 1.13 × 10−6 (disregarding sign), i.e., 0.00011%. The highest relative difference (again disregarding sign) was 1.81 × 10−5 or 0.0018%, which occured for M-cone-opic EDI. The following figure provides a histogram of all relative differences (excluding zero difference), colored by variable.

Histogram 
#make a histogram of the values and calculate relevant values

Base_Plot <- 
  Data %>% filter(Dev_toolbox !=0) %>% 
  ggplot(aes(x=abs(Dev_toolbox))) +
  geom_histogram(aes(fill = Name))+
  xlab("relative difference (irregarding sign)")+
  expand_limits(x= 1)
Base_Plot +
  scale_x_log10(breaks = breaks, labels = c(vec_fmt_number(breaks*100, 
                                                           n_sigfig = 1, 
                                                           pattern = "{x}%")))+
  ylab("no. of spectra")


Base_Plot +
  scale_x_log10(breaks = breaks)+
  ylab("no. of spectra")+
    facet_wrap("Name")


Base_Plot +
  scale_x_log10(breaks = breaks)+
  ylab("no. of variables")+
  facet_wrap("spectrum_name")

Conclusion

Overall, the agreement between the different sources is very high and differences only occur several decimals back. For most if not all of those cases, rounding errors seem a plausible explanation. In an older version of the Shiny app, negative input values for irradiance were taken at face value, i.e., they actually reduced variable values that require summation. With that state, many more comparisons showed a zero difference for the luox app, which seems to indicate that the luox app also takes negative values at face value. However, the median relative difference in that older state was about double that compared to the current state for both the luox app and the CIE Toolbox sources. Since both the overall error is reduced by the current state of the Shiny app and it is sensible to restrict input values to zero or positive numbers, this method will be used in the public release.

In summary, the Shiny app offers a sufficiently accurate calculation of ⍺-opic values, especially given its focus on education. It is of note, however, that the age corrected values could no be validated against the other two sources, since they don´t provide similar functionality.