Playing around with IEEE754

ieee754.R

ieee754 = function(x, precision = 'long') {
  switch(precision, long = {
    dig_exponent = 11L
    exp_shift = 1023L
    dig_mantissa = 52L
  }, short = {
    dig_exponent = 8L
    exp_shift = 127L
    dig_mantissa = 23L
  }, stop("Valid precisions are 'long' and 'short'."))
    
  sign = as.integer(x < 0)
  x = abs(x)
  exponent = 0
  while (x < 2^(exponent <- exponent - 1)){}
  x = x - 2^exponent
  mantissa = integer(dig_mantissa)
  for (ii in seq_along(mantissa)) {
    if ((delta <- x - 2^(exponent-ii)) < 0) {
      mantissa[ii] = 0L
    } else {
      mantissa[ii] = 1L
      x = delta
    }
  }
  bias_exponent = as.integer(intToBits(exponent + exp_shift))[dig_exponent:1]

  out = list(
    sign = sign,
    bias_exponent = bias_exponent,
    mantissa = bits,
    precision = precision
  )
  class(out) = 'ieee754'
  out
}

print.ieee754 = function(x, hex = FALSE)  {
  bin_str_to_hex = function(b) {
    N = nchar(b)
    n_chunk = ceiling(N/4)
    out = character(n_chunk)
    for (ii in seq_along(out)) {
      rng = N - 4L*ii + c(1L, 4L)
      chunk = substr(b, rng[1L], rng[2L])
      out[length(out) + 1L - ii] = 
        sprintf('%X', sum(2^((nchar(chunk) - 1L):0) * 
                            as.integer(strsplit(chunk, NULL)[[1L]])))
    }
    paste(out, collapse = '')
  }
  if (hex) {
    bias_print = bin_str_to_hex(x$bias_exponent)
    mantissa_print = bin_str_to_hex(x$mantissa)
  } else { 
    bias_print = x$bias_exponent
    mantissa_print = x$mantissa
  }
  sprintf('%d | %s | %s', x$sign, 
          prettyNum(bias_print, big.mark = ' ', big.interval = 4L),
          prettyNum(mantissa_print, big.mark = ' ', big.interval = 4L))
}

print.ieee754 = function(x, hex = FALSE)  {
  bin_to_hex = function(b) {
    N = length(b)
    n_chunk = ceiling(N/4)
    out = character(n_chunk)
    for (ii in seq_along(out)) {
      chunk = b[N - 4L*ii + 1:4]
      out[length(out) + 1L - ii] = 
        sprintf('%X', sum(2L^((length(chunk) - 1L):0) * chunk))
    }
    paste(out, collapse = '')
  }
  if (hex) {
    bias_print = bin_to_hex(x$bias_exponent)
    mantissa_print = bin_to_hex(x$mantissa)
  } else { 
    bias_print = paste(x$bias_exponent, collapse = '')
    mantissa_print = paste(x$mantissa, collapse = '')
  }
  sprintf('%d | %s | %s', x$sign, 
          prettyNum(bias_print, big.mark = ' ', big.interval = 4L),
          prettyNum(mantissa_print, big.mark = ' ', big.interval = 4L))
}