with updated learn rate

Simple learning curve with updated learn rate

First and foremost, the distribution of information and knowledge should have something to do with learning. So I start with an exponential learning curve, which is easy to implement.

It does not seem realistic that the learning rate will remain constant over time. Therefore, the learn rate is redefined on the basis of current knowledge. In the absence of better knowledge, a factor of 0.5 is used.

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

Pop <- update_StudyTime( Pop = Pop, 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

Timelines

saving Timelines during Simulations

Get Agents-Timelines

Needs

1. A containername 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.65             0.65
 2     2     0      0.6            0.65             0.65
 3     3     0      0.65           0.65             0.65
 4     4     0      0.7            0.65             0.65
 5     5     0      0.75           0.65             0.65
 6     1     1      0.55           0.65             0.65
 7     2     1      0.6            0.65             0.65
 8     3     1      0.65           0.65             0.65
 9     4     1      0.7            0.65             0.65
10     5     1      0.75           0.65             0.65

Learning

Learning with a exponential Lernrate

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 lLearnRate (LR). 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 e vector with the same length as the Population

Hints

• If LearnRate 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 = c(1, 0),
        legend.justification = c(1, 0))
}

Simulation

A learning process with uptated LearnRate by actual 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

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_learn <- 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) {
    Pop <- learn(  Pop = Pop,
                   LR = LR,
                   ST = ST)
    Pop <- update_LearnRate_Knowledge( 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

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_learn(Pop = Pop,
                 ST = 1,
                 STn = 500)
res$Pop

# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0         0           500
 2     2     0.930     0.465       500
 3     3     0.931     0.466       500
 4     4     0.932     0.466       500
 5     5     0.932     0.466       500
 6     6     0.933     0.466       500
 7     7     0.933     0.467       500
 8     8     0.933     0.467       500
 9     9     0.934     0.467       500
10    10     0.934     0.467       500
# ℹ 40 more rows

plt_Timeline(res$TL)

Warning: A numeric `legend.position` argument in `theme()` was deprecated in ggplot2
3.5.0.
ℹ Please use the `legend.position.inside` argument of `theme()` instead.