R语言实现传统数学概念中的四舍五入

最近被R中的round函数搞得郁闷，有人说round函数的规则是如此定义的：

引用cos 版主肖楠：这个规则有个俗名叫「四舍六入五凑偶」，也叫「银行家舍入」，完整版如下：

1. 被修约的数字等于或小于 4 时，该数字舍去；
2. 被修约的数字等于或大于 6 时，则进位；
3. 被修约的数字等于 5 时，要看 5 前面的数字，若是奇数则进位，若是偶数则将 5 舍掉，即修约后末尾数字都成为偶数；若 5 的后面还有不为 “0” 的任何数，则此时无论 5 的前面是奇数还是偶数，均应进位。


举例，用上述规则对下列数据保留 3 位有效数字：
9.8249=9.82, 9.82671=9.83
9.8350=9.84, 9.8351 =9.84

9.8250=9.82, 9.82501=9.83

好像是说明了问题，但是：

round(9.9995,3)结果是9.999，难道9是奇数中一个特例？

一下为自己在R中实现的小数的四舍五入（主要是想按照数学中的规则：对该数的的绝对值四舍五入再加上正负号）

一下代码还有许多改进的方面，目前只是满足个人的需要（对某个数小数位后保留n位后四舍五入）：

myRound <- function(x, keep=4){
  x <- as.character(x)
  if(grepl("[.]", x)){
    xSplit <- unlist(strsplit(x, "[.]"))
    xSplitBef <- xSplit[1]
    minusYN <- substring(xSplitBef, 1, 1)
    #     minusYN <- minusYN == "-"
    xSplitAft <- xSplit[2]
    xSplitAft <- substring(xSplitAft, 1:nchar(xSplitAft), 1:nchar(xSplitAft))
    
    if(minusYN == "-"){
      xSplitBef <- substring(xSplitBef, 2:nchar(xSplitBef), 2:nchar(xSplitBef))
      lenBef <- length(xSplitBef)
      lenAft <- length(xSplitAft)
      
      if(lenAft > keep){
        all <- c(xSplitBef, xSplitAft[1:(keep + 1)])
        if(as.integer(tail(all,1)) < 5){
          res1 <- c(xSplitBef, xSplitAft[1:keep])
          res1 <- paste(c(res1[1:lenBef], ".", res1[(lenBef+1):length(res1)]), collapse="")
          res1 <- -as.numeric(res1)
        }else{
          res1 <- c(xSplitBef, xSplitAft[1:keep])
          res1 <- as.integer(res1)
          for(i in length(res1):1){
            if(i == length(res1)){
              res1[i] <- res1[i] + 1
            }
            if(res1[i] != 10){
              break
            }else{
              res1[i - 1] <- res1[i - 1] + 1
            }
          }
          
          if(res1[1] == 10){
            res1[-1] <- 0
            res1 <- c(1,0,res1[-1])
            res1 <- paste(c(res1[1:(lenBef+1)], ".", res1[(lenBef+2):length(res1)]), collapse="")
            res1 <- -as.numeric(res1)
          }else{
            res1[which(res1 == 10)] <- 0
            res1 <- paste(c(res1[1:lenBef], ".", res1[(lenBef+1):length(res1)]), collapse="")
            res1 <- -as.numeric(res1)
          }

        }
      }else{
        res1 <- as.numeric(x)
      }
    }else{
      xSplitBef <- substring(xSplitBef, 1:nchar(xSplitBef), 1:nchar(xSplitBef))
      lenBef <- length(xSplitBef)
      lenAft <- length(xSplitAft)
      
      if(lenAft > keep){
        all <- c(xSplitBef, xSplitAft[1:(keep + 1)])
        if(as.integer(tail(all,1)) < 5){
          res1 <- c(xSplitBef, xSplitAft[1:keep])
          res1 <- paste(c(res1[1:lenBef], ".", res1[(lenBef+1):length(res1)]), collapse="")
          res1 <- as.numeric(res1)
        }else{
          res1 <- c(xSplitBef, xSplitAft[1:keep])
          res1 <- as.integer(res1)
          for(i in length(res1):1){
            if(i == length(res1)){
              res1[i] <- res1[i] + 1
            }
            if(res1[i] != 10){
              break
            }else{
              res1[i - 1] <- res1[i - 1] + 1
            }
          }
          
          if(res1[1] == 10){
            res1[-1] <- 0
            res1 <- c(1,0,res1[-1])
            res1 <- paste(c(res1[1:(lenBef+1)], ".", res1[(lenBef+2):length(res1)]), collapse="")
            res1 <- as.numeric(res1)
          }else{
            res1[which(res1 == 10)] <- 0
            res1 <- paste(c(res1[1:lenBef], ".", res1[(lenBef+1):length(res1)]), collapse="")
            res1 <- as.numeric(res1)
          }

        }
      }else{
        res1 <- as.numeric(x)
      }
    }
  }else{
    res1 <- as.numeric(x)
  }
  return(res1)
}

myRound(-0.374832,3)

该函数不适合向量计算，x必须为单一数值

对多个数值可使用：

( x1 <- seq(-.2, .4, by = .05) )
sapply(x1, myRound, keep=1)