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)



评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值