[英]Create connection between numericInput and function in a Shiny app
The code below generates a map with clusters.下面的代码生成一个带有簇的 map。 The cluster number will depend on the k
variable that is inside my function. To get this k
value, I use the Weighted Sum Method (WSM)
calculation.簇数将取决于我的 function 中的k
变量。为了获得这个k
值,我使用Weighted Sum Method (WSM)
计算。 Note that for this calculation it is necessary to choose the weights of the criteria, in my case there are only two.请注意,对于此计算,有必要选择标准的权重,在我的例子中只有两个。 Therefore, k
can vary depending on the chosen weights.因此, k
可以根据所选的权重而变化。 In my function I manually put ( weights <- c(0.5,0.5)
).在我的 function 中,我手动输入 ( weights <- c(0.5,0.5)
)。 However, I would like to put the weights from the two numericInput
I created.但是,我想从我创建的两个numericInput
中放置权重。 So how to do this?那么该怎么做呢? Another thing, in this case, the map is only generated after the weights are selected.另一件事,在这种情况下,map 仅在选择权重后生成。
This question can help: Approach without inserting all the code on the server这个问题可以帮助: 不在服务器上插入所有代码的方法
library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
library(shinyjs)
function.cl<-function(df,k){
#database df
df<-structure(list(Properties = c(1,2,3,4,5,6,7),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5),
Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2),
Coverage = c (1526, 2350, 3526, 2469, 1285, 2433, 2456),
Production = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
#Calculation WSM
weights <- c(0.5,0.5)
scaled <- df |>
mutate(Coverage = min(Coverage) / Coverage,
Production = Production / max(Production))
scaled <- scaled |>
rowwise() |>
mutate(`Performance Score` = weighted.mean(c(Coverage, Production), w = weights))
scaled$Rank <- (nrow(scaled) + 1) - rank(scaled$`Performance Score`)
k<-subset(scaled, Rank==2)$Properties #number of clusters
#clusters
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
df1<-df[c("Latitude","Longitude")]
#Color and Icon for map
ai_colors <-c("red","gray","blue","orange","green","beige")
clust_colors <- ai_colors[df$cluster]
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = clust_colors)
# Map for all clusters:
m1<-leaflet(df1) %>% addTiles() %>%
addMarkers(~Longitude, ~Latitude) %>%
addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>%
addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
plot1<-m1
return(list(
"Plot1" = plot1
))
}
ui <- bootstrapPage(
useShinyjs(),
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
numericInput("weight1", label = h4("Weight 1"),
min = 0, max = 1, value = NA, step=0.1),
disabled(numericInput("weight2", label = h4("Weight 2"),
min = 0, max = 1, value = NA, step=0.1)),
helpText("The sum of weights should be equal to 1")),
mainPanel(
tabsetPanel(
tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
))))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,k)
})
output$Leaf1 <- renderLeaflet({
Modelcl()[[1]]
})
observeEvent(input$weight1, {
freezeReactiveValue(input, "weight2")
updateNumericInput(session, 'weight2', value = 1 - input$weight1)
})
}
shinyApp(ui = ui, server = server)
Why don't you redesign your function to this:为什么不将 function 重新设计为:
function.cl<-function(weights){
...
}
and in the reactive call on the server side you do this:在服务器端的反应式调用中,您可以这样做:
Modelcl<-reactive({
function.cl(weights=c(input$weight1, input$weight2))
})
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.