R4marketing | канал Алексея Селезнёва | Язык R. Страница 15

 
library(bigrquery)
library(magrittr)

bq_auth(email = '[email protected]')

ds <- bq_dataset(project = "my_proj", dataset = 'my_ds')

# тестовые данные
df <- data.frame(
  gr = c('a', 'a', 'a', 'b', 'b'),
  val = c(3, 5, 1, 3,4)
)

# создаём кластеризированную таблицу
bq_mtcars <- bq_table_create(
  bq_table(ds, 'cluster_tbl'),
  clustering = list(fields = "gr"),
  fields = as_bq_fields(df)
)

# записываем данные
bq_table(project = "my_proj",
         dataset = "my_ds",
         table   = "cluster_tbl") %>%
  bq_table_upload(
    values = df,
    write_disposition = "WRITE_APPEND"
)

# запрашиваем данные
sql <- "SELECT * FROM my_ds.cluster_tbl WHERE gr = 'b'"
bq_df <- bq_project_query('choice31', sql) %>%
         bq_table_download()

  
library(ggplot2)
library(patchwork)

# создаём 2 графика
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))

# располагаем их на одном изображении
p1 + p2

 
p3 <- ggplot(mtcars) + geom_smooth(aes(disp, qsec))
p4 <- ggplot(mtcars) + geom_bar(aes(carb))

(p1 | p2 | p3) /
      p4

 
p1 + p2 + p3 + p4 + 
  plot_layout(ncol = 3)

 
p1 <- ggplot(mtcars) + geom_point(aes(mpg, disp))
p2 <- ggplot(mtcars) + geom_boxplot(aes(gear, disp, group = gear))
p3 <- ggplot(mtcars) + geom_bar(aes(gear)) + facet_wrap(~cyl)
p4 <- ggplot(mtcars) + geom_bar(aes(carb))
p5 <- ggplot(mtcars) + geom_violin(aes(cyl, mpg, group = cyl))

# пример 1
design <- c(
  area(1, 1, 2),
  area(1, 2, 1, 3),
  area(2, 3, 3),
  area(3, 1, 3, 2),
  area(2, 2)
)

p1 + p2 + p3 + p4 + p5 + plot_layout(design = design)

# пример 2
design <- "
  122
  153
  443
"
p1 + p2 + p3 + p4 + p5 + plot_layout(design = design)

library(bulletchartr)

# загрузка тестовых данных
data('bc_ex')

# обычная пулевая диаграмма
bullet_chart(dataframe = bc_ex)

bullet_chart_wide(
  file_name = read_example("Indicators_Targets_ext.xlsx"),
  cal_type = "cal"
)

 
# This works in R 4.2
mtcars |>
  lm(mpg ~ disp, data = _)

 
if (1:2 == 1) do_something()
# Error in if (1:2 == 1) do_something() : the condition has length > 1

 
plot.new()
polygon(x = c(0, 1, 1, 0), y = c(0, 0, 0.5, 0.5), col = "#FFDD00")
polygon(x = c(0, 1, 1, 0), y = c(0.5, 0.5, 1, 1), col = "#0057B7")

 
# тестовый список
test_list <- list(
  list(name = 'John', 
       age  = '37',
       children = list('Paul', 'Ron')),
  list(name = 'Tim', 
       age  = '25',
       children = list('Liza'))
)

 
# первая попытка развёртывания
tibble(uncol = test_list) %>% 
  unnest_wider(uncol)

# A tibble: 2 x 3
  name  age   children  
  <chr> <chr> <list>    
1 John  37    <list [2]>
2 Tim   25    <list [1]>

 
# добавляем проверку типа данных в поле age
tibble(uncol = test_list) %>% 
  unnest_wider(
    uncol, 
    ptype = list(age = 2)
)

Error: Can't convert <character> to <double>.

 
# используем ptype и transform
tibble(uncol = test_list) %>% 
  unnest_wider(
    uncol, 
    transform = list(
      children = function(x) paste(x, collapse = ', '),
      age = as.integer),
    ptype = list(age = 2),
) 

# A tibble: 2 x 3
  name    age children 
  <chr> <dbl> <chr>    
1 John     37 Paul, Ron
2 Tim      25 Liza