View difference between Paste ID: <a href="/BhhJdyFV">BhhJdyFV</a> and <a href="/MZcsYYb6">MZcsYYb6</a>

library(XML)
1		library(XML)
2		black <- readHTMLTable("http://www.gwern.net/Black-market%20survival", colClasses = c("character", "factor", "factor", "logical",
3		"factor", "logical", "character", "logical", "logical",
4		"factor", "factor", "logical", "logical",
5		"integer", "logical",
6		"character"))[[1]]
7		black[black$Codebase=="",]$Codebase <- NA
8		black$Start <- as.Date(black$Start); black$End <- as.Date(black$End)
9		black[is.na(black$End),]$End <- Sys.Date() # assuming the table is up to date
10		black$Age <- black$End - black$Start
11		black$Age <- as.integer(black$End - black$Start)
12
13		# for competing-risks modeling
14		levels(black$Closure) <- c("alive", "hacked", "raided", "scam", "voluntary") # sets "" to "alive"
15
16		sum(sort(as.Date(black$Start)) >= as.Date("2014-01-01"))
17		# [1] 43
18		sort(black[as.Date(black$Start) >= as.Date("2014-01-01"),]$Market)
19		# [1] 1776 Abraxas Alpaca Marketplace
20		# [4] AlphaBay Andromeda Area51
21		# [7] Armory Vendor Market BlackBank Market Black Goblin Market
22		# [10] Breaking Bad Cannabis Road Cannabis Road 2
23		# [13] Cannabis Road 3 Cantina Cloud-Nine
24		# [16] DarkBay Darknet Nation Deepzon
25		# [19] Diabolus Doge Road drugslist
26		# [22] evolution EXXTACY Freedom Market
27		# [25] GreyRoad Hansa Hydra
28		# [28] Middle Earth Marketplace Mr Nice Guy Nucleus Marketplace
29		# [31] Onionshop Panacea Pigeon Market
30		# [34] Red Sun Marketplace Sanitarium Market Silk Street
31		# [37] TOM Topix 2 TorBazaar
32		# [40] TorEscrow Tortuga 2 Underground Market
33		# [43] Utopia
34		length(black[black$End > as.Date("2014-01-01") & black$End < as.Date("2015-01-01"),]$Market)
35		# [1] 46
36		sort(black[black$End > as.Date("2014-01-01") & black$End < as.Date("2015-01-01"),]$Market)
37		# [1] 1776 Alpaca Marketplace Andromeda Armory Vendor Market
38		# [5] BlackBox Market Black Goblin Market Black Services Market Blue Sky
39		# [9] Breaking Bad BuyItNow Cannabis Road Cannabis Road 2
40		# [13] Cannabis Road 3 Cantina Cloud-Nine DarkBay
41		# [17] Darknet Nation Deepzon Doge Road drugslist
42		# [21] EXXTACY FreeBay Freedom Market GreyRoad
43		# [25] Hansa Hydra Mr Nice Guy Onionshop
44		# [29] Pandora Pigeon Market Pirate Market Red Sun Marketplace
45		# [33] Sanitarium Market Silk Road 2 Silk Street The Marketplace
46		# [37] TOM Topix 2 TorBay TorBazaar
47		# [41] TorEscrow Tortuga Tortuga 2 Underground Market
48		# [45] Utopia White Rabbit
49
50		sort(black[black$Alive,]$Market)
51		# [1] Abraxas Agora AlphaBay
52		# [4] Area51 BlackBank Market Diabolus
53		# [7] Dream Market evolution Middle Earth Marketplace
54		# [10] Nucleus Marketplace Outlaw Market Panacea
55		# 67 Levels: 1776 Abraxas Agora Alpaca Marketplace AlphaBay Andromeda Area51 ... White Rabbit
56		sort(black[black$Alive & black$Start >= as.Date("2014-01-01"),]$Market)
57		# [1] Abraxas AlphaBay Area51
58		# [4] BlackBank Market Diabolus evolution
59		# [7] Middle Earth Marketplace Nucleus Marketplace Panacea
60		# 67 Levels: 1776 Abraxas Agora Alpaca Marketplace AlphaBay Andromeda Area51 ... White Rabbit
61
62		sort(table(black[as.Date(black$End) >= as.Date("2014-01-01"),]$Closure))
63		# raided hacked alive scam voluntary
64		# 6 9 12 12 20
65
66		library(survival)
67		summary(survfit(Surv(Age, Alive, type="right") ~ 1, data=black))
68		# time n.risk n.event survival std.err lower 95% CI upper 95% CI
69		# 11 58 1 0.98276 0.017092 0.949823 1.00000
70		# 20 54 1 0.96456 0.024627 0.917479 1.00000
71		# 67 38 1 0.93918 0.034675 0.873615 1.00000
72		# 70 37 1 0.91379 0.042013 0.835050 0.99996
73		# 81 35 1 0.88768 0.048248 0.797983 0.98747
74		# 194 23 1 0.84909 0.059621 0.739919 0.97437
75		# 196 22 1 0.81049 0.068269 0.687151 0.95598
76		# 331 10 1 0.72945 0.098424 0.559938 0.95027
77		# 353 7 1 0.62524 0.128160 0.418378 0.93438
78		# 369 5 1 0.50019 0.151728 0.276014 0.90644
79		# 395 4 1 0.37514 0.157090 0.165105 0.85238
80		# 413 3 1 0.25010 0.146261 0.079489 0.78688
81		plot(survfit(Surv(Age, Alive, type="right") ~ 1, data=black))
82		# https://i.imgur.com/OamVzjO.png
83
84		library(cmprsk)
85		blackc <- with(black, cuminc(Age, Closure, cencode="alive")); blackc
86		# Estimates and Variances:
87		# $est
88		# 200 400 600 800
89		# 1 hacked 0.1389819240 0.138981924 0.138981924 0.138981924
90		# 1 raided 0.0149253731 0.114655933 0.114655933 0.114655933
91		# 1 scam 0.2069723259 0.299188940 0.299188940 0.299188940
92		# 1 voluntary 0.2702539221 0.327633148 0.327633148 0.327633148
93		#
94		# $var
95		# 200 400 600 800
96		# 1 hacked 0.001900471515 0.00190047151 0.00190047151 0.00190047151
97		# 1 raided 0.000223039082 0.00212491076 0.00212491076 0.00212491076
98		# 1 scam 0.002707980885 0.00366455525 0.00366455525 0.00366455525
99		# 1 voluntary 0.003240020448 0.00383384036 0.00383384036 0.00383384036
100
101		# risk of shut down by cause:
102		plot(blackc, lty=1, color=c(1:4), xlab="Days")
103	-	# https://i.imgur.com/xZE8O5n.png
103	+	# https://i.imgur.com/xZE8O5n.png
104
105		# Generate predictions of shutdown in next 6 / 12 months for the still-running marketplaces:
106
107		# You are not expected to understand this ugly hack. I don't either. But it seems to work...
108		# for background, see http://gwern.net/Google%20shutdowns & http://www.gwern.net/Silk%20Road#the-bet-bmr-or-sheep-to-die-in-a-year-by-oct-2014
109		library(rms)
110		conditionalProbability <- function (d, followupUnits, cmodel) {
111		chances <- rep(NA, nrow(d)) # stash results
112
113		for (i in 1:nrow(d)) {
114
115		# extract chance of particular subject surviving as long as it has:
116		beginProb <- survest(cmodel, d[i,], times=(d[i,]$Age))$surv
117		if (length(beginProb)==0) { beginProb <- 1 } # set to a default
118
119		tmpFollowup <- followupUnits # reset in each for loop
120		while (TRUE) {
121		# extract chance of subject surviving as long as it has + an arbitrary additional time-units
122		endProb <- survest(cmodel, d[i,], times=(d[i,]$Age + tmpFollowup))$surv
123		# survival curve may not reach that far! 'survexp returns 'numeric(0)' if it doesn't;
124		# so we shrink down 1 day and try again until 'survexp' does return a usable answer
125		if (length(endProb)==0) { tmpFollowup <- tmpFollowup - 1} else { break }
126		}
127
128		# if 50% of all subjects survive to time t, and 20% of all survive to time t+100, say, what chance
129		# does a survivor - at exactly time t - have of making it to time t+100? 40%: 0.20 / 0.50 = 0.40
130		chances[i] <- endProb / beginProb
131		}
132		return(chances)
133		}
134		# we can't regress on '~ 1' because `survest` crashes inside `conditionalProbability` (‽),
135		# so let's just toss in all the covariates to make it work despite none of them being well-justified...
136		cpmodel <- cph(Surv(Age, Alive) ~ Multisig + I2P + Coin + Guns + Fraud, data = black, x=TRUE, y=TRUE, surv=TRUE)
137		# report in %s rather than raw probabilities for easier reading
138		black$SixMonth <- round(digits=1, conditionalProbability(black, round(365/2), cpmodel) * 100)
139		black$OneYear <- round(digits=1, conditionalProbability(black, 365, cpmodel) * 100)
140
141		subset(black, Alive, select=c("Market", "SixMonth", "OneYear"))
142		# Market SixMonth OneYear
143		# 56 Dream Market 100.0 100.0
144		# 57 Agora 65.6 65.6
145		# 58 Outlaw Market 72.3 72.3
146		# 59 evolution 17.5 17.5
147		# 60 BlackBank Market 13.1 13.1
148		# 61 Area51 57.7 28.1
149		# 62 Middle Earth Marketplace 56.8 28.8
150		# 63 Diabolus 34.7 0.0
151		# 64 Nucleus Marketplace 15.7 0.0
152		# 65 Panacea 89.7 34.4
153		# 66 Abraxas 85.9 51.2
154		# 67 AlphaBay 92.5 48.4