Commit 1b5446c8 authored by dmattek's avatar dmattek
Browse files

Dist and link methods directly from UI

parent cc6c269e
...@@ -17,7 +17,7 @@ helpText.clHier = c(alertNAsPresentDTW = paste0("NAs present. DTW cannot calcula ...@@ -17,7 +17,7 @@ helpText.clHier = c(alertNAsPresentDTW = paste0("NAs present. DTW cannot calcula
# UI ---- # UI ----
clustHierUI <- function(id, label = "Hierarchical CLustering") { clustHierUI <- function(id, label = "Hierarchical Clustering") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
...@@ -29,37 +29,37 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") { ...@@ -29,37 +29,37 @@ clustHierUI <- function(id, label = "Hierarchical CLustering") {
" functions."), " functions."),
br(), br(),
fluidRow( fluidRow(
column(4, column(3,
selectInput( selectInput(
ns("selectPlotHierDiss"), ns("selectPlotHierDiss"),
label = ("Select type of dissimilarity measure:"), label = ("Dissimilarity measure"),
choices = list("Euclidean" = 1, choices = list("Euclidean" = "euclidean",
"Maximum" = 2, "Manhattan" = "manhattan",
"Manhattan" = 3, "Maximum" = "maximum",
"Canberra" = 4, "Canberra" = "canberra",
"DTW" = 5), "DTW" = "DTW"),
selected = 1 selected = 1
), ),
bsAlert("alertAnchorClHierNAsPresent"), bsAlert("alertAnchorClHierNAsPresent"),
selectInput( selectInput(
ns("selectPlotHierLinkage"), ns("selectPlotHierLinkage"),
label = ("Select linkage method:"), label = ("Linkage method"),
choices = list( choices = list(
"Average" = 1, "Average" = "average",
"Complete" = 2, "Complete" = "complete",
"Single" = 3, "Single" = "single",
"Centroid" = 4, "Centroid" = "centroid",
"Ward" = 5, "Ward" = "ward.D",
"Ward D2" = 6, "Ward D2" = "ward.D2",
"McQuitty" = 7 "McQuitty" = "mcquitty"
), ),
selected = 2 selected = 1
) )
), ),
column(4, column(6,
sliderInput( sliderInput(
ns('inPlotHierNclust'), ns('inPlotHierNclust'),
'#dendrogram branches to colour', 'Number of dendrogram branches to cut',
min = 1, min = 1,
max = 20, max = 20,
value = 1, value = 1,
...@@ -263,7 +263,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -263,7 +263,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
} }
#pr_DB$set_entry(FUN = fastDTW, names = c("fastDTW")) #pr_DB$set_entry(FUN = fastDTW, names = c("fastDTW"))
cl.dist = dist(dm.t, method = s.cl.diss[as.numeric(input$selectPlotHierDiss)]) cl.dist = dist(dm.t, method = input$selectPlotHierDiss)
return(cl.dist) return(cl.dist)
}) })
...@@ -279,7 +279,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -279,7 +279,7 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
return(NULL) return(NULL)
} }
cl.hc = hclust(dm.dist, method = s.cl.linkage[as.numeric(input$selectPlotHierLinkage)]) cl.hc = hclust(dm.dist, method = input$selectPlotHierLinkage)
# number of clusters at which dendrigram is cut # number of clusters at which dendrigram is cut
loc.k = input$inPlotHierNclust loc.k = input$inPlotHierNclust
...@@ -402,9 +402,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -402,9 +402,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
output$downCellCl <- downloadHandler( output$downCellCl <- downloadHandler(
filename = function() { filename = function() {
paste0('clust_hierch_data_', paste0('clust_hierch_data_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.csv') input$selectPlotHierLinkage, '.csv')
}, },
content = function(file) { content = function(file) {
...@@ -451,9 +451,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -451,9 +451,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
createMethodStr = reactive({ createMethodStr = reactive({
paste0(s.cl.diss[as.numeric(input$selectPlotHierDiss)], paste0(input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)]) input$selectPlotHierLinkage)
}) })
...@@ -466,9 +466,11 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -466,9 +466,11 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
if (is.null(loc.dm)) if (is.null(loc.dm))
return(NULL) return(NULL)
print(sum(is.na(loc.dm))) # Throw some warnings if NAs present in the dataset.
# DTW cannot compute distance when NA's are preset.
# Other distance measures can be calculated but caution is required with interpretation.
if(sum(is.na(loc.dm)) > 0) { if(sum(is.na(loc.dm)) > 0) {
if (input$selectPlotHierDiss == 5) { if (input$selectPlotHierDiss == "DTW") {
createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentDTW", title = "Error", createAlert(session, "alertAnchorClHierNAsPresent", "alertNAsPresentDTW", title = "Error",
content = helpText.clHier[["alertNAsPresentDTW"]], content = helpText.clHier[["alertNAsPresentDTW"]],
append = FALSE, append = FALSE,
...@@ -511,9 +513,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -511,9 +513,9 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
breaks.arg = loc.col.bounds, breaks.arg = loc.col.bounds,
title.arg = paste0( title.arg = paste0(
"Distance measure: ", "Distance measure: ",
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
"\nLinkage method: ", "\nLinkage method: ",
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)] input$selectPlotHierLinkage
)) ))
return(loc.p) return(loc.p)
...@@ -541,45 +543,45 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i ...@@ -541,45 +543,45 @@ clustHier <- function(input, output, session, in.data4clust, in.data4trajPlot, i
createFnameHeatMap = reactive({ createFnameHeatMap = reactive({
paste0('clust_hierch_heatMap_', paste0('clust_hierch_heatMap_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], input$selectPlotHierLinkage,
'.png') '.png')
}) })
createFnameTrajPlot = reactive({ createFnameTrajPlot = reactive({
paste0('clust_hierch_tCourses_', paste0('clust_hierch_tCourses_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], input$selectPlotHierLinkage,
'.pdf') '.pdf')
}) })
createFnameRibbonPlot = reactive({ createFnameRibbonPlot = reactive({
paste0('clust_hierch_tCoursesMeans_', paste0('clust_hierch_tCoursesMeans_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], input$selectPlotHierLinkage,
'.pdf') '.pdf')
}) })
createFnamePsdPlot = reactive({ createFnamePsdPlot = reactive({
paste0('clust_hierch_tCoursesPsd_', paste0('clust_hierch_tCoursesPsd_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], input$selectPlotHierLinkage,
'.pdf') '.pdf')
}) })
createFnameDistPlot = reactive({ createFnameDistPlot = reactive({
paste0('clust_hierch_clDist_', paste0('clust_hierch_clDist_',
s.cl.diss[as.numeric(input$selectPlotHierDiss)], input$selectPlotHierDiss,
'_', '_',
s.cl.linkage[as.numeric(input$selectPlotHierLinkage)], '.pdf') input$selectPlotHierLinkage, '.pdf')
}) })
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment