ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)27 Приложения Shiny
27.1 Создание директории и файла приложения
File->New Project->New Directory->Shiny ApplicationФайл
App.Rсодержит скрипт, который
- определяет пользовательский интерфейс - страницу html, с которой будет взаимодействовать пользователь
- формирует поведение приложения путем определения функции server
- вызывает функцию
shiny(ui, server)для сборки и запуска приложения
Запустить приложение можно кнопкой Run App.
27.2 Элементы пользовательского интерфейса
27.2.1 Макет и заголовки
В созданном автоматически файле вы видите следующее.
Здесь:
fluidPage()- функция разметки, отвечающая за визуальную структуру приложения. Внутрь кладём всё, что хотим увидеть на экране. Обычно это какой-то Input, с которым взаимодействует пользователь, и какой-то Output.titlePanel()отвечает за заголовок.sidebarLayout(...)делит экран на две основные части: узкая панель с элементами управления (слева) и главная панель.sidebarPanel(...)отвечает за боковую панель. В ней мы видимsliderInput()- это ползунок.mainPanel(...)- это главная, большая панель. В ней будет что-то отображаться. Например, график:plotOutput().
Запустите приложение еще раз и посмотрите, что получилось.
27.2.2 Элементы ввода
Полный список элементов ввода доступен по ссылке.
Небольшие фрагменты текста удобно обрабатывать при помощи функции textInput(), а если вы хотите, чтобы пользователь ввел один или несколько абзацев, используйте textAreaInput(). Для нашего классификатора подойдет последняя. Добавьте ее вместо ползунка:
textAreaInput("user_text",
NULL,
placeholder = "Введите текст новости здесь...",
rows = 6)Для сравнения добавьте рядом (чуть позже мы это уберем):
textInput("user_name",
# заметьте положение вопроса
"Как вас зовут?")27.2.3 Кнопки
Для подтверждения действия пользователю можно дать в распроряжение кнопку или ссылку с помощью функций actionButton() или actionLink().
Добавьте под областью ввода текста:
actionButton("predict_btn", "🔍 Предсказать категорию", class = "btn-primary")Обычно кнопки и ссылки работаю в паре с функциями observeEvent() или eventReactive().
Функция observeEvent() используется для выполнения “побочных действий”, например, печати в консоль, записи файла, запуска функций без прямого вывода в интерфейс. Это функция для действий, она не возвращает данных.
Функция eventReactive() используется для создания реактивного значения (которое возвращает значение, и этим значением можно пользоваться в других частях Shiny, например для построения графика).
В последних версиях Shiny обе функции заменяет bindEvent(). Пока мы не использовали эти функции, так что наша кнопка бездействует.
Вы можете настроить внешний вид кнопок по своему желанию, передав в качестве аргумента class одно из следующих значений: "btn-primary", "btn-success","btn-info","btn-warning","btn-danger". Вы также можете изменить размер кнопки при помощи значений "btn-lg", "btn-lg" или "btn-lg". Наконец, вы можете заставить кнопку занять всю свободную ширину внутри элемента, в который она встроена, используя значение "btn-block".
27.2.4 Элементы вывода
Элементы вывода (output) представляют собой своеобразные заглушки в интерфейсе пользователя, которые при необходимости заполняются с помощью функции server().
Как и элементы ввода, элементы вывода принимают идентификатор в качестве обязательного первого аргумента. Если в пользовательском интерфейсе есть элемент с идентификатором “plot” (или любым другим!), в серверной части приложения обращаться к нему можно будет по имени output$plot.
Каждая функция вывода в клиентской части сопоставляется с функцией отображения в серверной. Существует три основных типа вывода: текст, таблицы, графики.
Начнем с текста. Добавьте в серверную часть (вместо функции, которая генерирует гистограмму):
output$user_name <- renderText(paste("Привет, ", input$user_name, "!"))Функция renderText() собирает результат в строку и обычно применяется в паре с функцией textOutput(). Добавьте вывод на главную панель в пользовательском интерфейсе вместо plotOutput():
textOutput("user_name")Обратите внимание: кнопка все еще бездействует, вывод обновляется реактивно.
Для того, чтобы кнопка “заработала”, необходимо внести изменения в серверную часть:
server <- function(input, output) {
output$salutation <- renderText(paste("Привет, ", input$user_name, "!")) |>
bindEvent(input$predict_btn)
}В интерфейсе замените, соответственно, вывод на textOutput("salutation").
Теперь разберемся, что здесь происходит. Когда вы пишете output$salutation, вы определяете реактивный выход - объект, который потом будете выводить на UI с помощью textOutput("salutation"). Функция renderText() которая возвращает текст для отображения. Внутри paste("Привет, ", input$user_name, "!") вставляет имя, который ввел пользователь. Наконец, функция функция bindEvent() (с пайпом |>) говорит Shiny, что обновлять (пересчитыать) выходной текст надо только тогда, когда нажата кнопка с id “predict_btn”. Теперь только нажатие кнопки вызывает обновление вывода. Это понадобится нам чуть позже.
Если все получилось и все понятно, можно удалить лишние строчки кода, которые не нужны для нашего приложения. На этом этапе у вас должно получиться вот что:
library(shiny)
# пользовательский интерфейс
ui <- fluidPage(
# название приложения
titlePanel("📰 Классификатор новостей"),
# макет
sidebarLayout(
sidebarPanel(
width = 6,
tags$h4("Вставьте или напечатайте новость:"),
textAreaInput("user_text",
NULL,
placeholder = "Введите текст новости здесь...",
rows = 6),
actionButton("predict_btn",
"🔍 Предсказать категорию",
class = "btn-primary")
),
mainPanel(
width = 6,
tags$h3("Результаты классификации"),
)
)
)
# сервер (пока пустой)
server <- function(input, output) {
# пока пусто
}
# поехали!
shinyApp(ui = ui, server = server)27.3 Сервер
В предыдущем уроке мы обучили нейросетевую модель, которая предсказывает категорию новости по ее тексту. Если вы не сохранили результат, то препроцессор и модель надо забрать по ссылкам и положить в директорию с приложением.
После этого прочитайте в окружение данные и загрузите нужные пакеты (пока можно это сделать в отдельном скрипте, потом добавим в приложение):
library(keras3)
onehot_rec <- readRDS("onehot_prep.rds")
model <- load_model("my_dense_model.keras")Также нам понадобятся имена для классов: они соответствуют уровням фактора, который мы создали в прошлый раз при помощи as.factor(class):
class_names <- c("Business", "Sci/Tech", "Sports", "World") Теперь воспользуемся этим, чтобы получить:
- предсказание для пользовательского текста;
- вектор вероятностей для каждой категории;
- визуализацию вероятностей.
Как мы помним, обученный рецепт можно использовать вместе с bake() на новых данных, но для этого строку, которую введет пользователь, нужно преобразовать в тиббл с теми же названиями столбцов, которые ожидает препроцессор.
library(tidyverse)
library(recipes, quietly = TRUE)
library(textrecipes)
text <- "A British man has been arrested after he drove his car into a crowd of Liverpool FC football fans celebrating their team's Premier League"
new_data <- tibble(description = text)
model_input <- bake(onehot_rec,
new_data = new_data,
composition = "matrix")
probs <- as.numeric(model |> predict(model_input))
pred_cat <- class_names[which.max(probs)]
names(probs) <- class_names
probsТеперь нам надо добавить все эти вычисления на сервер.
library(shiny)
library(keras3)
library(recipes)
library(tibble)
library(dplyr)
library(stringr)
library(purrr)
library(ggplot2)
library(textrecipes)
# Загрузка обученного препроцессора и модели
onehot_rec <- readRDS("onehot_prep.rds")
model <- load_model("my_dense_model.keras")
# Список названий классов
class_names <- c("Business", "Sci/Tech", "Sports", "World")
# пользовательский интерфейс
ui <- fluidPage(
# название приложения
titlePanel("📰 Классификатор новостей"),
# макет
sidebarLayout(
sidebarPanel(
width = 6,
tags$h4("Вставьте или напечатайте новость:"),
textAreaInput("user_text", NULL, placeholder = "Введите текст новости здесь...", rows = 6),
actionButton("predict_btn", "🔍 Предсказать категорию", class = "btn-primary")
),
mainPanel(
width = 6,
tags$h3("Результаты классификации"),
textOutput("result_text")
)
)
)
# сервер
server <- function(input, output) {
pred_result <- reactive({
req(input$user_text)
new_data <- tibble(description = input$user_text)
model_input <- bake(onehot_rec,
new_data = new_data,
composition = "matrix")
probs <- as.numeric(model |> predict(model_input))
pred_cat <- class_names[which.max(probs)]
list(
category = pred_cat,
probs = setNames(probs, class_names)
)
}) |> bindEvent(input$predict_btn)
output$result_text <- renderText({
req(pred_result())
paste0(
"🌟 Предсказанная категория: ", pred_result()$category)
})
}
# поехали!
shinyApp(ui = ui, server = server)Функция reactive() означает, что мы используем реактивное выражение. Реактивные выражения — это особые части кода, которые автоматически пересчитываются, когда зависящие от них переменные изменяются.
Реактивные выражения нужны, когда вы хотите: - Выполнить вычисления, которые используете несколько раз, не повторяя один и тот же код; - Эффективно управлять зависимостями и пересчётами: Shiny будет хранить результат вычисления, и пересчитывать, только когда реально изменились входные значения.
В нашем случае реактивное выражение считает результат, только когда пользователь нажимает кнопку, за связь с кнопкой отвечает bindEvent(). сли бы этого не было, приложение реагировало бы на каждый введённый символ!
Вызов req(input$user_text) - это проверка. Если поле ввода пустое, дальше ничего не происходит. Иными словами, req() останавливает выполнение реактивного выражения, если в него передано NULL, FALSE и т.п. Это гарантирует, что ваш код не будет выполняться при отсутсвии необходимых данных.
На шаге new_data <- tibble(description = input$user_text) оборачиваем введённый текст в табличку, чтобы дальше передать в препроцессор.
В конце вызываем list(...), который возвращает список с двумя значениями:
- category — категория с самой высокой вероятностью. - probs — вектор вероятностей для всех четырёх классов.
Почему список? В реактивных выражениях, как и в базовых функциях, можно вернуть только один объект. Чтобы иметь возможность обращаться к разным значениям внутри реактива, их удобно объединить в список.
Наконец, output$result_text – это то, что будет отображено в textOutput("result_text") на главной странице приложения. Все внутри renderText({...}) – это реактивно пересчитываемый текст, который появится при обновлении pred_result().
Итак, как всё работает вместе?
- Пользователь вводит текст и нажимает кнопку.
- Только в этот момент (!) вычисляется реактивное выражение
pred_result:- Текст подготавливается, обрабатывается препроцессором, подаётся модели.
- Получается вектор вероятностей по имеющимся категориям.
- Определяется категория с максимальной вероятностью.
- Результат пакуется в список.
- Значения из
pred_resultавтоматически (реактивно!) используются в части вывода:- Текстовое поле показывает предсказанную категорию.
(Пользователь вводит текст)
│
▼
(Жмёт кнопку)
│
▼
pred_result (реактивное выражение):
├─ 1. Обработка текста
├─ 2. Векторизация/onehot
├─ 3. Предсказание нейросетью
└─ 4. Формирование списка с вероятностями и категорией
│
▼
output$result_text (реактивный вывод)Вместо простого текста можно использовать html-код. В таком случае вместо renderText() и textOutput() используем renderUI() и uiOutput(), например:
# в серверной части
output$result_text <- renderUI({
req(pred_result())
HTML(
paste0(
"<h4>🌟 Предсказанная категория: <span style='color:#0072B2;'>", pred_result()$category, "</span></h4>"
)
)
})
# в пользовательском интерфейсе
uiOutput("result_text")Теперь попробуем усовершенстовать наше приложение, добавив график.
27.4 Добавление графика
Вот так мы бы визуализировали вероятности вне приложения:
tibble(category = class_names, probability = probs) |>
ggplot(aes(y = reorder(category, probability), x = probability, fill = category)) +
geom_col(width = 0.6, show.legend = FALSE) +
scale_fill_brewer(palette = "Set2") +
scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x = "Вероятность", y = "Категория") +
theme_minimal(base_size = 15) +
theme(
axis.title.y = element_blank(),
plot.title = element_text(face="bold"),
axis.text = element_text(size=12)
)На сервере почти все то же самое, но оборачиваем в реактивное выражение и проверяем наличие вероятностей. Код ниже нужно добавить на сервер.
output$prob_plot <- renderPlot({
req(pred_result())
tibble(category = class_names,
probability = pred_result()$probs) |>
ggplot(aes(y = reorder(category, probability), x = probability, fill = category)) +
geom_col(width = 0.6, show.legend = FALSE) +
scale_fill_brewer(palette = "Set2") +
scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(x = "Вероятность", y = "Категория") +
theme_minimal(base_size = 15) +
theme(
axis.title.y = element_blank(),
plot.title = element_text(face="bold"),
axis.text = element_text(size=12)
)
})