Skip to content

Commit 5bfa9fc

Browse files
PaulJonasJostPaulJonasJost
committed
ML works with download and report
1 parent 3902da1 commit 5bfa9fc

4 files changed

Lines changed: 397 additions & 20 deletions

File tree

‎program/shinyApp/R/code_generation/function_infos.R‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -357,4 +357,59 @@ volcano_plot_info <<- list(
357357
),
358358
to_util = FALSE,
359359
plot_name = "volcano_plt"
360+
)
361+
362+
# --- ML Classification ---
363+
run_kmeans_analysis_info <<- list(
364+
foo = run_kmeans_analysis,
365+
name = "run_kmeans_analysis",
366+
input_mapping = list(
367+
data_matrix = "as.matrix(assay(data))",
368+
k = "parameters$MLClassification$k_clusters",
369+
filter_genes = "parameters$MLClassification$filter_genes_unsupervised",
370+
n_genes = "parameters$MLClassification$n_genes_unsupervised"
371+
),
372+
output_name = "kmeans_result",
373+
to_util = TRUE
374+
)
375+
376+
render_kmeans_plot_info <<- list(
377+
foo = render_kmeans_plot,
378+
name = "render_kmeans_plot",
379+
input_mapping = list(
380+
kmeans_result = "kmeans_result$result",
381+
data_matrix = "kmeans_result$data_matrix",
382+
sample_annotation = "as.data.frame(colData(data))",
383+
condition_column = "parameters$MLClassification$condition_overlay"
384+
),
385+
to_util = FALSE,
386+
plot_name = "cluster_plot"
387+
)
388+
389+
run_svm_classification_info <<- list(
390+
foo = run_svm_classification,
391+
name = "run_svm_classification",
392+
input_mapping = list(
393+
data_matrix = "as.matrix(assay(data))",
394+
condition_vector = "as.data.frame(colData(data))[[parameters$MLClassification$condition_column_supervised]]",
395+
filter_genes = "parameters$MLClassification$filter_genes_supervised",
396+
n_genes = "parameters$MLClassification$n_genes_supervised",
397+
kernel = "parameters$MLClassification$svm_kernel %||% 'radial'"
398+
),
399+
output_name = "svm_result",
400+
to_util = TRUE
401+
)
402+
403+
render_svm_plot_info <<- list(
404+
foo = render_svm_plot,
405+
name = "render_svm_plot",
406+
input_mapping = list(
407+
svm_model = "svm_result$model",
408+
X = "svm_result$X",
409+
y = "svm_result$y",
410+
predictions = "svm_result$predictions",
411+
accuracy = "svm_result$accuracy"
412+
),
413+
to_util = FALSE,
414+
plot_name = "svm_plot"
360415
)

‎program/shinyApp/R/code_generation/plot_generators.R‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,4 +71,14 @@ UPSET_PLOT_PIPELINE <<- list(
7171
VOLCANO_PIPELINE <<- list(
7272
performSigAnalysis_info,
7373
volcano_plot_info
74+
)
75+
76+
# --- ML Classification ---
77+
KMEANS_CLUSTERING_PIPELINE <<- list(
78+
run_kmeans_analysis_info,
79+
render_kmeans_plot_info
80+
)
81+
SVM_CLASSIFICATION_PIPELINE <<- list(
82+
run_svm_classification_info,
83+
render_svm_plot_info
7484
)

‎program/shinyApp/R/ml_classification/server.R‎

Lines changed: 256 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -117,6 +117,14 @@ ml_classification_Server <- function(id, session_data, session_params, data_inpu
117117

118118
ml_code$current <- generated_code
119119

120+
# Store parameters for code generation
121+
session_params$MLClassification <- list(
122+
k_clusters = input$k_clusters,
123+
filter_genes_unsupervised = input$filter_genes_unsupervised,
124+
n_genes_unsupervised = input$n_genes_unsupervised,
125+
condition_overlay = input$condition_overlay
126+
)
127+
120128
showNotification("k-means clustering completed successfully!", type = "default")
121129

122130
}, error = function(e) {
@@ -157,12 +165,18 @@ ml_classification_Server <- function(id, session_data, session_params, data_inpu
157165
sample_annotation <- as.data.frame(colData(data$data))
158166
}
159167

160-
render_kmeans_plot(
168+
# Generate and store plot
169+
plot_obj <- render_kmeans_plot(
161170
kmeans_result = ml_results$kmeans,
162171
data_matrix = ml_results$data_matrix,
163172
sample_annotation = sample_annotation,
164173
condition_column = condition_col
165174
)
175+
176+
# Store for download/report handlers
177+
ml_results$cluster_plot <- plot_obj
178+
179+
plot_obj
166180
})
167181

168182
# Render cluster assignments table
@@ -307,6 +321,14 @@ ml_classification_Server <- function(id, session_data, session_params, data_inpu
307321
kernel = "radial"
308322
)
309323

324+
# Store parameters for code generation
325+
session_params$MLClassification <- list(
326+
condition_column_supervised = input$condition_column_supervised,
327+
filter_genes_supervised = input$filter_genes_supervised,
328+
n_genes_supervised = input$n_genes_supervised,
329+
svm_kernel = "radial"
330+
)
331+
310332
showNotification("SVM classification completed successfully!", type = "message")
311333

312334
}, error = function(e) {
@@ -333,13 +355,19 @@ ml_classification_Server <- function(id, session_data, session_params, data_inpu
333355
req(ml_results$predictions)
334356
req(ml_results$accuracy)
335357

336-
render_svm_plot(
358+
# Generate and store plot
359+
plot_obj <- render_svm_plot(
337360
svm_model = ml_results$svm,
338361
X = ml_results$svm_X,
339362
y = ml_results$svm_y,
340363
predictions = ml_results$predictions,
341364
accuracy = ml_results$accuracy
342365
)
366+
367+
# Store for download/report handlers
368+
ml_results$svm_plot <- plot_obj
369+
370+
plot_obj
343371
})
344372

345373
# Render predictions table
@@ -411,5 +439,231 @@ ml_classification_Server <- function(id, session_data, session_params, data_inpu
411439
write.csv(predictions_df, file, row.names = FALSE)
412440
}
413441
)
442+
443+
## Download and Reporting Handlers ----
444+
445+
# K-means clustering handlers
446+
observeEvent(input$only2Report_cluster, {
447+
req(ml_results$cluster_plot)
448+
notificationID <- showNotification("Saving to Report...", duration = 0)
449+
450+
tmp_filename <- paste0(
451+
getwd(), "/", session_params$file_path,
452+
"KMeans_Clustering_", Sys.time(), input$file_ext_cluster
453+
)
454+
455+
ggsave(
456+
tmp_filename,
457+
plot = ml_results$cluster_plot,
458+
width = 16,
459+
height = 9,
460+
units = "in",
461+
device = gsub("\\.","", input$file_ext_cluster)
462+
)
463+
464+
# Log to report with proper section structure
465+
fun_LogIt(session, message = "## ML Classification - k-means Clustering {.tabset .tabset-fade}")
466+
fun_LogIt(session, message = "### Info")
467+
fun_LogIt(session, message = paste0(
468+
"**k-means Clustering** - Number of clusters: k=", input$k_clusters
469+
))
470+
if (input$filter_genes_unsupervised) {
471+
fun_LogIt(session, message = paste0(
472+
"**k-means** - Filtered to top ", input$n_genes_unsupervised, " variable genes"
473+
))
474+
}
475+
if (!is.null(input$condition_overlay) && input$condition_overlay != "none") {
476+
fun_LogIt(session, message = paste0(
477+
"**k-means** - Overlay condition: ", input$condition_overlay
478+
))
479+
}
480+
fun_LogIt(session, message = paste0("![k-means Clustering](", tmp_filename, ")"))
481+
482+
removeNotification(notificationID)
483+
showNotification("Saved!", type = "message", duration = 1)
484+
})
485+
486+
output$SavePlot_cluster <- downloadHandler(
487+
filename = function() {
488+
paste0("KMeans_Clustering_k", input$k_clusters, "_",
489+
format(Sys.time(), "(%d.%m.%Y)_(%H;%M;%S)"),
490+
input$file_ext_cluster)
491+
},
492+
content = function(file) {
493+
req(ml_results$cluster_plot)
494+
ggsave(
495+
file,
496+
plot = ml_results$cluster_plot,
497+
width = 16,
498+
height = 9,
499+
units = "in",
500+
dpi = "print",
501+
device = gsub("\\.","", input$file_ext_cluster)
502+
)
503+
on.exit({shinyjs::click(ns("only2Report_cluster"))})
504+
}
505+
)
506+
507+
output$getR_Code_cluster <- downloadHandler(
508+
filename = function() {
509+
paste0("cOmicsArt_Rcode2Reproduce_", Sys.Date(), ".zip")
510+
},
511+
content = function(file) {
512+
waiter <- Waiter$new(
513+
html = LOADING_SCREEN,
514+
color = "#3897F147",
515+
hide_on_render = FALSE
516+
)
517+
waiter$show()
518+
519+
temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
520+
dir.create(temp_directory)
521+
522+
# Save data
523+
save_summarized_experiment(
524+
session_data$data_original,
525+
temp_directory
526+
)
527+
528+
# Generate R script
529+
write(
530+
create_workflow_script(
531+
pipeline_info = KMEANS_CLUSTERING_PIPELINE,
532+
par = reactiveValuesToList(session_params),
533+
par_mem = "MLClassification",
534+
path_to_util = file.path(temp_directory, "util.R")
535+
),
536+
file.path(temp_directory, "Code.R")
537+
)
538+
539+
# Save environment data
540+
envList <- list(
541+
par_tmp = reactiveValuesToList(session_params)
542+
)
543+
saveRDS(envList, file.path(temp_directory, "Data.rds"))
544+
545+
# Zip everything
546+
zip::zip(
547+
zipfile = file,
548+
files = dir(temp_directory),
549+
root = temp_directory
550+
)
551+
waiter$hide()
552+
},
553+
contentType = "application/zip"
554+
)
555+
556+
# SVM classification handlers
557+
observeEvent(input$only2Report_svm, {
558+
req(ml_results$svm_plot)
559+
notificationID <- showNotification("Saving to Report...", duration = 0)
560+
561+
tmp_filename <- paste0(
562+
getwd(), "/", session_params$file_path,
563+
"SVM_Classification_", Sys.time(), input$file_ext_svm
564+
)
565+
566+
ggsave(
567+
tmp_filename,
568+
plot = ml_results$svm_plot,
569+
width = 16,
570+
height = 9,
571+
units = "in",
572+
device = gsub("\\.","", input$file_ext_svm)
573+
)
574+
575+
# Log to report with proper section structure
576+
fun_LogIt(session, message = "## ML Classification - SVM {.tabset .tabset-fade}")
577+
fun_LogIt(session, message = "### Info")
578+
fun_LogIt(session, message = paste0(
579+
"**SVM Classification** - Predicting: ", input$condition_column_supervised
580+
))
581+
fun_LogIt(session, message = paste0(
582+
"**SVM** - Training accuracy: ", round(ml_results$accuracy * 100, 1), "%"
583+
))
584+
fun_LogIt(session, message = paste0(
585+
"**SVM** - Note: This is training accuracy only (no validation). ",
586+
"Results are exploratory."
587+
))
588+
if (input$filter_genes_supervised) {
589+
fun_LogIt(session, message = paste0(
590+
"**SVM** - Filtered to top ", input$n_genes_supervised, " variable genes"
591+
))
592+
}
593+
fun_LogIt(session, message = paste0("![SVM Classification](", tmp_filename, ")"))
594+
595+
removeNotification(notificationID)
596+
showNotification("Saved!", type = "message", duration = 1)
597+
})
598+
599+
output$SavePlot_svm <- downloadHandler(
600+
filename = function() {
601+
paste0("SVM_Classification_", input$condition_column_supervised, "_",
602+
format(Sys.time(), "(%d.%m.%Y)_(%H;%M;%S)"),
603+
input$file_ext_svm)
604+
},
605+
content = function(file) {
606+
req(ml_results$svm_plot)
607+
ggsave(
608+
file,
609+
plot = ml_results$svm_plot,
610+
width = 16,
611+
height = 9,
612+
units = "in",
613+
dpi = "print",
614+
device = gsub("\\.","", input$file_ext_svm)
615+
)
616+
on.exit({shinyjs::click(ns("only2Report_svm"))})
617+
}
618+
)
619+
620+
output$getR_Code_svm <- downloadHandler(
621+
filename = function() {
622+
paste0("cOmicsArt_Rcode2Reproduce_", Sys.Date(), ".zip")
623+
},
624+
content = function(file) {
625+
waiter <- Waiter$new(
626+
html = LOADING_SCREEN,
627+
color = "#3897F147",
628+
hide_on_render = FALSE
629+
)
630+
waiter$show()
631+
632+
temp_directory <- file.path(tempdir(), as.integer(Sys.time()))
633+
dir.create(temp_directory)
634+
635+
# Save data
636+
save_summarized_experiment(
637+
session_data$data_original,
638+
temp_directory
639+
)
640+
641+
# Generate R script
642+
write(
643+
create_workflow_script(
644+
pipeline_info = SVM_CLASSIFICATION_PIPELINE,
645+
par = reactiveValuesToList(session_params),
646+
par_mem = "MLClassification",
647+
path_to_util = file.path(temp_directory, "util.R")
648+
),
649+
file.path(temp_directory, "Code.R")
650+
)
651+
652+
# Save environment data
653+
envList <- list(
654+
par_tmp = reactiveValuesToList(session_params)
655+
)
656+
saveRDS(envList, file.path(temp_directory, "Data.rds"))
657+
658+
# Zip everything
659+
zip::zip(
660+
zipfile = file,
661+
files = dir(temp_directory),
662+
root = temp_directory
663+
)
664+
waiter$hide()
665+
},
666+
contentType = "application/zip"
667+
)
414668
})
415669
}

0 commit comments

Comments
 (0)