Author

Hubert Baechli

Simulating random meetings (in a Day Structure)

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.

A daily structure with a certain number of working hours is introduced to enable better interpretation of the results.

Definitions

Loading some Packages for easier Data management and Presentation of Results

Code 
── 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)

Population for testing the Functions

Code
nA = 10            # number of Agents
ID = seq_len(nA)  # ID of the Agents

Pop <- tibble( ID = ID )
Pop
# A tibble: 10 × 1
      ID
   <int>
 1     1
 2     2
 3     3
 4     4
 5     5
 6     6
 7     7
 8     8
 9     9
10    10

Functions

Knowledge

Functions to set and update Knowledge

Set Knowledge

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A value for the Knowledge (K) between 0 and 1. could be a scalar or e vector with the same length as the Population

  3. optional for future implementations a name (Typ) for the specific Knowledge

Code
set_Knowledge <- function(Pop = Pop,
                          Typ = FALSE,
                          K = Knowledge) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  Pop <- Pop %>%
    mutate(!!Kname := K)

  return(Pop)
}

Output

  1. Population with the defined Knowledge
Code
K <- seq_len(nA)/5

Pop <- set_Knowledge( Pop = Pop, K = 0.5 )
Pop <- set_Knowledge( Pop = Pop, Typ = "A", K = K )
Pop
# A tibble: 10 × 3
      ID Knowledge Knowledge_A
   <int>     <dbl>       <dbl>
 1     1       0.5         0.2
 2     2       0.5         0.4
 3     3       0.5         0.6
 4     4       0.5         0.8
 5     5       0.5         1  
 6     6       0.5         1.2
 7     7       0.5         1.4
 8     8       0.5         1.6
 9     9       0.5         1.8
10    10       0.5         2

Update Knowledge

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A value to add to the Knowledge. could be a scalar or e vector with the same length as the Population. if not defined 0 is used to add

  3. A value to multiplie (fac) the Knowledge. could be a scalar or e vector with the same length as the Population. if not defined 1 is used for the multiplikation

  4. optional for future implementations a name (Typ) for the specific Knowledge

Hints

  • The add operation is always used first!

  • If the Knowledge is not defined before it will be generated with the start value (add) and the multiplication with the value (fac)

Code
update_Knowledge <- function(Pop = Pop,
                            Typ = FALSE,
                            add = 0,
                            fac = 1) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  if (Kname %in% colnames(Pop)) {
    Pop <- Pop %>%
      mutate( !!Kname := ( .data[[Kname]] + add ) * fac )
  } else {
    Pop <- set_Knowledge(Pop = Pop, K = add, Typ = Typ)
    Pop <- Pop %>%
      mutate( !!Kname := .data[[Kname]] * fac )
  }
  return(Pop)
}

Output

  1. Population with the defined Knowledge
Code
add <- seq_len(nA)/20
fac <- seq_len(nA)/10 

Pop <- update_Knowledge( Pop = Pop, add = add ) 
Pop <- update_Knowledge( Pop = Pop, Typ = "A", fac = fac ) 
Pop <- update_Knowledge( Pop = Pop, Typ = "B", add = add, fac = fac ) 
Pop
# A tibble: 10 × 4
      ID Knowledge Knowledge_A Knowledge_B
   <int>     <dbl>       <dbl>       <dbl>
 1     1      0.55        0.02       0.005
 2     2      0.6         0.08       0.02 
 3     3      0.65        0.18       0.045
 4     4      0.7         0.32       0.08 
 5     5      0.75        0.5        0.125
 6     6      0.8         0.72       0.18 
 7     7      0.85        0.98       0.245
 8     8      0.9         1.28       0.32 
 9     9      0.95        1.62       0.405
10    10      1           2          0.5

LearnRate

Functions to set and update the learn rate

Set LearnRate

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A value for the learn rate (LR) greater than 0 and up to 1. could be a scalar or e vector with the same length as the Population

Hints

  • LernRate 0 leads to Problems so it ist limited it to 1E-3
Code
set_LearnRate <- function(Pop = Pop,
                          LR = LearnRate) {
  LRname <- "LearnRate"
  Pop <- Pop %>%
    mutate(!!LRname := LR,
           !!LRname := pmax(.data[[LRname]],1E-3))
  return(Pop)
}

Output

  1. Population with the defined learn rate
Code
LR <- seq_len(nA)/5  
Pop <- set_LearnRate( Pop = Pop, LR = 0 ) 
Pop
# A tibble: 10 × 5
      ID Knowledge Knowledge_A Knowledge_B LearnRate
   <int>     <dbl>       <dbl>       <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.001
 2     2      0.6         0.08       0.02      0.001
 3     3      0.65        0.18       0.045     0.001
 4     4      0.7         0.32       0.08      0.001
 5     5      0.75        0.5        0.125     0.001
 6     6      0.8         0.72       0.18      0.001
 7     7      0.85        0.98       0.245     0.001
 8     8      0.9         1.28       0.32      0.001
 9     9      0.95        1.62       0.405     0.001
10    10      1           2          0.5       0.001

Update LearnRate by Knowledge

Needs

  1. A Population (Pop) with several Agents defined by ID’s and Knowledge

  2. optional for future implementations a name (Typ) for the specific Knowledge

Hints

  • The learn rate is defined as 50% of the Knowledge for each Agent
Code
update_LearnRate_Knowledge <- function(Pop = Pop,
                                       Typ = FALSE) {
  LR <- "LearnRate"
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  if (Kname %in% colnames(Pop)) {
    Pop <- Pop %>%
      mutate( !!LR := .data[[Kname]] * 0.5,
              !!LR := pmax(.data[[LR]],1E-3))
  }
  return(Pop)
}

Output

  1. Population with the defined learn rate
Code
Pop <- update_LearnRate_Knowledge( Pop = Pop )  
Pop
# A tibble: 10 × 5
      ID Knowledge Knowledge_A Knowledge_B LearnRate
   <int>     <dbl>       <dbl>       <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.275
 2     2      0.6         0.08       0.02      0.3  
 3     3      0.65        0.18       0.045     0.325
 4     4      0.7         0.32       0.08      0.35 
 5     5      0.75        0.5        0.125     0.375
 6     6      0.8         0.72       0.18      0.4  
 7     7      0.85        0.98       0.245     0.425
 8     8      0.9         1.28       0.32      0.45 
 9     9      0.95        1.62       0.405     0.475
10    10      1           2          0.5       0.5

StudyTime

Functions to set and update the StudyTime

Set StudyTime

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A value for the StudyTime (ST). could be a scalar or a vector with the same length as the Population

Hints

  • If StudyTime isn’t given the Population will be initialising with 0
Code
set_StudyTime <- function(Pop = Pop,
                          ST = 0) {
  STname <- "StudyTime"
  Pop <- Pop %>%
    mutate(!!STname := ST)
  return(Pop)
}

Output

  1. Population with the defined StudyTime
Code
Pop <- set_StudyTime( Pop = Pop, ST = 3)  
Pop
# A tibble: 10 × 6
      ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
   <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.275         3
 2     2      0.6         0.08       0.02      0.3           3
 3     3      0.65        0.18       0.045     0.325         3
 4     4      0.7         0.32       0.08      0.35          3
 5     5      0.75        0.5        0.125     0.375         3
 6     6      0.8         0.72       0.18      0.4           3
 7     7      0.85        0.98       0.245     0.425         3
 8     8      0.9         1.28       0.32      0.45          3
 9     9      0.95        1.62       0.405     0.475         3
10    10      1           2          0.5       0.5           3

Update StudyTime

Needs

  1. A Population (Pop) with several Agents defined by ID’s and StudyTime

  2. A Time (dT) that should added.

Hints

  • If StudyTime isn’t defined in Population it will be initialising with dT
Code
update_StudyTime <- function(Pop = Pop,
                             dT = TimeToAdd) {
  STname <- "StudyTime"
  if (STname %in% colnames(Pop)) {
    Pop <- Pop %>%
      mutate( !!STname := .data[[STname]] + dT )
  } else {
    Pop <- set_StudyTime(Pop = Pop, ST = dT )
  }
  return(Pop)
}

Output

  1. Population with the defined StudyTime
Code
Pop <- update_StudyTime( Pop = Pop, dT = 1)   
Pop
# A tibble: 10 × 6
      ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
   <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.275         4
 2     2      0.6         0.08       0.02      0.3           4
 3     3      0.65        0.18       0.045     0.325         4
 4     4      0.7         0.32       0.08      0.35          4
 5     5      0.75        0.5        0.125     0.375         4
 6     6      0.8         0.72       0.18      0.4           4
 7     7      0.85        0.98       0.245     0.425         4
 8     8      0.9         1.28       0.32      0.45          4
 9     9      0.95        1.62       0.405     0.475         4
10    10      1           2          0.5       0.5           4

Data Management

Functions to select and reintegrate a Sub Populations

Select a Sub Population

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A vector wit ID’s(IDs). If no vector is defined it needs a (n, witch is initialised by 2) for selecting random ID’s

  3. A value (n) if the selection should be random

Hints

  • If StudyTime isn’t given the Population will be initialising with 0
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)
}

Output

  1. List with Sub Population ($sel) and the rest of the Population($rest)
Code
SubPop <- sel_SubPop( Pop = Pop )
SubPop$sel
# A tibble: 2 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     2      0.6         0.08       0.02      0.3           4
2     1      0.55        0.02       0.005     0.275         4
Code
SubPop$rest
# A tibble: 8 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     3      0.65        0.18       0.045     0.325         4
2     4      0.7         0.32       0.08      0.35          4
3     5      0.75        0.5        0.125     0.375         4
4     6      0.8         0.72       0.18      0.4           4
5     7      0.85        0.98       0.245     0.425         4
6     8      0.9         1.28       0.32      0.45          4
7     9      0.95        1.62       0.405     0.475         4
8    10      1           2          0.5       0.5           4
Code
SubPop <- sel_SubPop( Pop = Pop , IDs = c(2, 1))
SubPop$sel
# A tibble: 2 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     2      0.6         0.08       0.02      0.3           4
2     1      0.55        0.02       0.005     0.275         4
Code
SubPop$rest
# A tibble: 8 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     3      0.65        0.18       0.045     0.325         4
2     4      0.7         0.32       0.08      0.35          4
3     5      0.75        0.5        0.125     0.375         4
4     6      0.8         0.72       0.18      0.4           4
5     7      0.85        0.98       0.245     0.425         4
6     8      0.9         1.28       0.32      0.45          4
7     9      0.95        1.62       0.405     0.475         4
8    10      1           2          0.5       0.5           4

Integrate Sub Population

Needs

  1. A Sub Population (SubPop) with Agents defined by ID’s which are also defined in Population

  2. A Population (Pop) with several Agents defined by ID’s

Hints

  • SubPop and Pop has to have the same cols
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)
}

Output

  1. Population with the defined StudyTime
Code
Pop
# A tibble: 10 × 6
      ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
   <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.275         4
 2     2      0.6         0.08       0.02      0.3           4
 3     3      0.65        0.18       0.045     0.325         4
 4     4      0.7         0.32       0.08      0.35          4
 5     5      0.75        0.5        0.125     0.375         4
 6     6      0.8         0.72       0.18      0.4           4
 7     7      0.85        0.98       0.245     0.425         4
 8     8      0.9         1.28       0.32      0.45          4
 9     9      0.95        1.62       0.405     0.475         4
10    10      1           2          0.5       0.5           4
Code
SubPop <- sel_SubPop(Pop = Pop, n = 2 )$sel
SubPop <- set_Knowledge(Pop = SubPop, K = 0)
SubPop
# A tibble: 2 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     3         0        0.18       0.045     0.325         4
2     9         0        1.62       0.405     0.475         4
Code
Pop <- int_SubPop(SubPop = SubPop, Pop = Pop)
Pop
# A tibble: 10 × 6
      ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
   <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
 1     1      0.55        0.02       0.005     0.275         4
 2     2      0.6         0.08       0.02      0.3           4
 3     3      0           0.18       0.045     0.325         4
 4     4      0.7         0.32       0.08      0.35          4
 5     5      0.75        0.5        0.125     0.375         4
 6     6      0.8         0.72       0.18      0.4           4
 7     7      0.85        0.98       0.245     0.425         4
 8     8      0.9         1.28       0.32      0.45          4
 9     9      0           1.62       0.405     0.475         4
10    10      1           2          0.5       0.5           4

Timelines

saving Timelines during Simulations

Get Agents-Timelines

Needs

  1. A container name for the Timeline

  2. A value for the Time

  3. A Population (Pop) with several Agents defined by ID’s

  4. A colname from the Population which should followed ver Time

  5. optional parameter Sum. Ich Sum = 1 a mean and median is calculated for each Time

Code
get_Timeline <- function(TL = Timeline,
                          Time = 0,
                          Pop = Pop,
                          Info = name,
                          Sum = 0) {
  TLadd <- tibble( ID = Pop[["ID"]],
                   Time = Time,
                   !!Info := Pop[[Info]])
  if (Sum == 1) {
    Sumname1 <- paste(Info,"mean", sep = "_")
    Sumname2 <- paste(Info,"median", sep = "_")
    TLadd <- TLadd %>%
        mutate(!!Sumname1 := mean(Pop[[Info]], na.rm = TRUE),
               !!Sumname2 := median(Pop[[Info]], na.rm = TRUE))
    }
  if (Time == 0) {
    TL <- TLadd
  } else {
    TL <- bind_rows(TL, TLadd)
  }
  return(TL) 
}

Output

  1. A Timeline in a long format
Code
Timeline <- get_Timeline( TL = Timeline, 
                           Time = 0, 
                           Pop = Pop, 
                           Info = "Knowledge", 
                           Sum = 1)
Timeline <- get_Timeline( TL = Timeline, 
                           Time = 1, 
                           Pop = Pop, 
                           Info = "Knowledge", 
                           Sum = 1)
Timeline
# A tibble: 20 × 5
      ID  Time Knowledge Knowledge_mean Knowledge_median
   <int> <dbl>     <dbl>          <dbl>            <dbl>
 1     1     0      0.55          0.615            0.725
 2     2     0      0.6           0.615            0.725
 3     3     0      0             0.615            0.725
 4     4     0      0.7           0.615            0.725
 5     5     0      0.75          0.615            0.725
 6     6     0      0.8           0.615            0.725
 7     7     0      0.85          0.615            0.725
 8     8     0      0.9           0.615            0.725
 9     9     0      0             0.615            0.725
10    10     0      1             0.615            0.725
11     1     1      0.55          0.615            0.725
12     2     1      0.6           0.615            0.725
13     3     1      0             0.615            0.725
14     4     1      0.7           0.615            0.725
15     5     1      0.75          0.615            0.725
16     6     1      0.8           0.615            0.725
17     7     1      0.85          0.615            0.725
18     8     1      0.9           0.615            0.725
19     9     1      0             0.615            0.725
20    10     1      1             0.615            0.725

Learning

Learning with a exponential lern rate

Needs

  1. A Population (Pop) with several Agents defined by ID’s and Knowledge

  2. optional for future implementations a name (Typ) for the specific Knowledge

  3. A value for the learn rate (LR). could be a scalar or e vector with the same length as the Population

  4. A value for the study time (ST). could be a scalar or e vector with the same length as the Population

Hints

  • If learn rate isn’t given the values from the Population will be used, if this is missing in the Population 0 is used.
Code
learn <- function(Pop = Pop,
                  Typ = FALSE,
                  LR = FALSE,
                  ST = StudyTime) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  if (Kname %in% colnames(Pop)) {
    K <- Pop[[Kname]]
  }
  if (LR == FALSE) {
    if ("LearnRate" %in% colnames(Pop)) {
      LR <- Pop[["LearnRate"]]
    }
  }

  T0 <- ( 1 - K )^( 1 / -LR )   # assumed time learnd allready
  K <- 1 - ( T0 + ST )^( -LR )  # Knowledge after time learnd
  
  Pop <- set_Knowledge(Pop = Pop, Typ = Typ, K = K)
  Pop <- update_StudyTime(Pop = Pop, dT = ST)
  return(Pop)
}

Output

  1. Population with updated Knowledge
Code
Pop <- tibble( ID = ID )
Pop <- set_Knowledge(Pop = Pop, K = 0.1)
Pop <- set_LearnRate(Pop = Pop, LR = 1)
Pop
# A tibble: 10 × 3
      ID Knowledge LearnRate
   <int>     <dbl>     <dbl>
 1     1       0.1         1
 2     2       0.1         1
 3     3       0.1         1
 4     4       0.1         1
 5     5       0.1         1
 6     6       0.1         1
 7     7       0.1         1
 8     8       0.1         1
 9     9       0.1         1
10    10       0.1         1
Code
Pop <- learn( Pop = Pop, ST = 1)
Pop
# A tibble: 10 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.526         1         1
 2     2     0.526         1         1
 3     3     0.526         1         1
 4     4     0.526         1         1
 5     5     0.526         1         1
 6     6     0.526         1         1
 7     7     0.526         1         1
 8     8     0.526         1         1
 9     9     0.526         1         1
10    10     0.526         1         1

Slots

Functions to select and sets learning slots from a Population

Select a random Slot of pairs

Needs

  1. A Population (Pop) with several Agents defined by ID’s

  2. A size of the Slot in percents of the population

Hints

  • because it leads to trouble will selecting otherwise the calculated n is limited at the moment between 1 and half of the Population
Code
sel_Slot_rnd <- function(Pop = Pop,
                         psize = percentsOfPop) {   
  sID <- "Slot_ID"
  n <- round(nrow(Pop)*psize / 2, 0)
  n <- max(n, 1)
  n <- min(n, round(nrow(Pop) / 2, 0))
  
  SubPop <- sel_SubPop( Pop = Pop, n = n)   
  Slot1 <- SubPop$sel %>%     
    mutate(!!sID := seq_len(n)) 
  SubPop <- sel_SubPop( Pop = SubPop$rest, n = n) 
  Slot2 <- SubPop$sel %>%     
    mutate(!!sID := seq_len(n))
  Slot <- bind_rows(Slot1, Slot2)
  return(Slot)  
  }

Output

  1. A random Slot-Population with Slot ID’s which marks the pairs
Code
Pop
# A tibble: 10 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.526         1         1
 2     2     0.526         1         1
 3     3     0.526         1         1
 4     4     0.526         1         1
 5     5     0.526         1         1
 6     6     0.526         1         1
 7     7     0.526         1         1
 8     8     0.526         1         1
 9     9     0.526         1         1
10    10     0.526         1         1
Code
Slot <- sel_Slot_rnd(Pop = Pop, psize = 1)
Slot
# A tibble: 10 × 5
      ID Knowledge LearnRate StudyTime Slot_ID
   <int>     <dbl>     <dbl>     <dbl>   <int>
 1     6     0.526         1         1       1
 2     4     0.526         1         1       2
 3     2     0.526         1         1       3
 4     9     0.526         1         1       4
 5     8     0.526         1         1       5
 6     3     0.526         1         1       1
 7     1     0.526         1         1       2
 8     7     0.526         1         1       3
 9     5     0.526         1         1       4
10    10     0.526         1         1       5

Sets Slot parameter by Slot-ID’s

Needs

  1. A Slot of paird Agents defined by Slot_ID’s

  2. A duration of the slot. could be a scalar or a vector with the same length as the number of pairs in the Slot

Code
set_SlotPar <- function(Slot = Slot,
                        ST = SlotDuration) {
  LRname <- "LearnRate"
  sLRname <- "Slot_LearnRate"
  STname <- "Slot_Duration"
  Slot <- Slot %>%
    group_by(Slot_ID) %>%
    mutate( !!sLRname := mean(.data[[LRname]], na.rm = TRUE),
            !!STname := ST) %>%
    ungroup()
  return(Slot)
}

Output

  1. A random Slot-Population with Slot ID’s which marks the pairs, learn rate and duration of the Slot defined by pairs
Code
Slot <- set_SlotPar(Slot = Slot, ST = 1)
Slot
# A tibble: 10 × 7
      ID Knowledge LearnRate StudyTime Slot_ID Slot_LearnRate Slot_Duration
   <int>     <dbl>     <dbl>     <dbl>   <int>          <dbl>         <dbl>
 1     6     0.526         1         1       1              1             1
 2     4     0.526         1         1       2              1             1
 3     2     0.526         1         1       3              1             1
 4     9     0.526         1         1       4              1             1
 5     8     0.526         1         1       5              1             1
 6     3     0.526         1         1       1              1             1
 7     1     0.526         1         1       2              1             1
 8     7     0.526         1         1       3              1             1
 9     5     0.526         1         1       4              1             1
10    10     0.526         1         1       5              1             1

Learning by Slots

Learning with a exponential learn rate defined by pairs

Needs

  1. A Slot-Population with several paired Agents defined by Slot-ID’s. Prepaerd by the function set_SlotPar()

  2. optional for future implementations a name (Typ) for the specific Knowledge

Code
learn_Slot <- function(Slot = Slot,
                       Typ = FALSE) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  LRname <- "Slot_LearnRate"
  STname <- "Slot_Duration"
  K <- Slot[[Kname]]
  LR <- Slot[[LRname]]
  ST <- Slot[[STname]]

  T0 <- ( 1 - K )^( 1 / -LR )   # assumed time learnd allready
  K <- 1 - ( T0 + ST )^( -LR )  # Knowledge after time learnd
  Slot <- set_Knowledge(Pop = Slot, Typ = Typ, K = K)
  Slot <- update_StudyTime(Pop = Slot, dT = ST)
  return(Slot)
}

Output

  1. Slot-Population with updated Knowledge
Code
Slot <- learn_Slot(Slot = Slot)
Slot
# A tibble: 10 × 7
      ID Knowledge LearnRate StudyTime Slot_ID Slot_LearnRate Slot_Duration
   <int>     <dbl>     <dbl>     <dbl>   <int>          <dbl>         <dbl>
 1     6     0.679         1         2       1              1             1
 2     4     0.679         1         2       2              1             1
 3     2     0.679         1         2       3              1             1
 4     9     0.679         1         2       4              1             1
 5     8     0.679         1         2       5              1             1
 6     3     0.679         1         2       1              1             1
 7     1     0.679         1         2       2              1             1
 8     7     0.679         1         2       3              1             1
 9     5     0.679         1         2       4              1             1
10    10     0.679         1         2       5              1             1

Learning by Days

Learning by Days with a exponential learn rate defined by pairs according learning by Slots

Needs

  1. A Population (Pop) with several Agents defined by ID’s and Knowledge

  2. optional for future implementations a name (Typ) for the specific Knowledge

  3. A percentage of Daytime which each agents stays in meetings (mean-value). has to be a scalar.

  4. A amount of hours for the day, is set to 8

  5. A duration for the meetings in hours, is set to 1

Hints

  • The learn rate is fixed during the Day and updated at the end of the Day
Code
learn_Days <- function(Pop = Pop,                        
                       Typ = FALSE,
                       pM = percentsOfMeetings,
                       dH = 8,
                       ST = 1) { 
  Pop <- update_LearnRate_Knowledge( Pop = Pop, Typ = Typ )
  Pop <- update_StudyTime( Pop = Pop , dT = 0)
  for(i in 1:dH) {
    Slot <- sel_Slot_rnd( Pop = Pop, psize = pM )
    Slot <- set_SlotPar(Slot = Slot, ST = ST)
    Slot <- learn_Slot(Slot = Slot, Typ = Typ)
    Pop <- int_SubPop( SubPop = Slot, Pop = Pop )
  } 
  Pop <- update_LearnRate_Knowledge( Pop = Pop, Typ = Typ )
  return(Pop) 
  }

Output

  1. Population with updated Knowledge, learn rate and study time
Code
Pop <- update_LearnRate_Knowledge( Pop = Pop, Typ = FALSE )
Pop <- set_StudyTime( Pop = Pop , ST = 0)
Pop
# A tibble: 10 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.526     0.263         0
 2     2     0.526     0.263         0
 3     3     0.526     0.263         0
 4     4     0.526     0.263         0
 5     5     0.526     0.263         0
 6     6     0.526     0.263         0
 7     7     0.526     0.263         0
 8     8     0.526     0.263         0
 9     9     0.526     0.263         0
10    10     0.526     0.263         0
Code
Pop <- learn_Days(Pop = Pop, pM = 0.8, dH = 2 ) 
Pop
# A tibble: 10 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.526     0.263         0
 2     2     0.540     0.270         2
 3     3     0.540     0.270         2
 4     4     0.540     0.270         2
 5     5     0.533     0.267         1
 6     6     0.533     0.267         1
 7     7     0.540     0.270         2
 8     8     0.540     0.270         2
 9     9     0.540     0.270         2
10    10     0.540     0.270         2

Plots

Plot Timeline

Needs

  1. A Timeline from get_Timeline
Code
plt_Timeline <- function(TL = Timeline) {
  ggplot(data = TL, aes(x = Time)) +
  geom_line(aes(y = Knowledge, group = ID, color = "Agents"), 
            alpha = 0.5,
            linetype = "solid") +
  geom_line(aes(y = Knowledge_mean, color = "Mean"),
            linetype = "solid")  +
  geom_line(aes(y = Knowledge_median, color = "Median"),
            linetype = "dashed") +
  ggtitle("Timeline") +
  xlab("Number of Days") +
  ylab("Knowledge") +
  scale_y_continuous(
    limits = c(0, 1),
    breaks = seq(0, 1, 0.2)
  ) +
  scale_color_manual(
    values = c("Agents" = "grey", "Mean" = "black", "Median" = "black"),
    labels = c("Agents" = "Agents", "Mean" = "Mean", "Median" = "Median")
  ) +
  theme_light() +
  theme(legend.title = element_blank(),
        legend.position = "top",
        legend.justification = "left"
        )
}

Output

  1. ggplot2

Simulation

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

Needs

  1. A Population (Pop) with several Agents defined by ID’s and Knowledge

  2. optional for future implementations a name (Typ) for the specific Knowledge

  3. A number of Days (nD)

  4. A percentage of Daytime which each agents stays in meetings (mean-value). has to be a scalar.

  5. A amount of hours for the day, is set to 8

  6. A duration for the meetings in hours, is set to 1

Code
sim_Days <- function(Pop = Pop,
                     Typ = FALSE,
                     nD = NumberOfDays,
                     pM = precentsOfMeetings,
                     dH = 8,
                     ST = 1) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  Pop <- update_LearnRate_Knowledge( Pop = Pop )
  Pop <- set_StudyTime( Pop = Pop, ST = 0 )
  TL <- get_Timeline( TL =TL,
                       Time = 0,
                       Pop = Pop,
                       Info = Kname,
                       Sum = 1 )
  for(i in 1:nD) {
    Pop <- learn_Days(Pop = Pop,
                      Typ = Typ,
                      pM = pM,
                      dH = dH,
                      ST = ST)
    TL <- get_Timeline( TL =TL,
                         Time = i,
                         Pop = Pop,
                         Info = Kname,
                         Sum = 1 )
  }
    
  Output <- list( Pop = Pop,
                  TL = TL)
  return(Output)
}

Output

  1. A List with the new Population and a Timeline over the number of Days
Code
nA <- 50                          # number of Agents
ID <- seq_len(nA)                 # ID of the Agents
K <- (seq_len(nA)-1)/50           # Knowledge

nM <- 160                         # number of meetings(mean)
pM <- 0.80
nD <- nM / 8 / pM

Pop <- tibble( ID = ID )
Pop <- set_Knowledge( Pop = Pop, K = K )
Pop
# A tibble: 50 × 2
      ID Knowledge
   <int>     <dbl>
 1     1      0   
 2     2      0.02
 3     3      0.04
 4     4      0.06
 5     5      0.08
 6     6      0.1 
 7     7      0.12
 8     8      0.14
 9     9      0.16
10    10      0.18
# ℹ 40 more rows
Code
res <- sim_Days(Pop = Pop,
                nD = nD,
                pM = pM)

mean(res$Pop[["StudyTime"]])
[1] 160
Code
res$Pop
# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.866     0.433       160
 2     2     0.864     0.432       158
 3     3     0.867     0.434       157
 4     4     0.865     0.432       154
 5     5     0.869     0.434       164
 6     6     0.871     0.436       167
 7     7     0.871     0.436       167
 8     8     0.867     0.433       156
 9     9     0.868     0.434       162
10    10     0.863     0.431       151
# ℹ 40 more rows
Code
plt_Timeline(res$TL)

… Special Cases

Only one Agent with Knowledge (0.8)

Code
K <- 0           # Knowledge

Pop <- tibble( ID = ID )
Pop <- set_Knowledge( Pop = Pop, K = K )
Pop[ID == 1, "Knowledge"] <- 0.8
Pop
# A tibble: 50 × 2
      ID Knowledge
   <int>     <dbl>
 1     1       0.8
 2     2       0  
 3     3       0  
 4     4       0  
 5     5       0  
 6     6       0  
 7     7       0  
 8     8       0  
 9     9       0  
10    10       0  
# ℹ 40 more rows
Code
res <- sim_Days(Pop = Pop,
                nD = nD,
                pM = pM)

res$Pop
# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.857     0.428       165
 2     2     0.804     0.402       162
 3     3     0.802     0.401       158
 4     4     0.791     0.395       159
 5     5     0.801     0.401       167
 6     6     0.790     0.395       160
 7     7     0.790     0.395       154
 8     8     0.801     0.401       163
 9     9     0.791     0.395       156
10    10     0.785     0.393       151
# ℹ 40 more rows
Code
plt_Timeline(res$TL)

Back to top