• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Somers'D and ASE - dirty implementation in R

mjaniec Dec 15th, 2013 130 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. PD    <- c(0.05,0.10,0.50,1,2,5,25)/100
2. total <- c(5,10,20,25,20,15,5)/100
3.
4. raw <- rbind(PD,total)*100
5.
6. defaulted    <- total*PD
7. nondefaulted <- total*(1-PD)
8.
9. n <- sum(total)
10.
11. portfolio <- rbind(defaulted,nondefaulted)/n
12.
13. portfolio
14.
15. ### ASE
16.
17. x <- portfolio
18.
19. wr <- n^2-sum(sapply(1:nrow(x), function(i) sum(x[i,])^2))
20.
21. A <- function(x,i,j) {
22.
23.   xr <- nrow(x)
24.   xc <- ncol(x)
25.
26.   sum(x[1:xr>i,1:xc>j])+sum(x[1:xr<i,1:xc<j])
27.
28. }
29.
30. D <- function(x,i,j) {
31.
32.   xr <- nrow(x)
33.   xc <- ncol(x)
34.
35.   sum(x[1:xr>i,1:xc<j])+sum(x[1:xr<i,1:xc>j])
36.
37. }
38.
39. Pf <- function(x) {
40.
41.   xr <- nrow(x)
42.   xc <- ncol(x)
43.
44.   tmp <- NULL
45.
46.   for (i in 1:xr)
47.     for (j in 1:xc)
48.
49.       tmp <- c(tmp,x[i,j]*A(x,i,j))
50.
51.   sum(tmp)
52.
53. }
54.
55. Qf <- function(x) {
56.
57.   xr <- nrow(x)
58.   xc <- ncol(x)
59.
60.   tmp <- NULL
61.
62.   for (i in 1:xr)
63.     for (j in 1:xc)
64.
65.       tmp <- c(tmp,x[i,j]*D(x,i,j))
66.
67.   sum(tmp)
68.
69. }
70.
71. P <- Pf(x)
72. Q <- Qf(x)
73.
74. # ASE1
75. tmp2 <- NULL
76. for (i in 1:nrow(x))
77.   for (j in 1:ncol(x))
78.     tmp2 <- c( tmp2, x[i,j] * ( wr*(A(x,i,j)-D(x,i,j)) - (P-Q)*(sum(x)-sum(x[i,])) )^2 )
79.
80. # ASE0
81. tmp <- NULL
82. for (i in 1:nrow(x))
83.   for (j in 1:ncol(x))
84.     tmp <- c( tmp, x[i,j]*(A(x,i,j)-D(x,i,j))^2 )
85.
86. # Somers' D
87. # -0.6839158
88. (P-Q)/wr
89.
90. # ASE1
91. # 2.378
92. 2/wr^2*sqrt(sum(tmp2))
93.
94. # ASE0 - hypothesis of independence
95. 2/wr*sqrt( sum(tmp)-(P-Q)^2/sum(x) )
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top