Areas of Knowledge

Author

Hubert Baechli

Simulating random meetings (Areas of Knowledge)

The basic idea is that when two agents meet, they learn together. Later, this should happen in a network. In the beginning, I will let the agents meet randomly in the population to see if the implementation of joint learning works.

If it works as it should, it will be expanded so that a certain percentage of the population meets at the same time.

Now it seems to be time to add other aspects. At first it seems central that different areas of knowledge should be possible.

Definitions

Loading some Packages for easier Data management and Presentation of Results

Code

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

Code

# set.seed(1)

Generic Functions

update_Pop

Code

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

Code

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

Code

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 = "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 = "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

Code

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

Code

update_Typ <- function(Pop = Pop,
                       name = Parametername,
                       Typ = Typ,
                       add = 0,
                       fac = 1,
                       set = FALSE) {
  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 = "_")
    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

Code

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

Code

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)
}

Code

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

Code

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.5) * 2,
           Agents_Knowledge_Max = max(Knowledge),
           Agents_Knowledge_Profile = tmp_Profile,
           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

Code

update_Topic <- 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,
           ID_Topic = Typ[which.max(tmp_Rank)]) %>%
    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

Code

gen_Pop <- function(addToPop = NULL,
                    nA = NumberOfAgents,
                    ID_Group = ID_Group,
                    K = Knowledge,
                    Typ = SpezKnowledge,
                    pWD = percentsWorkingaDay,
                    pMD = percentsMeetingsaDay){
  ID <- seq_len(nA)
  Pop <- tibble(ID = ID,
                ID_Group = ID_Group)
  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)
  }

Code

Pop <- gen_Pop( nA = 3, 
                ID_Group = "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, 
                ID_Group = "Bern",
                K = list(0.01, 0.2), 
                Typ = list("M3", "M1"), 
                pWD = 0.2,
                pMD = 0.5)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_Group = "Bern",
                K = list(0.8), 
                Typ = list("M1"), 
                pWD = 0.2,
                pMD = 0.5)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_Group = "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_Group = "Bern",
                K = list(0.0, 0.0, 0.0), 
                Typ = list("M1", "M2", "M3"), 
                pWD = 0.2,
                pMD = 0.5)
Pop

# A tibble: 8 × 12
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M2                        0.2                    0.171
2     2 Zürich   M2                        0.2                    0.171
3     3 Zürich   M2                        0.2                    0.171
4     4 Bern     M1                        0.2                    0.171
5     5 Bern     M1                        0.2                    0.171
6     6 Bern     M1                        0.8                    0.143
7     7 Bern     M2                        0.3                    1    
8     8 Bern     M2                        0                      1    
# ℹ 7 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   Learnrate_Others <dbl>, Learnrate_Topic <dbl>, Knowledge_M1 <dbl>,
#   Knowledge_M2 <dbl>, Knowledge_M3 <dbl>

Simulation parameter

reset_Counter

Code

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

Code

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)
}

Code

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

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M2                        0.2                    0.171
2     2 Zürich   M2                        0.2                    0.171
3     3 Zürich   M2                        0.2                    0.171
4     4 Bern     M1                        0.2                    0.171
5     5 Bern     M1                        0.2                    0.171
6     6 Bern     M1                        0.8                    0.143
7     7 Bern     M2                        0.3                    1    
8     8 Bern     M2                        0                      1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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)

Code

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)
}

Code

SubPop <- sel_SubPop( Pop = Pop )
SubPop$sel

# A tibble: 2 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M2                        0.2                    0.171
2     7 Bern     M2                        0.3                    1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

SubPop$rest

# A tibble: 6 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     2 Zürich   M2                        0.2                    0.171
2     3 Zürich   M2                        0.2                    0.171
3     4 Bern     M1                        0.2                    0.171
4     5 Bern     M1                        0.2                    0.171
5     6 Bern     M1                        0.8                    0.143
6     8 Bern     M2                        0                      1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 2 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     2 Zürich   M2                        0.2                    0.171
2     1 Zürich   M2                        0.2                    0.171
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

SubPop$rest

# A tibble: 6 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     3 Zürich   M2                        0.2                    0.171
2     4 Bern     M1                        0.2                    0.171
3     5 Bern     M1                        0.2                    0.171
4     6 Bern     M1                        0.8                    0.143
5     7 Bern     M2                        0.3                    1    
6     8 Bern     M2                        0                      1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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)
}

Code

Pop

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M2                        0.2                    0.171
2     2 Zürich   M2                        0.2                    0.171
3     3 Zürich   M2                        0.2                    0.171
4     4 Bern     M1                        0.2                    0.171
5     5 Bern     M1                        0.2                    0.171
6     6 Bern     M1                        0.8                    0.143
7     7 Bern     M2                        0.3                    1    
8     8 Bern     M2                        0                      1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                       0.01                    0.143
2     2 Zürich   M1                       0.01                    0.143
3     3 Zürich   M2                       0.2                     0.171
4     4 Bern     M1                       0.2                     0.171
5     5 Bern     M1                       0.2                     0.171
6     6 Bern     M1                       0.8                     0.143
7     7 Bern     M1                       0.3                     1    
8     8 Bern     M3                       0                       1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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)     
  }

Code

Pop

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                       0.01                    0.143
2     2 Zürich   M1                       0.01                    0.143
3     3 Zürich   M2                       0.2                     0.171
4     4 Bern     M1                       0.2                     0.171
5     5 Bern     M1                       0.2                     0.171
6     6 Bern     M1                       0.8                     0.143
7     7 Bern     M1                       0.3                     1    
8     8 Bern     M3                       0                       1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 4 × 21
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     7 Bern     M1                        0.3                    1    
2     6 Bern     M1                        0.8                    0.143
3     5 Bern     M1                        0.2                    0.171
4     3 Zürich   M2                        0.2                    0.171
# ℹ 16 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 2 × 21
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     6 Bern     M1                        0.8                    0.143
2     3 Zürich   M2                        0.2                    0.171
# ℹ 16 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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 == ID_Topic, 
      Learnrate_Topic, 
      Learnrate_Others)) %>%
  group_by(tmp_ID) %>%
    mutate(tmp_facT = ifelse(
      Typ == ID_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)
}

Code

Pairs

# A tibble: 2 × 21
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     6 Bern     M1                        0.8                    0.143
2     3 Zürich   M2                        0.2                    0.171
# ℹ 16 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

PairsT <- learn_Pairs(Pairs = Pairs, time_meet = 0.75)
PairsT

# A tibble: 2 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     6 Bern     M1                        0.8                    0.143
2     3 Zürich   M2                        0.2                    0.171
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

Pop <- int_SubPop(SubPop = PairsT, Pop = Pop)
Pop <- update_Learnrate(Pop = Pop)
Pop <- update_Topic(Pop = Pop)
Pop

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                      0.01                     0.143
2     2 Zürich   M1                      0.01                     0.143
3     3 Zürich   M2                      0.201                    0.345
4     4 Bern     M1                      0.2                      0.171
5     5 Bern     M1                      0.2                      0.171
6     6 Bern     M1                      0.800                    0.161
7     7 Bern     M3                      0.3                      1    
8     8 Bern     M2                      0                        1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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 == ID_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) 
  }

Code

Pop

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                      0.01                     0.143
2     2 Zürich   M1                      0.01                     0.143
3     3 Zürich   M2                      0.201                    0.345
4     4 Bern     M1                      0.2                      0.171
5     5 Bern     M1                      0.2                      0.171
6     6 Bern     M1                      0.800                    0.161
7     7 Bern     M3                      0.3                      1    
8     8 Bern     M2                      0                        1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                   0.0105                      0.143
2     2 Zürich   M1                   0.0105                      0.143
3     3 Zürich   M2                   0.212                       0.335
4     4 Bern     M1                   0.207                       0.170
5     5 Bern     M1                   0.207                       0.170
6     6 Bern     M1                   0.801                       0.161
7     7 Bern     M3                   0.334                       0.914
8     8 Bern     M2                   0.000588                    1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                   0.0124                      0.143
2     2 Zürich   M1                   0.0124                      0.143
3     3 Zürich   M2                   0.241                       0.311
4     4 Bern     M1                   0.214                       0.170
5     5 Bern     M1                   0.214                       0.170
6     6 Bern     M1                   0.801                       0.161
7     7 Bern     M3                   0.365                       0.848
8     8 Bern     M2                   0.000955                    1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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 <- median(Pop[["Agents_p_MeetDay"]])
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_rnd(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) 
}

Code

Pop <- reset_Counter(Pop = Pop)
Pop

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                   0.0124                      0.143
2     2 Zürich   M1                   0.0124                      0.143
3     3 Zürich   M2                   0.241                       0.311
4     4 Bern     M1                   0.214                       0.170
5     5 Bern     M1                   0.214                       0.170
6     6 Bern     M1                   0.801                       0.161
7     7 Bern     M3                   0.365                       0.848
8     8 Bern     M2                   0.000955                    1    
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Code

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

# A tibble: 8 × 20
     ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
  <int> <chr>    <chr>                   <dbl>                    <dbl>
1     1 Zürich   M1                     0.0419                    0.442
2     2 Zürich   M2                     0.0394                    0.459
3     3 Zürich   M2                     0.265                     0.299
4     4 Bern     M1                     0.223                     0.169
5     5 Bern     M1                     0.222                     0.173
6     6 Bern     M1                     0.803                     0.191
7     7 Bern     M3                     0.399                     0.826
8     8 Bern     M1                     0.0176                    0.267
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

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)  
}

Code

Timeline <- get_Timeline(TL = Timeline,                          
                         Pop = Pop) 
Pop1 <- update_Pop(Pop = Pop,
                   name = "Counter_Day",
                   add = 1)
Timeline <- get_Timeline(TL = Timeline,                          
                         Pop = Pop1) 
Timeline

# A tibble: 16 × 17
      ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
   <int> <chr>    <chr>                   <dbl>                    <dbl>
 1     1 Zürich   M1                     0.0419                    0.442
 2     2 Zürich   M2                     0.0394                    0.459
 3     3 Zürich   M2                     0.265                     0.299
 4     4 Bern     M1                     0.223                     0.169
 5     5 Bern     M1                     0.222                     0.173
 6     6 Bern     M1                     0.803                     0.191
 7     7 Bern     M3                     0.399                     0.826
 8     8 Bern     M1                     0.0176                    0.267
 9     1 Zürich   M1                     0.0419                    0.442
10     2 Zürich   M2                     0.0394                    0.459
11     3 Zürich   M2                     0.265                     0.299
12     4 Bern     M1                     0.223                     0.169
13     5 Bern     M1                     0.222                     0.173
14     6 Bern     M1                     0.803                     0.191
15     7 Bern     M3                     0.399                     0.826
16     8 Bern     M1                     0.0176                    0.267
# ℹ 12 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>

Timelineplots

plt_Learnrate

Code

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("Timeline - Mean Learnrate") +     
    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)) {
    str_remove(Group,"^ID_")
    plt <- plt +
      aes(color = .data[[Group]]) +
      guides(color = guide_legend(title = str_remove(Group,"^ID_"), 
                                  position = "right" ),
             override.aes = list(linewidth = 1,
                                 alpha = 1))
    }
  
  return(plt)
}

plt_Knowledge

Code

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("Timeline - Mean Knowledge") +     
    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

Code

plt_Topics <- function(TL = Timeline) {   
  TL <- TL %>%
    group_by(Counter_Day, ID_Topic) %>%
    summarise(Frequency = n(), .groups = "drop") %>%
    mutate(TopicColor = case_when(
      grepl("M1", ID_Topic) ~ "blue",  
      grepl("M2", ID_Topic) ~ "green",  
      grepl("M3", ID_Topic) ~ "red",  
      TRUE ~ "lightgray")
      )
  
  TL$Time <- factor(TL$Counter_Day, levels = unique(TL$Counter_Day))
  
  ggplot(TL, aes(x = Time, y = Frequency, fill = ID_Topic)) +
    geom_bar(stat = "identity", 
             position = "stack",
             width = 0.8) +
    scale_fill_manual(values = unique(TL$TopicColor)) +
    ggtitle("Timeline - Agent's Topic") +     
    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

Code

plt_Number_meet <- function(TL = Timeline,
                            TP = NA,
                            Group = Group) {
  if (is.na(TP)) {
    TP <- unique(TL$Counter_Day)
  } 
  Titel <- paste("Number of Meetings - Day", TP)
  Data <- TL %>%
    filter(Counter_Day == TP)
  
  if (Group %in% colnames(Data)) {
    Data <- Data %>%
      mutate( !!Group := factor(.data[[Group]]))
  } else {
    Group <- "without"
    Data <- Data %>%
      mutate( !!Group := "Population")
  }
  
  plt <- ggplot(Data, 
                aes(x = ID, y = Counter_Number_meet, color = .data[[Group]])) +
    geom_step(direction = "mid",linewidth = 1) +
    scale_x_continuous(limits = c(1,max(Data$ID))) +
    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"
    )
  
  return(plt)
  }

Time_invested

Code

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]]))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ)
  }
    
  Data$Typ <- factor(Data$Typ, levels = c("meet", "learnd", "total"))

  plt <- ggplot(Data, 
                aes(x = ID, y = Counter_Time, 
                    group = plt_Typ, 
                    alpha = Typ,
                    linewidth = Typ)) +
    
    geom_step(direction = "mid") +
    scale_alpha_manual(values = c("total" = 0.4, 
                                  "learnd" = 0.6, 
                                  "meet" = 1.0)) +
    scale_linewidth_manual(values = c("total" = 1.5, 
                                      "learnd" = 0.5, 
                                      "meet" = 1.0)) +
    scale_x_continuous(limits = c(1,max(Data$ID))) +
    scale_y_continuous(limits = c(0,max(Data$Counter_Time))) +
    ggtitle(Titel) +     
    xlab("Agents") +     
    ylab("Hours") +
    guides(alpha = "none",
           linewidth = guide_legend(title = ""))+
    theme_minimal() +
    theme(
      legend.title = element_blank(),       
      legend.position = "top",       
      legend.justification = "left"
    )
  
  if (Group %in% colnames(Data)) {
    str_remove(Group,"^ID_")
    plt <- plt +
      aes(color = .data[[Group]]) +
      guides(color = guide_legend(title = str_remove(Group,"^ID_"), 
                                  position = "right" ),
             override.aes = list(linewidth = 1,
                                 alpha = 1))
    }
  
  return(plt)
  }

Learnrate at Timepoint

Code

plt_Learnrate_Timet <- 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]]))
  } else {
    Data <- Data %>%
      mutate( plt_Typ = Typ)
  }
  
  Data$Typ <- factor(Data$Typ, levels = c("Topic", "Others"))
  
  plt <- ggplot(data = Data, 
                aes(x = 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(limits = c(min(Data$ID), max(Data$ID))) +
    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)) {
    str_remove(Group,"^ID_")
    plt <- plt +
      aes(color = .data[[Group]]) +
      guides(color = guide_legend(title = str_remove(Group,"^ID_"), 
                                  position = "right" ),
             override.aes = list(linewidth = 1,
                                 alpha = 1))
    }

  return(plt)
}

Knowledge at Timepoint

Code

plt_Knowledge_Time <- function(TL = Timeline, 
                               TP = 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)
  
  plt <- ggplot(Data, 
                aes(x = ID, y = Knowledge, group = Typ, color = Typ)) +
    geom_step(direction = "mid", linewidth = 1) +
    scale_x_continuous(limits = c(min(Data$ID), max(Data$ID))) +
    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"
    )
  
  return(plt)
}

Simulation

Function

A learning process with updated learn rate by current knowledge when Agents meet randomly by Days

Code

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

Code

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

Pop

# A tibble: 60 × 11
      ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
   <int> <chr>    <chr>                   <dbl>                    <dbl>
 1     1 Zürich   M1                       0.01                    0.333
 2     2 Zürich   M1                       0.01                    0.333
 3     3 Zürich   M1                       0.01                    0.333
 4     4 Zürich   M1                       0.01                    0.333
 5     5 Zürich   M1                       0.01                    0.333
 6     6 Zürich   M1                       0.01                    0.333
 7     7 Zürich   M1                       0.01                    0.333
 8     8 Zürich   M1                       0.01                    0.333
 9     9 Zürich   M1                       0.01                    0.333
10    10 Zürich   M1                       0.01                    0.333
# ℹ 50 more rows
# ℹ 6 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   Learnrate_Others <dbl>, Learnrate_Topic <dbl>, Knowledge_M1 <dbl>,
#   Knowledge_M2 <dbl>

Code

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

res$Pop

# A tibble: 60 × 19
      ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
   <int> <chr>    <chr>                   <dbl>                    <dbl>
 1     1 Zürich   M1                      0.698                    0.614
 2     2 Zürich   M1                      0.709                    0.592
 3     3 Zürich   M1                      0.704                    0.559
 4     4 Zürich   M1                      0.701                    0.638
 5     5 Zürich   M1                      0.703                    0.628
 6     6 Zürich   M1                      0.703                    0.589
 7     7 Zürich   M1                      0.704                    0.584
 8     8 Zürich   M1                      0.698                    0.628
 9     9 Zürich   M1                      0.700                    0.579
10    10 Zürich   M1                      0.708                    0.560
# ℹ 50 more rows
# ℹ 14 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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

Code

plt_Topics(TL = res$TL)

Code

plt_Knowledge(TL = res$TL)

Code

plt_Learnrate(TL = res$TL)

Code

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

Code

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

Code

plt_Number_meet(TL = res$TL, TP = 10, Group = "ID_Group")

Code

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

Code

plt_Time_invest(TL = res$TL, TP = 10)

Code

plt_Learnrate_Timet(TL = res$TL, TP = 20, Group = "ID_Group")

Code

plt_Learnrate_Timet(TL = res$TL, TP = 10)

Code

plt_Knowledge_Time(TL = res$TL, TP = 10)

Special Cases

Only one Agent with Knowledge (0.8)

Code

Pop <- gen_Pop( nA = 29, 
                ID_Group = "Zürich",
                K = list(0.01), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_Group = "Zürich",
                K = list(0.8), 
                Typ = list("M1"), 
                pWD = 0.8,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 29, 
                ID_Group = "Bern",
                K = list(0.01), 
                Typ = list("M2"), 
                pWD = 0.4,
                pMD = 0.8)
Pop <- gen_Pop( addToPop = Pop,
                nA = 1, 
                ID_Group = "Bern",
                K = list(0.8), 
                Typ = list("M2"), 
                pWD = 0.4,
                pMD = 0.4)
Pop <- gen_Pop( addToPop = Pop,
                nA = 30, 
                ID_Group = "Basel",
                K = list(0.01), 
                Typ = list("M3"), 
                pWD = 0.8,
                pMD = 0.4)

Pop

# A tibble: 90 × 12
      ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
   <int> <chr>    <chr>                   <dbl>                    <dbl>
 1     1 Zürich   M1                       0.01                    0.143
 2     2 Zürich   M1                       0.01                    0.143
 3     3 Zürich   M1                       0.01                    0.143
 4     4 Zürich   M1                       0.01                    0.143
 5     5 Zürich   M1                       0.01                    0.143
 6     6 Zürich   M1                       0.01                    0.143
 7     7 Zürich   M1                       0.01                    0.143
 8     8 Zürich   M1                       0.01                    0.143
 9     9 Zürich   M1                       0.01                    0.143
10    10 Zürich   M1                       0.01                    0.143
# ℹ 80 more rows
# ℹ 7 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   Learnrate_Others <dbl>, Learnrate_Topic <dbl>, Knowledge_M1 <dbl>,
#   Knowledge_M2 <dbl>, Knowledge_M3 <dbl>

Code

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

res1$Pop

# A tibble: 90 × 20
      ID ID_Group ID_Topic Agents_Knowledge_Max Agents_Knowledge_Profile
   <int> <chr>    <chr>                   <dbl>                    <dbl>
 1     1 Zürich   M1                      0.809                    0.473
 2     2 Zürich   M1                      0.808                    0.328
 3     3 Zürich   M1                      0.815                    0.503
 4     4 Zürich   M1                      0.810                    0.439
 5     5 Zürich   M1                      0.808                    0.405
 6     6 Zürich   M1                      0.805                    0.413
 7     7 Zürich   M1                      0.795                    0.352
 8     8 Zürich   M1                      0.821                    0.497
 9     9 Zürich   M1                      0.803                    0.481
10    10 Zürich   M1                      0.799                    0.291
# ℹ 80 more rows
# ℹ 15 more variables: Agents_p_MeetDay <dbl>, Agents_p_WorkDay <dbl>,
#   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>, …

Visualization Results

Code

plt_Topics(TL = res1$TL)

Code

plt_Knowledge(TL = res1$TL)

Code

plt_Learnrate(TL = res1$TL)

Code

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

Code

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

Code

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

Code

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

Code

plt_Learnrate_Timet(TL = res1$TL, TP = 20, Group = "ID_Group")

Code

plt_Knowledge_Time(TL = res1$TL, TP = 20)