Commit 445892c5 authored by dmattek's avatar dmattek
Browse files

Dist and link methods directly from UI

parent 1b5446c8
...@@ -17,7 +17,7 @@ helpText.clHierSpar = c(alImportance = paste0("<p>Weight factors (WF) calculated ...@@ -17,7 +17,7 @@ helpText.clHierSpar = c(alImportance = paste0("<p>Weight factors (WF) calculated
"Journal of the American Statistical Association 105(490): 713-726.</p>")) "Journal of the American Statistical Association 105(490): 713-726.</p>"))
# UI ---- # UI ----
clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") { clustHierSparUI <- function(id, label = "Sparse Hierarchical Clustering") {
ns <- NS(id) ns <- NS(id)
tagList( tagList(
...@@ -30,32 +30,32 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") { ...@@ -30,32 +30,32 @@ clustHierSparUI <- function(id, label = "Sparse Hierarchical CLustering") {
br(), br(),
fluidRow( fluidRow(
column( column(
4, 3,
selectInput( selectInput(
ns("selectPlotHierSparDiss"), ns("selectPlotHierSparDiss"),
label = ("Select type of dissimilarity measure:"), label = ("Dissimilarity measure"),
choices = list("Euclidean" = 1, choices = list("Euclidean" = "squared.distance",
"Manhattan" = 2), "Manhattan" = "absolute.value"),
selected = 1 selected = 1
), ),
selectInput( selectInput(
ns("selectPlotHierSparLinkage"), ns("selectPlotHierSparLinkage"),
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"
), ),
selected = 2 selected = 1
) )
), ),
column( column(
4, 6,
sliderInput( sliderInput(
ns('inPlotHierSparNclust'), ns('inPlotHierSparNclust'),
'#dendrogram branches to colour', 'Number of dendrogram branches to cut',
min = 1, min = 1,
max = 20, max = 20,
value = 1, value = 1,
...@@ -294,15 +294,15 @@ clustHierSpar <- function(input, output, session, ...@@ -294,15 +294,15 @@ clustHierSpar <- function(input, output, session,
dm.t, dm.t,
wbounds = NULL, wbounds = NULL,
nperms = ifelse(input$inHierSparAdv, input$inPlotHierSparNperms, 1), nperms = ifelse(input$inHierSparAdv, input$inPlotHierSparNperms, 1),
dissimilarity = s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)] dissimilarity = input$selectPlotHierSparDiss
) )
sparsehc <- HierarchicalSparseCluster( sparsehc <- HierarchicalSparseCluster(
dists = perm.out$dists, dists = perm.out$dists,
wbound = perm.out$bestw, wbound = perm.out$bestw,
niter = ifelse(input$inHierSparAdv, input$inPlotHierSparNiter, 1), niter = ifelse(input$inHierSparAdv, input$inPlotHierSparNiter, 1),
method = s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], method = input$selectPlotHierSparLinkage,
dissimilarity = s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)] dissimilarity = input$selectPlotHierSparDiss
) )
#cat('=============\nsparsehc:\n') #cat('=============\nsparsehc:\n')
...@@ -433,9 +433,9 @@ clustHierSpar <- function(input, output, session, ...@@ -433,9 +433,9 @@ clustHierSpar <- function(input, output, session,
output$downCellClSpar <- downloadHandler( output$downCellClSpar <- downloadHandler(
filename = function() { filename = function() {
paste0('clust_hierchSpar_data_', paste0('clust_hierchSpar_data_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.csv') input$selectPlotHierSparLinkage, '.csv')
}, },
content = function(file) { content = function(file) {
...@@ -530,9 +530,9 @@ clustHierSpar <- function(input, output, session, ...@@ -530,9 +530,9 @@ clustHierSpar <- function(input, output, session,
breaks.arg = loc.col.bounds, breaks.arg = loc.col.bounds,
title.arg = paste( title.arg = paste(
"Distance measure: ", "Distance measure: ",
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
"\nLinkage method: ", "\nLinkage method: ",
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)] input$selectPlotHierSparLinkage
)) ))
return(loc.p) return(loc.p)
...@@ -545,45 +545,45 @@ clustHierSpar <- function(input, output, session, ...@@ -545,45 +545,45 @@ clustHierSpar <- function(input, output, session,
createFnameHeatMap = reactive({ createFnameHeatMap = reactive({
paste0('clust_hierchSparse_heatMap_', paste0('clust_hierchSparse_heatMap_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], input$selectPlotHierSparLinkage,
'.png') '.png')
}) })
createFnameTrajPlot = reactive({ createFnameTrajPlot = reactive({
paste0('clust_hierchSparse_tCourses_', paste0('clust_hierchSparse_tCourses_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], input$selectPlotHierSparLinkage,
'.pdf') '.pdf')
}) })
createFnameRibbonPlot = reactive({ createFnameRibbonPlot = reactive({
paste0('clust_hierchSparse_tCoursesMeans_', paste0('clust_hierchSparse_tCoursesMeans_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], input$selectPlotHierSparLinkage,
'.pdf') '.pdf')
}) })
createFnamePsdPlot = reactive({ createFnamePsdPlot = reactive({
paste0('clust_hierchSparse_tCoursesPsd_', paste0('clust_hierchSparse_tCoursesPsd_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], input$selectPlotHierSparLinkage,
'.pdf') '.pdf')
}) })
createFnameDistPlot = reactive({ createFnameDistPlot = reactive({
paste0('clust_hierchSparse_clDist_', paste0('clust_hierchSparse_clDist_',
s.cl.spar.diss[as.numeric(input$selectPlotHierSparDiss)], input$selectPlotHierSparDiss,
'_', '_',
s.cl.spar.linkage[as.numeric(input$selectPlotHierSparLinkage)], '.pdf') }) input$selectPlotHierSparLinkage, '.pdf') })
...@@ -634,6 +634,8 @@ clustHierSpar <- function(input, output, session, ...@@ -634,6 +634,8 @@ clustHierSpar <- function(input, output, session,
plotHierSpar() plotHierSpar()
}, height = getPlotHierSparHeatMapHeight) }, height = getPlotHierSparHeatMapHeight)
# Pop-overs ----
addPopover(session, addPopover(session,
ns("alImportance"), ns("alImportance"),
title = "Variable importance", title = "Variable importance",
......
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