mirror of
https://github.com/Rucknium/misc-research.git
synced 2024-12-22 19:39:21 +00:00
190 lines
7.5 KiB
R
190 lines
7.5 KiB
R
library(ggplot2)
|
|
library(data.table)
|
|
library(Cairo)
|
|
library(fixest)
|
|
|
|
xmr.blockchain <- readRDS("")
|
|
|
|
|
|
block.template.update.adjustment <- xmr.blockchain[,
|
|
mean(diff(sort(unique(canon.receive_time))), na.rm = TRUE)]
|
|
|
|
p2pool.confirm.delay <- xmr.blockchain[Pool == "P2Pool",
|
|
.(block.template.update =
|
|
min(canon.block_receive_time - canon.receive_time -
|
|
block.template.update.adjustment, na.rm = TRUE) ),
|
|
by = c("block_height")]$block.template.update
|
|
# Removes transactions with no canon.receive_time. The nodes did not see
|
|
# those transactions before they appeared in a received block
|
|
# WARNING: Produces Infs when block has no transactions
|
|
|
|
mean.p2pool.confirm.delay <- mean(p2pool.confirm.delay[is.finite(p2pool.confirm.delay)])
|
|
|
|
|
|
receive_time.unique <- sort(unique(xmr.blockchain$canon.receive_time))
|
|
receive_time.unique <- receive_time.unique[is.finite(receive_time.unique)]
|
|
block_receive_time.unique <- sort(unique(xmr.blockchain$canon.block_receive_time))
|
|
block_receive_time.unique <- block_receive_time.unique[is.finite(block_receive_time.unique)]
|
|
|
|
p2pool.sim.confirm <- vector("list", length(block_receive_time.unique) - 1)
|
|
|
|
for (i in seq_along(p2pool.sim.confirm)) {
|
|
receive_time.confirm = receive_time.unique[
|
|
(receive_time.unique + 1 + mean.p2pool.confirm.delay) %between%
|
|
c(block_receive_time.unique[i] - 1, block_receive_time.unique[i + 1])
|
|
]
|
|
|
|
if (length(receive_time.confirm) > 0) {
|
|
p2pool.sim.confirm[[i]] <- data.table(
|
|
p2pool.sim.confirm.time = block_receive_time.unique[i + 1],
|
|
canon.receive_time = receive_time.confirm
|
|
)
|
|
} else {
|
|
p2pool.sim.confirm[[i]] <- data.table(
|
|
p2pool.sim.confirm.time = integer(0),
|
|
canon.receive_time = integer(0)
|
|
)
|
|
}
|
|
}
|
|
|
|
p2pool.sim.confirm <- data.table::rbindlist(p2pool.sim.confirm)
|
|
|
|
xmr.blockchain <- merge(xmr.blockchain, p2pool.sim.confirm, by = "canon.receive_time", all.x = TRUE)
|
|
|
|
xmr.blockchain[, mean(canon.block_receive_time - p2pool.sim.confirm.time, na.rm = TRUE)]
|
|
|
|
block.reward <- unique(xmr.blockchain[, .(block_height, block_reward, Pool, is_p2pool)])
|
|
|
|
|
|
block.reward[, mean(block_reward, na.rm = TRUE) / 1e12, by = "Pool"]
|
|
block.reward[, mean(block_reward, na.rm = TRUE) / 1e12, by = "is_p2pool"]
|
|
|
|
block.reward[, (mean(block_reward[is_p2pool], na.rm = TRUE) -
|
|
mean(block_reward[!is_p2pool], na.rm = TRUE) )/ 1e12]
|
|
|
|
|
|
|
|
block.reward[, Pool := relevel(factor(Pool), "other")]
|
|
|
|
summary(feols(I(block_reward/1e12) ~ Pool, data = block.reward), vcov = "hetero")
|
|
# Check statistical significance
|
|
|
|
block.num.txs <- unique(xmr.blockchain[, .(block_num_txes, Pool, is_p2pool)])
|
|
|
|
|
|
block.num.txs[, mean(block_num_txes, na.rm = TRUE), by = "Pool"]
|
|
block.num.txs[, mean(block_num_txes, na.rm = TRUE), by = "is_p2pool"]
|
|
|
|
block.num.txs[, (mean(block_num_txes[is_p2pool], na.rm = TRUE) -
|
|
mean(block_num_txes[!is_p2pool], na.rm = TRUE) )]
|
|
|
|
block.num.txs[, Pool := relevel(factor(Pool), "other")]
|
|
|
|
summary(feols(block_num_txes ~ Pool, data = block.num.txs), vcov = "hetero")
|
|
# Check statistical significance
|
|
|
|
|
|
|
|
block.template.update.adjustment <- xmr.blockchain[,
|
|
mean(diff(sort(unique(canon.receive_time))))]
|
|
print(block.template.update.adjustment)
|
|
|
|
xmr.tx.eligiibility <- xmr.blockchain[,
|
|
.(block.template.update =
|
|
min(canon.block_receive_time - canon.receive_time -
|
|
block.template.update.adjustment, na.rm = TRUE) / 60),
|
|
by = c("block_height", "Pool")]
|
|
# Removes transactions with no canon.receive_time. The nodes did not see
|
|
# those transactions before they appeared in a received block
|
|
# WARNING: Produces Infs when block has no transactions
|
|
|
|
xmr.tx.eligiibility <- xmr.tx.eligiibility[is.finite(block.template.update), ]
|
|
|
|
xmr.tx.eligiibility[block.template.update < 0, block.template.update := 0]
|
|
|
|
|
|
sum.stats <- function(x) {
|
|
r <- quantile(x, probs = c(0.05, 0.25, 0.5, 0.75, 0.95))
|
|
names(r) <- c("ymin", "lower", "middle", "upper", "ymax")
|
|
r
|
|
}
|
|
# https://stackoverflow.com/questions/21915286/r-ggplot2-geom-boxplot-with-custom-quantiles
|
|
|
|
png("Monero-TX-Confirm-Delay/images/pool-comparison-tx-eligibility-boxplot.png", width = 800, height = 400)
|
|
|
|
ggplot(xmr.tx.eligiibility, aes(y = Pool, x = block.template.update)) +
|
|
stat_summary(fun.data = sum.stats, geom = "boxplot", position = "dodge", width = 0.75,
|
|
fill = "#FF6600") +
|
|
ggtitle("Boxplots of Time Between Transactions Entering the Mempool and\nBecoming Candidates for Blockchain Confirmation, by Mining Pool") +
|
|
xlab(" Minutes github.com/Rucknium") +
|
|
stat_summary(fun = mean, geom = "point", shape = 18, size = 3, color = "blue") +
|
|
scale_x_continuous(breaks = 0:10, expand = expansion(mult = c(0, 0.05))) +
|
|
expand_limits(x = 0) +
|
|
theme(axis.ticks.y = element_blank(), plot.title = element_text(size = 20),
|
|
axis.text = element_text(size = 15), axis.title.x = element_text(size = 15),
|
|
axis.title.y = element_blank())
|
|
|
|
dev.off()
|
|
|
|
|
|
png("Monero-TX-Confirm-Delay/images/pool-comparison-tx-eligibility-barchart.png", width = 800, height = 400)
|
|
|
|
ggplot(xmr.tx.eligiibility, aes(y = Pool, x = block.template.update)) +
|
|
ggtitle("Average Time Between Transactions Entering the Mempool and\nBecoming Candidates for Blockchain Confirmation, by Mining Pool") +
|
|
xlab(" Minutes github.com/Rucknium") +
|
|
stat_summary(fun = mean, geom = "bar", col = "black", fill = "#FF6600", width = 0.75) +
|
|
scale_x_continuous(breaks = 0:10, expand = expansion(mult = c(0, 0.05))) +
|
|
expand_limits(x = 0) +
|
|
theme(axis.ticks.y = element_blank(), plot.title = element_text(size = 20),
|
|
axis.text = element_text(size = 15), axis.title.x = element_text(size = 15),
|
|
axis.title.y = element_blank())
|
|
|
|
dev.off()
|
|
|
|
|
|
|
|
|
|
|
|
|
|
prev.block.time <- unique(xmr.blockchain[, .(block_height, canon.block_receive_time)])
|
|
setorder(prev.block.time, block_height)
|
|
prev.block.time[, canon.prev.block_receive_time := shift(canon.block_receive_time, type = "lag")]
|
|
|
|
xmr.blockchain <- merge(xmr.blockchain,
|
|
prev.block.time[, .(block_height, canon.prev.block_receive_time)], by = "block_height")
|
|
|
|
prev.block.summary <- xmr.blockchain[,
|
|
.(elapsed = (max(canon.receive_time, na.rm = TRUE) - unique(canon.prev.block_receive_time)) / 60),
|
|
by = c("block_height", "Pool")]
|
|
# max() will produce -Inf if there are no txs in the block
|
|
|
|
prev.block.summary[! is.finite(elapsed), elapsed := 0]
|
|
# elapsed will be NA if the block contains no transactions. Therefore,
|
|
# the amount of time that has elapsed between last block and this block's
|
|
# block template is assumed to be zero.
|
|
|
|
|
|
line.frame <- seq(0, 10, by = 0.01)
|
|
|
|
png("Monero-TX-Confirm-Delay/images/mining-pool-behavior-histogram.png", width = 800, height = 800)
|
|
|
|
plot.xlim <- c(-1, 8.5)
|
|
|
|
ggplot(prev.block.summary, aes(elapsed)) +
|
|
geom_line(aes(x = x, y = y), data = data.frame(x = line.frame, y = dexp(line.frame, rate = 0.5))) +
|
|
geom_histogram(aes(y = ..density..), bins = diff(plot.xlim) * 60, fill = "#FF6600FF") +
|
|
ggtitle("Density Histogram of Age of Youngest Transaction in a Mined Block Minus\nAge of Previous Mined Block, by Mining Pool") +
|
|
xlab(" Minutes github.com/Rucknium") +
|
|
ylab ("Density") +
|
|
facet_wrap(~ Pool, ncol = 3, scales = "free_y") +
|
|
coord_cartesian(xlim = plot.xlim) +
|
|
scale_x_continuous(breaks = -1:10) +
|
|
theme(plot.title = element_text(size = 20),
|
|
axis.text = element_text(size = 15), axis.title.x = element_text(size = 15),
|
|
axis.title.y = element_text(size = 15), strip.text = element_text(size = 15))
|
|
|
|
dev.off()
|
|
|
|
|
|
|
|
|