एक स्टेम और लीफ प्लॉट कैसे आकर्षित करें जो

Question

को गोल किए बिना असली पत्ता दिखाता है उदाहरण के लिए, मेरे पास संख्याएं हैं: 43.2, 45.3, 48.1, 54.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 

तरह से पता चलता लेकिन साजिश से मैं केवल पता कर सकते हैं नंबर दिए गए हैं:: जब मैं स्टेम() फ़ंक्शन का उपयोग एक साजिश आकर्षित करने के लिए, मैं इस मिल 43,45,48,54। इसलिए मैं एक समारोह को एक स्टेम और पत्ता प्लॉट खींचना चाहता हूं जिसके साथ मैं अभी भी गोल किए बिना सटीक संख्या को जान सकता हूं।

इसके अलावा, मैं चाहता हूं कि यह स्टेम का प्रतिनिधित्व करने के लिए केवल एक अंक का उपयोग करे, जबकि पत्ते में और दिखा रहा हो। उदाहरण के लिए, 43.2 एक स्टेम 4 और एक पत्ता 3.2 होना चाहिए, 43.22 एक स्टेम 4 और एक पत्ता 3.22 होना चाहिए। संख्याओं के लिए: 43.2, 45.3, 48.1, 54.2। मैं इस तरह की साजिश हैं:

Answer 1

यहाँ एक तरीका है। मैंने नीचे data.table पैकेज का उपयोग किया है, इसलिए यदि आपके पास यह नहीं है, तो कृपया इसे पहले इंस्टॉल करें। यदि आप वास्तव में पसंद करते हैं कि प्लॉट नियमित डेटा फ्रेम का उपयोग करके बनाया जाए, तो मुझे बताएं और मैं तदनुसार इसे समायोजित कर दूंगा।

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 

संपादित: आप भूखंड वापस करने के लिए एक वापस चाहते हैं, तो उसके बाद निम्न कोड काम करना चाहिए। यह पिछले कोड के रूप में एक समान तरीके से काम करता है

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') 
}