Làm thế nào để vẽ một mảnh lá và lá cho thấy lá thật mà không làm tròn lên

Question

Ví dụ, tôi có số: 43.2, 45.3, 48.1, 54.2. Khi tôi sử dụng) chức năng (gốc để vẽ một cốt truyện, tôi có được điều này: gốc() chức năng cho thấy như thế này

x <- c(43.2, 45.3, 48.1, 54.2) 

stem(x) 
# 
# The decimal point is 1 digit(s) to the right of the | 
# 
# 4 | 3 
# 4 | 58 
# 5 | 4 

Nhưng từ cốt truyện tôi chỉ có thể biết được con số này là: 43,45,48,54. Vì vậy, tôi muốn có một chức năng để vẽ một cốt truyện gốc và lá mà tôi vẫn có thể biết chính xác số mà không làm tròn lên.

Hơn nữa, tôi muốn nó chỉ sử dụng một chữ số để biểu thị gốc, trong khi hiển thị chữ số khác trong lá. Ví dụ: 43.2 phải là một thân cây 4 và một chiếc lá 3.2, 43.22 phải là một thân cây 4 và một chiếc lá 3.22. Dành cho các số điện thoại: 43.2, 45.3, 48.1, 54.2. Tôi muốn âm mưu như thế này:

Answer 1

Đây là một cách. Tôi đã sử dụng gói data.table bên dưới, vì vậy nếu bạn không có, hãy cài đặt nó trước. Nếu bạn thực sự thích rằng cốt truyện được tạo ra bằng cách sử dụng khung dữ liệu thông thường, hãy cho tôi biết và tôi sẽ điều chỉnh nó cho phù hợp.

library(data.table) # Install via install.packages(data.table) 

# x is the vector of numbers for which you want to create the stem and leaf plot 
# leftDigits gives the position of the '|' relative to the decimal point, 
# e.g. leftDigits = 0 will result in 43.2 being represented as 43 | 0.2 
# e.g. leftDigits = 1 will result in 43.2 being represented as 4 | 3.2 
# I have included a rounding parameter, due to floating point problems seen when taking the difference of two numbers 
# rounding = 2 means that your numbers will show to 2 decimal places. Change as desired. 
myStem <- function(x, leftDigits, rounding = 2){ 
    data = data.table("x" = x) # Create a data.table 
    data[, left := floor(x/10^leftDigits)] # Get the number that will be to the left of '|' 
    data[, right := round(x - left*10^leftDigits, rounding)] # The remainder will be on the right 
    data = data[, paste(sort(right), collapse = ", "), by = left] # For each 'left', Place all the 'right' values in a comma separated string. 
    data[, out := paste(left, " | ", V1), by = left] # Add the "|" 
    cat(data$out, sep = "\n") # Output 
} 

# Example 
myStem(x = c(43.2, 45.3, 48.1, 54.2), 1) 
# 4 | 3.2, 5.3, 8.1 
# 5 | 4.2 

Sửa: Nếu bạn muốn có một trở lại trở lại cốt truyện, sau đó đoạn mã sau nên làm việc. Nó hoạt động một cách tương tự như mã trước

myStem <- function(leftVals, rightVals, mainDigits, rounding = 10){ 
    data = data.table("x" = leftVals, "ind" = "x") 
    data = rbind(data, data.table("x" = rightVals, "ind" = "y")) 
    data[, main := floor(x/10^mainDigits)] 
    data[, right := round(x - main*10^mainDigits, rounding)] 
    data = data[, ifelse(ind == "x", paste0(-sort(-right), collapse = ", "), paste0(sort(right), collapse = ", ")), by = c("ind", "main")] # For each 'main', Place all the 'right' values in a comma separated string. 
    data = dcast(data, main ~ ind, value.var = "V1") 
    data[, "left|" := ifelse(is.na(x), "", "|")] 
    data[, "right|" := ifelse(is.na(y), "", "|")] 
    data[, x := ifelse(is.na(x), "", x)] 
    data[, y := ifelse(is.na(y), "", y)] 
    data = data[, c("x", "left|", "main", "right|", "y"), with = F] 
    maxLengthY = max(nchar(data$y)) 
    data[, y := unlist(lapply(y, function(z) paste0(z, paste0(replicate(maxLengthY - nchar(z), " "), collapse = ""))))] 
    colnames(data) = rep(" ", ncol(data)) 
    data 
} 

# Example 
myStem(leftVals = c(43.2, 45.3, 48.1, 54.2), rightVals = c(30.2, 34.5, 44.3), 1) 

1:     3 | 0.2, 4.5 
2: 8.1, 5.3, 3.2 | 4 | 4.3  
3:   4.2 | 5   

Answer 2

x <- c(43.2, 45.3, 48.1, 54.2) 

stem(x) 
# 
# The decimal point is 1 digit(s) to the right of the | 
# 
# 4 | 3 
# 4 | 58 
# 5 | 4 

stem2(x) 
# 
# The decimal point is 1 digit(s) to the right of the | 
# 
# 4 | 3.2 
# 4 | 5.3, 8.1 
# 5 | 4.2 

stem2 <- function(x) { 
    cx <- gsub('^.', ', ', as.character(sort(x))) 
    co <- capture.output(stem(x)) 
    m <- gregexpr('\\d(?!.*\\|)', co, perl = TRUE) 
    l <- regmatches(co, m) 
    l <- t(do.call('rbind', lapply(l, `length<-`, max(lengths(l))))) 
    l[!is.na(l)] <- cx 
    regmatches(co, m) <- data.frame(l) 
    cat(gsub(' , ', ' ', co), sep = '\n') 
}