Skip to content

Commit b4d5cdd

Browse files
mztrkmztrk
authored
Create test
0 parents  commit b4d5cdd

File tree

1 file changed

+255
-0
lines changed

1 file changed

+255
-0
lines changed

‎test

+255
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,255 @@
1+
library(shiny)
2+
library(plyr)
3+
library(dplyr)
4+
library(data.table)
5+
library(tictoc)
6+
library(randomForest)
7+
library(stringr)
8+
library(htmlwidgets)
9+
library(XLConnect)
10+
library(DT)
11+
library(dichromat)
12+
source("scripts/utilities.R")
13+
14+
ui <- fluidPage(
15+
sidebarLayout(
16+
sidebarPanel(
17+
fileInput("file1", "Choose File (.csv, .txt, .rds):",
18+
accept = c(
19+
"text/csv/RDS/rds",
20+
"text/comma-Semicolon-values,text/plain",
21+
".csv", ".txt", ".rds", ".RDS")
22+
),
23+
h5(strong("\n Welcome to the clusterization App")),
24+
uiOutput("varsToCluster"),
25+
uiOutput("varsToShow"),
26+
uiOutput("varScore"),
27+
h5(strong("\n Please select the number of clusters and the sample proportion in number or percentile")),
28+
splitLayout(cellWidths = c("25%", "30%", "5%", "30%"),
29+
numericInput(inputId = "numClusters",
30+
label = "Num Clusters",
31+
value = 3,
32+
min = 0,
33+
max = 100,
34+
step = 1,
35+
width = '50%'),
36+
uiOutput("numCustomers"),
37+
h4("\n "),
38+
numericInput(inputId = "percCustomers",
39+
label = "% Customers",
40+
value = NULL,
41+
min = 0,
42+
max = 100,
43+
step = 0.0001,
44+
width = '50%')),
45+
checkboxInput(inputId ="scaleData",
46+
label = "Do you want to scale the data?", value = TRUE, width = NULL),
47+
actionButton("clusterTime", "Launch Clustering"),
48+
h4(strong("\n Please select the files you want to save:")),
49+
splitLayout(cellWidths = c("50%","25%", "25%"),
50+
h5(strong("\n Top riskiest with cluster")),
51+
radioButtons("filetype1", NULL,
52+
choices = c(".csv", ".rds"), inline = TRUE),
53+
downloadButton("downloadClusters", "Download")),
54+
splitLayout(cellWidths = c("50%","25%", "25%"),
55+
h5(strong("\n Clusterization summary")),
56+
h4("\n "),
57+
downloadButton("downloadSummary", "Download"))
58+
59+
),
60+
mainPanel(
61+
DT::dataTableOutput("DT_deepDiveDynamicClusterTable")
62+
)
63+
)
64+
)
65+
66+
67+
server <- function(input, output, session){
68+
options(shiny.maxRequestSize = 6000*1024^2)
69+
70+
globalVars <- eventReactive( {input$file1} , {
71+
inFile <- input$file1
72+
if (is.null(inFile))
73+
return(NULL)
74+
75+
76+
if(grepl(".rds$|.RDS$", inFile$name)){
77+
dt <- readRDS(inFile$datapath)
78+
} else {
79+
dt <- fread(inFile$datapath)
80+
#, header = input$header, sep = input$sep)
81+
}
82+
varsInTable <- unique(names(dt))
83+
nrows <- as.numeric(nrow(dt))
84+
85+
list( dt = dt, varsInTable = varsInTable, nrows = nrows)
86+
87+
})
88+
output$varsToCluster <- renderUI({
89+
selectizeInput(inputId = "selectVarToCluster", label = "Select variables to be used for clusterization",
90+
choices = globalVars()$varsInTable, selected = NULL, multiple = TRUE,
91+
options = NULL, width = "80%")
92+
93+
})
94+
output$varsToShow <- renderUI({
95+
selectizeInput(inputId = "selectVarToShow", label = "Select variables to be shown in the clustering summary",
96+
choices = globalVars()$varsInTable, selected = NULL, multiple = TRUE,
97+
options = NULL, width = "80%")
98+
})
99+
100+
output$varScore <- renderUI({
101+
selectInput(inputId = "score",
102+
label = "Select the variable containing the score",
103+
choices = globalVars()$varsInTable,
104+
selected = NULL, multiple = FALSE,
105+
selectize = FALSE, width = "80%", size = NULL)
106+
107+
})
108+
109+
output$numCustomers <- renderUI({
110+
numericInput(inputId = "numCustomers",
111+
label = "N Customers",
112+
value = globalVars()$nrows,
113+
min = 0,
114+
max = globalVars()$nrows,
115+
step = 1,
116+
width = '70%')
117+
118+
})
119+
120+
observeEvent(input$numCustomers, {
121+
#req(input$numCustomers)
122+
if(is.na(input$numCustomers)){
123+
updateNumericInput(session, "percCustomers", value = 0)
124+
} else {
125+
x <- round(input$numCustomers / globalVars()$nrows, 4) * 100
126+
if (x > 100){
127+
updateNumericInput(session, "percCustomers", value = 100)
128+
} else {
129+
updateNumericInput(session, "percCustomers", value = x)
130+
}
131+
}
132+
133+
})
134+
135+
observeEvent(input$percCustomers, {
136+
#req(input$percCustomers)
137+
if(is.na(input$percCustomers)){
138+
updateNumericInput(session, "numCustomers", value = 0 )
139+
} else {
140+
y <- round(input$percCustomers / 100 * globalVars()$nrows)
141+
if (y > globalVars()$nrows){
142+
updateNumericInput(session, "numCustomers", value = globalVars()$nrows )
143+
} else {
144+
updateNumericInput(session, "numCustomers", value = y )
145+
}
146+
}
147+
})
148+
clusterizationData <- eventReactive(input$clusterTime, {
149+
print(getwd())
150+
print(file.exists("auxFiles/clusteringTemplate.xlsx"))
151+
clusters <- kMeansClustering(dt = globalVars()$dt,
152+
clusteringVarnames = input$selectVarToCluster,
153+
shownVarnames = input$selectVarToShow,
154+
nClusters = input$numClusters,
155+
scoreColName = input$score,
156+
nRowsToCluster = input$numCustomers,
157+
percRowsToCluster = NULL,
158+
scaleData = input$scaleData,
159+
file = NULL,
160+
template = "auxFiles/clusteringTemplate.xlsx",
161+
plotFilename = NULL,
162+
plotSampleSize = 500,
163+
verbose = TRUE)
164+
print(input$score)
165+
166+
clustersSummary <- clusters$report
167+
clustersSummary[, (setdiff(names(clustersSummary),c("usedForClustering", "cluster"))) := lapply(.SD, function(x){round(x, 3)}), .SDcols = (setdiff(names(clustersSummary),c("usedForClustering", "cluster")))]
168+
clusters <- clusters$clusteredData
169+
list(clustersSummary = clustersSummary, clusters = clusters)
170+
})
171+
172+
output$DT_deepDiveDynamicClusterTable <- DT::renderDataTable({
173+
174+
n_months <- (clusterizationData()$clustersSummary %>% ncol) - 2
175+
print(n_months)
176+
palettes <- gsub(', ', '", "', paste(colorRampPalette(c("#F8696B","#FFEB84","#63BE7B"))(n_months), collapse=", "))
177+
print(palettes)
178+
palettes <- sprintf('"%s"',palettes)
179+
180+
return(DT::datatable(
181+
clusterizationData()$clustersSummary,
182+
rownames = TRUE,
183+
extensions = 'FixedColumns',
184+
options = list(
185+
scrollX = TRUE,
186+
fixedColumns = list(leftColumns = 1, rightColumns=0),
187+
lengthMenu = list(c(5, 15, -1), c('5', '15', 'All')),
188+
pageLength = -1,
189+
rowCallback = JS(sprintf('
190+
function(nRow, aData, iDisplayIndex, iDisplayIndexFull) {
191+
// Bold and green cells for conditions
192+
var defColors= [ %s ];
193+
console.log(aData.length);
194+
var valData=[];
195+
for (var i = 0; i < aData.length -3; i++) {
196+
valData.push(parseFloat(aData[i+2]));
197+
};
198+
valData.sort(function(a,b){return a - b});
199+
200+
console.log("aData", aData);
201+
console.log("valData", valData);
202+
203+
for (var i = 1; i < aData.length; i++) {
204+
var targetCell = "td:eq(" + i + ")";
205+
//var colCell = defColors[i];
206+
var colCell = defColors[valData.indexOf(parseFloat(aData[i]))];
207+
console.log("Test",i, targetCell, aData[i], valData.indexOf(parseFloat(aData[i])), colCell);
208+
//console.log(valData.indexOf(parseFloat(aData[i])));
209+
//console.log(colCell);
210+
$(targetCell, nRow).css("background-color", colCell);
211+
}
212+
}', palettes)))))
213+
214+
})
215+
216+
output$downloadClusters <- downloadHandler(
217+
# This function returns a string which tells the client
218+
# browser what name to use when saving the file.
219+
filename = function(){
220+
paste0("clusterization_output", input$filetype1)
221+
},
222+
# This function should write data to a file given to it by
223+
# the argument 'file'
224+
content = function(file){
225+
fileType <- switch(input$filetype1, ".csv" = ".csv", ".rds" = ".rds")
226+
if (fileType == ".rds"){
227+
saveRDS(clusterizationData()$clusters, file)
228+
} else {
229+
fwrite(clusterizationData()$clusters, file, sep = ";")
230+
}
231+
}
232+
)
233+
234+
output$downloadSummary <- downloadHandler(
235+
# This function returns a string which tells the client
236+
# browser what name to use when saving the file.
237+
filename = function(){
238+
paste0("clusterization_summary", ".xlsx")
239+
},
240+
# This function should write data to a file given to it by
241+
# the argument 'file'
242+
content = function(file){
243+
clustersSummary <- clusterizationData()$clustersSummary
244+
str(file)
245+
saveClustersSummary(clustersSummary = clustersSummary,
246+
file = file,
247+
template = "auxFiles/clusteringTemplate.xlsx")
248+
249+
})
250+
}
251+
252+
options(shiny.port = 5556,
253+
# shiny.host = "172.20.35.58",
254+
shiny.launch.browser = T, shiny.trace = T)
255+
shinyApp(ui, server)

0 commit comments

Comments
 (0)