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

 
library(wakefield)
library(dplyr)

# функция генерации отделов
department <- function(
    n, 
    x = c("Sales", "Marketing", "Developores", "Finance", "Managment"), 
    prob = c(0.5, 0.2, 0.1, 0.15, 0.05), 
    name = "Department") 
{
  if (missing(n)) stop("`n` is missing")
  out <- sample(x = x, size = n, replace = TRUE, prob = prob)
  out <- factor(out, levels = x)
  varname(out, name)
}

# генерируем табдицу сотрудников
staff <- r_data_frame(
  n = 60,
  id,
  name,
  gender,
  age,
  employment,
  department,
  income,
  car,
  date_stamp(start = as.Date('2020-01-01'), k = 700, by = 'days', random = T, name = 'StartWorks'),
  valid(prob = c(0.1, 0.9), name = 'IsActive')
) %>%
  r_na(cols = 8, prob= .25)

library(shiny)

ui <- fluidPage(
    actionButton("go", "Go"),
    shinycssloaders::withSpinner(
        plotOutput("plot")
    )
)
server <- function(input, output) {
    output$plot <- renderPlot({
        input$go
        Sys.sleep(1.5)
        plot(runif(10))
    })
}
shinyApp(ui, server)

 
example_df %>%
  mutate(
    a_dbl = a * 2,
    b_tri = b * 3,
    c_half = c / 2,
    b_min_c = b - c) %>%
  filter(b_min_c > 3) %>%
  group_by(category) %>%
  summarize(
    avg_a_dbl = mean(a_dbl),
    avg_b_tri = mean(b_tri),
    avg_c_half = mean(c_half),
    avg_b_min_c = mean(b_min_c)
  )

 
(
example_df
  >> mutate(
    a_dbl = _.a * 2,
    b_tri = _.b * 3,
    c_half = _.c / 2,
    b_min_c = _.b - _.c )
  >> filter(_.b_min_c > 3)
  >> group_by(_.category)
  >> summarize(
    avg_a_dbl = _.a_dbl.mean(),
    avg_b_tri = _.b_tri.mean(),
    avg_c_half = _.c_half.mean(),
    avg_b_min_c = _.b_min_c.mean() )
  )

 
 (
    example_df
      .assign(a_dbl = example_df.a * 2)
      .assign(b_tri = example_df.b * 3)
      .assign(c_half = example_df.c / 2)
      .assign(b_min_c = example_df.b - example_df.c)
      .query('b_min_c > 3')
      .groupby('category', as_index=False)
      .agg(
          avg_a_dbl = pd.NamedAgg(column='a_dbl', aggfunc=np.mean),
          avg_b_tri = pd.NamedAgg(column='b_tri', aggfunc=np.mean),
          avg_c_half = pd.NamedAgg(column='c_half', aggfunc=np.mean),
          avg_b_min_c = pd.NamedAgg(column='b_min_c', aggfunc=np.mean)
     )
  )

 
example_df['a_dbl'] = example_df['a'].mul(2)
  example_df['b_tri'] = example_df['b'] * 3
  example_df['c_half'] = example_df['c'].div(2)
  example_df['b_min_c'] = example_df['b'].sub(example_df['c'], axis = 0)
  example_df = example_df[example_df['b_min_c'] > 3]
  example_df['avg_a_dbl'] = example_df['a_dbl'].groupby(example_df['category']).transform('mean')
  example_df['avg_b_tri'] = example_df['b_tri'].groupby(example_df['category']).transform('mean')
  example_df['avg_c_half'] = example_df['c_half'].groupby(example_df['category']).transform('mean')
  example_df['avg_b_min_c'] = example_df['b_min_c'].groupby(example_df['category']).transform('mean')

#' ---
#' title: "A report generated from a pure R script"
#' output:
#'   pdf_document:
#'     keep_tex: true
#' ---
#'
#' This is a report generated by `knitr::spin()`.
#'
#' Let's try some **knitr** options:

#+ echo=FALSE, fig.width=7
#  This is a normal R comment.
plot(cars)

#' Now write an inline value. We know the value of $\pi$ is
{{ pi }}
#' .
#'
#' Finally please note that all roxygen comments are
#' optional. You do not need chunk options, either,
#' unless you want more control over the output
#' elements such as the size of plots.

# /* Write comments between /* and */ like C comments:
Sys.sleep(60)
# */

---
title: "A report generated from a pure R script"
output:
  pdf_document:
    keep_tex: true
---

This is a report generated by `knitr::spin()`.

Let's try some **knitr** options:

```{r echo=FALSE, fig.width=7}
#  This is a normal R comment.
plot(cars)
```

Now write an inline value. We know the value of $\pi$ is
``r  pi  ``
.

Finally please note that all roxygen comments are
optional. You do not need chunk options, either,
unless you want more control over the output
elements such as the size of plots.

# Извлечение только R кода
knitr::purl("script.R", documentation = 0L)

# Извлечение R кода и настроек чанков
knitr::purl("script.R", documentation = 1L)

# Извлечение всего содержимого Rmarkdown документа
knitr::purl("script.R", documentation = 2L)

 
class(mtcars) == 'data.frame'
[1] TRUE

 
class(tibble::tibble(mtcars)) == 'data.frame'
[1] FALSE FALSE  TRUE

 
class(tibble::tibble(mtcars))
[1] "tbl_df"     "tbl"        "data.frame"

 
'data.frame' %in% class(tibble::tibble(mtcars))
[1] TRUE

 
inherits(tibble::tibble(mtcars), 'data.frame')
[1] TRUE

library(worrrd)

# вектор слов
words <- c("filter", "mutate", "arrange", "summarise", "group_by", "left_join")
# создаём объект поля
x <- wordsearch(words, r = 20, c = 20)
# отображааем поле
plot(x, solution = TRUE)

R CMD <options> <r file>

clean <- function() {
  cli_progress_bar("Cleaning data", total = 100)
  for (i in 1:100) {
    Sys.sleep(5/100)
    cli_progress_update()
  }
  cli_progress_done()
}

clean()

```{r cars-plot, echo = FALSE, message = FALSE, fig.width = 6, fig.height = 6, fig.path = "figures/", fig.cap = "This is a long caption that fits better inside of a code chunk.", fig.alt = "This is a long description that conveys the meaning of the visual."}
ggplot(data = mtcars, aes(x = wt, y = mpg)) +
  geom_point()
```

```{r cars-plot}
#| echo = FALSE,
#| message = FALSE,
#| fig.width = 6, fig.height = 6,
#| fig.path = "figures/",
#| fig.caption = "This is a long caption that fits better inside of a code chunk"
#| fig.alt = "This is a long description that conveys the meaning of the visual."

ggplot(data = mtcars, aes(x = wt, y = mpg)) +
  geom_point()
```

library(worrrd)

# Вопросы и ответы
dat <- 
  dplyr::tribble(
    ~word,   ~clue,
    "filter",   "фильтрация данных",
    "mutate",   "добавляет новый столбец",
    "arrange",  "сортирует данные",
    "summarise", "агрегация данных",
    "group_by", "группировка данных",
    "left_join", "соединить две таблицы"
  )

# Создаём объект кроссворда
ex1 <- crossword(words = dat$word, clues = dat$clue, r = 40, c = 40)

# Рисуем кроссворд
plot(ex1, solution = TRUE, clues = TRUE, legend_size = 3)

 
tryExcept({
  foo <- "foo"
  stop()
}, except = {
  foo <- "foo bar"
})
print(foo) # "foo bar"

 
  stop()
} %except% {
  foo <- "foo bar"
}
print(foo) # "foo bar"

 
is.null.na <- is.null %|% is.na
all(is.null.na(NA), is.null.na(NULL)) # вернёт TRUE

 
# paste0 (%+%)
"01" %+% "jan" %+% "1970" # вернёт "01jan1970"

# file.path (%//%)
"home" %//% "dir" # вернёт "home/dir"

# nomatch (%!in%)
4 %!in% 1:3 # вернёт TRUE

# nil (%||%)
1 %||% 2 # вернёт 1
NULL %||% 2 # вернёт 2

 
---
title: My Document
output: html_document
params:
  year: 2018
  region: Europe
  printcode: TRUE
  data: file.csv
---

 
---
title: My Document
output: html_document
params:
  date: !r Sys.Date()
---

 
rmarkdown::render("MyDocument.Rmd", params = list(
  year = 2017,
  region = "Asia",
  printcode = FALSE,
  file = "file2.csv"
))

 
params$year
params$region