Random meetings

Simulating random meetings

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.

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)

Population for testing the Functions

nA = 5            # number of Agents
ID = seq_len(nA)  # ID of the Agents

Pop <- tibble( ID = ID )
Pop

# A tibble: 5 × 1
     ID
  <int>
1     1
2     2
3     3
4     4
5     5

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

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

  return(Pop)
}

Output

1. Population with the defined Knowledge

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: 5 × 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  

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)

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

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: 5 × 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

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

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

LR <- seq_len(nA)/5  
Pop <- set_LearnRate( Pop = Pop, LR = 1 ) 
Pop

# A tibble: 5 × 5
     ID Knowledge Knowledge_A Knowledge_B LearnRate
  <int>     <dbl>       <dbl>       <dbl>     <dbl>
1     1      0.55        0.02       0.005         1
2     2      0.6         0.08       0.02          1
3     3      0.65        0.18       0.045         1
4     4      0.7         0.32       0.08          1
5     5      0.75        0.5        0.125         1

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

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 )
  }
  return(Pop)
}

Output

1. Population with the defined learn rate

Pop <- update_LearnRate_Knowledge( Pop = Pop )  
Pop

# A tibble: 5 × 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

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

set_StudyTime <- function(Pop = Pop,
                          ST = 0) {
  STname <- "StudyTime"
  Pop <- Pop %>%
    mutate(!!STname := ST)
  return(Pop)
}

Output

1. Population with the defined StudyTime

Pop <- set_StudyTime( Pop = Pop, ST = 3)  
Pop

# A tibble: 5 × 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

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

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

s <- Pop

Pop <- update_StudyTime( Pop = s, dT = 1)   
Pop

# A tibble: 5 × 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

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

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)

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     4       0.7        0.32        0.08      0.35         4
2     2       0.6        0.08        0.02      0.3          4

SubPop$rest

# A tibble: 3 × 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     3      0.65        0.18       0.045     0.325         4
3     5      0.75        0.5        0.125     0.375         4

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

SubPop$rest

# A tibble: 3 × 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

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

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

Pop

# A tibble: 5 × 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

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     5         0        0.5        0.125     0.375         4

Pop <- int_SubPop(SubPop = SubPop, Pop = Pop)
Pop

# A tibble: 5 × 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           0.5        0.125     0.375         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

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

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: 10 × 5
      ID  Time Knowledge Knowledge_mean Knowledge_median
   <int> <dbl>     <dbl>          <dbl>            <dbl>
 1     1     0      0.55           0.37             0.55
 2     2     0      0.6            0.37             0.55
 3     3     0      0              0.37             0.55
 4     4     0      0.7            0.37             0.55
 5     5     0      0              0.37             0.55
 6     1     1      0.55           0.37             0.55
 7     2     1      0.6            0.37             0.55
 8     3     1      0              0.37             0.55
 9     4     1      0.7            0.37             0.55
10     5     1      0              0.37             0.55

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.

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

Pop <- tibble( ID = ID )
Pop <- set_Knowledge(Pop = Pop, K = 0.1)
Pop <- set_LearnRate(Pop = Pop, LR = 1)
Pop

# A tibble: 5 × 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

Pop <- learn( Pop = Pop, ST = 10)
Pop

# A tibble: 5 × 4
     ID Knowledge LearnRate StudyTime
  <int>     <dbl>     <dbl>     <dbl>
1     1      0.91         1        10
2     2      0.91         1        10
3     3      0.91         1        10
4     4      0.91         1        10
5     5      0.91         1        10

Plots

Plot Timeline

Needs

1. A Timeline from get_Timeline

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 Iterations") +
  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 two Agents meet randomly

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) greater than 0 and up to 1. could be a scalar or e vector with the same length as the Population

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

5. A number of iterations (STn)

sim_meeting <- function(Pop = Pop,
                      Typ = FALSE,
                      LR = FALSE,
                      ST = 1,
                      STn = Itterations) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  Pop <- update_LearnRate_Knowledge( Pop = Pop )
  Pop <- set_StudyTime( Pop = Pop )
  TL <- get_Timeline( TL =TL,
                       Time = 0,
                       Pop = Pop,
                       Info = Kname,
                       Sum = 1 )
  for(i in 1:STn) {
    SubPop <- sel_SubPop( Pop = Pop, n = 2 )$sel
    SubPop <- learn( Pop = SubPop, 
                     ST = ST,
                     LR = mean( SubPop[["LearnRate"]] ))
    SubPop <- update_LearnRate_Knowledge( Pop = SubPop )
    SubPop <- update_StudyTime( Pop = SubPop, dT = ST)
    Pop <- int_SubPop( SubPop = SubPop, Pop = Pop )
    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 itterations

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)
STn <- nM * nA / 4

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

res <- sim_meeting(Pop = Pop,
                   ST = 1,
                   STn = STn)

mean(res$Pop[["StudyTime"]])

[1] 160

res$Pop

# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.809     0.405       176
 2     2     0.803     0.402       162
 3     3     0.816     0.408       176
 4     4     0.797     0.399       158
 5     5     0.818     0.409       188
 6     6     0.777     0.389       134
 7     7     0.818     0.409       188
 8     8     0.767     0.384       126
 9     9     0.790     0.395       146
10    10     0.819     0.410       196
# ℹ 40 more rows

plt_Timeline(res$TL)

… Special Cases

Only one Agent with Knowledge (0.8)

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

res <- sim_meeting(Pop = Pop,
                   ST = 1,
                   STn = STn)

res$Pop

# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.824     0.412       180
 2     2     0.672     0.336       182
 3     3     0.577     0.289       138
 4     4     0.645     0.323       142
 5     5     0.643     0.321       150
 6     6     0.642     0.321       168
 7     7     0.616     0.308       168
 8     8     0.588     0.294       148
 9     9     0.631     0.315       156
10    10     0.650     0.325       150
# ℹ 40 more rows

plt_Timeline(res$TL)