Selected Meetings

Simulation of selected Meetings (by Knowledge)

The time is ripe for the next big step! So far, the encounters have been purely random, but this is about to change. A first assumption is that the agents are pure utility maximizers of their prefered knowledge.

Definitions

Loading some Packages for easier Data management and Presentation of Results

library(tidyverse)  

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

# set.seed(1)

Generic Functions

update_Pop

update_Pop <- function(Pop = Pop,
                       name = Parametername,
                       add = 0,
                       fac = 1,
                       set = FALSE) {

  if (set == FALSE & name %in% colnames(Pop)) {
    Pop <- Pop %>%
      mutate( !!name := ( .data[[name]] + add ) * fac )
  } else {
    Pop <- Pop %>%
      mutate( !!name := add * fac )
  }
  return(Pop)
}

sort_Pop

sort_Colnames <- function(Pop = Pop,
                          name = name) {
    cols <- Pop %>%
      select(starts_with(name)) %>%
      colnames()
  
  if (length(cols) == 0) { return(character(0)) }
  return(sort(cols)) 
  }

sort_Pop <- function(Pop = Pop,
                     sort_Par = TRUE,
                     clean_Par = FALSE,
                     sort_Agents = NA){
  if (sort_Par == TRUE) {
    Pop <- Pop %>%
      select(tidyselect::all_of(sort_Colnames(Pop = Pop, name = "ID")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Agents")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Preference")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Learnrate")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Knowledge")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Counter")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Resources")),
             everything())
    }
  if (clean_Par == TRUE) {
    Pop <- Pop %>%
      select(tidyselect::all_of(sort_Colnames(Pop = Pop, name = "ID")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Agents")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Preference")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Learnrate")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Knowledge")),
             tidyselect::all_of(sort_Colnames(Pop = Pop, name = "Counter")))
    }
  if (!is.na(sort_Agents)) {
    Pop <- Pop %>%
      arrange(across(all_of(sort_Agents)))
    }
  return(Pop)
}

update_Typ

get_Typ <- function(Pop = Pop,
                    name = name){
  del_name <- paste0("^", name, "_")
  Typ <- Pop %>%
    select(starts_with(name)) %>%
    colnames() %>%
    str_remove(del_name) 
  return(Typ)
}

update_Typ <- function(Pop = Pop,
                       name = Parametername,
                       Typ = Typ,
                       add = 0,
                       fac = 1,
                       set = FALSE) {
  sep <- "_"
  if (name == "") {sep <- ""}
  
  if (length(Typ) != length(add)) {
    add <- rep(add, length(Typ))
  }
  if (length(Typ) != length(fac)) {
    fac <- rep(fac, length(Typ))
  }
  if (length(Typ) != length(set)) {
    set <- rep(set, length(Typ))
  }
  for (i in seq_along(Typ)) {
    name_i <- paste(name, Typ[[i]], sep = sep)
    Pop <- update_Pop(Pop = Pop, 
                      name = name_i, 
                      add = add[[i]],
                      fac = fac[[i]],
                      set = set[[i]])
    }
  Pop <- sort_Pop(Pop = Pop)
  return(Pop)
}

Transform Population-Matrix

del_tmp <- function(Pop = Pop,
                    name = "tmp_"){
  Pop <- Pop %>%
    select(-starts_with(name))
  return(Pop)
}

longer_Pop <- function(Pop = Pop,
                       name = name){
  syntax_remove <- paste0(name, "_")
  Pop_long <- Pop %>%
  pivot_longer(cols = starts_with(name),
               names_to = "Typ",
               names_prefix = syntax_remove,  
               values_to = name )
  return(Pop_long)
}

wider_Pop <- function(Pop_long = Pop_long,
                      name = name){
  syntax_add <- paste0(name, "_")
  Pop <- Pop_long %>%
    pivot_wider(names_from = Typ,
                values_from = all_of(name),
                names_prefix = syntax_add)
  return(Pop)
}

Calculated Agents Information

update_Learnrate

update_Learnrate <- function(Pop = Pop,
                             sort_Par = TRUE,
                             clean_Par = FALSE,
                             sort_Agents = NA){
  Pop_long <- longer_Pop(Pop = Pop, name = "Knowledge")
  Pop_long <- Pop_long %>%
    group_by(ID) %>%
    mutate(tmp_Rank = rank(Knowledge, ties.method = "random"),
           tmp_Rank = max(tmp_Rank) - tmp_Rank + 1,
           tmp_Rank = 0.5 ^ tmp_Rank,
           tmp_LR = Knowledge * tmp_Rank,
           tmp_LR = max(sum(tmp_LR),1E-3),
           tmp_KxR = max(Knowledge) * sum(tmp_Rank),
           tmp_Profile = (min(tmp_LR / tmp_KxR, 1) - 0.25),
           tmp_Profile = (min(tmp_LR / tmp_KxR, 1) - 0.5) * 2,
           Learnrate_Topic = tmp_LR,
           Learnrate_Others = tmp_LR * tmp_Profile) %>%
    ungroup() 
  Pop_long <- del_tmp(Pop = Pop_long)
  Pop <- wider_Pop(Pop_long = Pop_long, name = "Knowledge")
  Pop <- sort_Pop(Pop = Pop,
                  sort_Par = sort_Par,
                  clean_Par = clean_Par,
                  sort_Agents = sort_Agents)
  return(Pop)
}

update_Topic

update_Topic <- function(Pop = Pop,
                                sort_Par = TRUE,
                                clean_Par = FALSE,
                                sort_Agents = NA){
  Typs <- get_Typ(Pop = Pop, name = "Knowledge")
  Pop_long <- longer_Pop(Pop = Pop, name = "Knowledge")
  Pop_long <- Pop_long %>%
    group_by(ID) %>%
    mutate(tmp_Rank = rank(Knowledge, ties.method = "random"),
           tmp_Rank = max(tmp_Rank) - tmp_Rank + 1,
           tmp_Rank = 0.5 ^ tmp_Rank,
           Agents_Topic = case_when(
             Preference %in% Typs ~ Preference,
             Preference == "All" ~ Typ[which.min(tmp_Rank)],
             TRUE ~ Typ[which.max(Knowledge)])) %>%
    ungroup() 
  Pop_long <- del_tmp(Pop = Pop_long)
  Pop <- wider_Pop(Pop_long = Pop_long, name = "Knowledge")
  Pop <- sort_Pop(Pop = Pop,
                  sort_Par = sort_Par,
                  clean_Par = clean_Par,
                  sort_Agents = sort_Agents)
  return(Pop)
}

Generate grouped Population

gen_Pop <- function(addToPop = NULL,
                    nA = NumberOfAgents,
                    Preference = "Max",
                    ID_University = ID_University,
                    K = Knowledge,
                    Typ = SpezKnowledge,
                    pWD = percentsWorkingaDay,
                    pMD = percentsMeetingsaDay){
  ID <- seq_len(nA)
  Pop <- tibble(ID = ID,
                ID_University = ID_University,
                Preference = Preference)
  Pop <- update_Typ(Pop = Pop, 
                    name = "Agents", 
                    Typ = list("p_WorkDay", "p_MeetDay"),
                    add = list(pWD, pMD),
                    set = TRUE)
  Pop <- update_Typ(Pop = Pop, 
                    name = "Knowledge", 
                    Typ = Typ, 
                    add = K,
                    set = TRUE)

  if (!is.null(addToPop)) {
    Pop <- Pop %>%
      mutate(ID = ID + max(addToPop$ID))
    Typ_add <- get_Typ(Pop = addToPop, name = "Knowledge")
    Pop <- update_Typ(Pop = Pop, 
                      name = "Knowledge", 
                      Typ = Typ_add, 
                      add = 0)
    addToPop <- update_Typ(Pop = addToPop, 
                           name = "Knowledge", 
                           Typ = Typ, 
                           add = 0)
    Pop <- bind_rows(addToPop,Pop)
    }
  Pop <- update_Learnrate(Pop = Pop)
  Pop <- update_Topic(Pop = Pop)
  Pop <- sort_Pop(Pop = Pop)
  return(Pop)
  }

Pop <- gen_Pop( nA = 3, 
                Preference = "Max",
                ID_University = "Zürich",
                K = list(0.01, 0.2), 
                Typ = list("M1", "M2"), 
                pWD = 0.5,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 2, 
                Preference = "All",
                ID_University = "Bern",
                K = list(0.01, 0.2), 
                Typ = list("M3", "M2"), 
                pWD = 0.2,
                pMD = 0.5)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                Preference = "M3",
                ID_University = "Bern",
                K = list(0.8), 
                Typ = list("M1"), 
                pWD = 0.2,
                pMD = 0.5)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                Preference = "M1",
                ID_University = "Bern",
                K = list(0.3, 0.3, 0.3), 
                Typ = list("M1", "M2", "M3"), 
                pWD = 0.2,
                pMD = 0.5)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1,
                ID_University = "Bern",
                K = list(0.0, 0.0, 0.0), 
                Typ = list("M1", "M2", "M3"), 
                pWD = 0.2,
                pMD = 0.5)
Pop

# A tibble: 8 × 11
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M2           Max       
2     2 Zürich                     0.8              0.5 M2           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M1           All       
5     5 Bern                       0.5              0.2 M1           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 5 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>

Simulation parameter

reset_Counter

reset_Counter <- function(Pop = Pop){
  Pop <- update_Typ(Pop = Pop,
                    name = "Counter",
                    Typ = list("Day", 
                               "Time_total",
                               "Time_meet",
                               "Time_learnd",
                               "Number_meet"),
                    add = 0,
                    set = TRUE)
  return(Pop)
}

update_Resources

update_Resources <- function(Pop = Pop,
                             time_day = hoursDay,
                             set = TRUE){
  tmp_Time <- time_day * Pop[["Agents_p_WorkDay"]]
  tmp_p <- Pop[["Agents_p_MeetDay"]]
  Pop <- update_Typ(Pop = Pop,
                  name = "Resources",
                  Typ = list("Time_total",
                             "Time_meet",
                             "Time_learnd"),
                  add = list(tmp_Time,
                             tmp_Time * tmp_p,
                             tmp_Time * (1-tmp_p)),
                  set = set)
  return(Pop)
}

Pop <- reset_Counter(Pop = Pop)
Pop <- update_Resources(Pop = Pop, time_day = 8)
Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M2           Max       
2     2 Zürich                     0.8              0.5 M2           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M1           All       
5     5 Bern                       0.5              0.2 M1           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Meetings

Functions to select and reintegrate a Sub Populations

Select a Sub Population (random)

sel_SubPop <- function(Pop = Pop,
                       IDs = NULL,
                       n = 2) {
  if (is.null(IDs)) {
    IDs <- sample( Pop[["ID"]], size=n )
    }
  SubPop <- list()
  SubPop$sel <- Pop %>%
    filter(ID %in% IDs) %>%
    arrange(match(ID, IDs))
  SubPop$rest <- Pop %>%
    filter(!ID %in% IDs)
  return(SubPop)
}

SubPop <- sel_SubPop( Pop = Pop , IDs = c(2, 1))
SubPop$sel

# A tibble: 2 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     2 Zürich                     0.8              0.5 M2           Max       
2     1 Zürich                     0.8              0.5 M2           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

SubPop$rest

# A tibble: 6 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     3 Zürich                     0.8              0.5 M2           Max       
2     4 Bern                       0.5              0.2 M1           All       
3     5 Bern                       0.5              0.2 M1           All       
4     6 Bern                       0.5              0.2 M3           M3        
5     7 Bern                       0.5              0.2 M1           M1        
6     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Integrate Sub Population

int_SubPop <- function(SubPop = SubPop,
                       Pop = Pop) {
  col_sort <- colnames(Pop)
  SubPop <- SubPop[, col_sort]
  IDs <- SubPop[["ID"]]
  Pop[Pop$ID %in% IDs,] <- SubPop
  Pop <- Pop %>%
    arrange(ID)
  return(Pop)
}

Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M2           Max       
2     2 Zürich                     0.8              0.5 M2           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M1           All       
5     5 Bern                       0.5              0.2 M1           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

SubPop <- sel_SubPop(Pop = Pop, IDs = c(2, 1) )$sel
SubPop <- update_Pop(Pop = SubPop,
                     name = "Knowledge_M2",
                     add = 0,
                     set = TRUE)
Pop <- int_SubPop(SubPop = SubPop, Pop = Pop)
Pop <- update_Learnrate(Pop = Pop)
Pop <- update_Topic(Pop = Pop)
Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M1           Max       
2     2 Zürich                     0.8              0.5 M1           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M1           All       
5     5 Bern                       0.5              0.2 M1           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Select a random Slot of pairs

sel_Pairs_rnd <- function(Pop = Pop,
                          psize = percentsOfPop) {      
  psize <- min(psize, 1)   
  nR <- nrow(Pop)   
  n <- round(nR * psize * 0.4999, 0)   
  n <- max(n, 1)      
  SubPop <- sel_SubPop( Pop = Pop, n = n)      
  Slot1 <- SubPop$sel %>%          
    mutate(tmp_ID = seq_len(n))   
  if (nrow(SubPop$rest) == n) {     
    Slot2 <- SubPop$rest   
  } else {     
      SubPop <- sel_SubPop( Pop = SubPop$rest, n = n)      
      Slot2 <- SubPop$sel   
  }   
  Slot2 <- Slot2 %>%          
    mutate(tmp_ID = seq_len(n))   
  Pairs <- bind_rows(Slot1, Slot2)   
  return(Pairs)     
  }  

Pairs <- sel_Pairs_rnd(Pop = Pop, psize = 0.5) 
Pairs 

# A tibble: 4 × 20
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     2 Zürich                     0.8              0.5 M1           Max       
2     3 Zürich                     0.8              0.5 M2           Max       
3     8 Bern                       0.5              0.2 M1           Max       
4     5 Bern                       0.5              0.2 M1           All       
# ℹ 14 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>, tmp_ID <int>

Select a Slot of pairs by utility

calc_utility <- function(Pop = Pop) { 
  Typs <- get_Typ(Pop = Pop, name = "Knowledge")
  Pop_Utility <- Pop %>%
    select(starts_with("ID"),
           starts_with("Agents_Topic"),
           starts_with("Learnrate"),
           starts_with("Knowledge"))
  Pop_Utility <- longer_Pop(Pop =  Pop_Utility, name = "Knowledge") %>%
    rename(Utility = Knowledge) %>%
    mutate(Utility = ifelse(
      Typ == Agents_Topic, 
      Learnrate_Topic, 
      0.5 * Learnrate_Others)) 
  Pop_Utility <- wider_Pop(Pop =  Pop_Utility, name = "Utility") %>%
    select("ID", starts_with("Utility"))
  
  Pop_Utility <- Pop_Utility[sample(nrow(Pop_Utility)), ]
  
  return(Pop_Utility)     
} 

calc_utility(Pop = Pop)

# A tibble: 8 × 4
     ID Utility_M1 Utility_M2 Utility_M3
  <int>      <dbl>      <dbl>      <dbl>
1     4    0.103     0.00879    0.00879 
2     1    0.005     0.000357   0.000357
3     7    0.262     0.131      0.131   
4     6    0.0286    0.0286     0.4     
5     3    0.00879   0.103      0.00879 
6     8    0.001     0.0005     0.0005  
7     5    0.103     0.00879    0.00879 
8     2    0.005     0.000357   0.000357

sel_Pairs_utility <- function(Pop = Pop,
                              psize = percentsOfPop) {      
  psize <- min(psize, 1)   
  nR <- nrow(Pop)   
  n <- round(nR * psize * 0.4999, 0)   
  n <- max(n, 1)      
  SubPop <- sel_SubPop( Pop = Pop, n = n)      
  Slot1 <- SubPop$sel %>%          
    mutate(tmp_ID = seq_len(n)) 
  
  Utility <- calc_utility(Pop = SubPop$rest)
  IDs <- as.vector(0)
  
  for (i in seq_len(nrow(Slot1))) {
    Topic <- Slot1$Agents_Topic[i]
    lookup <- paste("Utility",Topic, sep = "_")
    max_row <- which.max(Utility[[lookup]])
    ID_sel <- Utility$ID[max_row]
    Utility <- Utility %>% filter(ID != ID_sel)
    IDs[i] <- ID_sel
  }
  
  SubPop <- sel_SubPop( Pop = Pop, IDs = IDs)      
  Slot2 <- SubPop$sel %>% 
    mutate(tmp_ID = seq_len(n))   
  Pairs <- bind_rows(Slot1, Slot2)   
  return(Pairs)     
  }  

sel_Pairs_utility(Pop = Pop, psize = 1)

# A tibble: 8 × 20
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     5 Bern                       0.5              0.2 M1           All       
2     2 Zürich                     0.8              0.5 M1           Max       
3     4 Bern                       0.5              0.2 M1           All       
4     1 Zürich                     0.8              0.5 M1           Max       
5     7 Bern                       0.5              0.2 M1           M1        
6     6 Bern                       0.5              0.2 M3           M3        
7     3 Zürich                     0.8              0.5 M2           Max       
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 14 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>, tmp_ID <int>

Learning

Learning with a exponential lernrate

… by Pairs

learn_Pairs <- function(Pairs = Pairs,
                        time_meet = time_meet) {
  Pop_long <- longer_Pop(Pop = Pairs, name = "Knowledge")
  Pop_long <- Pop_long %>%
    mutate(tmp_Learnrate = ifelse(
      Typ == Agents_Topic, 
      Learnrate_Topic, 
      Learnrate_Others)) %>%
  group_by(tmp_ID) %>%
    mutate(tmp_facT = ifelse(
      Typ == Agents_Topic, 1, 0)) %>%
  group_by(tmp_ID, Typ) %>%
    mutate(tmp_facT = mean(tmp_facT ),
           tmp_Learnrate = mean(tmp_Learnrate)) %>%
  group_by(ID) %>%
    mutate(tmp_time_learn = tmp_facT * time_meet,
           tmp_Time0 = ( 1 - Knowledge )^( 1 / -tmp_Learnrate ),
           Knowledge = 1 - ( tmp_Time0 + tmp_time_learn)^( -tmp_Learnrate )) %>%
    ungroup()
  
  Pop_long <- del_tmp(Pop = Pop_long)
  Pairs <- wider_Pop(Pop_long = Pop_long, name = "Knowledge")
  Pairs <- sort_Pop(Pop = Pairs)
  
  Pairs <- update_Typ(Pop = Pairs,
                      name = "Counter",
                      Typ = list("Time_total",
                                 "Time_meet", 
                                 "Number_meet"),
                      add = list(time_meet,
                                 time_meet,
                                 1))
  Pairs <- update_Typ(Pop = Pairs,
                      name = "Resources",
                      Typ = list("Time_total","Time_meet"),
                      add = list(-time_meet))
  return(Pairs)
}

Pairs <- learn_Pairs(Pairs = Pairs, time_meet = 0.75)
Pop <- int_SubPop(SubPop = Pairs, Pop = Pop)
Pop <- update_Learnrate(Pop = Pop)
Pop <- update_Topic(Pop = Pop)
Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M1           Max       
2     2 Zürich                     0.8              0.5 M1           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M1           All       
5     5 Bern                       0.5              0.2 M3           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

… by it Own

learn <- function(Pop = Pop,                   
                  con = TRUE) {   
  if (con == TRUE){     
    tmp_Learnrate <- Pop[["Learnrate_Topic"]]
    Pop <- update_Learnrate(Pop = Pop)     
    Pop <- update_Topic(Pop = Pop) 
    Pop <- update_Pop(Pop = Pop,
                      name = "Learnrate_Topic",
                      add = tmp_Learnrate, 
                      fac = 0.5)
    tmp_Time <- Pop[["Resources_Time_meet"]]
    Pop <- update_Typ(Pop = Pop, 
                      name = "Resources_Time",
                      Typ = list("meet", "learnd"),
                      add = list(-tmp_Time, tmp_Time))
  } 
  
  Pop_long <- longer_Pop(Pop = Pop, name = "Knowledge") 
  Pop_long <- Pop_long %>%     
    group_by(ID) %>%     
    mutate(tmp_Time_learnd = ifelse(
      Typ == Agents_Topic, 
      Resources_Time_learnd, 
      0)) %>%  
    mutate(tmp_Learnrate = Learnrate_Topic,            
           tmp_Time0 = ( 1 - Knowledge )^( 1 / -tmp_Learnrate ),
           tmp_Time1 = tmp_Time0 + tmp_Time_learnd,
           Knowledge = 1 - ( tmp_Time1 )^( -tmp_Learnrate )) %>%
    ungroup()   
  
  Pop_long <- del_tmp(Pop = Pop_long)
  Pop <- wider_Pop(Pop_long = Pop_long, name = "Knowledge") 
  Pop <- sort_Pop(Pop = Pop)
  
  tmp_Time <- Pop[["Resources_Time_learnd"]]
  Pop <- update_Typ(Pop = Pop,
                    name = "Counter",
                    Typ = list("Time_total", "Time_learnd"),
                    add = list(tmp_Time))
  Pop <- update_Typ(Pop = Pop,
                    name = "Resources",
                    Typ = list("Time_total", "Time_learnd"),
                    add = list(-tmp_Time))
  Pop <- update_Learnrate(Pop = Pop)     
  Pop <- update_Topic(Pop = Pop)
  
  return(Pop) 
  }

Pop <- learn(Pop = Pop, con = TRUE) 
Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M1           Max       
2     2 Zürich                     0.8              0.5 M1           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M3           All       
5     5 Bern                       0.5              0.2 M1           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

… by Days

learn_Day <- function(Pop = Pop,
                      time_day = time_day,
                      time_meet = time_meet) { 
if (!any(startsWith(names(Pop), "Counter_"))) {
  Pop <- reset_Counter(Pop = Pop)
  }
Pop <- update_Resources(Pop = Pop, time_day = time_day)

nR_Pop <- nrow(Pop)
psize <- max(Pop[["Agents_p_MeetDay"]]) * 1.1
iD <- round(time_day / time_meet, digits = 0)

for(i in 1:iD) {
  Par <- Pop %>%
    select(Resources_Time_meet) %>%
    mutate(Break = ifelse(
      Resources_Time_meet >= time_meet, 
      1,
      0))
  ParBreak <- sum(Par$Break)
  if (ParBreak < 2) { break }
   
  Pop_Res <- Pop[Pop$Resources_Time_meet >= time_meet, ]
  
  nR_Pop_Res <- nrow(Pop_Res)
  psize_i <- psize / nR_Pop_Res * nR_Pop
  
  Pairs <- sel_Pairs_utility(Pop = Pop_Res, psize = psize_i)
  Pairs <- learn_Pairs(Pairs = Pairs, time_meet = time_meet)
  
  Pop <- int_SubPop(SubPop = Pairs, Pop = Pop)
} 
Pop <- learn(Pop = Pop, con = TRUE)

return(Pop) 
}

Pop <- reset_Counter(Pop = Pop)
Pop <- learn_Day(Pop = Pop, time_day = 8, time_meet = 0.75)
Pop

# A tibble: 8 × 19
     ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
  <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
1     1 Zürich                     0.8              0.5 M2           Max       
2     2 Zürich                     0.8              0.5 M1           Max       
3     3 Zürich                     0.8              0.5 M2           Max       
4     4 Bern                       0.5              0.2 M3           All       
5     5 Bern                       0.5              0.2 M3           All       
6     6 Bern                       0.5              0.2 M3           M3        
7     7 Bern                       0.5              0.2 M1           M1        
8     8 Bern                       0.5              0.2 M1           Max       
# ℹ 13 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Knowledge_M3 <dbl>,
#   Counter_Day <dbl>, Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Visualization

Get Agents-Timelines

get_Timeline <- function(TL = Timeline,                          
                         Pop = Pop) {   
  TLadd <- sort_Pop(Pop = Pop, clean_Par = TRUE)
  Time <- unique(Pop[["Counter_Day"]])
  if (Time == 0) {
    TL <- TLadd 
  } else {
    TL <- bind_rows(TL, TLadd)   
  }
  return(TL)  
}

Timelineplots

plt_Learnrate

plt_Learnrate <- function(TL = Timeline,
                          Group = NA) { 
  Grouping <- c("Counter_Day", "Typ")
  Data <- longer_Pop(Pop = TL, name = "Learnrate")
  
  if (Group %in% colnames(Data)) {
    Grouping <- c(Grouping, Group)
    Data <- Data %>%
      group_by(across(all_of(Grouping))) %>%
      summarise(Learnrate = mean(Learnrate, na.rm = TRUE), .groups = "drop") %>%
      mutate( plt_Typ = interaction(Typ, .data[[Group]], sep = "_"),
              !!Group := factor(.data[[Group]]))
  } else {
    Data <- Data %>%
      group_by(across(all_of(Grouping))) %>%
      summarise(Learnrate = mean(Learnrate, na.rm = TRUE), .groups = "drop") %>%
      mutate( plt_Typ = Typ)
  }
    
  Data$Typ <- factor(Data$Typ, levels = c("Topic", "Others"))
  
  plt <- ggplot(data = Data, 
                aes(x = Counter_Day, y = Learnrate, group = plt_Typ)) +
    geom_line(aes(linetype = Typ), linewidth = 1) +
    scale_linetype_manual(values = c("Topic" = "solid", 
                                     "Others" = "dashed")) +
    ggtitle("Mean Learnrate over Days") +     
    xlab("Number of Days") +     
    scale_x_continuous(
      limits = c(0, max(Data$Counter_Day, na.rm = TRUE))) +
    scale_y_continuous(
      limits = c(0, 1), 
      breaks = seq(0, 1, 0.2)) + 
    guides(linetype = guide_legend(title = ""))+
    theme_minimal() +
    theme(legend.position = "top",
          legend.justification = "left")
  
  if (Group %in% colnames(Data)) {
    del_prefix <- "^[^_]*_"
    plt <- plt +
      aes(color = .data[[Group]]) +
      guides(color = guide_legend(title = str_remove(Group,del_prefix), 
                                  position = "right" ),
             override.aes = list(linewidth = 1,
                                 alpha = 1))
    }
  
  return(plt)
}

plt_Knowledge

plt_Knowledge <- function(TL = Timeline) {  
   
  TL <- longer_Pop(Pop = TL, name = "Knowledge") %>%     
    group_by(Counter_Day, Typ) %>%  
    summarise(Knowledge = mean(Knowledge, na.rm = TRUE), .groups = "drop") %>%
    mutate(TopicColor = case_when(
      grepl("M1", Typ) ~ "blue",  
      grepl("M2", Typ) ~ "green",  
      grepl("M3", Typ) ~ "red",  
      TRUE ~ "lightgray")
      )
  ggplot(TL, aes(x = Counter_Day, y = Knowledge, group = Typ, color = Typ)) +
    geom_line(linewidth = 1) +
    scale_color_manual(values = unique(TL$TopicColor)) + 
    ggtitle("Mean Knowledge over Days") +     
    xlab("Number of Days") +     
    scale_x_continuous(
      limits = c(0, max(TL$Counter_Day, na.rm = TRUE)), 
      expand = expansion(mult = c(0, 0)) ) +
    scale_y_continuous(
      limits = c(0, 1), 
      breaks = seq(0, 1, 0.2)) + 
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )

}

plt_Topics

plt_Topics <- function(TL = Timeline) {   
  TL <- TL %>%
    group_by(Counter_Day, Agents_Topic) %>%
    summarise(Frequency = n(), .groups = "drop") %>%
    mutate(TopicColor = case_when(
      grepl("M1", Agents_Topic) ~ "blue",  
      grepl("M2", Agents_Topic) ~ "green",  
      grepl("M3", Agents_Topic) ~ "red",  
      TRUE ~ "lightgray")
      )
  
  TL$Time <- factor(TL$Counter_Day, levels = unique(TL$Counter_Day))
  
  ggplot(TL, aes(x = Time, y = Frequency, fill = Agents_Topic)) +
    geom_bar(stat = "identity", 
             position = "stack",
             width = 0.8) +
    scale_fill_manual(values = unique(TL$TopicColor)) +
    ggtitle("Agent's Topic over Days") +     
    xlab("Number of Days") +
    scale_x_discrete(
      expand = expansion(mult = c(0, 0))) +
    theme_minimal() +
    theme(legend.title = element_blank(),       
          legend.position = "top",       
          legend.justification = "left")
}

Timepointplots

Number of Meetings

plt_Number_meet <- function(TL = Timeline,
                            TP = NA,
                            Group = Group) {
  if (is.na(TP)) {
    TP <- unique(TL$Counter_Day)
  } 
  Titel <- paste("Number of Meetings until Day", TP)
  Data <- TL %>%
    filter(Counter_Day == TP)
  
  if (Group %in% colnames(Data)) {
    Data <- Data %>%
      mutate( !!Group := factor(.data[[Group]])) %>%
      group_by(.data[[Group]]) %>%
      mutate(plt_ID = seq_len(n())) %>% 
      ungroup()
    del_prefix <- "^[^_]*_"
    Titel <- paste(Titel,"- grouped by", str_remove(Group,del_prefix))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ,
              plt_ID = ID )
  }
  
  plt <- ggplot(Data, 
                aes(x = plt_ID, y = Counter_Number_meet)) +
    geom_step(direction = "mid",linewidth = 1) +
    scale_x_continuous( 
      breaks = function(limits) { scales::breaks_pretty()(limits)},
      labels = scales::number_format(accuracy = 1)) +
    scale_y_continuous(limits = c(0,max(Data$Counter_Number_meet))) +
    ggtitle(Titel) +     
    xlab("Agents") +     
    ylab("Frequency") +
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )
  
  if (Group %in% colnames(Data)) {
    plt <- plt + facet_grid(. ~ .data[[Group]], scales = "free_x")
  }
  
  return(plt)
  }

Time invested

plt_Time_invest <- function(TL = Timeline,
                            TP = NA,
                            Group = NA) {
  if (is.na(TP)) {
    TP <- unique(TL$Counter_Day)
  }
  Titel <- paste("Time invested until Day", TP)
  Data <- longer_Pop(Pop = TL, name = "Counter_Time") %>%
    filter(Counter_Day == TP)
  
  Grouping <- c("Typ")
  
  if (Group %in% colnames(Data)) {
    Grouping <- c(Grouping, Group)
    Data <- Data %>%
      mutate( plt_Typ = interaction(Typ, .data[[Group]], sep = "_"),
              !!Group := factor(.data[[Group]])) %>%
      group_by(plt_Typ) %>%
      mutate(plt_ID = seq_len(n())) %>% 
      ungroup()
    del_prefix <- "^[^_]*_"
    Titel <- paste(Titel,"- grouped by", str_remove(Group,del_prefix))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ,
              plt_ID = ID )
  }
    
  Data$Typ <- factor(Data$Typ, levels = c("meet", "learnd", "total"))

  plt <- ggplot(Data, 
                aes(x = plt_ID, y = Counter_Time, 
                    group = plt_Typ,
                    linewidth = Typ)) +
    
    geom_step(direction = "mid") +
    scale_linewidth_manual(values = c("total" = 1.5, 
                                      "learnd" = 0.5, 
                                      "meet" = 1.0)) +
    scale_x_continuous( 
      breaks = function(limits) { scales::breaks_pretty()(limits)},
      labels = scales::number_format(accuracy = 1)) +
    scale_y_continuous(limits = c(0,max(Data$Counter_Time))) +
    ggtitle(Titel) +     
    xlab("Agents") +     
    ylab("Hours") +
    guides(linewidth = guide_legend(title = ""))+
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )
  
  if (Group %in% colnames(Data)) {
    plt <- plt + facet_grid(. ~ .data[[Group]], scales = "free_x")
  }
  
  return(plt)
  }

Learnrate at Timepoint

plt_Learnrate_Time <- function(TL = Timeline,
                                TP = NA,
                                Group = NA) {
  if (is.na(TP)) {
    TP <- unique(TL$Counter_Day)
  }
  Titel <- paste("Learnrate at Day", TP)
  Data <- longer_Pop(Pop = TL, name = "Learnrate") %>%
    filter(Counter_Day == TP)
  
  Grouping <- c("Typ")
  
  if (Group %in% colnames(Data)) {
    Grouping <- c(Grouping, Group)
    Data <- Data %>%
      mutate( plt_Typ = interaction(Typ, .data[[Group]], sep = "_"),
              !!Group := factor(.data[[Group]])) %>%
      group_by(plt_Typ) %>%
      mutate(plt_ID = seq_len(n())) %>% 
      ungroup()
    del_prefix <- "^[^_]*_"
    Titel <- paste(Titel,"- grouped by", str_remove(Group,del_prefix))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ,
              plt_ID = ID)
  }
  
  Data$Typ <- factor(Data$Typ, levels = c("Topic", "Others"))
  
  plt <- ggplot(data = Data, 
                aes(x = plt_ID, 
                    y = Learnrate, 
                    group = plt_Typ,
                    linewidth = Typ)) +
    geom_step(direction = "mid") +
    scale_linewidth_manual(values = c("Topic" = 1.0, 
                                      "Others" = 0.8)) +
    scale_x_continuous( 
      breaks = function(limits) { scales::breaks_pretty()(limits)},
      labels = scales::number_format(accuracy = 1)) +
    scale_y_continuous(limits = c(0, 1)) +
    ggtitle(Titel) +     
    xlab("Agents") +     
    ylab("Learnrate") +
    guides(linewidth = guide_legend(title = ""))+
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )
  
  if (Group %in% colnames(Data)) {
    plt <- plt + facet_grid(. ~ .data[[Group]], scales = "free_x")
  }
  return(plt)
}

Knowledge at Timepoint

plt_Knowledge_Time <- function(TL = Timeline, 
                               TP = NA,
                               Group = NA) {
  if (is.na(TP)) {
    TP <- unique(TL$Counter_Day)
  }
  Titel <- paste("Knowledge at Day", TP)
  Data <- longer_Pop(Pop = TL, name = "Knowledge") %>%
    filter(Counter_Day == TP)
  
  Grouping <- c("Typ")
  
  if (Group %in% colnames(Data)) {
    Grouping <- c(Grouping, Group)
    Data <- Data %>%
      mutate( plt_Typ = interaction(Typ, .data[[Group]], sep = "_"),
              !!Group := factor(.data[[Group]])) %>%
      group_by(plt_Typ) %>%
      mutate(plt_ID = seq_len(n())) %>% 
      ungroup()
    del_prefix <- "^[^_]*_"
    Titel <- paste(Titel,"- grouped by", str_remove(Group,del_prefix))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ,
              plt_ID = ID)
  }
  
  plt <- ggplot(Data, 
                aes(x = plt_ID, y = Knowledge, group = Typ, color = Typ)) +
    geom_step(direction = "mid", linewidth = 1) +
    scale_x_continuous( 
      breaks = function(limits) { scales::breaks_pretty()(limits)},
      labels = scales::number_format(accuracy = 1)) +
    scale_y_continuous(limits = c(0, 1)) +
    ggtitle(Titel) +     
    xlab("Agents") +     
    ylab("Knowledge") +
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )
  
  if (Group %in% colnames(Data)) {
    plt <- plt + facet_grid(. ~ .data[[Group]], scales = "free_x")
  }
  return(plt)
}

Simulation

Function

A learning process with updated learn rate by current knowledge when Agents meet selective Agents with higher Knowledge

sim_Days <- function(Pop = Pop,
                     nD = nubmberDay,
                     time_day = 8,
                     time_meet = 0.75) {
  Pop <- update_Learnrate(Pop = Pop)
  Pop <- update_Topic(Pop = Pop)
  Pop <- reset_Counter( Pop = Pop)
  Pop <- update_Resources( Pop = Pop, time_day = time_day)
  TL <- get_Timeline(TL = TL, Pop = Pop)
  for(i in 1:nD) {
    Pop <- learn_Day(Pop = Pop,
                     time_day = time_day,
                     time_meet = time_meet)
    Pop <- update_Typ(Pop = Pop,
                      name = "Counter",
                      Typ = list("Day"),
                      add = list(i),
                      set = TRUE)
    TL <- get_Timeline(TL = TL, Pop = Pop)
  }
    
  Output <- list( Pop = Pop,
                  TL = TL)
  return(Output)
}

Definition & Calculation

Pop <- gen_Pop( nA = 30, 
                Preference = "M1",
                ID_University = "Zürich",
                K = list(0.01), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 30,
                Preference = "All",
                ID_University = "Bern",
                K = list(0.01), 
                Typ = list("M2"), 
                pWD = 0.8,
                pMD = 0.8)

Pop

# A tibble: 60 × 10
      ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
   <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
 1     1 Zürich                     0.8              0.8 M1           M1        
 2     2 Zürich                     0.8              0.8 M1           M1        
 3     3 Zürich                     0.8              0.8 M1           M1        
 4     4 Zürich                     0.8              0.8 M1           M1        
 5     5 Zürich                     0.8              0.8 M1           M1        
 6     6 Zürich                     0.8              0.8 M1           M1        
 7     7 Zürich                     0.8              0.8 M1           M1        
 8     8 Zürich                     0.8              0.8 M1           M1        
 9     9 Zürich                     0.8              0.8 M1           M1        
10    10 Zürich                     0.8              0.8 M1           M1        
# ℹ 50 more rows
# ℹ 4 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>

res <- sim_Days(Pop = Pop, nD = 20)

res$Pop

# A tibble: 60 × 18
      ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
   <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
 1     1 Zürich                     0.8              0.8 M1           M1        
 2     2 Zürich                     0.8              0.8 M1           M1        
 3     3 Zürich                     0.8              0.8 M1           M1        
 4     4 Zürich                     0.8              0.8 M1           M1        
 5     5 Zürich                     0.8              0.8 M1           M1        
 6     6 Zürich                     0.8              0.8 M1           M1        
 7     7 Zürich                     0.8              0.8 M1           M1        
 8     8 Zürich                     0.8              0.8 M1           M1        
 9     9 Zürich                     0.8              0.8 M1           M1        
10    10 Zürich                     0.8              0.8 M1           M1        
# ℹ 50 more rows
# ℹ 12 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Counter_Day <dbl>,
#   Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Visualization Results

plt_Topics(TL = res$TL)

plt_Knowledge(TL = res$TL)

plt_Learnrate(TL = res$TL)

plt_Learnrate(TL = res$TL, Group = "ID_University")

plt_Learnrate(TL = res$TL, Group = "Preference")

plt_Number_meet(TL = res$TL, TP = 1, Group = "ID_University")

plt_Number_meet(TL = res$TL, TP = 20, Group = "ID_University")

plt_Time_invest(TL = res$TL, TP = 20, Group = "ID_University")

plt_Learnrate_Time(TL = res$TL, TP = 20, Group = "ID_University")

plt_Knowledge_Time(TL = res$TL, TP = 20, Group = "ID_University")

Special Cases

Only one Agent with Knowledge (0.8)

Pop <- gen_Pop( nA = 10, 
                Preference = "M1",
                ID_University = "Zürich",
                K = list(0.01), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 10, 
                Preference = "All",
                ID_University = "Zürich",
                K = list(0.01), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 9, 
                ID_University = "Zürich",
                K = list(0.01), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_University = "Zürich",
                K = list(0.8), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 10, 
                Preference = "M2",
                ID_University = "Bern",
                K = list(0.01), 
                Typ = list("M2"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 10, 
                Preference = "All",
                ID_University = "Bern",
                K = list(0.01), 
                Typ = list("M2"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 9, 
                ID_University = "Bern",
                K = list(0.01), 
                Typ = list("M2"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_University = "Bern",
                K = list(0.4), 
                Typ = list("M2"), 
                pWD = 0.8,
                pMD = 0.8)

Pop

# A tibble: 60 × 10
      ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
   <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
 1     1 Zürich                     0.8              0.8 M1           M1        
 2     2 Zürich                     0.8              0.8 M1           M1        
 3     3 Zürich                     0.8              0.8 M1           M1        
 4     4 Zürich                     0.8              0.8 M1           M1        
 5     5 Zürich                     0.8              0.8 M1           M1        
 6     6 Zürich                     0.8              0.8 M1           M1        
 7     7 Zürich                     0.8              0.8 M1           M1        
 8     8 Zürich                     0.8              0.8 M1           M1        
 9     9 Zürich                     0.8              0.8 M1           M1        
10    10 Zürich                     0.8              0.8 M1           M1        
# ℹ 50 more rows
# ℹ 4 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>

res1 <- sim_Days(Pop = Pop, nD = 20)

res1$Pop

# A tibble: 60 × 18
      ID ID_University Agents_p_MeetDay Agents_p_WorkDay Agents_Topic Preference
   <int> <chr>                    <dbl>            <dbl> <chr>        <chr>     
 1     1 Zürich                     0.8              0.8 M1           M1        
 2     2 Zürich                     0.8              0.8 M1           M1        
 3     3 Zürich                     0.8              0.8 M1           M1        
 4     4 Zürich                     0.8              0.8 M1           M1        
 5     5 Zürich                     0.8              0.8 M1           M1        
 6     6 Zürich                     0.8              0.8 M1           M1        
 7     7 Zürich                     0.8              0.8 M1           M1        
 8     8 Zürich                     0.8              0.8 M1           M1        
 9     9 Zürich                     0.8              0.8 M1           M1        
10    10 Zürich                     0.8              0.8 M1           M1        
# ℹ 50 more rows
# ℹ 12 more variables: Learnrate_Others <dbl>, Learnrate_Topic <dbl>,
#   Knowledge_M1 <dbl>, Knowledge_M2 <dbl>, Counter_Day <dbl>,
#   Counter_Number_meet <dbl>, Counter_Time_learnd <dbl>,
#   Counter_Time_meet <dbl>, Counter_Time_total <dbl>,
#   Resources_Time_learnd <dbl>, Resources_Time_meet <dbl>,
#   Resources_Time_total <dbl>

Visualization Results

plt_Topics(TL = res1$TL)

plt_Knowledge(TL = res1$TL)

plt_Learnrate(TL = res1$TL)

plt_Learnrate(TL = res1$TL, Group = "ID_University")

plt_Learnrate(TL = res1$TL, Group = "Preference")

plt_Number_meet(TL = res1$TL, TP = 20, Group = "ID_University")

plt_Time_invest(TL = res1$TL, TP = 20, Group = "ID_University")

plt_Learnrate_Time(TL = res1$TL, TP = 20, Group = "ID_University")

plt_Learnrate_Time(TL = res1$TL, TP = 6, Group = "Preference")

plt_Learnrate_Time(TL = res1$TL, TP = 10, Group = "Preference")

plt_Learnrate_Time(TL = res1$TL, TP = 20, Group = "Preference")

plt_Knowledge_Time(TL = res1$TL, TP = 20, Group = "ID_University")

plt_Knowledge_Time(TL = res1$TL, TP = 6, Group = "Preference")

plt_Knowledge_Time(TL = res1$TL, TP = 10, Group = "Preference")

plt_Knowledge_Time(TL = res1$TL, TP = 20, Group = "Preference")