[wip] небольшие модификации при обучении для X5

71 report_samples/compile_pdf.cmd

@@ -2,4 +2,4 @@ set PATH=c:\Program Files\RStudio\bin\pandoc;%PATH%
 
 PATH
 
-R -e "rmarkdown::render('ru-tex-pdf-examples.Rmd', encoding = 'UTF-8')"
+"C:\Program Files\R\R-3.5.2\bin\R.exe" -e "rmarkdown::render('ru-tex-pdf-examples.Rmd', encoding = 'UTF-8')"

71 report_samples/compile_xDR_all.cmd

@@ -2,4 +2,4 @@ set PATH=c:\Program Files\RStudio\bin\pandoc;%PATH%
 
 PATH
 
-R -e "rmarkdown::render('xDR_analysis.Rmd', output_format='all', encoding = 'UTF-8')"
+C:\Program Files\R\R-3.5.2\bin\R.exe -e "rmarkdown::render('xDR_analysis.Rmd', output_format='all', encoding = 'UTF-8')"

77 artem/factory_analysis.Rmd

@@ -50,7 +50,7 @@ get_month_data <- function(filename, sheetname="") {
   # трансформируем колонки
   df0 <- raw %>%
     repair_names(prefix="repaired_", sep="")
-  
+  # browser()
   # названия колонок размазаны по строкам 2-3. 2-ая -- группирующая, 3-я -- детализирующая
   # Надо их слить и переименовать колонки, причем приоритет имеет строка 3, как уточняющая
   #name_c2 <- tidyr::gather(df0[1, ], key = name, value = name_c2) # 1-ая колонка ушла в имена

77 artem/factory_analysis_UTF.Rmd

@@ -0,0 +1,245 @@
+---
+title: "R Notebook"
+output: html_notebook
+editor_options: 
+  chunk_output_type: inline
+---
+
+
+# Инициализация пакетов
+
+```{r}
+library(tidyverse)
+library(lubridate)
+library(magrittr)
+library(stringi)
+library(stringr)
+library(readxl)
+library(iterators)
+library(foreach)
+library(doParallel)
+library(zoo)
+library(tictoc)
+library(extrafont)
+library(hrbrthemes)
+
+datafile <- "./data/2016.xlsx"
+```
+
+# Определение функции загрузки
+```{r echo=FALSE}
+get_month_data <- function(filename, sheetname="") {
+  # хак по считыванию типов колонок
+  raw <- read_excel(filename)
+  ncol(raw)
+  ctypes <- rep("text", 146)
+  cnames <- str_c("grp_", seq_along(ctypes))
+  raw <- read_excel(filename,
+                   sheet=sheetname,
+                   #col_names=cnames,
+                   col_types=ctypes,
+                   range = cell_cols("A:EP")) #, skip = 1)
+  
+  # имеем проблему, колонки с NA вместо имени
+  # можно писать в одно преобразование, но специально разбил на шаги
+  # трансформируем колонки
+  df0 <- raw %>%
+    repair_names(prefix="repaired_", sep="")
+  
+  # названия колонок размазаны по строкам 2-3. 2-ая -- группирующая, 3-я -- детализирующая
+  # Надо их слить и переименовать колонки, причем приоритет имеет строка 3, как уточняющая
+  #name_c2 <- tidyr::gather(df0[1, ], key = name, value = name_c2) # 1-ая колонка ушла в имена
+  #name_c3 <- tidyr::gather(df0[2, ], key = name, value = name_c3) # 1-ая колонка ушла в имена
+  
+  # различные виды join не подойдут, поскольку мы хотим оставить все строки, вне зависимости от результата
+  # сливать по именам опасно, вдруг есть дубли
+  # names.df <- dplyr::full_join(name_c2, name_c3, by = "name")
+  names_df <- tibble(name_c2=tidyr::gather(df0[1, ], key=name, value=v)$v,
+                     name_c3=tidyr::gather(df0[2, ], key=name, value=v)$v) %>%
+    # http://www.markhneedham.com/blog/2015/06/28/r-dplyr-update-rows-with-earlierprevious-rows-values/
+    mutate(name_c2 = na.locf(name_c2)) %>%
+    # если name_c3 = NA, то результат объединения строк также будет NA, нас это не очень устраивает
+    mutate(name_fix = ifelse(is.na(name_c3), name_c2, str_c(name_c2, name_c3, sep=": "))) %>%
+    mutate(name_fix = str_replace_all(name_fix, "\r", " ")) %>% # перевод строки
+    mutate(name_fix = str_replace_all(name_fix, "\n", " ")) %>% # перевод строки
+    mutate(name_fix = str_replace_all(name_fix, "  ", " "))
+  
+  # browser()
+  df1 <- df0
+  repl_df <- tribble(
+    ~pattern, ~replacement,
+    "Мастер-технолог", "foreman_tech",
+    "Формующая часть: Угол напорного ящика", "angle_in",
+    "Формующая часть: Разница скорости струи/сетки", "speed_diff_in",
+    "Формующая часть: Открытие щели напорного ящика", "slot_in",
+    "Формующая часть: Давление на напорном ящике", "pressure_in",
+    "Поток: Концентрация при размоле", "concentration_in",
+    "Производительность", "performance_out",
+    "Вес м2", "weight_out",
+    "Артикул", "mark_out",
+    "Примечание", "notes"
+  )
+  names(df1) <- stri_replace_all_fixed(names_df$name_fix,
+                                       pattern = repl_df$pattern,
+                                       replacement = repl_df$replacement,
+                                       vectorize_all = FALSE)
+  # Все равно кривые имена, дубли
+  names_df %>% 
+    group_by(name_fix) %>% 
+    filter(n()>1)
+  
+  df1 %<>% repair_names(prefix = "repaired_", sep = "")
+  
+  # выбираем только интересующие колонки
+  df2 <- df1 %>% 
+    select(foreman_tech, angle_in, speed_diff_in, slot_in, pressure_in, concentration_in,
+           performance_out, weight_out, mark_out, notes) %>%
+    filter(row_number() > 6) # удаляем весь верхний шлак
+  # browser()
+  
+  df3 <- df2 %>%
+    # filter(complete.cases(.)) %>% # удаляем строки, содержащие пустые данные
+    filter(performance_out>0) %>%
+    # distinct() %>% # уберем идентичные строчки
+    #http://stackoverflow.com/questions/27027347/mutate-each-summarise-each-in-dplyr-how-do-i-select-certain-columns-and-give
+    mutate_at(vars(-foreman_tech, -mark_out, -notes), funs(as.numeric))
+  
+  df3
+}
+
+```
+
+
+
+# Cоберем все закладки Excel файла вместе
+```{r}
+mnames <- c("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", 
+            "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")
+
+tmp <- excel_sheets(datafile)
+sheets <- tmp[tmp %in% mnames]
+
+df <- foreach(it=iter(sheets), .combine=rbind, .packages='readxl') %do% {
+  temp.df <- get_month_data(datafile, it) %>% mutate(month=it)
+
+  temp.df
+}
+
+# наверное данные без маркировки выходной продукции не имеют большого смысла
+df %<>% filter(!is.na(mark_out))
+
+df
+```
+
+```{r}
+tic("Analysis")
+# посчитаем количество уникальных значений в колонках
+dist_cols <- map_df(select(df, everything()), n_distinct)
+# посчитаем и отсортируем словарные уникальные значения
+unq <- map(df, unique) %>% map(sort, decreasing=T)
+toc()
+
+dist_cols
+unq
+
+
+```
+# Визуализация данных по результатам общения с фабрикой
+```{r}
+extrafont::loadfonts()
+extrafont::fonttable()
+extrafont::fonts()
+```
+
+## Зависимость speed_diff_in от slot_in
+
+```{r}
+gp <- ggplot(df, aes(x=slot_in, y=speed_diff_in, colour=mark_out)) + 
+  geom_point() +
+  # theme_ipsum_rc(base_family="Roboto Condensed", base_size = 11.5)
+  theme_ipsum_rc(base_size = 11.5) +
+  facet_wrap(~mark_out, scales = "free")
+
+gp
+
+```
+## Средняя speed_diff_in для каждого вида бумаги
+
+```{r}
+gp <- ggplot(df, aes(x=mark_out, y=speed_diff_in)) + 
+  geom_point() +
+  # theme_ipsum_rc(base_family="Roboto Condensed", base_size = 11.5)
+  theme_ipsum_rc(base_size = 11.5)
+
+gp
+
+```
+## Производительность машины по месяцам
+```{r}
+gp <- ggplot(df, aes(x=month, y=performance_out, fill=foreman_tech)) + 
+  geom_col() +
+  theme_ipsum_rc(base_size = 11.5)
+
+gp
+
+```
+## Лучший мастер по производительности на каждый вид бумаги
+```{r}
+df0 <- df %>% 
+  group_by(mark_out, month, foreman_tech) %>% 
+  summarise(performance = mean(performance_out)) %>%
+  arrange(desc(mark_out)) %>%
+  top_n(1, wt=performance)
+  # mutate(num=row_number()) 
+
+# df0
+
+gp <- ggplot(df0, aes(x=month, y=performance, fill=foreman_tech)) + 
+  geom_col() +
+  theme_ipsum_rc(base_size = 11.5) +
+  facet_wrap(~mark_out)
+
+gp
+
+```
+
+# Первичная визуализация данных
+Пытаемся понять, что скрывается за имеющимся набором данных.
+
+ - Минимальный удельный вес продукции составляет **`r min(df$weight_out)`** гр/м^2.
+ - Максимальный удельный вес продукции составляет **`r max(df$weight_out)`** гр/м^2.
+
+```{r}
+# распределение весов по марке продукции
+df0 <- df %>% group_by(mark_out) %>% mutate(row=row_number())
+
+gp <- ggplot(df0, aes(x=row, y=weight_out, colour=mark_out)) + 
+  geom_point()# +
+  #facet_wrap(~colour, scales = "free")
+
+gp # так не очень показательно
+
+```
+```{r}
+# распределение весов по марке продукции
+# http://ggplot2.tidyverse.org/reference/geom_dotplot.html
+df0 <- df %>% group_by(mark_out)
+
+gp <- ggplot(df0, aes(x=weight_out, fill=mark_out)) + 
+  theme_bw() +
+  geom_dotplot(alpha=0.5, method = "dotdensity", binpositions = "bygroup") +
+  facet_wrap(~mark_out, scales = "free")
+
+gp
+
+```
+```{r}
+gp <- ggplot(df0, aes(x=mark_out, y=weight_out, fill=mark_out)) +
+  theme_bw() +
+  geom_dotplot(alpha=0.3, binaxis="y", stackdir="center", binwidth=1/3) +
+  facet_wrap(~notes, scales = "free")
+
+gp
+
+```
+

77 artem/scorecard_demo/run_shiny_app.cmd

@@ -0,0 +1,3 @@
+rem https://shiny.rstudio.com/articles/running.html
+rem "C:\Program Files\R\R-3.4.4\bin\x64\Rscript.exe"  -e "Sys.setenv(LANG='C'); shiny::runApp('app.R')"
+"C:\Program Files\R\R-3.5.2\bin\x64\Rscript.exe"  -e "Sys.setenv(LANG='C'); shiny::runApp('app.R')"

92 andrey-khabarovsk/all_questions.Rmd

@@ -52,7 +52,7 @@ ggplot(df, aes(x = Segment, y = val, fill = param)) +
 # Почему то group_by не работает
 
 В переписке было указано, что не делает группироку по Store. В чистом примере все работает без вопросов.
-```{r}
+```{r, message=FALSE, warning=FALSE, include=FALSE}
 library(tidyverse)
 library(magrittr)
 library(readxl)
@@ -122,3 +122,14 @@ df %<>% group_by(Category, new_date) %>%
   summarise(Turn_over_present = sum(Turn_over_present, na.rm = TRUE), 
             Turn_over_previous = sum(Turn_over_previous, na.rm = TRUE))
 ```
+
+# Возникли проблемы с русским языком в путях
+При попытке прочитать данные по пути, содержащему русские буквы (Win, русская), возникает ошибка. Код и ошибка ниже:
+```{r}
+ setwd( normalizePath("C:/Users/kirson.a/Desktop/Данные/Данные для dashboard"))
+x <- readr::read_delim("01.01.csv", delim = ";", locale = locale("ru", encoding = "windows-1251",decimal_mark = ",", grouping_mark = " "))
+
+
+# Error in guess_header_(datasource, tokenizer, locale) : 
+#   Cannot read file C:/Users/kirson.a/Desktop/Данные/Данные для dashboard/01.01.csv: Системе не удается найти указанный путь.
+```