Nothing
#' Convert time stamp to POSIX
#'
#' This function returns the associated \code{POSIXct} time
#' to the time stamp integer in a block header.
#'
#' @param x \code{integer}, the block header time stamp
#'
#' @return An object of class \code{POSIXct, POSIXt}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @references \url{https://en.bitcoin.it/wiki/Block_timestamp}
#' @name int2date
#' @rdname int2date
#' @examples
#' ts <- 1532954868
#' int2date(ts)
#' @export
int2date <- function(x){
x <- abs(as.integer(x))
ans <- as.POSIXct(x,
tz = "GMT",
origin = "1970-01-01 00:00:00",
format = "%Y-%m-%d %H:%M:%S")
ans
}
#' Convert date/time to integer
#'
#' This function returns the associated \code{integer} time
#' for a given date/time object (coercible as \code{POSIXct} object.
#'
#' @param x \code{POSIXct}, date/time object.
#' @return \code{integer}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name date2int
#' @rdname date2int
#' @examples
#' d <- "2017-03-15"
#' date2int(d)
#' @export
date2int <- function(x){
x <- as.POSIXct(x, tz = "GMT", origin = "1970-01-01")
as.integer(x)
}
#' Integer representation of a day-begin
#'
#' This function returns the associated \code{integer} time
#' for the start of a specific day (\emph{i.e.}, \code{00:00:00} time).
#'
#' @param x \code{POSIXct}, date/time object.
#' @return \code{integer}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name intMinDay
#' @rdname intMinDay
#' @examples
#' d1 <- "2017-03-15"
#' d1 <- intMinDay(d1)
#' d2 <- "2017-03-15 00:00:00"
#' d2 <- intMinDay(d2)
#' identical(d1,d2)
#' @export
intMinDay <- function(x){
d <- as.Date(x)
s <- as.POSIXct(paste0(d, "00:00:00"),
tz = "GMT",
origin = "1970-01-01")
date2int(s)
}
#' Integer representation of a day-end
#'
#' This function returns the associated \code{integer} time
#' for the end of a specific day (\emph{i.e.}, \code{23:59:59} time).
#'
#' @param x \code{POSIXct}, date/time object.
#' @return \code{integer}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name intMaxDay
#' @rdname intMaxDay
#' @examples
#' d1 <- "2017-03-15"
#' d1 <- intMaxDay(d1)
#' d2 <- "2017-03-15 23:59:59"
#' d2 <- intMaxDay(d2)
#' identical(d1,d2)
#' @export
intMaxDay <- function(x){
d <- as.Date(x)
e <- as.POSIXct(paste0(d, "23:59:59"),
tz = "GMT",
origin = "1970-01-01")
date2int(e)
}
#' Integer range within a day
#'
#' This function returns the associated \code{integer} times
#' for the start and end of a specific day.
#'
#' @param x \code{POSIXct}, date/time object.
#'
#' @return \code{integer}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name intRangeDay
#' @rdname intRangeDay
#' @examples
#' d1 <- "2017-03-15"
#' intRangeDay(d1)
#' intMinDay(d1)
#' intMaxDay(d1)
#' @export
intRangeDay <- function(x){
d <- as.Date(x)
c(first = intMinDay(d), last = intMaxDay(d))
}
#' Integer range between two dates
#'
#' This function returns the associated \code{integer} times
#' for the start of date \code{d1} and the end of date \code{d2}.
#'
#' @param d1 \code{POSIXct}, date/time object.
#' @param d2 \code{POSIXct}, date/time object.
#'
#' @return \code{integer}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name intRangePeriod
#' @rdname intRangePeriod
#' @examples
#' d1 <- "2017-03-15"
#' d2 <- "2017-04-15"
#' intRangePeriod(d1, d2)
#' intMinDay(d1)
#' intMaxDay(d2)
#' @export
intRangePeriod <- function(d1, d2){
d1 <- as.Date(d1)
d2 <- as.Date(d2)
if (d1 <= d2){
ans <- c(first = intMinDay(d1), last = intMaxDay(d2))
} else {
ans <- c(first = intMinDay(d2), last = intMaxDay(d1))
}
ans
}
#' Retrieve TX Ids in block
#'
#' This function retrieves the transaction IDs in a block.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param height \code{integer}, the block's height.
#' @param excoinbase \code{logical}, whether coinbase transaction
#' should be excluded (default is \code{TRUE}).
#'
#' @return \code{character}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name txids
#' @rdname txids
#' @export
txids <- function(con, height, excoinbase = TRUE){
height <- as.integer(abs(height))
bc <- unlist(slot(getblockcount(con),
"result"))
if (height > bc) {
stop("'height' exceeds max height in local chain.\n")
}
h <- slot(getblockhash(con, height),
"result")
b <- slot(getblock(con, h),
"result")
ans <- unlist(b[["tx"]])
if (excoinbase){
ans <- ans[-1]
}
if (length(ans) < 1) {
warning("No transactions in block.\n")
}
ans
}
#' Retrieving the input transaction IDs
#'
#' This function returns the transaction IDs of the inputs for
#' a given transaction.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#'
#' @return \code{data.frame}, the transaction ID(s) and
#' the position(s) of the previous UTXO(s).
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name txinids
#' @rdname txinids
#' @export
txinids <- function(con, txid){
txraw <- slot(getrawtransaction(con, txid),
"result")
txdec <- slot(decoderawtransaction(con, txraw),
"result")
vin <- txdec[["vin"]]
txinids <- unlist(lapply(vin, function(x) x[["txid"]]))
txinpos <- unlist(lapply(vin, function(x) x[["vout"]])) + 1
ans <- data.frame(txinids, txinpos,
stringsAsFactors = FALSE)
ans
}
#' Retrieving values of UTXOs
#'
#' This function returns the values of UTXO(s) in a transaction.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#'
#' @return \code{numeric}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name utxovalue
#' @rdname utxovalue
#' @export
utxovalue <- function(con, txid){
txraw <- slot(getrawtransaction(con, txid),
"result")
txdec <- slot(decoderawtransaction(con, txraw),
"result")
vout <- txdec[["vout"]]
ans <- unlist(
lapply(vout, function(x) x[["value"]])
)
ans
}
#' Retrieving types of UTXOs
#'
#' This function returns the types of the UTXO(s) in a transaction.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#'
#' @return \code{character}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name utxotype
#' @rdname utxotype
#' @export
utxotype <- function(con, txid){
txraw <- slot(getrawtransaction(con, txid),
"result")
txdec <- slot(decoderawtransaction(con, txraw),
"result")
vout <- txdec[["vout"]]
ans <- unlist(
lapply(vout, function(x){
x[["scriptPubKey"]][["type"]]
})
)
ans
}
#' Age of UTXOs
#'
#' This function returns a \code{difftime} object measuring the elapsed time(s)
#' between the UTXO(s) in a transaction and its input(s) (previous UTXO(s)).
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#' @param units \code{character}, the time difference units;
#' passed to \code{difftime()}.
#'
#' @return \code{difftime}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name utxoage
#' @rdname utxoage
#' @export
utxoage <- function(con, txid,
units = c("auto", "secs", "mins",
"hours", "days", "weeks")){
txraw <- slot(getrawtransaction(con, txid, verbose = TRUE),
"result")
txotime <- int2date(txraw[["time"]])
txins <- unlist(lapply(txraw[["vin"]],
function(x) x[["txid"]])
)
n <- length(txins)
txitime <- integer(n)
for (i in 1:n){
txraw <- slot(getrawtransaction(con, txins[i], verbose = TRUE),
"result")
txitime[i] <- txraw[["time"]]
}
ans <- difftime(txotime, int2date(txitime), units = units)
list("TimeUtxo" = txraw[["time"]],
"AgeInput" = ans)
}
#' Compute fee of a transaction
#'
#' This function returns the implicit fee of a transaction,
#' by computing the difference between the sum of its inputs
#' and the sum of its outputs.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#'
#' @return \code{numeric}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name txfee
#' @rdname txfee
#' @export
txfee <- function(con, txid){
valo <- sum(utxovalue(con, txid))
txin <- txinids(con, txid)
n <- nrow(txin)
vali <- 0
for (i in 1:n) {
val <- utxovalue(con, txin[i, 1])[txin[i, 2]]
vali <- vali + val
}
ans <- vali - valo
ans
}
#' Compute fee in a block
#'
#' This function returns the fee of the coinbase transaction.
#' Hereby, the mining reward has been deducted.
#' Initially, the mining reward was 50 BCH and is halved every
#' 210,000 blocks.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param height \code{integer}, the height of the block.
#'
#' @return \code{numeric}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name bkfee
#' @rdname bkfee
#' @export
bkfee <- function(con, height){
height <- as.integer(abs(height))
cb <- txids(con, height, excoinbase = FALSE)[1]
mtot <- sum(utxovalue(con, cb))
hf <- ceiling(height / 209999) - 1
hf <- 2 ^ hf
mrwd <- 50 / hf
ans <- mtot - mrwd
ans
}
#' Obtaining statistics of a block
#'
#' This function returns key statistics of a block's content,
#' such as the time, the count of transactions,
#' and summary statistics of the UTXOs.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param height \code{integer}, the block's height.
#' @param excoinbase \code{logical}, whether coinbase transaction
#' should be excluded (default is \code{TRUE}).
#'
#' @return An object of class \code{data.frame}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name blockstats
#' @rdname blockstats
#' @export
blockstats <- function(con, height, excoinbase = TRUE){
height <- as.integer(abs(height))
bc <- slot(getblockcount(con),
"result")
if (height > bc){
stop("'height' exceeds max height in local chain.\n")
}
h <- slot(getblockhash(con, height),
"result")
b <- slot(getblock(con, h),
"result")
## to be filled
btime <- b[["time"]]
txids <- unlist(b[["tx"]])
n <- length(txids)
if (excoinbase){
txids <- txids[-1]
}
n <- length(txids)
if (n < 1) {
warning("No transactions in block.\n")
umax <- NA
umin <- NA
uavg <- NA
umed <- NA
usum <- NA
} else {
usum <- 0
uvals <- c()
for (i in 1:n){
uval <- utxovalue(con, txids[i])
usum <- usum + sum(uval)
uvals <- c(uvals, uval)
}
## Summary statistics of uvals
umax <- max(uvals)
umin <- min(uvals)
uavg <- mean(uvals)
umed <- stats::median(uvals)
}
ans <- data.frame("Height" = height,
"Time" = btime,
"TxCount" = n,
"UtxoMax" = umax,
"UtxoMin" = umin,
"UtxoMean" = uavg,
"UtxoMedian" = umed,
"UtxoVolume" = usum
)
ans
}
#' Statistics of a transaction
#'
#' This function returns key statistics/characteristics of
#' a transaction.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param txid \code{character}, the id of the transaction.
#'
#' @return \code{data.frame}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name txstats
#' @rdname txstats
#' @export
txstats <- function(con, txid){
txraw <- slot(getrawtransaction(con, txid, verbose = TRUE),
"result")
uvals <- utxovalue(con, txid)
fee <- txfee(con, txid)
ans <- data.frame("CountTxInIds" = length(txraw[["vin"]]),
"CountTxOutIds" = length(txraw[["vout"]]),
"SumOfUtxo" = sum(uvals),
"Fee" = fee,
"Size" = txraw[["size"]],
"Time" = txraw[["blocktime"]],
"BlockHash" = txraw[["blockhash"]],
"Confirmations" = txraw[["confirmations"]],
stringsAsFactors = FALSE)
ans
}
#' Time of a block
#'
#' This function returns the time of a block in GMT.
#'
#' @param con \code{CONRPC}, configuration object.
#' @param height \code{integer}, the height of the block.
#'
#' @return \code{POSIXct}
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name timeofblock
#' @rdname timeofblock
#' @export
timeofblock <- function(con, height){
height <- as.integer(abs(height))
h <- slot(getblockhash(con, height),
"result")
b <- slot(getblock(con, h),
"result")
ans <- int2date(b[["time"]])
ans
}
#' Block height at time
#'
#' This function returns the block heights closest to
#' a provided date/time (time zone is GMT).
#'
#' @param con \code{CONRPC}, configuration object.
#' @param targetdate \code{POSIXct}, the date/time of closest block heights.
#'
#' @return \code{data.frame}: the heights, the times and
#' the time differences (in minutes) to the provided date/time.
#' @family UtilityFuncs
#' @author Bernhard Pfaff
#' @name blockattime
#' @rdname blockattime
#' @export
blockattime <- function(con, targetdate){
dt <- as.POSIXct(targetdate, tz = "GMT")
bh <- slot(getbestblockhash(con),
"result")
lastblock <- slot(getblock(con, bh),
"result")
lastheight <- lastblock[["height"]]
lasttime <- int2date(lastblock[["time"]])
if (dt > lasttime) {
stop("Required block time is greater than last block in local chain.\n")
}
deltatime <- difftime(lasttime, dt, units = "mins")
deltaheight <- ceiling(as.numeric(deltatime / 10))
approxh1 <- lastheight - deltaheight
ht <- timeofblock(con, approxh1)
signtimedelta <- searchdir <- sign(as.numeric(dt - ht))
while (identical(signtimedelta, searchdir)) {
approxh1 <- approxh1 + searchdir
ht <- timeofblock(con, approxh1)
## big step, if current delta time is more than 100 mins
curdelta <- as.numeric(abs(
difftime(dt, ht, units = "mins")))
if (curdelta > 100){
approxh1 <- approxh1 + searchdir * floor(curdelta / 10)
ht <- timeofblock(con, approxh1)
searchdir <- sign(as.numeric(dt - ht))
}
signtimedelta <- sign(as.numeric(dt - ht))
}
approxt1 <- timeofblock(con, approxh1)
approxh2 <- approxh1 - searchdir
approxt2 <- timeofblock(con, approxh2)
Times <- c(approxt1, approxt2)
attr(Times, "tzone") <- "GMT"
ans <- data.frame("Height" = c(approxh1, approxh2),
"Time" = Times,
"DateQuery" = dt,
"DeltaMinutes" = difftime(dt,
c(approxt1, approxt2),
units = "mins")
)
ans <- ans[order(ans[, 1]), ]
ans
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.