Replication Code for “Automating Urban Soundscape Enhancements with AI: In-situ Assessment of Quality and Restorativeness in Traffic-Exposed Residential Areas”

The GitHub repository contains the code to replicate the analysis, figures and tables for the paper titled: “Automating Urban Soundscape Enhancements with AI: In-situ Assessment of Quality and Restorativeness in Traffic-Exposed Residential Areas”. The initial stable release v1.0.0 has been archived on Zenodo:

The data that support the findings of this study are openly available in NTU research
data repository DR-NTU (Data) at https://doi.org/10.21979/N9/NEH5TR.

The subheadings in this repository follows the headings in the paper (after the Data Loading section) for consistency.

The following figures are produced by this replication code:

Table 2 in 2.3. Stimuli and automatic masker selection
Table 3 in 2.4. Non-acoustic environmental conditions for in-situ validation study
Table 4 in 2.5. Participants
Table 5 in 3. Results
Table B.1 in 3. Results
Figure 3 in 3. Results
Table 6 in 3.3. Correlation between subjective metrics
Table B.2 in 3.4. Effect of order, group size and initial conditions
Table 7 in 4. Results: Objective binaural measurements
Table B.3 in 4. Results: Objective binaural measurements
Figure 4 in 4. Results: Objective binaural measurements

Initialisation

Data Loading

First, check if the RData file (fullData.Rdata) exists. If it does not exist, download the RData file containing all the data tables required to replicate all the figures, tables and analyses in this paper from the Dataverse repository (https://doi.org/10.21979/N9/NEH5TR).

#check if RData file exists then download from the DOI if it doesn't
if (!file.exists("data/fullData.RData")){
        as_binary<-dataverse::get_file(
                file = "fullData.RData",
                dataset = "doi:10.21979/N9/NEH5TR",
                server = "https://researchdata.ntu.edu.sg"
        )
        
        #write binary file
        writeBin(as_binary, con = "data/fullData.RData")
}

load("data/fullData.RData")

2. Method

2.3. Stimuli and automatic masker selection

`Table 2:` Frequency distribution of the maskers chosen by the AMSS during the 10-min listening period across all “AMSS” group participants. Description and availability of the corresponding maskers as detailed by Ooi et al. [48] in the ARAUS dataset.

tbl2_predictions <- predict_session_data |> 
        tbl_summary(
                include = c(predictions),
                #only show percentage
                statistic = list(all_categorical() ~ "{p}%")
                ) |> 
        remove_row_type(predictions, type = "header") |>
        as_gt() |>
        cols_add(
                 Description = c(
                        "Bahama Mockingbird",
                        "Baltimore Oriole",
                        "Northern Cardinal",
                        "Veery",
                        "Common Redshank"
                )
        ) |>
        cols_label(
                label = md("**Maskers**"),
                stat_0 = md("**Frequency (%)**"),
                Description = md("**Description**")
        ) |>
        rm_footnotes()
tbl2_predictions

Maskers	Frequency (%)	Description
bird_00012	0.2%	Bahama Mockingbird
bird_00025	1.0%	Baltimore Oriole
bird_00069	26%	Northern Cardinal
bird_00071	5.8%	Veery
bird_00075	67%	Common Redshank

2.4. Non-acoustic environmental conditions for in-situ validation study

`Table 3`: Summary statistics of environmental parameters captured at ROOF during the 10-min listening period across all participants.

#list of metrics to compute mean
metric_list <- c("temperature","humidity","lux","wind_speed","24h_psi","pm25")

enviro_summary_tbl <- enviro_session_data |>
        tbl_summary(
                include = metric_list,
                by = condition,
                digits = all_continuous() ~ 2,
                type = list(everything() ~ 'continuous'),
                statistic = list(all_continuous() ~ "{mean} ({sd})"),
                missing = "no"
                ) |>
        #add_n() %>% # add column with total number of non-missing observations
        modify_header(label = "**Environmental Parameter**") |>
        add_p(
                everything() ~ "wilcox.test",
                pvalue_fun = function(x) style_pvalue(x, digits = 3)
                ) |>
        as_gt()
        
enviro_summary_tbl

Environmental Parameter	AMB, N = 32¹	AMSS, N = 36¹	p-value²
temperature	33.64 (2.37)	31.53 (1.29)	0.073
humidity	54.88 (7.78)	59.77 (4.23)	0.271
lux	361.58 (116.25)	310.76 (121.34)	0.271
wind_speed	3.25 (1.49)	3.64 (0.69)	0.267
24h_psi	44.13 (6.17)	51.14 (6.12)	0.054
pm25	13.00 (4.63)	15.86 (3.80)	0.236
¹ Mean (SD)
² Wilcoxon rank sum test

2.5. Participants

`Table 4:` Summary of participant demographics and non-acoustic factors (PSS-10, WNSS, WHO-5, baseline annoyance) across each condition (AMSS and AMB).

#custom function for ks-test between ambient and amss groups across {}
ks_test <- function(data, variable, by, ...) {
  data <- data[c(variable, by)] %>% dplyr::filter(complete.cases(.))
  ks.test(data[[variable]] ~ factor(data[[by]])) %>%
  broom::tidy()
}

amss_insitu_participant_data |>
        dplyr::select(c(condition,gender,age,pss,wnss,wbi), 
                              starts_with("annoy-")) |>
        drop_na() |>
        tbl_summary(
                by = condition,
                type = list(!c(gender) ~ 'continuous'),
                statistic = list(all_continuous() ~ "{mean} ({sd})"),
                digits = list(all_continuous() ~ c(2, 2)),
                label = list(
                        pss ~ "PSS-10",
                        wnss ~ "INS",
                        wbi ~ "WHO-5",
                        `annoy-aircraft` ~ "BA@aircraft~",
                        `annoy-mrt` ~ "BA@mrt~",
                        `annoy-consite` ~ "BA@consite~",
                        `annoy-reno` ~ "BA@reno~",
                        `annoy-traffic` ~ "BA@traffic~",
                        `annoy-animals` ~ "BA@animals~",
                        `annoy-children` ~ "BA@children~",
                        `annoy-people` ~ "BA@people~",
                        `annoy-others` ~ "BA@others~"
                        )
        ) |>
        add_p(
                test = list(
                        gender ~ "prop.test",
                        c(age,pss,wnss,wbi,
                          starts_with("annoy-")) ~ c("ks_test")
                        ),
                pvalue_fun = function(x) style_pvalue(x, digits = 2)
                ) |>
        add_overall() |>
        as_gt() |>
        text_transform(
                locations = cells_body(),
                fn = function(x) {
                        str_replace_all(x,pattern = "@",
                                        replacement = "<sub>") |>
                                str_replace_all("~","</sub>") 
                        }
                )

Characteristic	Overall, N = 68¹	AMB, N = 32¹	AMSS, N = 36¹	p-value²
gender				0.091
Female	40 (59%)	21 (66%)	19 (53%)
Male	28 (41%)	11 (34%)	17 (47%)
age	41.75 (12.83)	42.00 (13.22)	41.53 (12.65)	0.91
PSS-10	0.51 (0.13)	0.51 (0.13)	0.51 (0.14)	0.94
INS	0.67 (0.06)	0.67 (0.05)	0.67 (0.06)	0.72
WHO-5	0.62 (0.17)	0.59 (0.17)	0.65 (0.16)	0.54
BA_aircraft	3.93 (1.39)	3.88 (1.41)	3.97 (1.38)	0.82
BA_mrt	2.35 (1.22)	2.59 (1.29)	2.14 (1.13)	0.46
BA_consite	3.53 (1.30)	3.59 (1.29)	3.47 (1.32)	0.80
BA_reno	3.46 (1.34)	3.59 (1.39)	3.33 (1.31)	0.59
BA_traffic	3.46 (1.20)	3.53 (1.14)	3.39 (1.27)	0.90
BA_animals	2.12 (1.10)	1.94 (1.05)	2.28 (1.14)	0.28
BA_children	2.51 (1.17)	2.66 (1.21)	2.39 (1.13)	0.51
BA_people	2.34 (1.02)	2.47 (1.05)	2.22 (0.99)	0.28
BA_others	2.35 (1.18)	2.38 (1.10)	2.33 (1.26)	0.83
¹ n (%); Mean (SD)
² 4-sample test for equality of proportions without continuity correction; Exact two-sample Kolmogorov-Smirnov test

3. Results: Site evaluation questionnaire

`Table 5:` Mean responses $\mu$ (standard deviation $\sigma$) of perceptual attributes in the site evaluation questionnaire investigated for the validation study, organized by site and condition. The scales for all attributes are normalised to the range $[-1,1]$. Percentage changes are computed between the AMB and AMSS for site, and between ROOF and GND for condition as scale changes on the $[-1,1]$ range with respect to the former. For instance, a change from $-0.25$ in the AMB condition to $0.75$ in the AMSS condition would be reported as a $50$% change. Significant changes as determined by posthoc tests are indicated in bold.

#compute statistical tests for all variables
stat.results<-twoWLMERMANOVA(metadata,amss_insitu_participant_data)

Category is: categorical; Variable is: dom_noise
Two-Way Mixed Effects Repeated Measures Formula: 
rank(dom_noise) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: categorical; Variable is: dom_natural
Two-Way Mixed Effects Repeated Measures Formula: 
rank(dom_natural) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0 (p<0.05) 
Category is: categorical; Variable is: dom_human
Two-Way Mixed Effects Repeated Measures Formula: 
rank(dom_human) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: interval; Variable is: PosAff
Two-Way Mixed Effects Repeated Measures Formula: 
PosAff ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.021 (p<0.05) 
Category is: interval; Variable is: NegAff
Two-Way Mixed Effects Repeated Measures Formula: 
NegAff ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
NegAff is non-normal: p<0.05 (p=3.40444416059014e-14)Two-Way Mixed Effects Repeated Measures Formula: 
rank(NegAff) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: categorical; Variable is: overall
Two-Way Mixed Effects Repeated Measures Formula: 
rank(overall) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.027 (p<0.05) 
Category is: categorical; Variable is: appropriate
Two-Way Mixed Effects Repeated Measures Formula: 
rank(appropriate) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: categorical; Variable is: loudness
Two-Way Mixed Effects Repeated Measures Formula: 
rank(loudness) ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.022 (p<0.05) 
Category is: interval; Variable is: ISOPL
Two-Way Mixed Effects Repeated Measures Formula: 
ISOPL ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.008 (p<0.05) 
Category is: interval; Variable is: ISOEV
Two-Way Mixed Effects Repeated Measures Formula: 
ISOEV ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: interval; Variable is: PRSSFas
Two-Way Mixed Effects Repeated Measures Formula: 
PRSSFas ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.008 (p<0.05) 
Category is: interval; Variable is: PRSSBA
Two-Way Mixed Effects Repeated Measures Formula: 
PRSSBA ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.019 (p<0.05) 
Category is: interval; Variable is: PRSSCom
Two-Way Mixed Effects Repeated Measures Formula: 
PRSSCom ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Interaction Effect is significant: p=0.046 (p<0.05) 
Category is: interval; Variable is: PRSSEC
Two-Way Mixed Effects Repeated Measures Formula: 
PRSSEC ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>
Category is: interval; Variable is: PRSSES
Two-Way Mixed Effects Repeated Measures Formula: 
PRSSES ~ (1 | pID) + site * condition
<environment: 0x0000018a1081b358>

#retrieve significant results
signif_posthoc <- stat.results |>
        dplyr::filter(
                p.value<0.05 & 
                        !grepl("MP",term) &
                        grepl("Contrasts",test)
                      ) 

signif_posthoc_bycond <- signif_posthoc |>
        filter(grepl("Condition",test)) |>
        select(variable,term)

signif_posthoc_bysite <- signif_posthoc |>
        filter(grepl("Site",test)) |>
        select(variable,term)

#summarise by condition at each site
summary_bycond_gt <- amss_insitu_participant_data |>
        dplyr::filter(!site=="MP") |>
        dplyr::select(!c(pID,order,partGrp,p:m,pss:who5)) |>
        tbl_strata(
            strata = site,
            .tbl_fun =
              ~ .x %>%
                tbl_summary(
                        by = condition, 
                        missing = "no",
                        type = everything() ~ "continuous",
                        statistic = all_continuous() ~ "{mean} ({sd})",
                        label = list(
                                dom_noise ~ "!DOM#@Noi~",
                                dom_human ~ "!DOM#@Hum~",
                                dom_natural ~ "!DOM#@Nat~",
                                overall ~ "!OSQ#",
                                appropriate ~ "!APPR#",
                                loudness ~ "!PLN#",
                                ISOPL ~ "!ISOPL#",
                                ISOEV ~ "!ISOEV#",
                                PRSSFas ~ "!PRSS#@Fas~",
                                PRSSBA ~ "!PRSS#@BA~",
                                PRSSCom ~ "!PRSS#@Com~",
                                PRSSEC ~ "!PRSS#@EC~",
                                PRSSES ~ "!PRSS#@ES~",
                                PosAff ~ "!PA#",
                                NegAff ~ "!NA#"
                                )
                        ) %>%
                add_difference(
                        estimate_fun = everything() ~ 
                                function(x) paste0(style_sigfig((-x/2) * 100), "%")
                ),
            .header = "**{strata}**"
            ) |>
        modify_column_hide(columns = c(p.value_1,ci_1,p.value_2,ci_2)) |>
        # remove difference footnote
        modify_footnote(update = everything() ~ NA) |>
        modify_header(all_stat_cols() ~ "**{level}**") 

#summarise by site for each cond
summary_bysite_gt <- amss_insitu_participant_data |>
        dplyr::filter(!site=="MP") |>
        dplyr::select(!c(pID,order,partGrp,p:m,pss:who5)) |>
        dplyr::mutate(site=factor(site, levels=c("GND","ROOF"))) |>
        tbl_strata(
            strata = condition,
            .tbl_fun =
              ~ .x %>%
                tbl_summary(
                        by = site, 
                        missing = "no",
                        type = everything() ~ "continuous",
                        statistic = all_continuous() ~ "{mean} ({sd})",
                        label = list(
                                dom_noise ~ "!DOM#@Noi~",
                                dom_human ~ "!DOM#@Hum~",
                                dom_natural ~ "!DOM#@Nat~",
                                overall ~ "!OSQ#",
                                appropriate ~ "!APPR#",
                                loudness ~ "!PLN#",
                                ISOPL ~ "!ISOPL#",
                                ISOEV ~ "!ISOEV#",
                                PRSSFas ~ "!PRSS#@Fas~",
                                PRSSBA ~ "!PRSS#@BA~",
                                PRSSCom ~ "!PRSS#@Com~",
                                PRSSEC ~ "!PRSS#@EC~",
                                PRSSES ~ "!PRSS#@ES~",
                                PosAff ~ "!PA#",
                                NegAff ~ "!NA#"
                                )
                        ) %>%
                add_difference(
                        estimate_fun = everything() ~ 
                                function(x) paste0(style_sigfig((-x/2) * 100), "%")
                        ),
            .header = "**{strata}**"
            ) |>
        modify_column_hide(columns = c(p.value_1,ci_1,p.value_2,ci_2)) |>
        # remove difference footnote
        modify_footnote(update = everything() ~ NA) |>
        modify_header(all_stat_cols() ~ "**{level}**") 

#merge tables columnwise        
tbl_merge_cond_site <-
        tbl_merge(
                tbls = list(summary_bycond_gt, summary_bysite_gt),
                tab_spanner = c(
                        "**Contrasts by condition at ...**",
                        "**Contrasts by site under ...**"
                        )
                ) |>
        as_gt() |>
        text_transform(
                locations = cells_body(),
                fn = function(x) {
                        str_replace_all(
                                x,pattern = "@",
                                replacement = "<sub>"
                                ) |>
                                str_replace_all("~","</sub>") |>
                                str_replace_all("!","<i>") |>
                                str_replace_all("#","</i>")
                        }
                ) |>
        #highlight significant results at GND site
        tab_style(
                style = list(
                        cell_fill(color = "#FDE992"),
                        cell_text(weight = "bold")
                        ),
                locations = cells_body(
                        columns = c(estimate_1_1),
                        rows = variable %in% 
                                signif_posthoc_bycond[
                                        str_detect(signif_posthoc_bycond$term,
                                                   "GND"),
                                        ]$variable
                        )
        ) |>
        #highlight significant results at ROOF site
        tab_style(
                style = list(
                        cell_fill(color = "#FDE992"),
                        cell_text(weight = "bold")
                        ),
                locations = cells_body(
                        columns = c(estimate_2_1),
                        rows = variable %in% 
                                signif_posthoc_bycond[
                                        str_detect(signif_posthoc_bycond$term,
                                                   "ROOF"),
                                        ]$variable
                        )
        ) |>
        #highlight significant results under AMB condition
        tab_style(
                style = list(
                        cell_fill(color = "#FDE992"),
                        cell_text(weight = "bold")
                        ),
                locations = cells_body(
                        columns = c(estimate_1_2),
                        rows = variable %in% 
                                signif_posthoc_bysite[
                                        str_detect(signif_posthoc_bysite$term,
                                                   "AMB"),
                                        ]$variable
                        )
        ) |>
        #highlight significant results under AMSS condition
        tab_style(
                style = list(
                        cell_fill(color = "#FDE992"),
                        cell_text(weight = "bold")
                        ),
                locations = cells_body(
                        columns = c(estimate_2_2),
                        rows = variable %in% 
                                signif_posthoc_bysite[
                                        str_detect(signif_posthoc_bysite$term,
                                                   "AMSS"),
                                        ]$variable
                        )
        )
        
tbl_merge_cond_site

Characteristic	Contrasts by condition at …						Contrasts by site under …
	AMB	AMSS	Difference	AMB	AMSS	Difference	GND	ROOF	Difference	GND	ROOF	Difference
DOM_Noi	0.25 (0.44)	0.15 (0.50)	-4.9%	0.66 (0.39)	0.51 (0.42)	-7.1%	0.25 (0.44)	0.66 (0.39)	20%	0.15 (0.50)	0.51 (0.42)	18%
DOM_Hum	-0.25 (0.38)	-0.24 (0.60)	0.69%	-0.86 (0.34)	-0.93 (0.34)	-3.6%	-0.25 (0.38)	-0.86 (0.34)	-30%	-0.24 (0.60)	-0.93 (0.34)	-35%
DOM_Nat	0.19 (0.40)	0.17 (0.49)	-1.0%	-0.36 (0.50)	0.19 (0.44)	28%	0.19 (0.40)	-0.36 (0.50)	-27%	0.17 (0.49)	0.19 (0.44)	1.4%
OSQ	0.17 (0.47)	0.14 (0.39)	-1.6%	-0.17 (0.50)	0.07 (0.55)	12%	0.17 (0.47)	-0.17 (0.50)	-17%	0.14 (0.39)	0.07 (0.55)	-3.5%
APPR	-0.02 (0.39)	0.15 (0.44)	8.4%	-0.38 (0.49)	0.01 (0.57)	19%	-0.02 (0.39)	-0.38 (0.49)	-18%	0.15 (0.44)	0.01 (0.57)	-6.9%
PLN	-0.17 (0.35)	-0.11 (0.49)	3.0%	0.34 (0.43)	0.15 (0.55)	-9.5%	-0.17 (0.35)	0.34 (0.43)	26%	-0.11 (0.49)	0.15 (0.55)	13%
ISOPL	0.16 (0.32)	0.14 (0.30)	-1.0%	-0.19 (0.38)	0.10 (0.45)	15%	0.16 (0.32)	-0.19 (0.38)	-17%	0.14 (0.30)	0.10 (0.45)	-1.9%
ISOEV	0.03 (0.23)	0.05 (0.23)	1.2%	0.06 (0.24)	0.08 (0.26)	1.2%	0.03 (0.23)	0.06 (0.24)	1.5%	0.05 (0.23)	0.08 (0.26)	1.5%
PRSS_Fas	-0.16 (0.44)	-0.08 (0.39)	3.9%	-0.49 (0.43)	-0.06 (0.50)	21%	-0.16 (0.44)	-0.49 (0.43)	-16%	-0.08 (0.39)	-0.06 (0.50)	1.0%
PRSS_BA	0.08 (0.59)	0.19 (0.48)	5.5%	-0.22 (0.50)	0.30 (0.68)	26%	0.08 (0.59)	-0.22 (0.50)	-15%	0.19 (0.48)	0.30 (0.68)	5.8%
PRSS_Com	-0.40 (0.35)	-0.32 (0.30)	3.9%	-0.66 (0.35)	-0.38 (0.41)	14%	-0.40 (0.35)	-0.66 (0.35)	-13%	-0.32 (0.30)	-0.38 (0.41)	-3.2%
PRSS_EC	-0.40 (0.33)	-0.25 (0.29)	7.1%	-0.61 (0.34)	-0.35 (0.39)	13%	-0.40 (0.33)	-0.61 (0.34)	-11%	-0.25 (0.29)	-0.35 (0.39)	-4.6%
PRSS_ES	-0.34 (0.33)	-0.28 (0.32)	3.0%	-0.55 (0.29)	-0.36 (0.31)	9.5%	-0.34 (0.33)	-0.55 (0.29)	-11%	-0.28 (0.32)	-0.36 (0.31)	-4.2%
PA	-0.07 (0.43)	-0.07 (0.50)	0.12%	-0.21 (0.38)	0.07 (0.59)	14%	-0.07 (0.43)	-0.21 (0.38)	-7.0%	-0.07 (0.50)	0.07 (0.59)	6.9%
NA	-0.88 (0.18)	-0.88 (0.23)	0.17%	-0.78 (0.30)	-0.83 (0.43)	-2.2%	-0.88 (0.18)	-0.78 (0.30)	4.8%	-0.88 (0.23)	-0.83 (0.43)	2.5%

`Table B.1:` Summary of statistical tests for attributes in soundscape evaluation questionnaire (sound source dominance, overall quality, appropriateness, loudness, ISOPL, ISOEV, and PRSS dimensions) across site (GND and ROOF), condition (AMSS and AMB), and their interaction (site:condition). Test abbreviations and symbols for significance levels and effect sizes are defined in the footnote.

#plot statistical test reults in a table
stat.results |>
        dplyr::mutate(
                p.value=paste0(
                        gtools::stars.pval(p.value),
                        formatC(p.value, format = "f", digits = 4)
                        ),
                eff.size=case_when(
                        eff.size > 0.14 ~ paste0(
                                "(L)",
                                formatC(eff.size,format = "f",digits = 4)
                                ),
                        eff.size > 0.06 ~ paste0(
                                "(M)",
                                formatC(eff.size,format = "f",digits = 4)
                                ),
                        eff.size > 0.01 ~ paste0(
                                "(S)",formatC(eff.size,format = "f",digits = 4)
                                ),
                        .default = formatC(eff.size,format = "f",digits = 4))) |>
        dplyr::group_by(variable) |>
        gt::gt() |>
        cols_label(
                term ~ html("<b>Term</b>"),
                test ~ html("<b>Test</b>"),
                p.value ~ html("<i>p</i>-<b>value</b>"),
                eff.size ~ html("<b>Effect Size</b>")
        )

Term	Test	p-value	Effect Size
dom_noise
site	2ME-RT-RMANOVA	***0.0000	(L)0.3182
condition	2ME-RT-RMANOVA	0.1571	(S)0.0145
site:condition	2ME-RT-RMANOVA	0.5667	0.0000
dom_natural
site	2ME-RT-RMANOVA	***0.0004	(L)0.1464
condition	2ME-RT-RMANOVA	**0.0015	(M)0.1175
site:condition	2ME-RT-RMANOVA	***0.0003	(L)0.1492
AMB - AMSS \| GND	Simple Contrasts for Condition	0.9513	(S)0.0149
AMB - AMSS \| ROOF	Simple Contrasts for Condition	***0.0000	-1.1574
GND - ROOF \| AMB	Simple Contrasts for Site	***0.0000	(L)1.1661
GND - ROOF \| AMSS	Simple Contrasts for Site	0.9783	-0.0061
dom_human
site	2ME-RT-RMANOVA	***0.0000	(L)0.5180
condition	2ME-RT-RMANOVA	0.1039	(S)0.0121
site:condition	2ME-RT-RMANOVA	0.8785	0.0000
PosAff
Residuals	Shapiro-Wilk normality test	0.1731	NA
site	2ME-RMANOVA	0.6753	0.0000
condition	2ME-RMANOVA	0.1620	(S)0.0139
site:condition	2ME-RMANOVA	*0.0211	(S)0.0403
AMB - AMSS \| GND	Simple Contrasts for Condition	0.9835	-0.0050
AMB - AMSS \| MP	Simple Contrasts for Condition	0.2242	-0.2963
AMB - AMSS \| ROOF	Simple Contrasts for Condition	*0.0179	-0.5839
GND - MP \| AMB	Simple Contrasts for Site	0.8971	(M)0.0669
GND - ROOF \| AMB	Simple Contrasts for Site	0.1369	(L)0.2912
MP - ROOF \| AMB	Simple Contrasts for Site	0.2999	(L)0.2243
GND - MP \| AMSS	Simple Contrasts for Site	0.2625	-0.2243
GND - ROOF \| AMSS	Simple Contrasts for Site	0.1133	-0.2876
MP - ROOF \| AMSS	Simple Contrasts for Site	0.8977	-0.0633
NegAff
Residuals	Shapiro-Wilk normality test	***0.0000	NA
site	2ME-RT-RMANOVA	0.3525	0.0006
condition	2ME-RT-RMANOVA	*0.0253	(S)0.0550
site:condition	2ME-RT-RMANOVA	0.1665	(S)0.0114
overall
site	2ME-RT-RMANOVA	**0.0041	(M)0.0965
condition	2ME-RT-RMANOVA	0.2204	0.0073
site:condition	2ME-RT-RMANOVA	*0.0271	(S)0.0540
AMB - AMSS \| GND	Simple Contrasts for Condition	0.7087	(M)0.0910
AMB - AMSS \| ROOF	Simple Contrasts for Condition	*0.0221	-0.5631
GND - ROOF \| AMB	Simple Contrasts for Site	***0.0009	(L)0.7525
GND - ROOF \| AMSS	Simple Contrasts for Site	0.6297	(M)0.0984
appropriate
site	2ME-RT-RMANOVA	**0.0024	(M)0.1074
condition	2ME-RT-RMANOVA	***0.0007	(M)0.1327
site:condition	2ME-RT-RMANOVA	0.1591	(S)0.0142
loudness
site	2ME-RT-RMANOVA	***0.0000	(L)0.3561
condition	2ME-RT-RMANOVA	0.5667	0.0000
site:condition	2ME-RT-RMANOVA	*0.0221	(S)0.0587
AMB - AMSS \| GND	Simple Contrasts for Condition	0.4189	-0.1971
AMB - AMSS \| ROOF	Simple Contrasts for Condition	.0.0812	(L)0.4274
GND - ROOF \| AMB	Simple Contrasts for Site	***0.0000	-1.1600
GND - ROOF \| AMSS	Simple Contrasts for Site	**0.0057	-0.5355
ISOPL
Residuals	Shapiro-Wilk normality test	0.1229	NA
site	2ME-RMANOVA	**0.0011	(M)0.1248
condition	2ME-RMANOVA	*0.0432	(S)0.0434
site:condition	2ME-RMANOVA	**0.0082	(M)0.0808
AMB - AMSS \| GND	Simple Contrasts for Condition	0.8241	(S)0.0541
AMB - AMSS \| ROOF	Simple Contrasts for Condition	**0.0014	-0.7926
GND - ROOF \| AMB	Simple Contrasts for Site	***0.0001	(L)0.9473
GND - ROOF \| AMSS	Simple Contrasts for Site	0.6487	(M)0.1006
ISOEV
Residuals	Shapiro-Wilk normality test	0.7790	NA
site	2ME-RMANOVA	0.4576	0.0000
condition	2ME-RMANOVA	0.5795	0.0000
site:condition	2ME-RMANOVA	0.9990	0.0000
PRSSFas
Residuals	Shapiro-Wilk normality test	0.8728	NA
site	2ME-RMANOVA	*0.0203	(M)0.0606
condition	2ME-RMANOVA	**0.0034	(M)0.1000
site:condition	2ME-RMANOVA	**0.0083	(M)0.0806
AMB - AMSS \| GND	Simple Contrasts for Condition	0.4713	-0.1755
AMB - AMSS \| ROOF	Simple Contrasts for Condition	***0.0001	-0.9538
GND - ROOF \| AMB	Simple Contrasts for Site	**0.0011	(L)0.7314
GND - ROOF \| AMSS	Simple Contrasts for Site	0.8178	-0.0468
PRSSBA
Residuals	Shapiro-Wilk normality test	0.7777	NA
site	2ME-RMANOVA	0.3081	0.0006
condition	2ME-RMANOVA	**0.0034	(M)0.1005
site:condition	2ME-RMANOVA	*0.0193	(M)0.0618
AMB - AMSS \| GND	Simple Contrasts for Condition	0.4309	-0.1920
AMB - AMSS \| ROOF	Simple Contrasts for Condition	***0.0003	-0.9116
GND - ROOF \| AMB	Simple Contrasts for Site	*0.0241	(L)0.5165
GND - ROOF \| AMSS	Simple Contrasts for Site	0.3390	-0.2031
PRSSCom
Residuals	Shapiro-Wilk normality test	0.3328	NA
site	2ME-RMANOVA	***0.0009	(M)0.1287
condition	2ME-RMANOVA	*0.0135	(M)0.0698
site:condition	2ME-RMANOVA	*0.0456	(S)0.0422
AMB - AMSS \| GND	Simple Contrasts for Condition	0.3652	-0.2209
AMB - AMSS \| ROOF	Simple Contrasts for Condition	**0.0020	-0.7697
GND - ROOF \| AMB	Simple Contrasts for Site	***0.0005	(L)0.7308
GND - ROOF \| AMSS	Simple Contrasts for Site	0.3378	(L)0.1819
PRSSEC
Residuals	Shapiro-Wilk normality test	0.9051	NA
site	2ME-RMANOVA	**0.0015	(M)0.1182
condition	2ME-RMANOVA	**0.0023	(M)0.1089
site:condition	2ME-RMANOVA	0.2031	0.0090
PRSSES
Residuals	Shapiro-Wilk normality test	.0.0581	NA
site	2ME-RMANOVA	**0.0010	(M)0.1254
condition	2ME-RMANOVA	*0.0410	(S)0.0446
site:condition	2ME-RMANOVA	0.1504	(S)0.0155

`Figure 3:` Simple contrast of means across all perceptual attributes organized by condition and site Contrasts by condition are between groups at each site, whereas contrasts by site are within group for each condition. The scales for all attributes are normalised to the range [-1,1]. Significant differences as determined by posthoc contrast tests are accentuated

#prepare dataframe for plotting
plot_df<- amss_insitu_participant_data |>
        dplyr::filter(!site=="MP") |> #remove the meeting point
        pivot_longer(
                cols = metadata$variable,
                values_to = "score",
                names_to = "Attribute"
                ) |>
        dplyr::select(!c(p:who5)) |>
        dplyr::mutate(
                Attribute=factor(Attribute,levels=metadata$variable)
        )

#Contrasts by condition under GND and ROOF site conditions
plot_site_df<-plot_df |>
        group_by(site,condition,Attribute) |>
        summarise(
                mean=mean(score,na.rm=TRUE),
                sd=sd(score,na.rm=TRUE)
                ) |>
        ungroup() |>
        dplyr::mutate(
                significant=ifelse(
                        site=="ROOF" & 
                                Attribute %in% c("dom_natural","PosAff",
                                                 "ISOPL","overall",
                                                 "PRSSFas","PRSSBA",
                                                 "PRSSCom"),
                                   TRUE,FALSE)
                )

#Contrasts by site under AMSS and AMB conditions
plot_cond_df<-plot_df |>
        group_by(condition,site,Attribute) |>
        summarise(mean=mean(score,na.rm=TRUE),
                  sd=sd(score,na.rm=TRUE)) |>
        ungroup() |>
        dplyr::mutate(
                significant=ifelse((
                        condition=="AMB" & 
                                Attribute %in% c("dom_natural","ISOPL",
                                              "overall","loudness",
                                              "PRSSFas","PRSSBA","PRSSCom")) |
                                (condition=="AMSS" & 
                                         Attribute %in% c("loudness")),
                                   TRUE,FALSE)
                )

#prepare legend labels
plot_legends <- c(
                bquote(~DOM[Noi]),
                bquote(~DOM[Nat]),
                bquote(~DOM[Hum]),
                "PA","NA","OQ","APPR",
                "PLN","ISOPL","ISOEV",
                bquote(~PRSS[Fas]),
                bquote(~PRSS[BA]),
                bquote(~PRSS[Com]),
                bquote(~PRSS[EC]),
                bquote(~PRSS[ES])
                )

site_plot<-ggplot(data = plot_site_df,
       aes(x=condition,y=mean,group=Attribute,
           alpha=significant,color=Attribute)) +
        geom_line() + 
        geom_point() +
        scale_alpha_discrete(
                range=c(0.2, 1),
                guide = 'none' #turn off legend
                ) +
        scale_color_paletteer_d(
                palette = "awtools::bpalette",
                labels=plot_legends
                ) +
        facet_wrap(vars(site)) +
        theme_minimal() +
        theme(
                panel.grid.major.x = element_blank(),
                panel.grid.minor.x = element_blank()
        ) +
        geom_hline(
                yintercept = 0,
                color="darkgrey",
                size=1
                ) +
        ylim(c(-1,1)) +
        ylab("Normalised mean") +
        ggpubr::labs_pubr()
        

cond_plot<-ggplot(data = plot_cond_df,
       aes(x=site,y=mean,group=Attribute,
           alpha=significant,color=Attribute)) +
        geom_line() + 
        geom_point() +
        scale_alpha_discrete(
                range=c(0.2, 1),
                guide = 'none' #turn off legend
                ) +
        scale_color_paletteer_d(
                palette = "awtools::bpalette",
                labels=plot_legends) +
        facet_wrap(vars(condition)) +
        theme_minimal() +
        theme(
                panel.grid.major.x = element_blank(),
                panel.grid.minor.x = element_blank()
        ) +
        geom_hline(
                yintercept = 0,
                color="darkgrey",
                size=1
                ) +
        ylim(c(-1,1)) +
        ylab("Normalised mean") +
        ggpubr::labs_pubr()


comb_plot<-ggarrange(
        site_plot, cond_plot, #labels = c("Site", "Condition"),
        common.legend = TRUE, legend = "right"
)
comb_plot

3.3. Correlation between subjective metrics

`Table 6:` Kendall correlation matrix between all attributes in the site evaluation questionnaire where the significance of each entry in the upper triangle is denoted with a Holm-adjusted $p$-value and each entry in the lower triangle is denoted with an unadjusted $p$-value. Asterisks indicate $p<0.05$; $p<0.01$; $p<0.001$; ****$p<0.0001$. The unit diagonal has been removed for clarity.

	dom_noise	dom_human	dom_natural	PosAff	NegAff	overall	appropriate	loudness	ISOPL	ISOEV	PRSSFas	PRSSBA	PRSSCom	PRSSEC	PRSSES
dom_noise		-0.22	-0.03	-0.06	0.06	**-0.35	*-0.30	***0.44	*-0.30	0.08	-0.12	-0.23	-0.24	-0.22	-0.07
dom_human	*-0.22		0.27	0.04	-0.03	0.08	0.12	-0.14	0.09	0.01	0.12	0.07	0.07	0.10	0.17
dom_natural	-0.03	**0.27		0.18	-0.11	*0.29	0.23	-0.13	*0.29	0.02	.0.28	0.24	0.25	*0.30	*0.29
PosAff	-0.06	0.04	*0.18		-0.04	*0.29	0.23	-0.02	0.23	0.01	**0.35	***0.39	**0.34	***0.37	**0.35
NegAff	0.06	-0.03	-0.11	-0.04		-0.22	-0.20	0.16	*-0.29	0.04	-0.07	-0.10	-0.21	-0.14	-0.00
overall	***-0.35	0.08	***0.29	***0.29	**-0.22		***0.56	***-0.47	***0.62	-0.13	**0.34	***0.49	***0.54	***0.52	.0.27
appropriate	***-0.30	0.12	**0.23	**0.23	*-0.20	***0.56		***-0.41	***0.50	-0.03	**0.35	***0.43	***0.48	***0.47	.0.28
loudness	***0.44	.-0.14	-0.13	-0.02	.0.16	***-0.47	***-0.41		***-0.39	0.10	-0.16	-0.25	**-0.35	*-0.31	-0.17
ISOPL	***-0.30	0.09	***0.29	**0.23	***-0.29	***0.62	***0.50	***-0.39		-0.03	**0.34	***0.50	***0.52	***0.46	0.25
ISOEV	0.08	0.01	0.02	0.01	0.04	-0.13	-0.03	0.10	-0.03		-0.02	-0.08	-0.08	-0.06	0.03
PRSSFas	-0.12	0.12	***0.28	***0.35	-0.07	***0.34	***0.35	.-0.16	***0.34	-0.02		***0.61	***0.57	***0.55	***0.65
PRSSBA	**-0.23	0.07	**0.24	***0.39	-0.10	***0.49	***0.43	**-0.25	***0.50	-0.08	***0.61		***0.69	***0.64	***0.51
PRSSCom	**-0.24	0.07	**0.25	***0.34	*-0.21	***0.54	***0.48	***-0.35	***0.52	-0.08	***0.57	***0.69		***0.65	***0.50
PRSSEC	**-0.22	0.10	***0.30	***0.37	-0.14	***0.52	***0.47	***-0.31	***0.46	-0.06	***0.55	***0.64	***0.65		***0.52
PRSSES	-0.07	.0.17	***0.29	***0.35	-0.00	**0.27	**0.28	*-0.17	**0.25	0.03	***0.65	***0.51	***0.50	***0.52

3.4. Effect of order, group size and initial conditions

`Table B.2:` Summary of exact two-sample Kolmogorov-Smirnov tests to examine effect of order (GND–ROOF or ROOF–GND) and group size (1 or $>1$) on each soundscape evaluation attribute (sound source dominance, overall quality, appropriateness, loudness, ISOPL, ISOEV, and PRSS dimensions) across each condition (AMSS and AMB). All the $p$-values were adjusted for multiple comparisons within conditions with the Benjamini-Hochberg (BH) method.

ks.df <- amss_insitu_participant_data |>
        dplyr::select(c(condition,partGrp,order,metadata$variable)) |>
        pivot_longer(names_to = "variable",
                     values_to = "score",
                     cols = metadata$variable)

ks.order.grpsize <- rbind(
        #KS Test by order
        ks.df |> 
                dplyr::group_by(condition,variable) |>
                dplyr::summarise(
                        ks_test = list(ks.test(score[order == 18],
                                               score[order == 81],
                                               exact = NULL,
                                               alternative = "two.sided")),
                        ks.pvalue = ks_test[[1]]$p.value
                ) |>
                dplyr::ungroup() |>
                dplyr::group_by(condition) |>
                dplyr::mutate(ks.padj = p.adjust(ks.pvalue, method="BH"),
                              confvar = "order"),
        #KS Test by group size
        ks.df |> 
                dplyr::group_by(condition,variable) |>
                dplyr::summarise(
                        ks_test = list(ks.test(score[partGrp == "single"],
                                               score[partGrp == "multi"],
                                               exact = NULL,
                                               alternative = "two.sided")),
                        ks.pvalue = ks_test[[1]]$p.value
                ) |>
                dplyr::ungroup() |>
                dplyr::group_by(condition) |>
                dplyr::mutate(ks.padj = p.adjust(ks.pvalue, method="BH"),
                              confvar = "group size")
        ) |>
        #add significance stars
        dplyr::mutate(
                        ks.padj=paste0(gtools::stars.pval(ks.padj),
                               formatC(ks.padj,
                                       format = "f",
                                       digits = 2))
        ) |>
        dplyr::select(!ks_test) |>
        pivot_wider(values_from = ks.padj,
                    names_from = variable,
                    id_cols = c(condition,confvar)) |>
        #reorder columns
        dplyr::select(
                dom_noise, dom_human, dom_natural, 
                PosAff, NegAff, 
                overall, appropriate, loudness, 
                ISOPL, ISOEV,
                PRSSFas, PRSSBA, PRSSCom, PRSSEC, PRSSES, confvar) |>
        dplyr::group_by(confvar) |>
        gt::gt() |>
        cols_label(
                ISOEV ~ html("<i>ISOEV</i>"),
                ISOPL ~ html("<i>ISOPL</i>"),
                NegAff ~ html("<i>NA</i>"),
                PosAff ~ html("<i>PA</i>"),
                PRSSFas ~ html("<i>PRSS</i><sub>Fas</sub>"),
                PRSSBA ~ html("<i>PRSS</i><sub>BA</sub>"),
                PRSSCom ~ html("<i>PRSS</i><sub>Com</sub>"),
                PRSSEC ~ html("<i>PRSS</i><sub>EC</sub>"),
                PRSSES ~ html("<i>PRSS</i><sub>ES</sub>"),
                appropriate ~ html("<i>APPR</i>"),
                dom_natural ~ html("<i>DOM</i><sub>Nat</sub>"),
                dom_human ~ html("<i>DOM</i><sub>Hum</sub>"),
                dom_noise ~ html("<i>DOM</i><sub>Noi</sub>"),
                loudness ~ html("<i>PLN</i>"),
                overall ~ html("<i>OSQ</i>"),
        ) 
ks.order.grpsize

condition	DOM_Noi	DOM_Hum	DOM_Nat	PA	NA	OSQ	APPR	PLN	ISOPL	ISOEV	PRSS_Fas	PRSS_BA	PRSS_Com	PRSS_EC	PRSS_ES
order
AMB	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00
AMSS	0.95	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83	0.83
group size
AMB	0.98	0.98	0.98	0.98	0.96	0.96	0.98	0.96	0.98	0.96	0.98	0.96	0.96	0.98	0.96
AMSS	0.75	0.75	0.94	0.75	0.75	0.94	0.75	0.94	0.75	0.94	0.80	0.80	0.75	0.75	0.80

4. Results: Objective binaural measurements

`Table 7:` Summary of mean L_Aeq, L_Ceq, N₉₅, ISOPL, OSQ, PRSS_Fas, PRSS_BA, and PRSS_Com values across 20 AMSS and AMB sessions in each of the GND and RTGP sites. Supplemented mean values for the AMSS sessions excluding aircraft flyby (3 in GND; 1 in ROOF) are included.

#summary including aircraft flyby
isopl_obj_tbl <- comb_obj_insitu_session_data |>
        ungroup() |>
        pivot_wider(
                names_from = "attribute",
                values_from = "score"
        ) |>
        tbl_strata2(
                strata = condition,
                .tbl_fun =
                        ~ .x %>%
                        tbl_summary(include = c(`L[Aeq]`,`L[Ceq]`,
                                                `N[95]`,`ISOPL`,
                                                `OSQ`,`PRSS[Fas]`,
                                                `PRSS[BA]`,`PRSS[Com]`),
                            by = site,
                            type = list(everything() ~ 'continuous'),
                            statistic = list(everything() ~ "{mean} ({sd})"),
                            missing = "no",
                            digits = list(all_continuous() ~ c(2, 2)))
                )

#remove aircraft noise
isopl_obj_noaircraft_tbl<-comb_obj_insitu_session_data |> 
        ungroup() |>
        pivot_wider(
                names_from = "attribute",
                values_from = "score"
        ) |>
        dplyr::filter(
                !((date=="20230914" & sessionTime=="9" & site=="GND") |
                        (date=="20230915" & sessionTime=="14" 
                         & site %in% c("GND","ROOF")) |
                                 (date=="20230915" & sessionTime=="16" 
                                  & site=="GND"))
        ) |>
        #dplyr::group_by(condition,site) |>
        tbl_strata2(
                strata = condition,
                .tbl_fun =
                        ~ .x %>%
                        tbl_summary(include = c(`L[Aeq]`,`L[Ceq]`,
                                                `N[95]`,`ISOPL`,
                                                `OSQ`,`PRSS[Fas]`,
                                                `PRSS[BA]`,`PRSS[Com]`),
                            by = site,
                            type = list(everything() ~ 'continuous'),
                            statistic = list(everything() ~ "{mean} ({sd})"),
                            missing = "no",
                            digits = list(all_continuous() ~ c(2, 2))),
                .header = "**{strata}** (without aircraft flyby)"
                ) |>
        modify_header(label="") |>
        modify_column_hide(columns = c(stat_1_1,stat_2_1))

#merge tables columnwise        
tbl_merge_cond_site <-
        tbl_merge(
                tbls = list(isopl_obj_tbl, isopl_obj_noaircraft_tbl)
        ) |>
        modify_spanning_header(
                c(stat_1_1_1,stat_2_1_1) ~ "**AMB**"
        ) |>
        modify_spanning_header(
                c(stat_1_2_1,stat_2_2_1) ~ "**AMSS**"
        ) |>
        modify_spanning_header(
                c(stat_1_2_2,stat_2_2_2) ~ "**AMSS (without aircraft flyby)**"
        ) |>
        as_gt()
tbl_merge_cond_site

Characteristic	AMB		AMSS		AMSS (without aircraft flyby)
	GND, N = 24¹	ROOF, N = 24¹	GND, N = 20¹	ROOF, N = 20¹	GND, N = 17¹	ROOF, N = 19¹
L[Aeq]	57.91 (1.46)	63.96 (2.95)	61.04 (7.17)	64.97 (3.38)	58.26 (1.77)	64.25 (1.07)
L[Ceq]	65.60 (1.55)	70.81 (2.54)	70.89 (6.42)	72.30 (3.27)	68.93 (4.39)	71.71 (2.01)
N[95]	9.80 (0.87)	15.03 (1.64)	9.67 (0.31)	15.44 (0.87)	9.66 (0.34)	15.47 (0.88)
ISOPL	0.17 (0.32)	-0.20 (0.37)	0.17 (0.23)	0.09 (0.38)	0.20 (0.23)	0.08 (0.38)
OSQ	0.14 (0.43)	-0.22 (0.47)	0.17 (0.29)	0.03 (0.52)	0.21 (0.28)	0.00 (0.52)
PRSS[Fas]	-0.13 (0.44)	-0.47 (0.44)	-0.11 (0.38)	-0.09 (0.44)	-0.10 (0.40)	-0.10 (0.45)
PRSS[BA]	0.10 (0.60)	-0.21 (0.52)	0.21 (0.38)	0.32 (0.63)	0.25 (0.37)	0.30 (0.64)
PRSS[Com]	-0.38 (0.32)	-0.65 (0.37)	-0.30 (0.24)	-0.36 (0.36)	-0.28 (0.24)	-0.37 (0.37)
¹ Mean (SD)

`Table B.3:` Kendall correlation matrix between all objective acoustic measures and perceptual attributes in the site evaluation questionnaire where the significance of each entry in the upper triangle is denoted with a Holm-adjusted $p$-value and each entry in the lower triangle is denoted with an unadjusted $p$-value. Asterisks indicate $p<0.05$; $p<0.01$; $p<0.001$; ****$p<0.0001$. The unit diagonal has been removed for clarity.

corr_obj<-psych::corr.test(
        comb_obj_insitu_session_data |>
                ungroup() |>
                pivot_wider(
                        names_from = attribute,
                        values_from = score,
                ) |>
                dplyr::select(ISOPL,
                              OSQ,
                              `PRSS[Fas]`,`PRSS[BA]`,`PRSS[Com]`,
                              `L[Aeq]`,`L[Ceq]`,`N[95]`) |>
                dplyr::mutate_all(.funs = as.numeric),
    method = "kendall")

corr_obj_r <- as.data.frame(corr_obj$r) |>
        dplyr::mutate_all(
                .funs = list(~formatC(.,digits = 2,format = "f"))
                ) 

corr_obj_p <- as.data.frame(corr_obj$p) |>
        dplyr::mutate_all(
                .funs=list(~gtools::stars.pval(.))
                )

corr_obj_mat <- matrix(
        paste0(as.matrix(corr_obj_p),as.matrix(corr_obj_r)),
        nrow=nrow(corr_obj_p), 
        dimnames=dimnames(corr_obj_p)
        ) 

#remove diagonal values
diag(corr_obj_mat)=NA

#convert to data frame
corr_obj_mat <- as.data.frame(corr_obj_mat) |>
        `rownames<-`(colnames(corr_obj_p)) 


corr_obj_mat |>
        gt(rownames_to_stub = TRUE) |>
        sub_missing(
            columns = everything(),
            missing_text = ""
            )

	ISOPL	OSQ	PRSS[Fas]	PRSS[BA]	PRSS[Com]	L[Aeq]	L[Ceq]	N[95]
ISOPL		***0.64	**0.40	***0.56	***0.61	-0.22	-0.10	-0.18
OSQ	***0.64		.0.29	***0.49	***0.52	-0.19	-0.09	-0.16
PRSS[Fas]	***0.40	**0.29		***0.59	***0.59	-0.09	-0.07	-0.11
PRSS[BA]	***0.56	***0.49	***0.59		***0.71	-0.05	0.01	-0.05
PRSS[Com]	***0.61	***0.52	***0.59	***0.71		-0.19	-0.12	-0.18
L[Aeq]	*-0.22	.-0.19	-0.09	-0.05	.-0.19		***0.59	***0.68
L[Ceq]	-0.10	-0.09	-0.07	0.01	-0.12	***0.59		***0.47
N[95]	-0.18	-0.16	-0.11	-0.05	.-0.18	***0.68	***0.47

`Figure 4:` Mean perceptual ISOPL, OSQ, PRSS_Fas, PRSS_BA, and PRSS_Com scores across all participants per session (y-axis) as a function of normalized objective L_Aeq, L_Ceq, N₉₅, scores of each session (x-axis). Fifty percent of the sessions lie within the median contours computed for AMB–GND, AMB–ROOF, AMSS–GND, AMSS–ROOF contrast subgroups. The left to right columns represent L_Aeq, L_Ceq, and N₉₅, and each row represents each of the perceptual metrics, respectively.

#plot isopl vs decibel score

#density colors
densityClr<-pals::stevens.pinkgreen()[c(9,5,7,3)]

#ISOPL vs LAeq
isopl_LA_plot <- ggplot(comb_obj_insitu_session_data) +
  facet_wrap(~attribute,
    labeller = label_parsed,
    scales = "free", 
    ncol = 1
  ) +
  # add mean points of each session
  geom_point(aes(y = `L[Aeq]`, x = score, shape = site, color = pair)) +
  # add kde contours
  stat_density_2d(
    bins = 3, contour_var = "ndensity", breaks = c(0.5),
    geom = "density_2d",
    aes(y = `L[Aeq]`, x = score, color = pair)
  ) +
  scale_fill_manual(values = densityClr) +
  scale_color_manual(values = densityClr, name = "subgroup") +
  ylim(c(50, 70)) +
  xlim(c(-1, 1)) +
  geom_vline(
    xintercept = 0,
    color = "darkgrey",
    size = 1
  ) +
  #xlab("ISOPL") +
  ylab(bquote(paste(L[Aeq], ", dB(A)"))) +
  ggpubr::labs_pubr() +
  theme(
    legend.position = "bottom",
    strip.background = element_blank(),
    strip.text.x = element_blank(),
    axis.title.x = element_blank()
  )

isopl_LC_plot <- ggplot(comb_obj_insitu_session_data) +
  # add mean points of each session
  geom_point(aes(y = `L[Ceq]`, x = score, shape = site, color = pair)) +
  facet_wrap(~attribute,
    labeller = label_parsed,
    scales = "free",
    ncol = 1
  ) +
  # add kde contours
  stat_density_2d(
    bins = 3, contour_var = "ndensity", breaks = c(0.5),
    geom = "density_2d",
    aes(y = `L[Ceq]`, x = score, color = pair)
  ) +
  scale_fill_manual(values = densityClr) +
  scale_color_manual(values = densityClr, name = "subgroup") +
  ylim(c(60, 80)) +
  xlim(c(-1, 1)) +
  geom_vline(
    xintercept = 0,
    color = "darkgrey",
    size = 1
  ) +
  ylab(bquote(paste(L[Ceq], ", dB(C)"))) +
  ggpubr::labs_pubr() +
  theme(
    legend.position = "bottom",
    strip.background = element_blank(),
    strip.text.x = element_blank(),
    axis.title.x = element_blank(),
  )

isopl_N95_plot <- ggplot(comb_obj_insitu_session_data) +
  facet_wrap(~attribute,
    labeller = label_parsed,
    scales = "free",
    ncol = 1,
    strip.position = "right"
  ) +
  # add mean points of each session
  geom_point(aes(y = `N[95]`, x = score, shape = site, color = pair)) +
  # add kde contours
  stat_density_2d(
    bins = 3, contour_var = "ndensity", breaks = c(0.5),
    geom = "density_2d",
    aes(y = `N[95]`, x = score, color = pair)
  ) +
  scale_fill_manual(values = densityClr) +
  scale_color_manual(values = densityClr, name = "subgroup") +
  ylim(c(5, 20)) +
  xlim(c(-1, 1)) +
  geom_vline(
    xintercept = 0,
    color = "darkgrey",
    size = 1
  ) +
  ylab(bquote(paste(N[95], ", soneGF"))) +
  ggpubr::labs_pubr() +
  theme(
    legend.position = "bottom",
    axis.title.x = element_blank()
  )

comb_isopl_obj_plot <- ggarrange(
  isopl_LA_plot, 
  isopl_LC_plot,
  isopl_N95_plot,
  common.legend = TRUE, legend = "bottom",
  nrow = 1
)
comb_isopl_obj_plot

Name		Name	Last commit message	Last commit date
Latest commit History 23 Commits
README_files/figure-commonmark		README_files/figure-commonmark
data		data
images		images
output		output
scripts		scripts
.DS_Store		.DS_Store
.gitignore		.gitignore
CITATION.cff		CITATION.cff
LICENSE		LICENSE
README.md		README.md
README.qmd		README.qmd
amss-insitu-replication-github.Rproj		amss-insitu-replication-github.Rproj
fullData.RData		fullData.RData

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Repository files navigation

Replication Code for “Automating Urban Soundscape Enhancements with AI: In-situ Assessment of Quality and Restorativeness in Traffic-Exposed Residential Areas”

Initialisation

Data Loading

2. Method

2.3. Stimuli and automatic masker selection

`Table 2:` Frequency distribution of the maskers chosen by the AMSS during the 10-min listening period across all “AMSS” group participants. Description and availability of the corresponding maskers as detailed by Ooi et al. [48] in the ARAUS dataset.

2.4. Non-acoustic environmental conditions for in-situ validation study

`Table 3`: Summary statistics of environmental parameters captured at ROOF during the 10-min listening period across all participants.

2.5. Participants

`Table 4:` Summary of participant demographics and non-acoustic factors (PSS-10, WNSS, WHO-5, baseline annoyance) across each condition (AMSS and AMB).

3. Results: Site evaluation questionnaire

3.3. Correlation between subjective metrics

3.4. Effect of order, group size and initial conditions

4. Results: Objective binaural measurements

`Table 7:` Summary of mean L_Aeq, L_Ceq, N₉₅, ISOPL, OSQ, PRSS_Fas, PRSS_BA, and PRSS_Com values across 20 AMSS and AMB sessions in each of the GND and RTGP sites. Supplemented mean values for the AMSS sessions excluding aircraft flyby (3 in GND; 1 in ROOF) are included.

About

Releases 2

Packages

Languages

License

ntudsp/amss-insitu-replication

Folders and files

Latest commit

History

Repository files navigation

Replication Code for “Automating Urban Soundscape Enhancements with AI: In-situ Assessment of Quality and Restorativeness in Traffic-Exposed Residential Areas”

Initialisation

Data Loading

2. Method

2.3. Stimuli and automatic masker selection

Table 2: Frequency distribution of the maskers chosen by the AMSS during the 10-min listening period across all “AMSS” group participants. Description and availability of the corresponding maskers as detailed by Ooi et al. [48] in the ARAUS dataset.

2.4. Non-acoustic environmental conditions for in-situ validation study

Table 3: Summary statistics of environmental parameters captured at ROOF during the 10-min listening period across all participants.

2.5. Participants

Table 4: Summary of participant demographics and non-acoustic factors (PSS-10, WNSS, WHO-5, baseline annoyance) across each condition (AMSS and AMB).

3. Results: Site evaluation questionnaire

3.3. Correlation between subjective metrics

3.4. Effect of order, group size and initial conditions

4. Results: Objective binaural measurements

Table 7: Summary of mean LAeq, LCeq, N95, ISOPL, OSQ, PRSSFas, PRSSBA, and PRSSCom values across 20 AMSS and AMB sessions in each of the GND and RTGP sites. Supplemented mean values for the AMSS sessions excluding aircraft flyby (3 in GND; 1 in ROOF) are included.

About

Resources

License

Stars

Watchers

Forks

Releases 2

Packages 0

Languages

`Table 2:` Frequency distribution of the maskers chosen by the AMSS during the 10-min listening period across all “AMSS” group participants. Description and availability of the corresponding maskers as detailed by Ooi et al. [48] in the ARAUS dataset.

`Table 3`: Summary statistics of environmental parameters captured at ROOF during the 10-min listening period across all participants.

`Table 4:` Summary of participant demographics and non-acoustic factors (PSS-10, WNSS, WHO-5, baseline annoyance) across each condition (AMSS and AMB).

`Table 7:` Summary of mean L_Aeq, L_Ceq, N₉₅, ISOPL, OSQ, PRSS_Fas, PRSS_BA, and PRSS_Com values across 20 AMSS and AMB sessions in each of the GND and RTGP sites. Supplemented mean values for the AMSS sessions excluding aircraft flyby (3 in GND; 1 in ROOF) are included.

Packages