R Function – Infinity Multiplication – Beyond Memory

Advertisement

# "Copyright Notice", please do not remove.
# Written by Kevin Ng
# The full tutorial on this subject can be found @ http://kevinhng86.iblog.website or http://programming.world.edu.
# Release date to http://programming.world.edu will lag at least one week after release on http://kevinhng86.iblog.website
# This source code file is a part of Kevin Ng's Z library.
# This source code is licenses under CCDL-1.0  A copy of CDDL1.0 can be found at https://opensource.org/licenses/CDDL-1.0
# End "Copyright Notice"

# Notice: This is the protype version of infiXF.
#         This version does support decimal calculation.
#         InfiXF is for sciencetific use.
#         InfiXf protype maximum potential can only be achieve on a 64 bits operating environment.
#         For 32 bits operating environment, the maximum file size for A or B file is 1 Gb or 1 billion digits.

# Limitation: Although had not calculate the number to be that large yet, in theory InfiXF can calculate two strings of digits that are 1/5 the size of the hard drive.
#             If the hard drive is 1 Terabyte, This program can calculate the multiplication procedure for two strings of digit with the combine storage of 200 GB.
#             That is about 100 billion digits in length for each string of digits.
#             This version does not come with the renderer.
#             After a huge calculation, and if the answer file is larger than 1GB another program woulb be requires to render the answer on screen.
#             InfiXF does not consume memory and have very little memory foot print.
#             InfiXF however does requires the storage space as large as the two files that contained the strings of digits to produce the answer string.
infiXF <- function(){
  # This function is to be use until R platform have a search POS that is not grepexpr.
  # If grepexpr found a match on the first position of the string or the second, it will treat both position as position one.
  # This is from the left side of the string.
  searchPos <- function(match, string){
    found <- -1
    for ( i in 1:nchar(string)){
      if ( substr(string,i,i) == match ){
        found <- i
        break
      }
    }
    return(found)
  }
  
  options(scipen = 25)
  isaNeg <- FALSE
  isbNeg <- FALSE
  afile <- "a.infiX"
  bfile <- "b.infiX"
  atmp <- paste(afile, ".tmp", sep="")
  btmp <- paste(bfile, ".tmp", sep="")
  outputfile <- "result.infiX"
  outputtmp <- paste(outputfile, ".tmp", sep="")
  readA <- ""
  readB <- ""
  dAfterDecA <- -1
  dAfterDecB <- -1
  dAfterDecT <- 0
  tmpDReadA <- 0
  tmpDReadB <- 0
  perReadTmp <- 50 # This is changeable, how many character to read at once during temporary file reading.
  
  afilelen <- file.info(afile)$size
  bfilelen <- file.info(bfile)$size
  afileposr <- 0
  bfileposr <- 0
  
  FileA <- file(afile, "r")
  TmpA <- file(atmp, "w")
  readA <- readChar(FileA, nchars = ifelse(afilelen - afileposr > perReadTmp, perReadTmp, afilelen - afileposr), useBytes = FALSE)
  isaNeg <- substr(readA,1,1) == '-'
  readA <- gsub("^[+-]+", "" , readA)
  readA <- gsub("[\r\n ]+$", "", readA)
  dAfterDecA <- searchPos('.', readA)
  dAfterDecA <- ifelse(dAfterDecA > -1, nchar(readA) - dAfterDecA, dAfterDecA)
  if (dAfterDecA > -1){
    readA <- gsub("[.]", "", readA) 
  }
  cat(file = TmpA, readA, sep = "")
  afileposr <- afileposr + perReadTmp 
  while (afileposr < afilelen ){
    readA <- readChar(FileA, nchars = ifelse(afilelen - afileposr > perReadTmp, perReadTmp, afilelen - afileposr), useBytes = FALSE)
    readA <- gsub("[\r\n ]+$", "", readA)
    if (dAfterDecA < 0){
      dAfterDecA <- searchPos('.', readA)
      dAfterDecA <- ifelse(dAfterDecA > -1, nchar(readA) - dAfterDecA, dAfterDecA)
      if (dAfterDecA > -1){
        readA <- gsub("[.]", "", readA) 
      }
    } else {
      tmpDReadA <- nchar(readA)
      dAfterDecA <- dAfterDecA + tmpDReadA
    }
    cat(file = TmpA, readA, sep = "")
    afileposr <-afileposr + perReadTmp
  }
  close(TmpA)
  close(FileA)
  
  FileB <- file(bfile, "r")
  TmpB <- file(btmp, "w")
  readB <- readChar(FileB, nchars = ifelse(bfilelen - bfileposr > perReadTmp, perReadTmp, bfilelen - bfileposr), useBytes = FALSE)
  isbNeg <- substr(readB,1,1) == '-'
  readB <- gsub("^[+-]+", "" , readB)
  readB <- gsub("[\r\n ]+$", "", readB)
  dAfterDecB <- searchPos('.', readB)
  dAfterDecB <- ifelse(dAfterDecB > -1, nchar(readB) - dAfterDecB, dAfterDecB)
  if (dAfterDecB > -1){
    readB <- gsub("[.]", "", readB) 
  }
  cat(file = TmpB, readB, sep = "")
  bfileposr <- bfileposr + perReadTmp 
  while (bfileposr < bfilelen ){
    readB <- readChar(FileB, nchars = ifelse(bfilelen - bfileposr > perReadTmp, perReadTmp, bfilelen - bfileposr), useBytes = FALSE)
    readB <- gsub("[\r\n ]+$", "", readB)
    if (dAfterDecB < 0){
      dAfterDecB <- searchPos('.', readB)
      dAfterDecB <- ifelse(dAfterDecB > -1, nchar(readB) - dAfterDecB, dAfterDecB)
      if (dAfterDecB > -1){
        readB <- gsub("[.]", "", readB) 
      }
    } else {
      tmpDReadB <- nchar(readB)
      dAfterDecB <- dAfterDecB + tmpDReadB
    }
    cat(file = TmpB, readB, sep = "")
    bfileposr <- bfileposr + perReadTmp
  }
  close(TmpB)
  close(FileB)  
  
  pad0 <- ""
  dAfterDecA <- ifelse(dAfterDecA < 0, 0, dAfterDecA)
  dAfterDecB <- ifelse(dAfterDecB < 0, 0, dAfterDecB)
  dAfterDecT <- dAfterDecA + dAfterDecB
  digit <- 7  # This is the amount of digits to calculate per cycle. Do not set this above 7.
  atmpsize <- file.info(atmp)$size
  btmpsize <- file.info(btmp)$size
  premakeoutlen <- (atmpsize + btmpsize) + (digit * 2)
  
  while (nchar(pad0) < (digit - 1)){
    pad0 <- paste("0", pad0, sep="")
  }
  # This code is for the event of someone setting the digit variable to 1.
  # The event most likely not to occur. nevertheless being able to set the digit variable to one also offer the greatest backward compatibility in technology.
  pad0tmp <- ifelse(nchar(pad0) < 1, "0", pad0)
  digittmp <- ifelse(digit < 1, 1, digit - 1)
  
  OutputTmp <- file(outputtmp, "w")
  idn = 0
  while (idn < premakeoutlen){
    cat(file = OutputTmp, pad0tmp, sep = "")
    idn <- idn + digittmp
  }
  close(OutputTmp)
  
  a <- 0
  b <- 0
  o <- 0
  posrB <- 1
  posrO <- 1
  loopidxB <- 1
  temp <- ""
  tempadd <- "" 
  blen <- btmpsize
  olen <- file.info(outputtmp)$size
  
  TmpB <- file(btmp, "r")
  while (posrB != 0){
    alen <- atmpsize
    posrA <- 1
    leftover <- 0
    remainder <- 0
    loopidxA <- 1
    posrB <- blen - (loopidxB * digit)
    seek(TmpB, where = ifelse(posrB > 0, posrB, 0), origin = "start", rw = "r")
    b <- as.numeric(readChar(TmpB, nchars = ifelse(posrB > 0, digit , digit + posrB), useBytes = FALSE))
    
    TmpA <- file(atmp, "r")
    OutputTmp <- file(outputtmp, "r+b")
    while (posrA != 0){
      posrO <- olen - ((loopidxA + loopidxB - 1) * digit)
      posrA <- alen - (loopidxA * digit)
      seek(TmpA, where = ifelse(posrA > 0, posrA, 0), origin = "start", rw = "r")
      a <- as.numeric(readChar(TmpA, nchars = ifelse(posrA > 0, digit , digit + posrA), useBytes = FALSE))      
      temp <- toString(b * a + remainder + leftover)
      leftover <- ifelse(nchar(temp) > digit, as.numeric(substr(temp,1, nchar(temp) - digit)), 0);
      temp <- paste(pad0, temp, sep="");
      
      seek(OutputTmp, where = posrO, origin = "start", rw = "r")      
      o <- as.numeric(readChar(OutputTmp, nchars = digit, useBytes = FALSE))
      
      tempadd <- toString(as.numeric(substr(temp, nchar(temp) - digit + 1, nchar(temp))) + o)
      remainder <- ifelse(nchar(tempadd) > digit, as.numeric(substr(tempadd,1, nchar(tempadd) - digit)), 0);
      tempadd <- paste(pad0, tempadd, sep="")
      
      seek(OutputTmp, where = posrO, origin = "start", rw = "w")
      writeBin(charToRaw(substr(tempadd, nchar(tempadd) - digit + 1, nchar(tempadd))), OutputTmp, useBytes = FALSE, endian = .Platform$endian)
      
      posrA <- ifelse(posrA > 0, posrA, 0)
      loopidxA <- loopidxA + 1
    }
    if (remainder + leftover > 0){
      posrO <- posrO - digit
      leftover <- paste(pad0, toString(leftover + remainder), sep="")
      seek(OutputTmp, where = posrO, origin = "start", rw = "w")
      writeBin(charToRaw(substr(leftover, nchar(leftover) - digit + 1, nchar(leftover))), OutputTmp, useBytes = FALSE, endian = .Platform$endian)
    }
    close(OutputTmp)
    close(TmpA)
    posrB <- ifelse(posrB > 0, posrB, 0)
    loopidxB <- loopidxB + 1
  }
  close(TmpB)
  
  lead0End = FALSE
  dBeforeDec = olen - dAfterDecT
  posw = 0
  truncatediff = 0
  truncatelen = 0
  readOutputTmp = ""
  checker = ""
  truncatestr = ""
  
  OutputTmp = file(outputtmp, "r")
  Output = file(outputfile, "w")
  if (isaNeg != isbNeg){
    cat(file = Output, sep = "", "-")
  }
  while (posw < dBeforeDec){
    readOutputTmp <- readChar(OutputTmp, nchars = ifelse(posw + perReadTmp < dBeforeDec, perReadTmp , dBeforeDec - posw), useBytes = FALSE)
    if (lead0End == FALSE){
      readOutputTmp <- gsub("^0+", "" , readOutputTmp)
      lead0End <- ifelse(nchar(readOutputTmp) > 0, TRUE, FALSE)
    }
    cat(file = Output, sep = "", readOutputTmp)
    posw <- ifelse(posw + perReadTmp < dBeforeDec, posw + perReadTmp, dBeforeDec)
  }
  close(Output)
  
  outputlen <- file.info(outputfile)$size
  Output <- file(outputfile, "r+")
  if (outputlen < 2){
    seek(Output, where = 0, origin = "start", rw = "r")
    checker <- readChar(Output, nchars = 1, useBytes = FALSE)
    if (outputlen < 1 || checker == "-"){
      seek(Output, where = outputlen, origin = "start", rw = "w")
      cat(file = Output, sep = "", "0")
    }
  }
  
  outputlen <- file.info(outputfile)$size
  seek(Output, where = outputlen , origin = "start", rw = "w")
  
  if (dAfterDecT > 0){
    cat(file = Output, sep = "", ".")
  }
  
  while (posw < olen){
    readOutputTmp <- readChar(OutputTmp, nchars = ifelse(posw + perReadTmp < olen, perReadTmp , olen - posw), useBytes = FALSE)
    truncatestr <- readOutputTmp
    truncatestr <- gsub("0+$", "", readOutputTmp)
    truncatediff <- nchar(readOutputTmp) - nchar(truncatestr)
    truncatelen <- ifelse(truncatediff == nchar(readOutputTmp), truncatediff + truncatelen, truncatediff)
    cat(file = Output, sep = "", readOutputTmp)
    posw <- posw + perReadTmp
  }
  close(Output)
  close(OutputTmp)
  
  outputlen <- file.info(outputfile)$size
  Output = file(outputfile, "r+")
  seek(Output, where = (outputlen - truncatelen) , origin = "start", rw = "w")
  truncate(Output)
  close(Output)
  
  outputlen <- file.info(outputfile)$size
  Output = file(outputfile, "r")
  seek(Output, where = outputlen - 1, origin = "start", rw = "r")
  readOutputTmp <- readChar(Output, nchars = 1, useBytes = FALSE)
  close(Output)
  
  if (readOutputTmp == "."){
    Output = file(outputfile, "a")
    seek(Output, where = (outputlen - 1), origin = "start", rw = "w")
    truncate(Output)
    close(Output)
  }
  # Sometimes file do not close properly in R, this is to close all unclose file.
  closeAllConnections() 
}

randFile <- function (){
  fileA <- "a.infiX"
  fileB <- "b.infiX"
  randDigitA <- floor(runif(1, min=0, max=350)) + 40
  randDigitB <- floor(runif(1, min=0, max=350)) + 40
  randDecPOSA <- floor(runif(1, min=0, max=randDigitA - 20)) + 20
  randDecPOSB <- floor(runif(1, min=0, max=randDigitB - 20)) + 20
  
  RANDOMA <- file(fileA, "w")
  cat(file = RANDOMA, sep = "", "-")
  for (idn in seq(0,randDigitA)){
    cat(file = RANDOMA, sep = "", floor(runif(1, min=0, max=9)))
    if (idn == randDecPOSA){
      cat(file = RANDOMA, sep = "", ".")
    }
  }
  close(RANDOMA)
  
  RANDOMB <- file(fileB, "w")
  for (idn in seq(0,randDigitB)){
    cat(file = RANDOMB, sep = "", floor(runif(1, min=0, max=9)))
    if (idn == randDecPOSB){
      cat(file = RANDOMB, sep = "", ".")
    }
  }
  close(RANDOMB)
  
}

randFile()
infiXF()
print("Check in the working directory.")
print(" a.infiX is the file that hold the first set of digits.")
print(" b.infiX is the second file that hold the digits.")
print(" result.infiX is the result of the multiplication procedure.")
print("The name of the temporary file for them are a.infiX.tmp, b.infiX.tmp, result.infiX.tmp.")
print("Temporary files can be delete after execution, but are currently kept for debuging purposes.")
Advertisement


Random Article You May Like