Вместо того, чтобы использовать kable для вывода таблицы, не могли бы вы вместо этого использовать dataTable?
Если вы сделаете это, вы можете ограничить число отображаемых строк, то есть пользователю придется нажать на следующая страница, чтобы увидеть следующие 5 кластеров.
В частности, параметр pageLength в dataTable - это то, что вы ищете:
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
##Need to install this package if you don't have it
library(DT)
#database
df<-structure(list(Properties = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9,
+ -23.9, -23.9, -23.9, -23.9, -23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9,-23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7,
+ -49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6,-49.6), Waste = c(526, 350, 526, 469, 285, 175, 175, 350, 350, 175, 350, 175, 175, 364,
+ 175, 175, 350, 45.5, 54.6,350,350,350,350,350,350,350,350,350,350,350,350,350,350,350,350)), class = "data.frame", row.names = c(NA, -35L))
function.clustering<-function(df,k,Filter1,Filter2){
if (Filter1==2){
Q1<-matrix(quantile(df$Waste, probs = 0.25))
Q3<-matrix(quantile(df$Waste, probs = 0.75))
L<-Q1-1.5*(Q3-Q1)
S<-Q3+1.5*(Q3-Q1)
df_1<-subset(df,Waste>L[1])
df<-subset(df_1,Waste<S[1])
}
#cluster
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
#Number of clusters
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#Localization
center_mass<-matrix(nrow=k,ncol=2)
for(i in 1:k){
center_mass[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters
center_mass<-cbind(center_mass,matrix(c(1:k),ncol=1))
#Coverage
coverage<-matrix(nrow=k,ncol=1)
for(i in 1:k){
aux_dist<-distm(rbind(subset(coordinates,cluster==i),center_mass[i,])[,2:1])
coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage_meters","cluster")
#Sum of Waste from clusters
sum_waste<-matrix(nrow=k,ncol=1)
for(i in 1:k){
sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
}
sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
colnames(sum_waste)<-c("Potential_Waste_m3","cluster")
#Output table
data_table <- Reduce(merge, list(df, coverage, sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Properties)),]
data_table_1 <- aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3, data_table[,c(1,7,6,2)], toString)
#Scatter Plot
suppressPackageStartupMessages(library(ggplot2))
df1<-as.data.frame(center_mass)
colnames(df1) <-c("Latitude", "Longitude", "cluster")
g<-ggplot(data=df, aes(x=Longitude, y=Latitude, color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
Centro_View<- g + geom_text(data=df, mapping=aes(x=eval(Longitude), y=eval(Latitude), label=Waste), size=3, hjust=-0.1)+ geom_point(data=df1, mapping=aes(Longitude, Latitude), color= "green", size=4) + geom_text(data=df1, mapping = aes(x=Longitude, y=Latitude, label = 1:k), color = "black", size = 4)
plotGD<-print(Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5)))
return(list(
"Data" = data_table_1,
"Plot" = plotGD,
"Coverage" = coverage
))
}
function.LetControl <- function(coverage) {
m <- mean(coverage[, 1])
MR <- mean(abs(diff(coverage[, 1])))
d2 <- 1.1284
LIC <- m - 3 * (MR / d2)
LSC <- m + 3 * (MR / d2)
plot(
coverage[, 1],
type = "b",
pch = 16,
ylim = c(LIC - 0.1 * LIC, LSC + 0.5 * LSC),
axes = FALSE
)
axis(1, at = 1:35)
axis(2)
box()
grid()
abline(h = MR,
lwd = 2)
abline(h = LSC, lwd = 2, col = "red")
abline(h = LIC, lwd = 2, col = "red")
}
ui <- fluidPage(
titlePanel("Clustering "),
sidebarLayout(
sidebarPanel(
helpText(h3("Generation of clustering")),
radioButtons("filter1", h3("Waste Potential"),
choices = list("Select all properties" = 1,
"Exclude properties that produce less than L and more than S" = 2),
selected = 1),
radioButtons("filter2", h3("Coverage do cluster"),
choices = list("Use default limitations" = 1,
"Do not limite coverage" = 2
),selected = 1),
tags$hr(),
helpText(h3("Are you satisfied with the solution?")),
helpText(h4("(1) Yes")),
helpText(h4("(2) No")),
helpText(h4("(a) Change the number of clusters")),
sliderInput("Slider", h3("Number of clusters"),
min = 2, max = 34, value = 8),
helpText(h4("(b) Change the filter options"))
),
mainPanel(
##uiOutput("tabela"),
DTOutput("tabela"),
plotOutput("ScatterPlot"),
plotOutput("LetCoverage"),
)))
server <- function(input, output) {
f1<-renderText({input$filter1})
f2<-renderText({input$filter2})
Modelclustering<-reactive(function.clustering(df,input$Slider,1,1))
# output$tabela <- renderUI({
# data_table_1 <- req(Modelclustering())[[1]]
# x <- kable(data_table_1[order(data_table_1$cluster), c(1, 4, 2, 3)], align = "c", row.names = FALSE)
# x <- kable_styling(kable_input = x, full_width = FALSE)
# HTML(x)
output$tabela <- renderDataTable({
data_table_1 <- req(Modelclustering())[[1]]
x <- datatable(data_table_1[order(data_table_1$cluster), c(1, 4, 2, 3)],
options = list(
paging =TRUE,
pageLength = 5
)
)
return(x)
})
output$ScatterPlot <- renderPlot({
Modelclustering()[[2]]
})
output$LetCoverage <- renderPlot({
function.LetControl(Modelclustering()[[3]])
})
}
# Run the application
shinyApp(ui = ui, server = server)
Теперь ваше приложение работает. Это должно сработать, оно покажет только 5 кластеров, независимо от того, сколько вы установили в своем входе. Если вы хотите изменить это, просто добавьте новый ползунок ввода или виджет управления.
Я закомментировал ваш код и добавил свой код. Я изменил на пользовательском интерфейсе и стороне сервера.