Comparison of selecting by rating grade v.s. fitness

Population of companies

Suppose we have a population of companies. Each company has a log-normal fitness, expressed as a probability of default (PD) as follows:

# Simulate the population with log-normal fitness
nPop <- 10000
pop<-rnorm(10000,mean=-2.3,sd=0.6)
popPD<-pmin(exp(pop),1)/5
hist(popPD)

summary(popPD)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## 0.00248 0.01337 0.02017 0.02407 0.03000 0.19980

Ratings

Next we consider a hypothetical exponential rating scale.

CRRscale<-c(0,exp((1:15)*0.35 - 5.5))
nBuckets<-length(CRRscale)
Bucket<-1:nBuckets
plot(Bucket,CRRscale,type="l")

This scale is applied to the fitness to get the rating for each company. In the real world this would correspond to a perfect rating agency, ahem!

CRRbuckets<-as.numeric(cut(popPD, breaks=CRRscale, include.lowest=TRUE))
hist(CRRbuckets)

In reality we would calculate the historic default rate for each rating grade. However, for this demonstration we will take the average fitness.

# Calculate mean PD by CRR and plot
CRRmeanPD<-as.numeric(lapply(Bucket,function(x){mean(popPD[CRRbuckets==x])}))
plot(Bucket,CRRmeanPD)

These are the PDs associated with each grade. Thus, they are what we might fit a model to.

Note that the mean of these is the same as the populatio mean.

mean(CRRmeanPD[CRRbuckets])
## [1] 0.02406901

A random subsample of companies

A sample of companies chosen entirely at random has similar characteristics to the population.

nSamp <- 1000
rndSamp<-sample(1:nPop,nSamp)
mean(popPD[rndSamp]) # mean actual PD
## [1] 0.02438447
mean(CRRmeanPD[CRRbuckets[rndSamp]]) # mean PD according to CRR scale
## [1] 0.02446997

Note that the average rating-implied PD is close to the average actual PD.

Sample favouring better ratings

We might suppose that risk managers and approvers favour companies with better ratings.

Let us check the effect of this. First the sampling weight is defined based on the bucket.

weights <- 4 - 1.2*log(CRRbuckets) # (better buckets more likely to be sampled)
plot(CRRbuckets,weights)

The ratings for companies sampled with these weights can be shown below. The red is the original distribution.

BetterCRRSamp <- sample(1:nPop,nSamp,prob=weights)

# compare the distributions
countByCRR<-as.numeric(lapply(Bucket,function(x){sum(CRRbuckets[BetterCRRSamp]==x)}))
plot(Bucket,countByCRR,col="red",type="l")

countByCRR<-as.numeric(lapply(Bucket,function(x){sum(CRRbuckets==x)}))
lines(Bucket,countByCRR/10,col="blue")

# Average notch difference
mean(CRRbuckets) - mean(CRRbuckets[BetterCRRSamp])
## [1] 0.329

Now, we calculate the average actual PD and compare to the rating implied PD.

mean(popPD[BetterCRRSamp]) # mean actual PD
## [1] 0.02153543
mean(CRRmeanPD[CRRbuckets[BetterCRRSamp]]) # mean PD according to CRR scale
## [1] 0.02149525

Both PDs are better than the population, as expected. However note that the actual PD is still close the rating implied PD!

Sample according to fitness

The hope is that RMs and approvers in an actively managed portfolio add value to the ratings.
That is, they attempt to choose the best companies within rating grades.

This can be simulated by weighting each company according to their fitness within their grade.

weights <- numeric(nPop) # vector(mode="numeric",length=nPop)
countByCRR<-as.numeric(lapply(Bucket,function(x){sum(CRRbuckets==x)}))
for (bucket in Bucket) { 
  weights[CRRbuckets == bucket]<-(1 - rank(popPD[CRRbuckets==bucket])/countByCRR[bucket])^2 
}

plot(popPD,weights)

Note that the rating distribution of the resulting sample is still close the original population.

# make the sample according to these weights
BetterFitnessSamp <- sample(1:nPop,nSamp,prob=weights)

# compare the distributions
countByCRR<-as.numeric(lapply(Bucket,function(x){sum(CRRbuckets[BetterFitnessSamp]==x)}))
plot(Bucket,countByCRR,col="red",type="l")

countByCRR<-as.numeric(lapply(Bucket,function(x){sum(CRRbuckets==x)}))
lines(Bucket,countByCRR/10,col="blue")

However, the average fitness is better. A portfolio thus constructed will have a lower default rate than implied by its ratings.

mean(popPD[BetterFitnessSamp]) # mean actual PD
## [1] 0.02140855
mean(CRRmeanPD[CRRbuckets[BetterFitnessSamp]]) # mean PD according to CRR scale
## [1] 0.02323331

Comments