Simple learningcurve

Author

Hubert Baechli

Simple learning curve

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.

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

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

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

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 initializing 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: 5 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     1      0.55        0.02       0.005         1         3
2     2      0.6         0.08       0.02          1         3
3     3      0.65        0.18       0.045         1         3
4     4      0.7         0.32       0.08          1         3
5     5      0.75        0.5        0.125         1         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: 5 × 6
     ID Knowledge Knowledge_A Knowledge_B LearnRate StudyTime
  <int>     <dbl>       <dbl>       <dbl>     <dbl>     <dbl>
1     1      0.55        0.02       0.005         1         4
2     2      0.6         0.08       0.02          1         4
3     3      0.65        0.18       0.045         1         4
4     4      0.7         0.32       0.08          1         4
5     5      0.75        0.5        0.125         1         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

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: 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.
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: 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
Code
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
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 itterations") +
  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 fixed LearnRate

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 itterations (STn)

Code
sim_learn <- function(Pop = Pop,
                      Typ = FALSE,
                      LR = LearnRate,
                      ST = 1,
                      STn = Itterations) {
  Kname <- "Knowledge"
  if (Typ != FALSE) {
    Kname <- paste(Kname, Typ, sep = "_")
  }
  Pop <- set_LearnRate( Pop = Pop, 
                        LR = LR)
  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)
    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
Code
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
Code
res <- sim_learn(Pop = Pop,
                 LR = 0.1,
                 ST = 1,
                 STn = 500)
res$Pop
# A tibble: 50 × 4
      ID Knowledge LearnRate StudyTime
   <int>     <dbl>     <dbl>     <dbl>
 1     1     0.463       0.1       500
 2     2     0.463       0.1       500
 3     3     0.463       0.1       500
 4     4     0.463       0.1       500
 5     5     0.463       0.1       500
 6     6     0.463       0.1       500
 7     7     0.463       0.1       500
 8     8     0.463       0.1       500
 9     9     0.463       0.1       500
10    10     0.464       0.1       500
# ℹ 40 more rows
Code
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.

Back to top