Master Thesis:
  • Proposal
  • Concepts
  • Sketchbooks

On this page

  • Definitions
  • Visualisation

Exampels

Author

Hubert Bächli

Published

11.02.2026

Definitions

set.seed(1)
fea_m_n <- c("L", "M", "H")
fea_m_v <- c(0.35, 0.5, 0.65)
fea_m_v
[1] 0.35 0.50 0.65
cog_m_n <- c("L", "M", "H")
cog_m_v <- c(0.35, 0.5, 0.65)
cog_m_v
[1] 0.35 0.50 0.65
sen_v_n <- c("L", "M", "H")
sen_m <- 0.15
sen_v <- c(0.05, 0.0, -0.05)
sen_v
[1]  0.05  0.00 -0.05
n_exp_n <- c("050", "150", "250")
n_exp_v <- c(50, 150, 250)
n_exp_v
[1]  50 150 250
types <- expand.grid(
  n_exp_n = n_exp_n,
  fea_m_n = fea_m_n,
  cog_m_n = cog_m_n,
  sen_v_n = sen_v_n,
  stringsAsFactors = FALSE
)

types$ID <- apply(types, 1, paste0, collapse = "_")
types$n <- n_exp_v[match(types$n_exp_n, n_exp_n)]
types$fea_m <- fea_m_v[match(types$fea_m_n, fea_m_n)]
types$fea_sd <- sen_m
types$fea_sd <- types$fea_sd + sen_v[match(types$sen_v_n, sen_v_n)]
types$cog_m <- cog_m_v[match(types$cog_m_n, cog_m_n)]
types$cog_sd <- sen_m
types$cog_sd <- types$cog_sd - sen_v[match(types$sen_v_n, sen_v_n)]
types <- types[, !grepl("_n$", names(types))]

types$ID <- factor(types$ID, levels = unique(types$ID))
types$n <- as.integer(types$n)

head(types)
         ID   n fea_m fea_sd cog_m cog_sd
1 050_L_L_L  50  0.35    0.2  0.35    0.1
2 150_L_L_L 150  0.35    0.2  0.35    0.1
3 250_L_L_L 250  0.35    0.2  0.35    0.1
4 050_M_L_L  50  0.50    0.2  0.35    0.1
5 150_M_L_L 150  0.50    0.2  0.35    0.1
6 250_M_L_L 250  0.50    0.2  0.35    0.1
create_rnd_exa <- function(types, blur = NULL, eps = 1e-6) {                                                                
    reps <- as.integer(types$n)
    len <- sum(reps)
    
    df <- data.frame(
        ID = rep(types$ID,   times = reps),
        p = 0,
        fea_m = rep(types$fea_m,  times = reps),
        fea_sd = rep(types$fea_sd, times = reps),
        cog_m = rep(types$cog_m,  times = reps),
        cog_sd = rep(types$cog_sd, times = reps),
        fea = 0,
        cog = 0
      )
    
    df$fea <- rbeta_msd(n = len, m = df$fea_m, sd = df$fea_sd, eps = eps)
    df$p   <- pbeta_msd(q = df$fea, m = df$fea_m, sd = df$fea_sd, eps = eps)
    df$cog <- qbeta_msd(p = df$p,   m = df$cog_m, sd = df$cog_sd, eps = eps)

    if (!is.null(blur) && length(blur) == 1) {
        df$fea <- df$fea + runif(len, min = -blur, max = blur)
        df$cog <- df$cog + runif(len, min = -blur, max = blur)
        
        df$fea <- pmin(pmax(df$fea, 0), 1)
        df$cog <- pmin(pmax(df$cog, 0), 1)
    }
    
    df[, c("ID", "fea", "cog")]
}

exampels <- create_rnd_exa(types, blur = 0.02)

head(exampels)
         ID       fea       cog
1 050_L_L_L 0.2206815 0.2880768
2 050_L_L_L 0.3863547 0.3830593
3 050_L_L_L 0.1511579 0.2820009
4 050_L_L_L 0.4368182 0.3962253
5 050_L_L_L 0.1906481 0.2660567
6 050_L_L_L 0.5009487 0.4102112
dir.create(here("Concepts"), showWarnings = FALSE)
saveRDS(exampels, here("Concepts", "exampels.rds"))

exampels <- readRDS(here("Concepts", "exampels.rds"))

Visualisation

plot_exampels_lm(exampels, 
                 c("150_L_H_M", "150_M_H_M", "150_H_H_M",
                   "150_L_M_M", "150_M_M_M", "150_H_M_M",
                   "150_L_L_M", "150_M_L_M", "150_H_L_M"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Feature Expression and Cognitive Reaction",
                 save = "dif_cog_int_fea_exp_cog_rea")
Saving 8 x 9.5 in image

plot_exampels_lm(exampels, 
                 c("150_M_M_L", "150_M_M_M", "150_M_M_H"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Interpretative Sensitivity (Slopes)",
                 save = "dif_cog_int_sen")
Saving 8 x 4 in image

plot_exampels_lm(exampels, 
                 c("050_M_M_M", "150_M_M_M", "250_M_M_M"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Accumulated Experience",
                 save = "dif_cog_int_nexp")
Saving 8 x 4 in image

← Back

Back to top
Source Code
---
title: "Exampels"
author: "Hubert Bächli"
date: last-modified
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(here)
library(tidyverse)

source(here("Concepts","Ext_beta.r"))
source(here("Concepts","Plots.r"))
```

## Definitions

```{r}
set.seed(1)
```

```{r}
fea_m_n <- c("L", "M", "H")
fea_m_v <- c(0.35, 0.5, 0.65)
fea_m_v
```

```{r}
cog_m_n <- c("L", "M", "H")
cog_m_v <- c(0.35, 0.5, 0.65)
cog_m_v
```

```{r}
sen_v_n <- c("L", "M", "H")
sen_m <- 0.15
sen_v <- c(0.05, 0.0, -0.05)
sen_v
```

```{r}
n_exp_n <- c("050", "150", "250")
n_exp_v <- c(50, 150, 250)
n_exp_v
```

```{r}
types <- expand.grid(
  n_exp_n = n_exp_n,
  fea_m_n = fea_m_n,
  cog_m_n = cog_m_n,
  sen_v_n = sen_v_n,
  stringsAsFactors = FALSE
)

types$ID <- apply(types, 1, paste0, collapse = "_")
types$n <- n_exp_v[match(types$n_exp_n, n_exp_n)]
types$fea_m <- fea_m_v[match(types$fea_m_n, fea_m_n)]
types$fea_sd <- sen_m
types$fea_sd <- types$fea_sd + sen_v[match(types$sen_v_n, sen_v_n)]
types$cog_m <- cog_m_v[match(types$cog_m_n, cog_m_n)]
types$cog_sd <- sen_m
types$cog_sd <- types$cog_sd - sen_v[match(types$sen_v_n, sen_v_n)]
types <- types[, !grepl("_n$", names(types))]

types$ID <- factor(types$ID, levels = unique(types$ID))
types$n <- as.integer(types$n)

head(types)
```

```{r}
create_rnd_exa <- function(types, blur = NULL, eps = 1e-6) {                                                                
    reps <- as.integer(types$n)
    len <- sum(reps)
    
    df <- data.frame(
        ID = rep(types$ID,   times = reps),
        p = 0,
        fea_m = rep(types$fea_m,  times = reps),
        fea_sd = rep(types$fea_sd, times = reps),
        cog_m = rep(types$cog_m,  times = reps),
        cog_sd = rep(types$cog_sd, times = reps),
        fea = 0,
        cog = 0
      )
    
    df$fea <- rbeta_msd(n = len, m = df$fea_m, sd = df$fea_sd, eps = eps)
    df$p   <- pbeta_msd(q = df$fea, m = df$fea_m, sd = df$fea_sd, eps = eps)
    df$cog <- qbeta_msd(p = df$p,   m = df$cog_m, sd = df$cog_sd, eps = eps)

    if (!is.null(blur) && length(blur) == 1) {
        df$fea <- df$fea + runif(len, min = -blur, max = blur)
        df$cog <- df$cog + runif(len, min = -blur, max = blur)
        
        df$fea <- pmin(pmax(df$fea, 0), 1)
        df$cog <- pmin(pmax(df$cog, 0), 1)
    }
    
    df[, c("ID", "fea", "cog")]
}

exampels <- create_rnd_exa(types, blur = 0.02)

head(exampels)
```

```{r}
dir.create(here("Concepts"), showWarnings = FALSE)
saveRDS(exampels, here("Concepts", "exampels.rds"))

exampels <- readRDS(here("Concepts", "exampels.rds"))
```

## Visualisation

```{r, fig.width=8, fig.height=9.5}
plot_exampels_lm(exampels, 
                 c("150_L_H_M", "150_M_H_M", "150_H_H_M",
                   "150_L_M_M", "150_M_M_M", "150_H_M_M",
                   "150_L_L_M", "150_M_L_M", "150_H_L_M"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Feature Expression and Cognitive Reaction",
                 save = "dif_cog_int_fea_exp_cog_rea")
```

```{r, fig.width=8, fig.height=4}
plot_exampels_lm(exampels, 
                 c("150_M_M_L", "150_M_M_M", "150_M_M_H"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Interpretative Sensitivity (Slopes)",
                 save = "dif_cog_int_sen")
```

```{r, fig.width=8, fig.height=4}
plot_exampels_lm(exampels, 
                 c("050_M_M_M", "150_M_M_M", "250_M_M_M"),
                 title = "Differences in Cognitive Interpretation\nAcross Levels of Accumulated Experience",
                 save = "dif_cog_int_nexp")
```

::: {.content-visible when-format="html"}
<a href="javascript:history.back()">← Back</a>
:::