r - 使用 substr 函数将列中字符的首字母大写

Question

我有这个数据框

head(df)
##   patnum hospstay    lowph pltct  race  bwt gest        inout twn lol magsulf
## 1      1       34       NA   100 white 1250   35 born at duke   0  NA      NA
## 2      2        9 7.250000   244 white 1370   32 born at duke   0  NA      NA
## 3      3       -2 7.059998   114 black  620   23 born at duke   0  NA      NA
## 4      4       40 7.250000   182 black 1480   32 born at duke   0  NA      NA
## 5      5        2 6.969997    54 black  925   28 born at duke   0  NA      NA
## 6      6       62 7.189999    NA white  940   28 born at duke   0  NA      NA
##   meth toc  delivery apg1 vent pneumo pda cld    sex dead
## 1    0   0 abdominal    8    0      0   0   0 female    0
## 2    1   0 abdominal    7    0      0   0   0 female    0
## 3    0   1   vaginal    1    1      0   0  NA female    1
## 4    1   0   vaginal    8    0      0   0   0   male    0
## 5    0   0 abdominal    5    1      1   0   0 female    1
## 6    1   0 abdominal    8    1      0   0   0 female    0

race 变量有 4 个条目，“white”、“black”、“native american”、“oriental”。我想用大写版本“White”、“Black”、“Native American”、“Oriental”替换这个字符串。我想使用 substr 函数来做到这一点。我不确定要使用什么代码来完成此操作。我在下面提供了一个示例，其中

day_full = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")

substr(day_full_1, nchar(day_full_1)-2, nchar(day_full_1)) = "DAY"

The result is: "SunDAY", "MonDAY", "TuesDAY", "WednesDAY", "ThursDAY", "FriDAY", "SaturDAY", "SunDAY"

这与我想做的类似，但我只想让每个种族的第一个字母大写。我将如何翻译它以使 4 个种族的每个首字母成为首都？

这是我现在尝试过的解决方案。

substr(SB_xlsx$race, 1, 1) <- toupper(substr(SB_xlsx$race, 1, 1))

substr(SB_xlsx$race, 1, 1) 

## structure(list(patnum = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
## 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24), hospstay = c(34, 
## 9, -2, 40, 2, 62, 32, NA, NA, 28, 38, NA, 62, 69, 1, 93, 44, 
## 50, 66, 65, 44, 70, 85, NA), lowph = c(NA, 7.25, 7.059998, 7.25, 
## 6.969997, 7.189999, 7.32, NA, NA, 7.16, 7.039997, NA, 7.179996, 
## 7.419998, 7.119999, 7.239998, 7.129997, 7.269997, 7.179996, 7.07, 
## 7.289997, 7.129997, 7.189999, NA), pltct = c(100, 244, 114, 182, 
## 54, NA, 282, NA, NA, 153, 229, NA, 182, 361, 378, 255, 186, NA, 
## 260, 183, 134, 229, 68, NA), race = c("white", "white", "black", 
## "black", "black", "white", "black", NA, NA, "black", "white", 
## NA, "black", "white", "white", "black", "white", "black", "black", 
## "white", "white", "black", "white", NA), bwt = c(1250, 1370, 
## 620, 1480, 925, 940, 1255, 600, 700, 1350, 1310, 550, 1110, 1180, 
## 970, 770, 1490, 1170, 1360, 1330, 1000, 1120, 740, NA), gest = c(35, 
## 32, 23, 32, 28, 28, 29.5, 26, 24, 34, 32, 24, 28, 28, 28, 26, 
## 33, 31, 31, 31, 28, 29, 26, NA), inout = c("born at duke", "born at duke", 
## "born at duke", "born at duke", "born at duke", "born at duke", 
## "born at duke", "born at duke", "born at duke", "born at duke", 
## "born at duke", "born at duke", "born at duke", "born at duke", 
## "born at duke", "born at duke", "born at duke", "born at duke", 
## "born at duke", "born at duke", "born at duke", "born at duke", 
## "born at duke", NA), twn = c(0, 0, 0, 0, 0, 0, 0, NA, NA, 0, 
## 0, NA, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, NA), lol = c(NA, NA, 
## NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
## NA, NA, NA, NA, NA, NA), magsulf = c(NA, NA, NA, NA, NA, NA, 
## NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
## NA, NA), meth = c(0, 1, 0, 1, 0, 1, 1, NA, NA, 1, 0, NA, 0, 0, 
## 1, 1, 1, 1, 1, 1, 0, 1, 0, NA), toc = c(0, 0, 1, 0, 0, 0, 0, 
## NA, NA, 0, 0, NA, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, NA), delivery = c("abdominal", 
## "abdominal", "vaginal", "vaginal", "abdominal", "abdominal", 
## "vaginal", NA, NA, "abdominal", "vaginal", NA, "vaginal", "abdominal", 
## "vaginal", "vaginal", "abdominal", "vaginal", "vaginal", "vaginal", 
## "vaginal", "vaginal", "abdominal", NA), apg1 = c(8, 7, 1, 8, 
## 5, 8, 9, NA, NA, 4, 6, NA, 6, 6, 2, 4, 8, 7, 1, 8, 5, 9, 9, NA
## ), vent = c(0, 0, 1, 0, 1, 1, 0, NA, NA, 0, 1, NA, 0, 0, 1, 1, 
## 0, 0, 1, 1, 0, 1, 0, NA), pneumo = c(0, 0, 0, 0, 1, 0, 0, NA, 
## NA, 0, 0, NA, 1, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, NA), pda = c(0, 
## 0, 0, 0, 0, 0, 0, NA, NA, 0, 0, NA, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
## 0, 0, NA), cld = c(0, 0, NA, 0, 0, 0, 0, NA, NA, 0, 0, NA, 1, 
## 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, NA), sex = c("female", "female", 
## "female", "male", "female", "female", "female", NA, NA, "female", 
## "male", NA, "male", "male", "female", "male", "male", "female", 
## "male", "male", "female", "female", "female", NA), dead = c(0, 
## 0, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 
## 0, NA)), class = "data.frame", row.names = c(NA, -24L))

Answer 1

两种解决方案:

df <- structure(list(patnum = 1:6, hospstay = c(34L, 9L, -2L, 40L, 2L, 62L), lowph = c(NA, 7.25, 7.059998, 7.25, 6.969997, 7.189999), pltct = c(100L, 244L, 114L, 182L, 54L, NA), race = c("white", "white", "black", "black", "black", "white"), bwt = c(1250L, 1370L, 620L, 1480L, 925L, 940L), gest = c(35L, 32L, 23L, 32L, 28L, 28L), inout = c("born_at_duke", "born_at_duke", "born_at_duke", "born_at_duke", "born_at_duke", "born_at_duke"), twn = c(0L, 0L, 0L, 0L, 0L, 0L), lol = c(NA, NA, NA, NA, NA, NA), magsulf = c(NA,  NA, NA, NA, NA, NA)), class = "data.frame", row.names = c("1", "2", "3", "4", "5", "6"))

tools::toTitleCase(df$race)
# [1] "White" "White" "Black" "Black" "Black" "White"

但是那些没有空格的更简单，让我们为这个练习创建一个:

vec <- c("white", "black", "native american")
tools::toTitleCase(vec)
# [1] "White"           "Black"           "Native American"

我们也可以使用gregexpr/regmatches来做:

gre <- gregexpr("(?<=^| ).", vec, perl=TRUE)
regmatches(vec, gre)
# [[1]]
# [1] "w"
# [[2]]
# [1] "b"
# [[3]]
# [1] "n" "a"
regmatches(vec, gre) <- lapply(regmatches(vec, gre), toupper)
vec
# [1] "White"           "Black"           "Native American"

我确定那里也有一个 stringr 变体。

对于 substr，可以使用正则表达式查找所有 (1) 个第一个字符和 (2) 个空格后的所有字符，然后提取每个字符，然后 toupper-them，然后将其放回原处...但此时您仍在使用正则表达式并有效地执行 toTitleCase native 执行的操作以及此 gregexpr/regmatches 代码做得有点冗长。

如果您只想替换第一个字符，而不关心空格后的字母，那么

substr(vec, 1, 1) <- toupper(substr(vec, 1, 1))
vec
# [1] "White"           "Black"           "Native american"

虽然在这种情况下，我认为 "Native american" 中的小写 "a" 是错误的，所以我认为这不是最好的方法.

---

缩放

由于您担心缩放(我假设您冒险进入 100K 或更多，因为小于 100K 不会成为任何演示方法的问题)，这里是一个比较:

bench::mark(
  toTitleCase = tools::toTitleCase(vec),
  gregexpr = {
    gre <- gregexpr("(?<=^| ).", vec, perl=TRUE)
    regmatches(vec, gre) <- lapply(regmatches(vec, gre), toupper)
    vec
  }
)
# # A tibble: 2 x 13
#   expression       min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result    memory             time     gc      
#   <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>    <list>             <list>   <list>  
# 1 toTitleCase    401us    474us     1735.    4.15KB     0      868     0      500ms <chr [3]> <Rprofmem [9 x 3]> <bench_~ <tibble~
# 2 gregexpr       111us    205us     5240.   24.28KB     2.26  2315     1      442ms <chr [3]> <Rprofmem [6 x 3]> <bench_~ <tibble~

当然，vec 大小 3 非常小，让我们将其放大一点。

vec30000 <- rep(vec, 10000) # 30000 length
bench::mark(
  toTitleCase = tools::toTitleCase(vec30000),
  gregexpr = {
    gre <- gregexpr("(?<=^| ).", vec30000, perl=TRUE)
    regmatches(vec30000, gre) <- lapply(regmatches(vec30000, gre), toupper)
    vec30000
  }
)
# Warning: Some expressions had a GC in every iteration; so filtering is disabled.
# # A tibble: 2 x 13
#   expression       min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result         memory       time      gc      
#   <bch:expr>  <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>         <list>       <list>    <list>  
# 1 toTitleCase    6.01s    6.01s     0.166      36MB    0.832     1     5      6.01s <chr [30,000]> <Rprofmem [~ <bench_t~ <tibble~
# 2 gregexpr    773.13ms 773.13ms     1.29      241MB    2.59      1     2   773.13ms <chr [30,000]> <Rprofmem [~ <bench_t~ <tibble~

查看显示每秒迭代次数的 `itr/sec` 列，似乎即使在规模上，gregexpr 方法也能更好地工作。 (如果你查看 toTitleCase 的源代码，你就会明白为什么:它不仅考虑空格分隔的词，还考虑链接词、异常词等)