Расчет премий, взимаемых с держателей полисов с использованием разных ставок претензий в R

Question

Я рассчитываю надбавки, подлежащие начислению на держателей полисов, используя 8 различных ставок претензий (вероятности предъявления претензии), используя пуассоновский процесс. Значения, использующие этот код: 568.48 625.44 684.34 732.58 772.40 802.90 832.46 851.66 Эти значения отличаются от правильных значений, которые я получаю в Excel, и теоретически рассчитываются: 517.4 550.26 601.14 650.96 705.86 757.4 796.18 829.64 Может кто-нибудь попробовать исправить код R, чтобы получить эти значения?

a <- array(0:0,dim=c(21,5000)) # over time period t=21, 5000 policy holders
d<-array(1:5) 
e<-array(1:5) # five discount levels used
p<-array(1:8) # premium charged for 8 separate claim rates
z=0
e[1]=1 # discount 0%
e[2]=.8 # discount 20%
e[3]=.7 # discount 30%
e[4]=.6 # discount 40%
e[5]=.5 # discount 50%

for (l in seq(0.1,0.8,.1)){ # claim rates 0.1,0.2,0.3...0.8
  for (j in 1:20){
    for (i in 1:5000) {
      b<-min(2,rpois(1,l))
      if (b==2) {a[j+1,i]=0}     # b is the number of claims made, if 2 or more, drop down to 0% discount
      if (b==0) {a[j+1,i]=min(5,a[j,i]+1)} # if 0 claims made, go to next level of discount
      if (b==1) {a[j+1,i]=max(0,a[j,i]-1)} # if 1 claim made, drop back one discount level
    }
  }
  for (k in 1:5){
    d[k]=1000*e[k]*(length(subset(a[5,],a[5,]==k-1))/5000)
  }
  z=z+1;p[z]=sum(d)
}
p   # premium charged at each claim rate 0.1,0.2, ... , 0.8

Answer 1

У вас есть небольшая проблема в вашем коде, относительно ваших уровней скидок. У вас есть 5 уровней скидок, 0%, 20%, 30%, 40% и 50%. В вашем цикле, однако, вы разрешаете 6: поскольку вы устанавливаете людей с 2 ​​или более утверждениями обратно на 0, вы допускаете 6 уровней скидки, 0,1,2,3,4,5. Когда вы вычисляете вектор d, вы итерируете от 1:5, но вы действительно итерируете от 0:4, потому что вы сравниваете с k-1, что означает, что вы упускаете группу с наибольшим дисконтом.

Есть несколько способов исправить это, но самый простой - изменить строку if(b==0)

if (b==0) {a[j+1,i]=min(4,a[j,i]+1)} # if 0 claims made, go to next level of discount

Это должно сделать это.

Кроме того, с теоретической точки зрения, почему ваша a-матрица имеет 21 строчку глубины (что подразумевает 21 год), но вы перебираете только первые 5, а затем игнорируете 6-й год? Я бы сделал цикл 1:20, а затем проверил 21-й ряд, а не 5-й. Полный код, который я использовал, приведен ниже:

a <- array(0:0,dim=c(21,5000)) # over time period t=21, 5000 policy holders
d<-array(1:5) 
e<-array(1:5) # five discount levels used
p<-array(1:8) # premium charged for 8 separate claim rates
z=0
e[1]=1 # discount 0%
e[2]=.8 # discount 20%
e[3]=.7 # discount 30%
e[4]=.6 # discount 40%
e[5]=.5 # discount 50%

for (l in seq(0.1,0.8,.1)){ # claim rates 0.1,0.2,0.3...0.8
  for (j in 1:20){
    for (i in 1:5000) {
      b<-min(2,rpois(1,l))
      if (b==2) {a[j+1,i]=0}     # b is the number of claims made, if 2 or more, drop down to 0% discount
      if (b==1) {a[j+1,i]=max(0,a[j,i]-1)} # if 1 claim made, drop back one discount level
      if (b==0) {a[j+1,i]=min(4,a[j,i]+1)} # if 0 claims made, go to next level of discount
    }
  }    
  for (k in 1:5){
    d[k]=1000*e[k]*(length(subset(a[21,],a[21,]==(k-1)))/5000)
  }
  z=z+1;p[z]=sum(d)
}
p