gmtools: My small tools for efficiency

#' tranfer numbers into Chinese numbers transfer_num_chinese(123)
#' generate Chinese number sequence with sapply(1:100,transfer_num_chinese)
#' @description Encoding:UTF-8
#' @author li guomin
#' @param nums
#' @return Chinese nums
#' @export
#' @examples
#' transfer_num_chinese(123)
#' transfer_num_chinese(1001)
#' transfer_num_chinese(12034)
#' sapply(1:10009,transfer_num_chinese)
#' sapply(10000:12001,transfer_num_chinese)

# arab nums to chinese nums
transfer_num_chinese <- function(nums){
	options(scipen=999)
	# 关闭自动使用科学计数法


	# a function that change a number into a Chinese number
	n_wh = function(num) {
		s = list(
			'1' = "一",
			'2' = '二',
			'3' = '三',
			'4' = '四',
			'5' = '五',
			'6' = '六',
			'7' = '七',
			'8' = '八' ,
			'9' = '九',
			'0' = '零'
		)


		i = 0
		while (i < 10){
			if (i==num) {
				r = ifelse(i==0,s[[10]],s[[i]])
				break
			}
			else
				i = i+1
		}
		return(r)
	}



	# a function for 10:19
	f_2d1 <- function(nums_2d){
		last <- n_wh(as.numeric(substr(nums_2d,start=2,stop=2)))
		r_2d <- paste0("十",last)
		return(r_2d)
	}

	# a function for 20:99
	f_2d2 <- function(nums_2d){
		second <- substr(nums_2d,2,2)
		first <- substr(nums_2d,1,1)
		if (second == "0") {
			r_2d <- paste0(as.character(n_wh(as.numeric(first))),"十")
		}
		else {
			r_2d <- paste0(as.character(n_wh(as.numeric(first))),"十",as.character(n_wh(as.numeric(second))))
		}

		return(r_2d)
	}

	# a function for 100:1000
	f_3d <- function(nums_3d){
		first <- substr(nums_3d,1,1)
		second <- substr(nums_3d,2,2)
		third <- substr(nums_3d,3,3)

		if (second =="0" & third=="0"){
			r_3d <- paste0(as.character(n_wh(first)),"百")
		} else if (second=="0" & third !="0") {
			r_3d <- paste0(as.character(n_wh(first)),"百零",as.character(n_wh(third)))
		} else {
			r_3d <- paste0(as.character(n_wh(first)),"百",f_2d2(as.numeric(paste0(second,third))))
		}
		return(r_3d)
	}

	# 1000-999
	f_4d <- function(nums_4d){
		nums_sp <- strsplit(as.character(nums_4d),"")[[1]]
		if (all(nums_sp[-1] == '0')) {
			# 1000
			r_4d <- f_big_int(nums_4d)
		} else if (nums_sp[1] != '0' & nums_sp[2] == '0' & nums_sp[3] == '0' & nums_sp[4] != '0'){
			# 1004
      r_4d <- paste0(n_wh(nums_sp[1]),"千零",n_wh(nums_sp[4]))
		} else if (nums_sp[1] != '0' & nums_sp[2] == '0' & nums_sp[3] != '0' & nums_sp[4] != '0'){
			#1034
			r_4d <- paste0(n_wh(nums_sp[1]),"千零",f_2d2(as.numeric(paste0(nums_sp[3:4],collapse = ""))))
		}	else if (nums_sp[1] != '0' & nums_sp[2] == '0' & nums_sp[3] != '0' & nums_sp[4] == '0'){
			#1030
			r_4d <- paste0(n_wh(nums_sp[1]),"千零",f_2d2(as.numeric(paste0(nums_sp[3:4],collapse = ""))))
		}	else if (all(nums_sp[1:2] != '0')){
			# 1200,1204
			r_4d <- paste0(n_wh(nums_sp[1]),"千",f_3d(as.numeric(paste0(nums_sp[2:4],collapse = ""))))
		}

		return(r_4d)
	}

 # 10000-99999
	f_5d <- function(nums_5d){
		nums_sp <- strsplit(as.character(nums_5d),"")[[1]]
		if (all(nums_sp[-1] == '0')) {
			# 20000,30000
			r_5d <- f_big_int(nums_5d)
		} else if (nums_sp[1] != '0' & nums_sp[5] != '0' & all(nums_sp[-c(1,5)] == '0') ){
			# 10005
			r_5d <- paste0(n_wh(nums_sp[1]),"万零",n_wh(nums_sp[5]))
		} else if (all(nums_sp[c(1,2)] != '0') & all(nums_sp[3:5]=='0')){
			# 12000
			r_5d <- paste0(n_wh(nums_sp[1]),"万")
		} else if (nums_sp[1] != '0' & nums_sp[2] == '0'& nums_sp[3] == '0'& nums_sp[4] == '0' & nums_sp[5] != '0'){
			# 10005
			r_5d <- paste0(n_wh(nums_sp[1]),"万零", n_wh(nums_sp[5]))
		} else if (nums_sp[1] != '0' & nums_sp[2] == '0'& nums_sp[3] == '0'& nums_sp[4] != '0'){
			# 10045
			r_5d <- paste0(n_wh(nums_sp[1]),"万零", f_2d2(as.numeric(paste0(nums_sp[4:5],collapse = ""))))

		} else if (nums_sp[1] != '0' & nums_sp[2] == '0'& nums_sp[3] != '0'){
			# 10345
			r_5d <- paste0(n_wh(nums_sp[1]),"万零", f_3d(as.numeric(paste0(nums_sp[3:5],collapse = ""))))
		} else if (nums_sp[1] != '0' & nums_sp[2] != '0'){
			# 12300-12399
			r_5d <- paste0(n_wh(nums_sp[1]),"万", f_4d(as.numeric(paste0(nums_sp[2:5],collapse = ""))))
		}

		return(r_5d)
	}

	# for 100,000-999,999
	f_6d <- function(nums_6d){
		nums_sp <- strsplit(as.character(nums_6d),"")[[1]]
		if (nums_sp[2]!='0'){
			# 120000,123000,123400,123450,123456
 			r_6d <- paste0(n_wh(nums_sp[1]), "十",n_wh(nums_sp[2]),"万", f_4d(as.numeric(paste0(nums_sp[3:6],collapse = ""))))
		} else if (nums_sp[2]=='0' & nums_sp[3]!='0' & nums_sp[4]!='0'){
			# 103456
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", f_4d(as.numeric(paste0(nums_sp[3:6],collapse = ""))))
		} else if (nums_sp[2]!='0' & nums_sp[3]=='0' & nums_sp[4]!='0'){
			# 120456
			r_6d <- paste0(n_wh(nums_sp[1]), "十",n_wh(nums_sp[2]), "万零", f_3d(as.numeric(paste0(nums_sp[4:6],collapse = ""))))
		} else if (nums_sp[2]!='0' & nums_sp[3]=='0' & nums_sp[4]=='0' & nums_sp[5]!='0'){
			# 120056
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", f_2d2(as.numeric(paste0(nums_sp[5:6],collapse = ""))))
		} else if (nums_sp[2]!='0' & nums_sp[3]=='0' & nums_sp[4]=='0' & nums_sp[5]=='0' & nums_sp[6] !='0'){
			# 120006
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", n_wh(nums_sp[6]))
		} else if (nums_sp[2]=='0' & nums_sp[3]=='0' & nums_sp[4]!='0' ){
			# 100456
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", f_3d(as.numeric(paste0(nums_sp[4:6],collapse = ""))))
		} else if (nums_sp[2]=='0' & nums_sp[3]=='0' & nums_sp[4]=='0'& nums_sp[5]!='0' ){
			# 100056
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", f_2d2(as.numeric(paste0(nums_sp[5:6],collapse = ""))))
		} else {
			# 100006
			r_6d <- paste0(n_wh(nums_sp[1]), "十万零", n_wh(nums_sp[6]))
		}

		return(r_6d)
	}



	# for big integer,like 1000,10000
	f_big_int <- function(nums){

		#nums = 1200 # test
		#nums = 15002 # test

		nums_sp <- strsplit(as.character(nums),"")[[1]]

		a = c("千", "万", "十万", "百万", "千万", "亿", "十亿", "百亿", "千亿", "万亿", "十万亿", "百万亿", "千万亿")
		b = rev(a)
		c = list('4'="千", '5'="万", '6'="十万", '7'="百万", '8'="千万", '9'="亿", '10'= "十亿",'11'= "百亿", '12'="千亿", '13'="万亿", '14'="=十万亿", '15'="百万亿", '16'="千万亿")

		# if (all(nums_sp[2:4] == "0") & length(nums_sp) == 4){
		# 	r_c <- paste0(n_wh(nums_sp[1]),a[1])
		# }

		if (all(nums_sp[-1] == '0')){
			len <- length(nums_sp)
			i <- 4
			while (i < 14) {
				if (i == len) {
					r_int <- paste0(n_wh(nums_sp[1]),a[[i-3]])
					break
				} else {
					i <- i + 1
				}

			}
		}  else {
      print("numbers too big, next time maybe works")
			r <- "numbers too big"
		}

		return(r_int)

	}


	# 0-9
	if (nums <10) {
		r <- n_wh(nums)
	} else if (nums > 9 & nums <20) {
		r<- f_2d1(nums)
	} else if (nums > 19 & nums <100) {
		r <- f_2d2(nums)
	} else if (nums > 99 & nums < 1000){
		r <- f_3d(nums)
	} else if (nums > 999 & nums < 10000) {
		r <- f_4d(nums)
	} else if (nums > 9999 & nums < 100000){
		r <- f_5d(nums)
	}	else if (nums > 99999 & nums < 1000000){
		r <- f_6d(nums)
	}	else {
		r <- f_big_int(nums)
	}

	return(r)

}