Bir cümlenin uzunluğunu kısaltın (Sınırla)

Question

Uzun ada sütunlarım var ve bunları max 40 karakter uzunluğuna kesmek istiyorum.

Örnek veri: - Bir sözcüğün ortasında cümle kısaltmak kalmamak (/ + 3 nchar)

x <- c("This is the longest sentence in world, so now just make it longer", 
"No in fact, this is the longest sentence in entire world, world, world, world, the whole world") 

Ben yaklaşık 40 sentece süresini kısaltmak istiyoruz. (Yani kelimeler arasındaki boşlukta uzunluk kararlaştırılır).

Ayrıca kısaltılmış sentece sonra 3 nokta eklemek istiyorum. Bu fonksiyon sadece körlemesine 40 Char de kısaltılacak

c("This is the longest sentence...","No in fact, this is the longest...") 

:

İstenen çıkış böyle bir şey olurdu.:

strtrim(x, 40) 

Answer 1

Tamam, şimdi daha iyi bir çözüm :)

x <- c("This is the longest sentence in world, so now just make it longer","No in fact, this is the longest sentence in entire world, world, world, world, the whole world") 

extract <- function(x){ 
    result <- stri_extract_first_regex(x, "^.{0,40}(|$)") 
    longer <- stri_length(x) > 40 
    result[longer] <- stri_paste(result[longer], "...") 
    result 
} 
extract(x) 
## [1] "This is the longest sentence in world, ..." "No in fact, this is the longest sentence ..." 

Deneyler yeni eski vs (32 000 cümle) vardır:

microbenchmark(sapply(x, cutAndAddDots, USE.NAMES = FALSE), extract(x), times=5) 
Unit: milliseconds 
             expr  min   lq  median   uq  max neval 
sapply(x, cutAndAddDots, USE.NAMES = FALSE) 3762.51134 3762.92163 3767.87134 3776.03706 3788.139  5 
            extract(x) 56.01727 57.18771 58.50321 79.55759 97.924  5 

ESKİ VERSION

Bu çözüm, stringi packag gerektirir e ve HER ZAMAN, dizenin sonuna üç nokta ... ekler.

require(stringi) 
sapply(x, function(x) stri_paste(stri_wrap(x, 40)[1],"..."),USE.NAMES = FALSE) 
## [1] "This is the longest sentence in world..." "No in fact, this is the longest..." 

Bu seferki sadece daha uzun 40 karakter olan cümlelere yanındaki üç noktayı ekler: Bu kabaca 3 kez hızlandırabilir stri_wrap yılında normalize=FALSE Ayar

require(stringi) 
cutAndAddDots <- function(x){ 
    w <- stri_wrap(x, 40) 
    if(length(w) > 1){ 
    stri_paste(w[1],"...") 
    }else{ 
    w[1] 
    } 
} 
sapply(x, cutAndAddDots, USE.NAMES = FALSE) 
## [1] "This is the longest sentence in world" "No in fact, this is the longest..." 

PERFORMANS NOT (30 üzerinde test 0001)

Test verileri:

x <- stri_rand_lipsum(3000) 
x <- unlist(stri_split_regex(x,"(?<=\\.) ")) 
head(x) 
[1] "Lorem ipsum dolor sit amet, vel commodo in."              
[2] "Ultricies mauris sapien lectus dignissim."              
[3] "Id pellentesque semper turpis habitasse egestas rutrum ligula vulputate laoreet mollis id."  
[4] "Curabitur volutpat efficitur parturient nibh sociosqu, faucibus tellus, eleifend pretium, quis." 
[5] "Feugiat vel mollis ultricies ut auctor."               
[6] "Massa neque auctor lacus ridiculus."                
stri_length(head(x)) 
[1] 43 41 90 95 39 35 

cutAndAddDots <- function(x){ 
    w <- stri_wrap(x, 40, normalize = FALSE) 
    if(length(w) > 1){ 
    stri_paste(w[1],"...") 
    }else{ 
    w[1] 
    } 
} 
cutAndAddDotsNormalize <- function(x){ 
    w <- stri_wrap(x, 40, normalize = TRUE) 
    if(length(w) > 1){ 
    stri_paste(w[1],"...") 
    }else{ 
    w[1] 
    } 
} 
require(microbenchmark) 
microbenchmark(sapply(x, cutAndAddDots, USE.NAMES = FALSE),sapply(x, cutAndAddDotsNormalize, USE.NAMES = FALSE),times=3) 
Unit: seconds 
               expr  min  lq median  uq  max 
      sapply(x, cutAndAddDots, USE.NAMES = FALSE) 3.917858 3.967411 4.016964 4.055571 4.094178 
sapply(x, cutAndAddDotsNormalize, USE.NAMES = FALSE) 13.493732 13.651451 13.809170 13.917854 14.026538 

Answer 2

Taban R çözümü:

baseR <- function(x){ 
    m <- regexpr("^.{0,40}(|$)", x) 
    result <- regmatches(x,m) 
    longer <- nchar(x)>40 
    result[longer] <- paste(result[longer],"...",sep = "") 
    result 
} 
baseR(x)==extract(x) 
[1] TRUE TRUE 

sadece extract @bartektartanus gibi İşleri :) Ama ... yavaş olduğunu Onun kodundan oluşturulan verileri temel test ettik. Yine de, harici paketler kullanmak istemiyorsanız - bu işe yarıyor!

microbenchmark(baseR(x), extract(x)) 
Unit: milliseconds 
     expr  min  lq median  uq  max neval 
    baseR(x) 101.20905 107.0264 108.79086 111.03229 162.6375 100 
extract(x) 52.83951 54.6931 55.46628 59.37808 103.0631 100 

Answer 3

Figürlü bunu da gönderirim. Kesinlikle stringi hız değil, ama çok perişan değil. str için baskı yöntemlerini atlamak için ihtiyacım vardı, bu yüzden bunu yazdım.@bartektartanus cevabını ipi

charTrunc <- function(x, width, end = " ...") { 
    ncw <- nchar(x) >= width 
    trm <- strtrim(x[ncw], width - nchar(end)) 
    trimmed <- gsub("\\s+$", "", trm) 
    replace(x, ncw, paste0(trimmed, end)) 
} 

Test:

x <- stri_rand_lipsum(3000) 
x <- unlist(stri_split_regex(x,"(?<=\\.) ")) 

library(microbenchmark) 
microbenchmark(charTrunc = { 
    out <- charTrunc(x, 40L) 
    }, 
    times = 3 
) 

Unit: milliseconds 
     expr  min  lq  mean median  uq  max neval 
charTrunc 506.553 510.988 513.4603 515.423 516.9139 518.4049  3 

head(out) 
# [1] "Lorem ipsum dolor sit amet, venenati ..." 
# [2] "Tincidunt at pellentesque id sociosq ..." 
# [3] "At etiam quis et mauris non tincidun ..." 
# [4] "In viverra aenean nisl ex aliquam du ..." 
# [5] "Dui mi mauris ac lacus sit hac."   
# [6] "Ultrices faucibus sed justo ridiculu ..."