効率的なRプログラミングを可能にするpurrrパッケージの基本的な使い方とdplyr, ggplot2等のtidyverseに含まれるパッケージとの合わせ技を覚えましょう 😼 Tokyo.R#66での発表資料です https://atnd.org/events/92993
ͦΖͦΖखΛग़͢purrr20171216 Tokyo.R#66@RopponngiShinya Uryu (HOXO-M INC.)@u_ribo@uriboPurrr that A functional programming toolkit for R
View Slide
YOUR TURNQ1.ߏ͕ಉ͡ෳͷDTWϑΝΠϧ͕ಉҰͷϑΥϧμʹอଘ͞Ε͍ͯ·͢ɻ͜ΕΒΛҰͭͷσʔλϑϨʔϜͱͯ͠ಡΈࠐΈ͍ͨ࣌ɺͲͷΑ͏ʹॲཧ͠·͔͢
YOUR TURNQ2. ࣮ྻ͔ΒͳΔྻͷσʔλϑϨʔϜ͔Βɺ֤ྻͷฏۉΛٻΊ͍ͨɻͲͷΑ͏ͳखஈΛར༻͠·͔͢
͖ʹ͍ͤGPS ʹΑΔϧʔϓEQMZSTVNNBSJTFBQQMZͷؔͨͩ͠ίϐϖͯΊʔμϝͩ˞
ίϯϐϡʔλ͕ಘҙͳ͜ͱ෮ॲཧŵŜŤũ ΫΝXͤ;͜͡ESGUHZ♂
3ͰΑ͋͘Δ෮ॲཧୀ۶ͳ͜ͱ3ʹͤΑ͏ŎwBQQMZ GPSؔwάϧʔϓॲཧ
QVSSS෮ॲཧʹର͢ΔࡦͷҰͭTJODF'JSTU3FMFBTFΔΔΔΓΌʔ͝རӹؔҾͷద༻ʹҰ؏໊ͨ͠শίʔυͷهड़Λ؆ུԽ͢Δ কདྷతͳ࣮ฒྻԽͱਐߦ۩߹ͷՄࢹԽ
҃Δਓͷܦݧޮೳʹݸਓ͕ࠩ͋Γ·͢
҆৺͍ͯͩ͘͠͞QVSSSΉ͍͔ͣΒҰͰཧղ͠ͳ͓ͯ͘LεϐʔυతʹGPSѱ͘ͳ͍ΑʢࠓʣQVSSSΛ͏ͷίʔυͷอकੑΛߴΊΔͨΊͬͯ)BEMFZ͕ݴͬͯͨϤ3GPS%BUB4DJFODF
map()
NBQϕΫτϧͷ֤ཁૉͷؔͷద༻# จࣈΛ͑Δॲཧ——————————————————————x <- c("kazutan", "hoxom", "uribo")nchar(x[1]) # 7nchar(x[2]) # 5nchar(x[3]) # 5sapply(x, nchar) # ؔΛҾʹͱΔߴ֊ؔ# kazutan hoxom uribo# 7 5 5
library(purrr)map(x, nchar)# [[1]]# [1] 7# [[2]]# [1] 5# [[3]]# [1] 5map(.x, .f, )ؔ...ϦετϕΫτϧσʔλϑϨʔϜ දݱࣜର ॲཧσʔλϑϨʔϜͰྻʢϕΫτϧʣ͕ରNBQϕΫτϧͷ֤ཁૉͷؔͷద༻
base::Map͡Όμϝͳͷ?Map(nchar, x)# $kazutan# [1] 7# $hoxom# [1] 5# $uribo# [1] 5%>%ʜ·͋ྑ͍͚ͲతʹୈҰҾʹૢ࡞ͷର/(ॊೈͳॲཧʹෆ͖
map_*()
NBQ৭ʑ ฦΓΛҙͷܕͷϕΫτϧʹFUNCTION RETURNmap_lgl() ཧܕmap_int() ܕmap_dbl() ࣮ܕmap_chr() จࣈྻܕฦΓͷσʔλܕʹԠͯ͡ద༻͢ΔؔΛมߋ
x %>% map_int(nchar)# [1] 7 5 5x %>% map_int(nchar) %>% sum()# [1] 17x %>% map_chr(nchar)[1] "7" "5" "5"NBQ৭ʑ ฦΓΛҙͷܕͷϕΫτϧʹ
CAUTIONDŽx %>% map_lgl(nchar)# Error: Can't coerce element 1 from a integerto a logicalσʔλܕͷมنଇʹҙཧܕɺܕɺഒਫ਼খܕɺจࣈྻͷॱʹॊೈੑ͕ߴ͍
NBQ৭ʑ Ґஔ݅ʹΑΔద༻x %>%map_at(.at = 2, nchar)# [[1]]#[1] "kazutan"# [[2]][1] 5# [[3]][1] "uribo"x %>%map_if(.p = . == "kazutan",nchar)# [[1]]# [1] 7# [[2]]# [1] "hoxom"# [[3]]# [1] "uribo".ppredicateΛҙຯ͢Δ
ͳΜ͔ग़͖ͯͨx %>% map_if(.p = == "kazutan", nchar)NBHSJUUSͷͱҰॹμωʢ໌ࣔతʹΦϒδΣΫτΛ༩͑Δʣx[1]: TRUE "kazutan" == "kazutan"x[2]: FALSE "hoxom" == "kazutan"x[3]: FALSE "uribo" == "kazutan"ཁૉͷ໊ࢺͱͯ͠ػೳ.
QVSSSʹ͓͚ΔγϣʔτΧοτԋࢉࢠ# 4QFDJFT͝ͱʹMN ͕࣮ߦ͞ΕΔiris %>%split(.$Species) %>%map(function(df) {lm(Petal.Width ~ Sepal.Length, data = df)})
# ؆ུԽͨ͠هड़iris %>%split(.$Species) %>%map(~lm(Petal.Width ~ Sepal.Length, data =.))})ୈҰҾͷΦϒδΣΫτ͕͞ΕΔແ໊ؔΛఆٛJSJTͷ4QFDJFT͝ͱʹॲཧQVSSSʹ͓͚ΔγϣʔτΧοτԋࢉࢠ
Ͳ͏͍͏͜ͱͩͬͯΑres = x %>% map(~nchar)res[[1]] %>% class()# [1] "function"res = x %>% map(~nchar(.))res[[1]] %>% class()# [1] "integer"ͨͩͷؔʢର͕༩͑ΒΕͳ͍ʣʹΑΓର͕༩͑ΒΕɺ͕࣮ؔߦ͞ΕΔ
# มͷࢀরiris %>%split(.$Species) %>%map_dfc(~ mean(.$Sepal.Width))# A tibble: 1 x 3setosa versicolor virginica 1 3.428 2.77 2.974QVSSSʹ͓͚ΔγϣʔτΧοτԋࢉࢠ
NBQ৭ʑ Ҿ͝ͱʹҟͳΔରΛࢦఆmap2_int(.x = 1:3, .y = 4:6, .f = `+`)# [1] 5 7 9.x .y123456579ཁૉͷҐஔ͝ͱʹฒྻॲཧ+
ద༻͢ΔؔͷҾͷͷ͠ํ# rnorm(n = 3, mean = 0, sd = 1)# NFBOͱTEͷΛมߋ͠ɺ# Oݻఆͨ͠ਖ਼نʹै͏ཚΛੜmap2(.x = c(0, -1, 1), # meanʹద༻.y = c(1, 1.5, 2), # sdʹద༻.f = rnorm,n = 3).ffunctionΛҙຯ͢Δ3ͭͷҾ͕ఆٛ͞ΕΔ
ద༻͢ΔؔͷҾͷͷ͠ํ# ແ໊ؔԽͯ͠ɺ໌ࣔతʹ໊લΛهड़ͯ͠ྑ͍map2(.x = c(0, -1, 1), # mean.y = c(1, 1.5, 2), # sd.f = ~ rnorm(mean = .x, sd = .y, n = 3))# Ґஔར༻Մೳ(લϖʔδͷྫಉ༷)map2(.x = c(0, -1, 1), # mean.y = c(1, 1.5, 2), # sd.f = ~ rnorm(n = 3, .x, .y,))
NBQ৭ʑ Ҿ͝ͱʹҟͳΔରΛࢦఆlibrary(jpmesh)# Ңܦ͔ΒϝογϡίʔυΛฦ٫# ϝογϡίʔυϝογϡαΠζʹԠܻ͕ͯ͡ҟͳΔcoords_to_mesh(longitude = 141.3468,latitude = 43.06462,mesh_size = "80km")# [1] "6441"coords_to_mesh(141.3468, 43.06462, "1km")# [1] "64414277"3ͭͷҾ͕ఆٛ͞ΕΔ
d <- tibble::data_frame(longitude = c(141.3468, 139.6917, 139.7147),latitude = c(43.06462, 35.68949, 35.70078),mesh_size = c("80km", "1km", "500m"))d %>%pmap_chr(coords_to_mesh)# [1] "6441" "53394525" "533945471"NBQ৭ʑ Ҿ͝ͱʹҟͳΔରΛࢦఆ
d %>%pmap_chr(coords_to_mesh)longitude latitude mesh_size໊લ·ͨҐஔͰࢦఆؔͷҾ໊ͱσʔλϑϨʔϜͷྻ໊͕ҰகNBQ৭ʑ Ҿ͝ͱʹҟͳΔରΛࢦఆ
# ໊લͰҰக͢ΔͷͰ͜ͷσʔλϑϨʔϜͰ0,d = tibble::data_frame(mesh_size = c("80km", "1km", "500m"),longitude = c(141.3468, 139.6917, 139.7147),latitude = c(43.06462, 35.68949, 35.70078))# ཁૉͷҐஔͰҰக͢ΔͷͰ͜ͷσʔλϑϨʔϜͰ0,d = tibble::data_frame(lon = c(141.3468, 139.6917, 139.7147),lat = c(43.06462, 35.68949, 35.70078),size = c("80km", "1km", "500m"))NBQ৭ʑ Ҿ͝ͱʹҟͳΔରΛࢦఆ
purrr +tidyverse20171216 Tokyo.R#66@Ropponngi※purrrlibrarary(tidyverse)Ͱϩʔυ͞Ε·͢
಄ͷΛUJEZWFSTFͰ# JSJTσʔληοτΛ4QFDJFT͝ͱ ߦͣͭʹอଘͨ͠DTW(target_files = list.files("data/",pattern = ".csv$",full.names = TRUE))target_files %>% map_df(readr::read_csv)# A tibble: 150 x 5# …ෳͷDTW͔ΒҰͭͷσʔλϑϨʔϜ
಄ͷΛUJEZWFSTFͰ# શม͕࣮ܕͰ͋Εdf %>% map_df(mean)# ࣮ྻ͚ͩΛରʹdf %>% map_if(is.double, mean)ෳྻͷฏۉΛٻΊΔ
άϧʔϓผͷਤΛαΫοͱ࡞walk2(paste0("img_", unique(iris$Species), ".png"),iris %>%split(.$Species) %>%map(~ggplot(., aes(Sepal.Length,Petal.Width))+ geom_point()),ggsave,# HHTBWF ʹ͢Ҿʢݻఆʣwidth = 4, height = 3)
Μ Կදࣔ͞Εͳ͍map2_int(1:3, 4:6, `+`)walk2(1:3, 4:6, `+`)XBML ग़ྗΛΘͳ͍for side-effect
EQMZSͷؔͰNBQ df_mesh = read_csv("data/mesh_1km.csv",col_types = "c")df_mesh %>% sample_n(3L)LNϝογϡͷΛؚΜͩσʔλ# A tibble: 3 x 1mesh_1km1 362347032 36235603…
jpmesh::mesh_to_coords(meshcode = df_mesh$mesh_1km[1])# A tibble: 1 x 4# …# meshcodeҾʹୈҰྻ͕༩͑ΒΕΔdf_mesh_map = df_mesh %>%mutate(out = pmap(., ~jpmesh::mesh_to_coords(meshcode = .x)))EQMZSͷؔͰNBQ .xʹmesh_1km͕ೖΔ
͓ ೖ͚ͬͨͲdf_mesh_map# A tibble: 60 x 2mesh_1km out 1 36225745 2 36225746 3 36225755 ֊ߏͷ͋ΔσʔλϑϨʔϜ
֊ߏͷ͋ΔσʔλϑϨʔϜdf_mesh_map$out[[1]]# A tibble: 1 x 4lng_center lat_center lng_error lat_error 1 122.94375 24.4541666667 0.006249999999990.0041666667தσʔλϑϨʔϜ
֊ߏͷ͋ΔσʔλϑϨʔϜdf_mesh_map %>% tidyr::unnest()# A tibble: 60 x 5mesh_1km lng_center lat_center lng_error lat_error 1 36225745 122.94375 24.4541666667 0.00624999999999 0.004166666700002 36225746 122.95625 24.4541666667 0.00624999999999 0.004166666700003 36225755 122.94375 24.4625000000 0.00624999999999 0.004166666666664 36225756 122.95625 24.4625000000 0.00624999999999 0.004166666666665 36225757 122.96875 24.4625000000 0.00624999999999 0.004166666666666 36225759 122.99375 24.4625000000 0.00625000000001 0.004166666666667 36225766 122.95625 24.4708333333 0.00624999999999 0.00416666663333…ల։͢Δʹtidyr::unnest()ݩͷσʔλϑϨʔϜʹྻ͕Ճ͞ΕΔ
άϧʔϓʹରͯ͠OFTU⁶VOOFTUiris_nest = iris %>%group_by(Species) %>% nest()# A tibble: 3 x 2Species data 1 setosa 2 versicolor 3 virginica all_equal(iris_nest %>% unnest(),iris)# [1] TRUE
άϧʔϓʹରͯ͠OFTU⁶VOOFTUiris_model = iris_nest %>%transmute(out = map(data, function(df) {broom::tidy(lm(Sepal.Length~Petal.Width, data=df))}))# A tibble: 3 x 1out1 2 3
άϧʔϓʹରͯ͠OFTU⁶VOOFTUiris_model %>% unnest()# A tibble: 6 x 5term estimate std.error statistic p.value 1 (Intercept) 4.777177508269 0.123912416859 38.552855552078.98396856599e-38…MN ͷ݁ՌΛσʔλϑϨʔϜʹ͋ͱ͓͖ʹʂ
Appendix20171216 Tokyo.R#66@Ropponngi
keep(),discard()
ཁૉͷอ࣋ͱআ֎res = x %>% map_at(1, nchar)res %>%keep(~ is.integer(.) == TRUE) %>%as_vector()[1] 7 # ཁૉͷ݁Ռ͕Δres %>%discard(~ is.integer(.) == TRUE) %>%as_vector()[1] "hoxom" "uribo" # ཁૉͷ݁ՌΛআ֎
invoke()
ཁૉʹద༻͢ΔؔΛมߋlibrary(stringr)c("str_to_upper", "str_to_title", "str_to_lower")%>% invoke_map_chr(x)# [1] "KAZUTAN" "Hoxom" "uribo"ؔจࣈྻͱͯ͠༩͑Δ֤ؔͷҾϦετͰ༩͑Δ
ϦετΛΈࠐΈ1:3 %>% reduce(`+`)# [1] 6# 1 +2 + 3x %>% map(nchar) %>%reduce(c)# 7 5 5# ͜ͷ߹ɺmap_int()Ͱྑ͍ݸਓతʹɺmap_df()ରԠ͍ͯ͠ͳ͍߹ʹಛʹΦεεϝ(ݱࡏͷsfύοέʔδ (v.0.5-5))ͱ͔
partial()
ؔͷҰ෦ͷҾΛݻఆ ෦ద༻set.seed(71)f = partial(runif, n = rpois(1, 5), .lazy = FALSE)f# QBSUJBM ҾͰએݴͨ͠ҾΛ͕ͭؔ࡞͞ΕΔfunction (...)runif(n = 4L, ...) 4set.seed(71)Λ༩͑ͨ࣌ͷ rpois(1,5)ͷ݁Ռ෦తʹಉ͡ॲཧΛࢪ͢ࡍʹศར
ؔͷҰ෦ͷҾΛݻఆ ෦ద༻f()# [1] 0.555103868479 0.3273699621200.211666960036 0.316121358424# SVOJG ͷOҎ֎ͷҾมߋՄೳf(min = 0.2)# [1] 0.957813141309 0.7293711725620.911536924727 0.470407903753
flatten()
Ϧετͷ֊ΛҰஈ্͛Δ# ֊ͷϦετx = list(list(hijiyama = c("kazutan")),list(tokyo = c("hoxom", "uribo")))x %>% flatten()# $hijiyama# [1] "kazutan"# $tokyo# [1] "hoxom" "uribo"2͔Β1֊ͷϦετʹ
Ϧετͷ֊ΛҰஈ্͛Δ# VOMJTU ͱҟͳΓɺҰஈͣͭωετΛղফ͢ΔʢΑΓ҆શʣx %>% unlist()# hijiyama tokyo1 tokyo2# "kazutan" "hoxom" "uribo"x %>% flatten() %>% flatten_chr()# [1] "kazutan" "hoxom" "uribo"֊͕ͳ͘ͳΓɺϕΫτϧʢจࣈྻʣͱͯ͠ฦ٫
ENJOY20171216 Tokyo.R#66@Ropponngi
s_uryu
manfredsteyer
amixedcolor
hsawaji
skanehira
efbmzwyk999
ohmae
fornewid
nozaki
honey32
devoc
akitotsukahara
hannesfritz
marcduiker
bcantrill
marktimemedia
garrettdimon
revolveconf
colly
sonatard
dougneiner
andyhume
stephaniewalter
philhawksworth