Я создаю приложение Shiny, которое использует пользовательские функции для выравнивания узлов в сети.Я хочу, чтобы базовый layout
кадр данных обновлялся после того, как пользователь выбрал функцию макета из раскрывающегося меню и выбрал узлы для перемещения и привязку.
Я застрял с тем, как использовать кнопку action
, чтобы обновить сервер, чтобы включить выбранную функцию и обновить layout
dataframe`.
В конечном счете, я бы хотелбыть в состоянии сохранить базу данных layout
с помощью кнопки действий.Хотя я могу подождать в этой части.
library(tidyverse)
library(ggraph)
library(graphlayouts)
library(tidygraph)
library(readxl)
library(janitor)
library(scales)
library(igraph)
rm(list = ls())
########################
### Layout Functions ###
########################
layout_align_x <- function(matrix, nodes, anchor) {
matrix[nodes, 1] <- matrix[anchor, 1]
return(matrix)
}
layout_align_y <- function(matrix, nodes, anchor) {
matrix[nodes, 2] <- matrix[anchor, 2]
return(matrix)
}
#############
### Graph ###
#############
g <- erdos.renyi.game(25, 0.15)
V(g)$name <- 1:vcount(g)
tbl_g <- g %>%
as_tbl_graph()
node.names <- tbl_g %>%
activate(nodes) %>%
as_tibble()
ui <- fluidPage(
titlePanel("Node Layout Saver"),
sidebarLayout(
sidebarPanel(
helpText("This Shiny app helps with creating custom network layouts."),
selectInput(
inputId = 'graph_layout',
label = 'Layout',
choices = c('Stress',
'KK',
'DH'), selected = 'Stress'),
selectInput(
inputId = 'node',
label = 'Node(s)',
choices = node.names, selected = '',
multiple = T),
selectInput(
inputId = 'anchor',
label = 'Anchors',
choices = node.names, selected = '',
multiple = T),
selectInput(
inputId = 'layout',
label = 'Alignment Functions',
choices = c('Align X',
'Align Y'), selected = '',
multiple = F),
wellPanel(
h3("Save"),
actionButton("save", "Update coordinates")
) ),
mainPanel(plotOutput("myplot"))
)
)
server <- function(input, output, session) {
output$myplot <- renderPlot({
if(input$graph_layout == 'Stress'){
set.seed(123)
layout <- as.igraph(tbl_g) %>%
layout_with_stress() %>%
as_tibble() %>%
set_names('x', 'y')
} else if (input$graph_layout == 'KK'){
set.seed(123)
layout <- as.igraph(tbl_g) %>%
layout_with_kk() %>%
as_tibble() %>%
set_names('x', 'y')
} else {
set.seed(123)
layout <- as.igraph(tbl_g) %>%
layout_with_dh() %>%
as_tibble() %>%
set_names('x', 'y')
}
## Nodes ##
tbl_g_i <- tbl_g %>%
activate(nodes) %>%
mutate(node = case_when(
name %in% input$node ~ 'Highlight',
T ~ 'Other'
), node = case_when(
name %in% input$anchor ~ 'Anchor',
T ~ node
))
#####################
### Action Button ###
#####################
input$save
layout <- layout %>%
layout_align_x(nodes = input$node,
anchor = input$anchor)
tbl_g_i %>%
ggraph(layout = layout)+
geom_edge_fan(show.legend = F)+
geom_node_point(color = 'black',
size = 7)+
geom_node_point(aes(color = node),
size = 6)+
geom_node_text(aes(label = name),
size = 3.25)+
theme_minimal()+
scale_color_brewer(type = 'seq',
palette = 'Spectral', direction = -1)
})
}
shinyApp(ui, server)