diff --git a/MetaProViz_Results/Heatmap/Heatmap__Heatmap__2025-03-26.svg b/MetaProViz_Results/Heatmap/Heatmap__Heatmap__2025-03-26.svg new file mode 100644 index 00000000..fdaae8d3 --- /dev/null +++ b/MetaProViz_Results/Heatmap/Heatmap__Heatmap__2025-03-26.svg @@ -0,0 +1,9040 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +MS55_04 +MS55_01 +MS55_02 +MS55_03 +MS55_18 +MS55_20 +MS55_17 +MS55_19 +MS55_35 +MS55_36 +MS55_33 +MS55_34 +MS55_29 +MS55_30 +MS55_08 +MS55_05 +MS55_06 +MS55_07 +MS55_39 +MS55_40 +MS55_37 +MS55_38 +MS55_21 +MS55_22 +MS55_23 +MS55_24 +MS55_47 +MS55_48 +MS55_45 +MS55_46 +MS55_31 +MS55_32 +MS55_27 +MS55_26 +MS55_25 +MS55_28 +MS55_15 +MS55_11 +MS55_12 +MS55_13 +MS55_14 +MS55_16 +MS55_09 +MS55_10 +MS55_41 +MS55_44 +MS55_42 +MS55_43 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-4 +-2 +0 +2 +4 + + + + + + diff --git a/NAMESPACE b/NAMESPACE index 3b5d65a4..5a7684e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,8 +32,10 @@ export(metaproviz_config_path) export(metaproviz_load_config) export(metaproviz_reset_config) export(metaproviz_save_config) +import(ggfortify) importFrom(KEGGREST,keggGet) importFrom(KEGGREST,keggList) +importFrom(MatrixGenerics,rowMins) importFrom(OmnipathR,ambiguity) importFrom(OmnipathR,config_path) importFrom(OmnipathR,id_types) @@ -45,6 +47,7 @@ importFrom(OmnipathR,reset_config) importFrom(OmnipathR,save_config) importFrom(OmnipathR,set_loglevel) importFrom(OmnipathR,translate_ids) +importFrom(S4Vectors,DataFrame) importFrom(broom,tidy) importFrom(dplyr,across) importFrom(dplyr,arrange) @@ -101,6 +104,7 @@ importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,stat_summary) +importFrom(ggplot2,sym) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggplot2,theme_classic) @@ -157,6 +161,7 @@ importFrom(stats,bartlett.test) importFrom(stats,kruskal.test) importFrom(stats,lm) importFrom(stats,p.adjust) +importFrom(stats,p.adjust.methods) importFrom(stats,shapiro.test) importFrom(stringr,str_match) importFrom(stringr,str_remove) @@ -169,6 +174,7 @@ importFrom(tibble,rownames_to_column) importFrom(tidyr,pivot_longer) importFrom(tidyr,replace_na) importFrom(tidyr,separate) +importFrom(tidyr,separate_longer_delim) importFrom(tidyr,separate_rows) importFrom(tidyr,unite) importFrom(tidyselect,all_of) diff --git a/R/DifferentialMetaboliteAnalysis.R b/R/DifferentialMetaboliteAnalysis.R index eb014906..0e46c029 100644 --- a/R/DifferentialMetaboliteAnalysis.R +++ b/R/DifferentialMetaboliteAnalysis.R @@ -45,365 +45,365 @@ #' @return Dependent on parameter settings, list of lists will be returned for DMA (DF of each comparison), Shapiro (Includes DF and Plot), Bartlett (Includes DF and Histogram), VST (Includes DF and Plot) and VolcanoPlot (Plots of each comparison). #' #' @examples -#' Intra <- MetaProViz::ToyData("IntraCells_Raw")[-c(49:58) ,] -#' ResI <- MetaProViz::DMA(InputData=Intra[ ,-c(1:3)], -#' SettingsFile_Sample=Intra[ , c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2")) +#' ## load data +#' Intra <- MetaProViz::ToyData("IntraCells_Raw") +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58) , c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' ResI <- MetaProViz::DMA(se, +#' SettingsInfo = c(Conditions = "Conditions", +#' Numerator = NULL, Denominator = "HK2")) #' #' @keywords Differential Metabolite Analysis, Multiple Hypothesis testing, Normality testing #' #' @importFrom dplyr rename #' @importFrom magrittr %>% +#' @importFrom stats p.adjust.methods #' @importFrom tibble rownames_to_column column_to_rownames #' @importFrom purrr map reduce #' @importFrom logger log_info #' #' @export #' -DMA <-function(InputData, - SettingsFile_Sample, - SettingsInfo = c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - StatPval ="lmFit", - StatPadj="fdr", - SettingsFile_Metab = NULL, - CoRe=FALSE, - VST = FALSE, - PerformShapiro =TRUE, - PerformBartlett =TRUE, - Transform=TRUE, - SaveAs_Plot = "svg", - SaveAs_Table = "csv", - PrintPlot = TRUE, - FolderPath = NULL -){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - logger::log_info("DMA: Differential metabolite analysis.") - - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=SettingsFile_Metab, - SettingsInfo=SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=SaveAs_Table, - CoRe=CoRe, - PrintPlot= PrintPlot) - - # HelperFunction `CheckInput` Specific - Settings <- CheckInput_DMA(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - StatPval=StatPval, - StatPadj=StatPadj, - PerformShapiro=PerformShapiro, - PerformBartlett=PerformBartlett, - VST=VST, - Transform=Transform) - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Plot)==FALSE |is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "DMA", - FolderPath=FolderPath) - - if(PerformShapiro==TRUE){ - SubFolder_S <- file.path(Folder, "Shapiro") - if (!dir.exists(SubFolder_S)) {dir.create(SubFolder_S)} - } - - if(PerformBartlett==TRUE){ - SubFolder_B <- file.path(Folder, "Bartlett") - if (!dir.exists(SubFolder_B)) {dir.create(SubFolder_B)} - } +DMA <-function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + StatPval = c("lmFit", "aov", "krustal.test", "welch"), + StatPadj = p.adjust.methods, + ##SettingsFile_Metab = NULL, + CoRe = FALSE, + VST = FALSE, + PerformShapiro = TRUE, + PerformBartlett = TRUE, + Transform = TRUE, + SaveAs_Plot = "svg", + SaveAs_Table = "csv", + PrintPlot = TRUE, + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + logger::log_info("DMA: Differential metabolite analysis.") + + ## ------------ Check Input files ----------- ## + StatPval <- match.arg(StatPval) + StatPadj <- match.arg(StatPadj) + + ## HelperFunction `CheckInput` + CheckInput(se = se, SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, SaveAs_Table = SaveAs_Table, CoRe = CoRe, + PrintPlot = PrintPlot) + + # HelperFunction `CheckInput` Specific + Settings <- CheckInput_DMA(se, ##InputData = InputData, + ##SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo, + StatPval = StatPval, StatPadj = StatPadj, + PerformShapiro = PerformShapiro, PerformBartlett = PerformBartlett, + VST = VST, Transform = Transform) + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Plot) | !is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "DMA", FolderPath = FolderPath) + + if (PerformShapiro) { + SubFolder_S <- file.path(Folder, "Shapiro") + if (!dir.exists(SubFolder_S)) + dir.create(SubFolder_S) + } - if(VST==TRUE){ - SubFolder_V <- file.path(Folder, "VST") - if (!dir.exists(SubFolder_V)) {dir.create(SubFolder_V)} - } - } - - ############################################################################################################################################################################################################### - ## ------------ Check hypothesis test assumptions ----------- ## - # 1. Normality - if(PerformShapiro==TRUE){ - if(length(Settings[["Metabolites_Miss"]]>=1)){ - message("There are NA's/0s in the data. This can impact the output of the SHapiro-Wilk test for all metabolites that include NAs/0s.")# - } - tryCatch( - { - Shapiro_output <-suppressWarnings(Shapiro(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - StatPval=StatPval, - QQplots=FALSE)) - }, - error = function(e) { - message("Error occurred during Shapiro that performs the Shapiro-Wilk test. Message: ", conditionMessage(e)) - } - ) - } - - # 2. Variance homogeneity - if(PerformBartlett==TRUE){ - if(Settings[["MultipleComparison"]]==TRUE){#if we only have two conditions, which can happen even tough multiple comparison (C1 versus C2 and C2 versus C1 is done) - UniqueConditions <- SettingsFile_Sample%>% - subset(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% Settings[["numerator"]] | SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% Settings[["denominator"]], select = c(SettingsInfo[["Conditions"]])) - UniqueConditions <- unique(UniqueConditions[[SettingsInfo[["Conditions"]]]]) - - if(length(UniqueConditions)>2){ - tryCatch( - { - Bartlett_output<-suppressWarnings(Bartlett(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo)) - }, - error = function(e) { - message("Error occurred during Bartlett that performs the Bartlett test. Message: ", conditionMessage(e)) + if (PerformBartlett) { + SubFolder_B <- file.path(Folder, "Bartlett") + if (!dir.exists(SubFolder_B)) + dir.create(SubFolder_B) } - ) - } - } - } - - ############################################################################################################################################################################################################### - #### Prepare the data ###### - #1. Metabolite names: - savedMetaboliteNames <- data.frame("InputName"=colnames(InputData)) - savedMetaboliteNames$Metabolite <- paste0("M", seq(1,length(colnames(InputData)))) - colnames(InputData) <- savedMetaboliteNames$Metabolite - - ################################################################################################################################################################################################ - ############### Calculate Log2FC, pval, padj, tval and add additional info ############### - Log2FC_table <- Log2FC_fun(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - CoRe=CoRe, - Transform=Transform) - - ################################################################################################################################################################################################ - ############### Perform Hypothesis testing ############### - if(Settings[["MultipleComparison"]] == FALSE){ - if(StatPval=="lmFit"){ - STAT_C1vC2 <- DMA_Stat_limma(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - StatPadj=StatPadj, - Log2FC_table=Log2FC_table, - CoRe=CoRe, - Transform=Transform) - - }else{ - STAT_C1vC2 <-DMA_Stat_single(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - Log2FC_table=Log2FC_table, - StatPval=StatPval, - StatPadj=StatPadj) - } - }else{ # MultipleComparison = TRUE - #Correct data heteroscedasticity - if(StatPval!="lmFit" & VST == TRUE){ - VST_res <- vst(InputData) - InputData <- VST_res[["DFs"]][["Corrected_data"]] - } - if(Settings[["all_vs_all"]] ==TRUE){ - message("No conditions were specified as numerator or denumerator. Performing multiple testing `all-vs-all` using ", paste(StatPval), ".") - }else{# for 1 vs all - message("No condition was specified as numerator and ", Settings[["denominator"]], " was selected as a denominator. Performing multiple testing `all-vs-one` using ", paste(StatPval), ".") + if (VST) { + SubFolder_V <- file.path(Folder, "VST") + if (!dir.exists(SubFolder_V)) + dir.create(SubFolder_V) + } } - if(StatPval=="aov"){ - STAT_C1vC2 <- AOV(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - Log2FC_table=Log2FC_table) - }else if(StatPval=="kruskal.test"){ - STAT_C1vC2 <-Kruskal(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - Log2FC_table=Log2FC_table, - StatPadj=StatPadj) - }else if(StatPval=="welch"){ - STAT_C1vC2 <-Welch(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - Log2FC_table=Log2FC_table) - }else if(StatPval=="lmFit"){ - STAT_C1vC2 <- DMA_Stat_limma(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - StatPadj=StatPadj, - Log2FC_table=Log2FC_table, - CoRe=CoRe, - Transform=Transform) + ############################################################################ + ## ------------ Check hypothesis test assumptions ----------- ## + ## 1. Normality + if (PerformShapiro) { + + if (length(Settings[["Metabolites_Miss"]] >= 1)) { + message("There are NA's/0s in the data. This can impact the output of the Shapiro-Wilk test for all metabolites that include NAs/0s.")# + } + + tryCatch({ + Shapiro_output <- suppressWarnings( + Shapiro(se = se, SettingsInfo = SettingsInfo, + StatPval = StatPval, QQplots = FALSE)) + }, error = function(e) { + message( + "Error occurred during Shapiro that performs the Shapiro-Wilk test. Message: ", + conditionMessage(e)) + }) } - } - - ################################################################################################################################################################################################ - ############### Add the previous metabolite names back ############### - DMA_Output <- lapply(STAT_C1vC2, function(df){ - merged_df <- merge(savedMetaboliteNames, df, by = "Metabolite", all.y = TRUE) - merged_df <-merged_df[,-1]%>%#remove the names we used as part of the function and add back the input names. - dplyr::rename("Metabolite"=1) - return(merged_df) - }) - - ################################################################################################################################################################################################ - ############### Add the metabolite Metadata if available ############### - if(is.null(SettingsFile_Metab) == FALSE){ - DMA_Output <- lapply(DMA_Output, function(df){ - merged_df <- merge(df,SettingsFile_Metab%>%tibble::rownames_to_column("Metabolite") , by = "Metabolite", all.x = TRUE) - return(merged_df) - }) + # 2. Variance homogeneity + if (PerformBartlett) { + if (Settings[["MultipleComparison"]]) { ##if we only have two conditions, which can happen even tough multiple comparison (C1 versus C2 and C2 versus C1 is done) + + UniqueConditions <- SettingsFile_Sample %>% + subset( + SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% Settings[["numerator"]] | + SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% Settings[["denominator"]], + select = c(SettingsInfo[["Conditions"]])) + UniqueConditions <- unique( + UniqueConditions[[SettingsInfo[["Conditions"]]]]) + + if (length(UniqueConditions) > 2) { + + tryCatch({ + Bartlett_output <- suppressWarnings( + Bartlett(se = se, SettingsInfo = SettingsInfo)) + }, + error = function(e) { + message( + "Error occurred during Bartlett that performs the Bartlett test. Message: ", + conditionMessage(e)) + }) + } + } } - ################################################################################################################################################################################################ - ############### For CoRe=TRUE create summary of Feature_metadata ############### - if(CoRe==TRUE){ - df_list_selected <- purrr::map(names(DMA_Output), function(df_name) { - df <- DMA_Output[[df_name]] # Extract the dataframe - - # Extract the dynamic column name - core_col <- grep("^CoRe_", names(df), value = TRUE) # Find the column that starts with "CoRe_" - # Filter only columns where the part after "CoRe_" is in valid_conditions - core_col <- core_col[str_remove(core_col, "^CoRe_") %in% unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]])] + ############################################################################ + #### Prepare the data ###### + ## 1. Metabolite names: + savedMetaboliteNames <- data.frame("InputName" = rownames(se)) + savedMetaboliteNames$Metabolite <- paste0("M", + seq(1, nrow(se))) + rownames(se) <- savedMetaboliteNames$Metabolite + + ############################################################################ + ######## Calculate Log2FC, pval, padj, tval and add additional info ######## + Log2FC_table <- Log2FC_fun(se, SettingsInfo = SettingsInfo, + CoRe = CoRe, Transform = Transform) + + ############################################################################ + ############### Perform Hypothesis testing ############### + if (!Settings[["MultipleComparison"]]) { + + if (StatPval == "lmFit") { + STAT_C1vC2 <- DMA_Stat_limma(se, + SettingsInfo = SettingsInfo, StatPadj = StatPadj, + Log2FC_table = Log2FC_table, CoRe = CoRe, Transform = Transform) + + } else { + STAT_C1vC2 <- DMA_Stat_single(se, + SettingsInfo = SettingsInfo, StatPadj = StatPadj, + Log2FC_table = Log2FC_table, StatPval = StatPval) + } + } else { ## MultipleComparison = TRUE + + ## Correct data heteroscedasticity + if (StatPval != "lmFit" & VST) { + VST_res <- vst(se) + se <- VST_res[["data"]][["se"]] + } + if (Settings[["all_vs_all"]]) { + message("No conditions were specified as numerator or denumerator. Performing multiple testing `all-vs-all` using ", + paste(StatPval), ".") + } else { ## for 1 vs all + message("No condition was specified as numerator and ", + Settings[["denominator"]], + " was selected as a denominator. Performing multiple testing `all-vs-one` using ", + paste(StatPval), ".") + } - # Select only the relevant columns - df_selected <- df %>% - select(Metabolite, all_of(core_col)) + if (StatPval == "aov") { + STAT_C1vC2 <- AOV(se, + SettingsInfo = SettingsInfo, Log2FC_table = Log2FC_table) + } else if (StatPval == "kruskal.test") { + STAT_C1vC2 <- Kruskal(se, + SettingsInfo = SettingsInfo, Log2FC_table = Log2FC_table, + StatPadj = StatPadj) + } else if (StatPval == "welch") { + STAT_C1vC2 <- Welch(se, + SettingsInfo = SettingsInfo, Log2FC_table = Log2FC_table) + } else if (StatPval == "lmFit") { + STAT_C1vC2 <- DMA_Stat_limma(se, + SettingsInfo = SettingsInfo, Log2FC_table = Log2FC_table, + StatPadj = StatPadj, CoRe = CoRe, Transform = Transform) + } + } - return(df_selected) - }) + ############################################################################ + ############### Add the previous metabolite names back ############### + DMA_Output <- lapply(STAT_C1vC2, function(df) { + merged_df <- merge(savedMetaboliteNames, df, by = "Metabolite", all.y = TRUE) + #merged_df[, -1] %>% + ## remove the names we used as part of the function and add back the input names. + # dplyr::rename("Metabolite" = 1) + }) - # Merge all dataframes by "Metabolite" - merged_df <- purrr::reduce(df_list_selected, full_join, by = "Metabolite") - names(merged_df) <- gsub("\\.x$", "", names(merged_df))#It is likely we have duplications that cause .x, .y, .x.x, .y.y, etc. to be added to the column names. We only keep one column (.x) - Feature_Metadata <- merged_df %>% - select(-all_of(grep("\\.[xy]+$", names(merged_df), value = TRUE)))#Now we remove all other columns with .x.x, .y.y, etc. + ############################################################################ + ################ Add the metabolite Metadata if available ################# + if (!is.null(rowData(se))) { + DMA_Output <- lapply(DMA_Output, function(df){ + merge(df, + tibble::rownames_to_column(as.data.frame(rowData(se)), "Metabolite"), + by = "Metabolite", all.x = TRUE) + }) + } - if(is.null(SettingsFile_Metab) == FALSE){ #Add to Metadata file: - Feature_Metadata <- merge(SettingsFile_Metab%>%tibble::rownames_to_column("Metabolite"), Feature_Metadata , by = "Metabolite", all.x = TRUE) - } - } + ############################################################################ + ############# For CoRe=TRUE create summary of Feature_metadata ############ + if (CoRe) { + df_list_selected <- purrr::map(names(DMA_Output), function(df_name) { + df <- DMA_Output[[df_name]] ## Extract the dataframe + + ## Extract the dynamic column name + ## Find the column that starts with "CoRe_" + core_col <- grep("^CoRe_", names(df), value = TRUE) + + ## Filter only columns where the part after "CoRe_" is in valid_conditions + core_col <- core_col[str_remove(core_col, "^CoRe_") %in% + unique(colData(se)[[SettingsInfo[["Conditions"]]]])] + + ## Select only the relevant columns and return + df %>% + select(Metabolite, all_of(core_col)) + }) + + ## Merge all dataframes by "Metabolite" + merged_df <- purrr::reduce(df_list_selected, full_join, + by = "Metabolite") + + ## It is likely we have duplications that cause .x, .y, .x.x, .y.y, etc. + ## to be added to the column names. We only keep one column (.x) + names(merged_df) <- gsub("\\.x$", "", names(merged_df)) + + ## Now we remove all other columns with .x.x, .y.y, etc. + Feature_Metadata <- merged_df %>% + select(-all_of(grep("\\.[xy]+$", names(merged_df), value = TRUE))) + + ## Add to Metadata file: + if (!is.null(rowData(se))){ + Feature_Metadata <- merge( + tibble::rownames_to_column(rowData(se), "Metabolite"), + Feature_Metadata , by = "Metabolite", all.x = TRUE) + } + } + ############################################################################ + ############### Plots ############### + if (CoRe) { + x <- "Log2(Distance)" + VolPlot_SettingsInfo <- c(color = "CoRe") + VolPlot_SettingsFile <- DMA_Output + } else { + x <- "Log2FC" + VolPlot_SettingsInfo <- NULL + VolPlot_SettingsFile <- NULL + } - ################################################################################################################################################################################################ - ############### Plots ############### - if(CoRe==TRUE){ - x <- "Log2(Distance)" - VolPlot_SettingsInfo= c(color="CoRe") - VolPlot_SettingsFile = DMA_Output - }else{ - x <- "Log2FC" - VolPlot_SettingsInfo= NULL - VolPlot_SettingsFile = NULL - } + volplotList = list() + se_l <- list() + for (DF in names(DMA_Output)) { # DF = names(DMA_Output)[2] + Volplotdata <- DMA_Output[[DF]] |> + column_to_rownames("Metabolite") + + cD <- data.frame(name = colnames(Volplotdata |> select(-feature))) + rownames(cD) <- cD$name + se_volcano <- SummarizedExperiment( + assays = column_to_rownames(DMA_Output[[DF]], "Metabolite") |> select(-feature), + colData = cD, + rowData = column_to_rownames(DMA_Output[[DF]], "Metabolite")) + + se_l[[DF]] <- se_volcano + #if (CoRe) { ## EDIT: needed + # VolPlot_SettingsFile <- DMA_Output[[DF]] %>% + # tibble::column_to_rownames("Metabolite") + #} + + dev.new() + VolcanoPlot <- invisible(VizVolcano(PlotSettings = "Standard", ### continue from here + se = se_volcano, ##InputData = tibble::column_to_rownames(Volplotdata, "Metabolite"), + SettingsInfo = VolPlot_SettingsInfo, + ##SettingsFile_Metab = VolPlot_SettingsFile, + y = "p.adj", x = x, PlotName = DF, + Subtitle = bquote(italic("Differential Metabolite Analysis")), + SaveAs_Plot = NULL)) + + ## Remove special characters and replace spaces with underscores + DF_save <- gsub("[^A-Za-z0-9._-]", "_", DF) + volplotList[[DF_save]]<- VolcanoPlot[["Plot_Sized"]][[1]] + + dev.off() + } + + ## assign names to se_l + names(se_l) <- names(DMA_Output) + + ############################################################################ + ##----- Save and Return + ## make a list in which we will save the outputs + DMA_Output_List <- list() + + if (PerformShapiro & exists("Shapiro_output")) { + suppressMessages(suppressWarnings( + SaveRes(data = Shapiro_output[["DF"]], + plot = Shapiro_output[["Plot"]][["Distributions"]], + SaveAs_Table = SaveAs_Table, SaveAs_Plot = SaveAs_Plot, + FolderPath = SubFolder_S, FileName = "ShapiroTest", + CoRe = CoRe, PrintPlot = PrintPlot))) + DMA_Output_List <- list("ShapiroTest" = Shapiro_output) + } - volplotList = list() - for(DF in names(DMA_Output)){ # DF = names(DMA_Output)[2] - Volplotdata<- DMA_Output[[DF]] + if (PerformBartlett & exists("Bartlett_output")) { + suppressMessages(suppressWarnings( + SaveRes(data = Bartlett_output[["DF"]], + plot = Bartlett_output[["Plot"]], + SaveAs_Table = SaveAs_Table, SaveAs_Plot = SaveAs_Plot, + FolderPath = SubFolder_B, FileName = "BartlettTest", + CoRe = CoRe, PrintPlot = PrintPlot))) + DMA_Output_List <- c(DMA_Output_List, + list("BartlettTest" = Bartlett_output)) + } - if(CoRe==TRUE){ - VolPlot_SettingsFile <- DMA_Output[[DF]]%>%tibble::column_to_rownames("Metabolite") + if (VST & exists("VST_res")) { + suppressMessages(suppressWarnings( + SaveRes(data = VST_res[["DF"]], + plot = VST_res[["Plot"]], SaveAs_Table = SaveAs_Table, + SaveAs_Plot = SaveAs_Plot, FolderPath = SubFolder_V, + FileName = "VST_res", CoRe = CoRe, PrintPlot = PrintPlot))) + DMA_Output_List <- c(DMA_Output_List, list("VSTres" = Bartlett_output)) } - dev.new() - VolcanoPlot <- invisible(VizVolcano(PlotSettings="Standard", - InputData=Volplotdata%>%tibble::column_to_rownames("Metabolite"), - SettingsInfo=VolPlot_SettingsInfo, - SettingsFile_Metab=VolPlot_SettingsFile, - y= "p.adj", - x= x, - PlotName= DF, - Subtitle= bquote(italic("Differential Metabolite Analysis")), - SaveAs_Plot= NULL)) - - DF_save <- gsub("[^A-Za-z0-9._-]", "_", DF)## Remove special characters and replace spaces with underscores - volplotList[[DF_save]]<- VolcanoPlot[["Plot_Sized"]][[1]] - - dev.off() + if (CoRe) { + suppressMessages(suppressWarnings( + SaveRes(data = list("Feature_Metadata" = Feature_Metadata), + plot = NULL, SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, FolderPath = Folder, FileName = "DMA", + CoRe = CoRe, PrintPlot = PrintPlot))) + DMA_Output_List <- c(DMA_Output_List, + list("Feature_Metadata" = Feature_Metadata)) } - ###################################################################################################################################################################### - ##----- Save and Return - DMA_Output_List <- list() - #Here we make a list in which we will save the outputs: - if(PerformShapiro==TRUE & exists("Shapiro_output")==TRUE){ suppressMessages(suppressWarnings( - SaveRes(InputList_DF=Shapiro_output[["DF"]], - InputList_Plot= Shapiro_output[["Plot"]][["Distributions"]], - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= SubFolder_S , - FileName= "ShapiroTest", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - DMA_Output_List <- list("ShapiroTest"=Shapiro_output) - } - - if(PerformBartlett==TRUE & exists("Bartlett_output")==TRUE){ - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=Bartlett_output[["DF"]], - InputList_Plot= Bartlett_output[["Plot"]], - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= SubFolder_B , - FileName= "BartlettTest", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - DMA_Output_List <- c(DMA_Output_List, list("BartlettTest"=Bartlett_output)) - } - - if(VST==TRUE & exists("VST_res")==TRUE){ - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=VST_res[["DF"]], - InputList_Plot= VST_res[["Plot"]], - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= SubFolder_V , - FileName= "VST_res", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - DMA_Output_List <- c(DMA_Output_List, list("VSTres"=Bartlett_output)) - } - - if(CoRe==TRUE){ - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=list("Feature_Metadata"=Feature_Metadata), - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= Folder, - FileName= "DMA", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - DMA_Output_List <- c(DMA_Output_List, list("Feature_Metadata"=Feature_Metadata)) - } - - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=DMA_Output,#This needs to be a list, also for single comparisons - InputList_Plot= volplotList, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= "DMA", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - DMA_Output_List <- c(DMA_Output_List, list("DMA"=DMA_Output, "VolcanoPlot"=volplotList)) - - return(invisible(DMA_Output_List)) + SaveRes(data = se_l, ##This needs to be a list, also for single comparisons + plot = volplotList, SaveAs_Table = SaveAs_Table, + SaveAs_Plot = SaveAs_Plot, FolderPath = Folder, FileName = "DMA", + CoRe = CoRe, PrintPlot = PrintPlot))) + DMA_Output_List <- c(DMA_Output_List, + list("DMA" = se_l, "VolcanoPlot" = volplotList)) + + ## return + invisible(DMA_Output_List) } @@ -430,281 +430,383 @@ DMA <-function(InputData, #' #' @noRd #' -Log2FC_fun <-function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - CoRe=FALSE, - Transform=TRUE -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - # ------------ Assignments ----------- ## - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==TRUE){ - # one-vs-one: Generate the comparisons - denominator <- SettingsInfo[["Denominator"]] - numerator <- SettingsInfo[["Numerator"]] - comparisons <- matrix(c(numerator, denominator)) - #Settings: - MultipleComparison = FALSE - all_vs_all = FALSE - } - - ## ------------ Check Missingness ------------- ## - Num <- InputData %>%#Are sample numbers enough? - filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% numerator) %>% - dplyr::select_if(is.numeric)#only keep numeric columns with metabolite values - Denom <- InputData %>% - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% denominator) %>% - dplyr::select_if(is.numeric) - - Num_Miss <- replace(Num, Num==0, NA) - Num_Miss <- Num_Miss[, (colSums(is.na(Num_Miss)) > 0), drop = FALSE] - - Denom_Miss <- replace(Denom, Denom==0, NA) - Denom_Miss <- Denom_Miss[, (colSums(is.na(Denom_Miss)) > 0), drop = FALSE] - - if((ncol(Num_Miss)>0 & ncol(Denom_Miss)==0)){ - Metabolites_Miss <- colnames(Num_Miss) - }else if(ncol(Num_Miss)==0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- colnames(Denom_Miss) - }else if(ncol(Num_Miss)>0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - }else{ - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - } - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - MultipleComparison = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - MultipleComparison = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==TRUE){ - MultipleComparison = FALSE - } - - #################################################################################################################################### - ## ----------------- Log2FC ---------------------------- - Log2FC_table <- list()# Create an empty list to store results data frames - for(column in 1:dim(comparisons)[2]){ - C1 <- InputData %>% # Numerator - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% comparisons[1,column]) %>% - dplyr::select_if(is.numeric)#only keep numeric columns with metabolite values - C2 <- InputData %>% # Deniminator - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% comparisons[2,column]) %>% - dplyr::select_if(is.numeric) - - ## ------------ Calculate Log2FC ----------- ## - # For C1_Mean and C2_Mean use 0 to obtain values, leading to Log2FC=NA if mean = 0 (If one value is NA, the mean will be NA even though all other values are available.) - C1_Zero <- C1 - C1_Zero[is.na(C1_Zero)] <- 0 - Mean_C1 <- C1_Zero %>% - dplyr::summarise_all("mean") - - C2_Zero <- C2 - C2_Zero[is.na(C2_Zero)] <- 0 - Mean_C2 <- C2_Zero %>% - dplyr::summarise_all("mean") - - if(CoRe==TRUE){#Calculate absolute distance between the means. log2 transform and add sign (-/+): - #CoRe values can be negative and positive, which can does not allow us to calculate a Log2FC. - Mean_C1_t <- as.data.frame(t(Mean_C1))%>% - tibble::rownames_to_column("Metabolite") - Mean_C2_t <- as.data.frame(t(Mean_C2))%>% - tibble::rownames_to_column("Metabolite") - Mean_Merge <-merge(Mean_C1_t, Mean_C2_t, by="Metabolite", all=TRUE)%>% - dplyr::rename("C1"=2, - "C2"=3) - - #Deal with NA/0s - Mean_Merge$`NA/0` <- Mean_Merge$Metabolite %in% Metabolites_Miss#Column to enable the check if mean values of 0 are due to missing values (NA/0) and not by coincidence - - if(any((Mean_Merge$`NA/0`==FALSE & Mean_Merge$C1 ==0) | (Mean_Merge$`NA/0`==FALSE & Mean_Merge$C2==0))==TRUE){ - Mean_Merge <- Mean_Merge%>% - dplyr::mutate(C1 = case_when(C2 == 0 & `NA/0`== TRUE ~ paste(C1),#Here we have a "true" 0 value due to 0/NAs in the input data - C1 == 0 & `NA/0`== TRUE ~ paste(C1),#Here we have a "true" 0 value due to 0/NAs in the input data - C2 == 0 & `NA/0`== FALSE ~ paste(C1+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - C1 == 0 & `NA/0`== FALSE ~ paste(C1+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - TRUE ~ paste(C1)))%>% - dplyr::mutate(C2 = case_when(C1 == 0 & `NA/0`== TRUE ~ paste(C2),#Here we have a "true" 0 value due to 0/NAs in the input data - C2 == 0 & `NA/0`== TRUE ~ paste(C2),#Here we have a "true" 0 value due to 0/NAs in the input data - C1 == 0 & `NA/0`== FALSE ~ paste(C2+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - C2 == 0 & `NA/0`== FALSE ~ paste(C2+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - TRUE ~ paste(C2)))%>% - dplyr::mutate(C1 = as.numeric(C1))%>% - dplyr::mutate(C2 = as.numeric(C2)) - - X <- Mean_Merge%>% - subset((Mean_Merge$`NA/0`==FALSE & Mean_Merge$C1 ==0) | (Mean_Merge$`NA/0`==FALSE & Mean_Merge$C2==0)) - message("We added +1 to the mean value of metabolite(s) ", paste0(X$Metabolite, collapse = ", "), ", since the mean of the replicate values where 0. This was not due to missing values (NA/0).") - } - - #Add the distance column: - Mean_Merge$`Log2(Distance)` <-log2(abs(Mean_Merge$C1 - Mean_Merge$C2)) - - Mean_Merge <- Mean_Merge%>%#Now we can adapt the values to take into account the distance - dplyr::mutate(`Log2(Distance)` = case_when(C1 > C2 ~ paste(`Log2(Distance)`*+1),#If C1>C2 the distance stays positive to reflect that C1 > C2 - C1 < C2 ~ paste(`Log2(Distance)`*-1),#If C1% - dplyr::mutate(`Log2(Distance)` = as.numeric(`Log2(Distance)`)) - - #Add additional information: - temp1 <- Mean_C1 - temp2 <- Mean_C2 - #Add Info of CoRe: - CoRe_info <- rbind(temp1, temp2,rep(0,length(temp1))) - for (i in 1:length(temp1)){ - if (temp1[i]>0 & temp2[i]>0){ - CoRe_info[3,i] <- "Released" - }else if (temp1[i]<0 & temp2[i]<0){ - CoRe_info[3,i] <- "Consumed" - }else if(temp1[i]>0 & temp2[i]<0){ - CoRe_info[3,i] <- paste("Released in" ,comparisons[1,column] , "and Consumed",comparisons[2,column] , sep=" ") - } else if(temp1[i]<0 & temp2[i]>0){ - CoRe_info[3,i] <- paste("Consumed in" ,comparisons[1,column] , " and Released",comparisons[2,column] , sep=" ") - }else{ - CoRe_info[3,i] <- "No Change" - } - } - - CoRe_info <- t(CoRe_info) %>% as.data.frame() - CoRe_info <- rownames_to_column(CoRe_info, "Metabolite") - names(CoRe_info)[2] <- paste("Mean", comparisons[1,column], sep="_") - names(CoRe_info)[3] <- paste("Mean", comparisons[2,column], sep="_") - names(CoRe_info)[4] <- "CoRe_specific" - - CoRe_info <-CoRe_info%>% - dplyr::mutate(CoRe = case_when(CoRe_specific == "Released" ~ 'Released', - CoRe_specific == "Consumed" ~ 'Consumed', - TRUE ~ 'Released/Consumed'))%>% - dplyr::mutate(!!paste("CoRe_", comparisons[1,column], sep="") := case_when(CoRe_specific == "Released" ~ 'Released', - CoRe_specific == "Consumed" ~ 'Consumed', - CoRe_specific == paste("Consumed in" ,comparisons[1,column] , " and Released",comparisons[2,column] , sep=" ")~ 'Consumed', - CoRe_specific == paste("Released in" ,comparisons[1,column] , "and Consumed",comparisons[2,column] , sep=" ")~ 'Released', - TRUE ~ 'NA'))%>% - dplyr::mutate(!!paste("CoRe_", comparisons[2,column], sep="") := case_when(CoRe_specific == "Released" ~ 'Released', - CoRe_specific == "Consumed" ~ 'Consumed', - CoRe_specific == paste("Consumed in" ,comparisons[1,column] , " and Released",comparisons[2,column] , sep=" ")~ 'Released', - CoRe_specific == paste("Released in" ,comparisons[1,column] , "and Consumed",comparisons[2,column] , sep=" ")~ 'Consumed', - TRUE ~ 'NA')) - - - Log2FC_C1vC2 <-merge(Mean_Merge[,c(1,5)], CoRe_info[,c(1,2,6,3,7,4:5)], by="Metabolite", all.x=TRUE) - - #Add info on Input: - temp3 <- as.data.frame(t(C1))%>%tibble::rownames_to_column("Metabolite") - temp4 <- as.data.frame(t(C2))%>%tibble::rownames_to_column("Metabolite") - temp_3a4 <- merge(temp3, temp4, by="Metabolite", all=TRUE) - Log2FC_C1vC2 <- merge(Log2FC_C1vC2, temp_3a4, by="Metabolite", all.x=TRUE) - - #Return DFs - ##Make reverse DF - Log2FC_C2vC1 <- Log2FC_C1vC2 - Log2FC_C2vC1$`Log2(Distance)` <- Log2FC_C2vC1$`Log2(Distance)` *-1 - - ##Name them - if(MultipleComparison == TRUE){ - logname <- paste(comparisons[1,column], comparisons[2,column],sep="_vs_") - logname_reverse <- paste(comparisons[2,column], comparisons[1,column],sep="_vs_") - - # Store the data frame in the results list, named after the contrast - Log2FC_table[[logname]] <- Log2FC_C1vC2 - Log2FC_table[[logname_reverse]] <- Log2FC_C2vC1 - }else{ - Log2FC_table <- Log2FC_C1vC2 - } - }else if(CoRe==FALSE){ - #Mean values could be 0, which can not be used to calculate a Log2FC and hence the Log2FC(A versus B)=(log2(A+x)-log2(B+x)) for A and/or B being 0, with x being set to 1 - Mean_C1_t <- as.data.frame(t(Mean_C1))%>% - tibble::rownames_to_column("Metabolite") - Mean_C2_t <- as.data.frame(t(Mean_C2))%>% - tibble::rownames_to_column("Metabolite") - Mean_Merge <- merge(Mean_C1_t, Mean_C2_t, by="Metabolite", all=TRUE)%>% - dplyr::rename("C1"=2, - "C2"=3) - Mean_Merge$`NA/0` <- Mean_Merge$Metabolite %in% Metabolites_Miss#Column to enable the check if mean values of 0 are due to missing values (NA/0) and not by coincidence - - Mean_Merge <- Mean_Merge%>% - dplyr::mutate(C1_Adapted = case_when(C2 == 0 & `NA/0`== TRUE ~ paste(C1),#Here we have a "true" 0 value due to 0/NAs in the input data - C1 == 0 & `NA/0`== TRUE ~ paste(C1),#Here we have a "true" 0 value due to 0/NAs in the input data - C2 == 0 & `NA/0`== FALSE ~ paste(C1+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - C1 == 0 & `NA/0`== FALSE ~ paste(C1+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - TRUE ~ paste(C1)))%>% - dplyr::mutate(C2_Adapted = case_when(C1 == 0 & `NA/0`== TRUE ~ paste(C2),#Here we have a "true" 0 value due to 0/NAs in the input data - C2 == 0 & `NA/0`== TRUE ~ paste(C2),#Here we have a "true" 0 value due to 0/NAs in the input data - C1 == 0 & `NA/0`== FALSE ~ paste(C2+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - C2 == 0 & `NA/0`== FALSE ~ paste(C2+1),#Here we have a "false" 0 value that occured at random and not due to 0/NAs in the input data, hence we add the constant +1 - TRUE ~ paste(C2)))%>% - dplyr::mutate(C1_Adapted = as.numeric(C1_Adapted))%>% - dplyr::mutate(C2_Adapted = as.numeric(C2_Adapted)) - - if(any((Mean_Merge$`NA/0`==FALSE & Mean_Merge$C1 ==0) | (Mean_Merge$`NA/0`==FALSE & Mean_Merge$C2==0))==TRUE){ - X <- Mean_Merge%>% - subset((Mean_Merge$`NA/0`==FALSE & Mean_Merge$C1 ==0) | (Mean_Merge$`NA/0`==FALSE & Mean_Merge$C2==0)) - message("We added +1 to the mean value of metabolite(s) ", paste0(X$Metabolite, collapse = ", "), ", since the mean of the replicate values where 0. This was not due to missing values (NA/0).") - } - - #Calculate the Log2FC - if(Transform== TRUE){#data are not log2 transformed - Mean_Merge$FC_C1vC2 <- Mean_Merge$C1_Adapted/Mean_Merge$C2_Adapted #FoldChange - Mean_Merge$Log2FC <- gtools::foldchange2logratio(Mean_Merge$FC_C1vC2, base=2) - } - - if(Transform== FALSE){#data has been log2 transformed and hence we need to take this into account when calculating the log2FC - Mean_Merge$FC_C1vC2 <- "Empty" - Mean_Merge$Log2FC <- Mean_Merge$C1_Adapted - Mean_Merge$C2_Adapted - } - - #Add info on Input: - temp3 <- as.data.frame(t(C1))%>%tibble::rownames_to_column("Metabolite") - temp4 <- as.data.frame(t(C2))%>%tibble::rownames_to_column("Metabolite") - temp_3a4 <-merge(temp3, temp4, by="Metabolite", all=TRUE) - Log2FC_C1vC2 <-merge(Mean_Merge[,c(1,8)], temp_3a4, by="Metabolite", all.x=TRUE) - - #Return DFs - ##Make reverse DF - Log2FC_C2vC1 <-Log2FC_C1vC2 - Log2FC_C2vC1$Log2FC <- Log2FC_C2vC1$Log2FC*-1 - - if(MultipleComparison == TRUE){ - logname <- paste(comparisons[1,column], comparisons[2,column],sep="_vs_") - logname_reverse <- paste(comparisons[2,column], comparisons[1,column],sep="_vs_") - - # Store the data frame in the results list, named after the contrast - Log2FC_table[[logname]] <- Log2FC_C1vC2 - Log2FC_table[[logname_reverse]] <- Log2FC_C2vC1 - }else{ - Log2FC_table <- Log2FC_C1vC2 - } +Log2FC_fun <-function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo=c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + CoRe=FALSE, + Transform=TRUE) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Assignments ----------- ## + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- unique(conditions) + numerator <- denominator + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + ##all-vs-one: Generate the pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <- unique(conditions) + + ## Remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE + } else if (("Denominator" %in% names(SettingsInfo)) & ("Numerator" %in% names(SettingsInfo))) { + ## one-vs-one: Generate the comparisons + denominator <- SettingsInfo[["Denominator"]] + numerator <- SettingsInfo[["Numerator"]] + comparisons <- matrix(c(numerator, denominator)) + + ## Settings: + MultipleComparison <- FALSE + all_vs_all <- FALSE + } + + ## ------------ Check Missingness ------------- ## + cols_num <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% numerator + Num <- t(assay(se)[, cols_num]) + cols_denom <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% denominator + Denom <- t(assay(se)[, cols_denom]) + + Num_Miss <- replace(Num, Num == 0, NA) + Num_Miss <- Num_Miss[, colSums(is.na(Num_Miss)) > 0, drop = FALSE] + + Denom_Miss <- replace(Denom, Denom == 0, NA) + Denom_Miss <- Denom_Miss[, colSums(is.na(Denom_Miss)) > 0, drop = FALSE] + + if (ncol(Num_Miss) > 0 & ncol(Denom_Miss) == 0){ + Metabolites_Miss <- colnames(Num_Miss) + } else if (ncol(Num_Miss) == 0 & ncol(Denom_Miss) > 0) { + Metabolites_Miss <- colnames(Denom_Miss) + } else if (ncol(Num_Miss) > 0 & ncol(Denom_Miss) > 0) { + Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) + Metabolites_Miss <- unique(Metabolites_Miss) + } else { + Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) + Metabolites_Miss <- unique(Metabolites_Miss) } - } - return(invisible(Log2FC_table)) -} + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + MultipleComparison <- TRUE + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + MultipleComparison <- TRUE + } else if ("Denominator" %in% names(SettingsInfo) & "Numerator" %in% names(SettingsInfo)) { + MultipleComparison <- FALSE + } + ############################################################################ + ## ----------------- Log2FC ---------------------------- + Log2FC_table <- list() ## Create an empty list to store results data frames + + for (column in seq_len(ncol(comparisons))) { + cols_num <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% comparisons[1, column] + C1 <- t(assay(se)[, cols_num]) ## Numerator + cols_denom <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% comparisons[2, column] + C2 <- t(assay(se)[, cols_denom]) ## Denominator + + ## ------------ Calculate Log2FC ----------- ## + ## For C1_Mean and C2_Mean use 0 to obtain values, leading to + ## Log2FC=NA if mean = 0 (If one value is NA, the mean will be NA even + ## though all other values are available.) + C1_Zero <- C1 + C1_Zero[is.na(C1_Zero)] <- 0 + Mean_C1 <- C1_Zero %>% + as.data.frame() |> + dplyr::summarise_all("mean") + + C2_Zero <- C2 + C2_Zero[is.na(C2_Zero)] <- 0 + Mean_C2 <- C2_Zero %>% + as.data.frame() |> + dplyr::summarise_all("mean") + + ## calculate absolute distance between the means. log2 transform and + ## add sign (-/+): + ## CoRe values can be negative and positive, which can does not allow + ## us to calculate a Log2FC. + + + ## Mean values could be 0, which can not be used to calculate a + ## Log2FC and hence the Log2FC(A versus B)=(log2(A+x)-log2(B+x)) + ## for A and/or B being 0, with x being set to 1 + Mean_C1_t <- as.data.frame(t(Mean_C1)) %>% + tibble::rownames_to_column("Metabolite") + Mean_C2_t <- as.data.frame(t(Mean_C2)) %>% + tibble::rownames_to_column("Metabolite") + Mean_Merge <- merge(Mean_C1_t, Mean_C2_t, by = "Metabolite", + all = TRUE) %>% + dplyr::rename("C1" = 2, "C2" = 3) + + ## Deal with NA/0s + ## create column to enable the check if mean values of 0 are due + ## to missing values (NA/0) and not by coincidence + Mean_Merge$`NA/0` <- Mean_Merge$Metabolite %in% Metabolites_Miss + + if (CoRe) { ## EDIT: can this be simplified? Identify steps that are identical between CoRe and !CoRe and try to remove duplicated code + + if (any( + (!Mean_Merge$`NA/0` & Mean_Merge$C1 == 0) | (!Mean_Merge$`NA/0` & Mean_Merge$C2 == 0))) { + + Mean_Merge <- Mean_Merge %>% + dplyr::mutate( + C1 = case_when( + ## here we have a "true" 0 value due to 0/NAs in + ## the input data + C2 == 0 & `NA/0` ~ paste(C1), + ## here we have a "true" 0 value due to 0/NAs in + ## the input data + C1 == 0 & `NA/0` ~ paste(C1), + ## here we have a "false" 0 value that occured at + ## random and not due to 0/NAs in the input data, + ## hence we add the constant +1 + C2 == 0 & !`NA/0` ~ paste(C1 + 1), + ## here we have a "false" 0 value that occured at + ## random and not due to 0/NAs in the input data, + ## hence we add the constant +1 + C1 == 0 & !`NA/0` ~ paste(C1 + 1), + TRUE ~ paste(C1))) %>% + dplyr::mutate( + C2 = case_when( + ## Here we have a "true" 0 value due to 0/NAs in + ## the input data + C1 == 0 & `NA/0` ~ paste(C2), + ## here we have a "true" 0 value due to 0/NAs in + ## the input data + C2 == 0 & `NA/0` ~ paste(C2), + ## here we have a "false" 0 value that occured at + ## random and not due to 0/NAs in the input data, + ## hence we add the constant +1 + C1 == 0 & !`NA/0` ~ paste(C2 + 1), ## EDIT: is this correct + ## here we have a "false" 0 value that occured at + ## random and not due to 0/NAs in the input data, + ## hence we add the constant +1 + C2 == 0 & !`NA/0` ~ paste(C2 + 1), + TRUE ~ paste(C2)))%>% + dplyr::mutate(C1 = as.numeric(C1), C2 = as.numeric(C2)) + + X <- Mean_Merge %>% + subset((!Mean_Merge$`NA/0` & Mean_Merge$C1 ==0) | + (!Mean_Merge$`NA/0` & Mean_Merge$C2==0)) + message("We added +1 to the mean value of metabolite(s) ", + paste0(X$Metabolite, collapse = ", "), + ", since the mean of the replicate values where 0. This was not due to missing values (NA/0).") + } + + ## Add the distance column: + Mean_Merge$`Log2(Distance)` <- log2( + abs(Mean_Merge$C1 - Mean_Merge$C2)) + + Mean_Merge <- Mean_Merge %>% + ## adapt the values to take into account the distance + dplyr::mutate(`Log2(Distance)` = case_when( ## FEAT: Why not use sign()? + ## If C1>C2 the distance stays positive to reflect that C1 > C2 + C1 > C2 ~ paste(`Log2(Distance)` * + 1), + ## If C1% + dplyr::mutate(`Log2(Distance)` = as.numeric(`Log2(Distance)`)) + + ##Add additional information: + temp1 <- Mean_C1 + temp2 <- Mean_C2 + + ## Add Info of CoRe: + CoRe_info <- rbind(temp1, temp2, rep(0, length(temp1))) + for (i in seq_along(temp1)) { + if (temp1[i] > 0 & temp2[i] > 0) { + CoRe_info[3, i] <- "Released" + } else if (temp1[i] < 0 & temp2[i] < 0) { + CoRe_info[3, i] <- "Consumed" + } else if (temp1[i] > 0 & temp2[i] < 0) { + CoRe_info[3, i] <- paste("Released in", + comparisons[1, column] , "and Consumed", + comparisons[2, column] , sep = " ") + } else if (temp1[i] < 0 & temp2[i] > 0) { + CoRe_info[3, i] <- paste("Consumed in", + comparisons[1, column] , + " and Released",comparisons[2, column], sep = " ") + } else { + CoRe_info[3, i] <- "No Change" + } + } + + CoRe_info <- t(CoRe_info) %>% + as.data.frame() + CoRe_info <- rownames_to_column(CoRe_info, "Metabolite") + names(CoRe_info)[2] <- paste("Mean", comparisons[1, column], + sep = "_") + names(CoRe_info)[3] <- paste("Mean", comparisons[2, column], + sep = "_") + names(CoRe_info)[4] <- "CoRe_specific" + + CoRe_info <- CoRe_info %>% + dplyr::mutate(CoRe = case_when( + CoRe_specific == "Released" ~ 'Released', + CoRe_specific == "Consumed" ~ 'Consumed', + TRUE ~ 'Released/Consumed')) %>% + dplyr::mutate( + !!paste("CoRe_", comparisons[1, column], sep="") := case_when( + CoRe_specific == "Released" ~ 'Released', + CoRe_specific == "Consumed" ~ 'Consumed', + CoRe_specific == paste("Consumed in", + comparisons[1, column], + " and Released", comparisons[2, column] , sep = " ") ~ 'Consumed', + CoRe_specific == paste("Released in", + comparisons[1, column], "and Consumed", + comparisons[2, column], sep =" ") ~ 'Released', + TRUE ~ 'NA')) %>% + dplyr::mutate( + !!paste("CoRe_", comparisons[2, column], sep = "") := case_when( + CoRe_specific == "Released" ~ 'Released', + CoRe_specific == "Consumed" ~ 'Consumed', + CoRe_specific == paste("Consumed in", + comparisons[1, column], " and Released", + comparisons[2, column] , sep = " ") ~ 'Released', + CoRe_specific == paste("Released in", + comparisons[1, column], "and Consumed", + comparisons[2, column] , sep = " ") ~ 'Consumed', + TRUE ~ 'NA')) + + Log2FC_C1vC2 <-merge(Mean_Merge[, c(1, 5)], + CoRe_info[, c(1, 2, 6, 3, 7, 4:5)], by = "Metabolite", + all.x = TRUE) + + ## add info on Input + temp3 <- as.data.frame(t(C1)) %>% + tibble::rownames_to_column("Metabolite") + temp4 <- as.data.frame(t(C2)) %>% + tibble::rownames_to_column("Metabolite") + temp_3a4 <- merge(temp3, temp4, by = "Metabolite", + all = TRUE) + Log2FC_C1vC2 <- merge(Log2FC_C1vC2, temp_3a4, by = "Metabolite", + all.x = TRUE) + + ## Return DFs + ## make reverse DF + Log2FC_C2vC1 <- Log2FC_C1vC2 + Log2FC_C2vC1$`Log2(Distance)` <- Log2FC_C2vC1$`Log2(Distance)` * -1 + + ## name them + if (MultipleComparison) { + logname <- paste(comparisons[1, column], comparisons[2, column], + sep = "_vs_") + logname_reverse <- paste(comparisons[2, column], + comparisons[1, column], sep = "_vs_") + + ## store the data frame in the results list, named after the contrast + Log2FC_table[[logname]] <- Log2FC_C1vC2 + Log2FC_table[[logname_reverse]] <- Log2FC_C2vC1 + } else { + Log2FC_table <- Log2FC_C1vC2 + } + } else { ## !Core + + Mean_Merge <- Mean_Merge %>% + dplyr::mutate(C1_Adapted = case_when( + ## here we have a "true" 0 value due to 0/NAs in the input data + C2 == 0 & `NA/0` ~ paste(C1), + ## here we have a "true" 0 value due to 0/NAs in the input data + C1 == 0 & `NA/0` ~ paste(C1), + ## here we have a "false" 0 value that occured at random + ## and not due to 0/NAs in the input data, hence we add + ## the constant +1 + C2 == 0 & !`NA/0` ~ paste(C1 + 1), + ## here we have a "false" 0 value that occured at random + ## and not due to 0/NAs in the input data, hence we add + ## the constant +1 + C1 == 0 & !`NA/0` ~ paste(C1 + 1), + TRUE ~ paste(C1))) %>% + dplyr::mutate(C2_Adapted = case_when( + ## here we have a "true" 0 value due to 0/NAs in the input data + C1 == 0 & `NA/0` ~ paste(C2), + ## here we have a "true" 0 value due to 0/NAs in the input data + C2 == 0 & `NA/0` ~ paste(C2), + ## here we have a "false" 0 value that occured at random + ## and not due to 0/NAs in the input data, hence we add + ## the constant +1 + C1 == 0 & !`NA/0` ~ paste(C2 + 1), + ## here we have a "false" 0 value that occured at random + ## and not due to 0/NAs in the input data, hence we add + ## the constant +1 + C2 == 0 & !`NA/0` ~ paste(C2 + 1), + TRUE ~ paste(C2))) %>% + dplyr::mutate(C1_Adapted = as.numeric(C1_Adapted), + C2_Adapted = as.numeric(C2_Adapted)) + + if (any((!Mean_Merge$`NA/0` & Mean_Merge$C1 == 0) | + (!Mean_Merge$`NA/0` & Mean_Merge$C2 == 0))) { + X <- Mean_Merge %>% + subset((!Mean_Merge$`NA/0` & Mean_Merge$C1 == 0) | + (!Mean_Merge$`NA/0` & Mean_Merge$C2 == 0)) + message("We added +1 to the mean value of metabolite(s) ", + paste0(X$Metabolite, collapse = ", "), + ", since the mean of the replicate values where 0. This was not due to missing values (NA/0).") + } + + ## Calculate the Log2FC + if (Transform) { + ## data are not log2 transformed + ## calculate FoldChange + Mean_Merge$FC_C1vC2 <- Mean_Merge$C1_Adapted / Mean_Merge$C2_Adapted + Mean_Merge$Log2FC <- gtools::foldchange2logratio( + Mean_Merge$FC_C1vC2, base = 2) + } + + if (!Transform) { + ## data has been log2 transformed and hence we need to + ## take this into account when calculating the log2FC + Mean_Merge$FC_C1vC2 <- "Empty" + Mean_Merge$Log2FC <- Mean_Merge$C1_Adapted - Mean_Merge$C2_Adapted + } + + ## Add info on Input: + temp3 <- as.data.frame(t(C1)) %>% + tibble::rownames_to_column("Metabolite") + temp4 <- as.data.frame(t(C2)) %>% + tibble::rownames_to_column("Metabolite") + temp_3a4 <- merge(temp3, temp4, by = "Metabolite", all = TRUE) + Log2FC_C1vC2 <- merge(Mean_Merge[, c(1, 8)], temp_3a4, + by = "Metabolite", all.x = TRUE) + + ## Return DFs + ## Make reverse DF + Log2FC_C2vC1 <- Log2FC_C1vC2 + Log2FC_C2vC1$Log2FC <- Log2FC_C2vC1$Log2FC * -1 + + if (MultipleComparison) { + logname <- paste(comparisons[1, column], comparisons[2, column], + sep = "_vs_") + logname_reverse <- paste(comparisons[2, column], + comparisons[1, column], sep = "_vs_") + + ## store the data frame in the results list, named after the contrast + Log2FC_table[[logname]] <- Log2FC_C1vC2 + Log2FC_table[[logname_reverse]] <- Log2FC_C2vC1 + } else { + Log2FC_table <- Log2FC_C1vC2 + } + } + } + + ## return + invisible(Log2FC_table) +} @@ -725,116 +827,126 @@ Log2FC_fun <-function(InputData, #' #' @keywords Statistical testing, p-value, t-value #' -#' @importFrom stats p.adjust +#' @importFrom stats p.adjust p.adjust.methods #' @importFrom dplyr select_if filter rename mutate summarise_all #' @importFrom magrittr %>% #' @importFrom tibble rownames_to_column #' #' @noRd #' -DMA_Stat_single <- function(InputData, - SettingsFile_Sample, - SettingsInfo, - Log2FC_table=NULL, - StatPval="t.test", - StatPadj="fdr"){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Check Missingness ------------- ## - Num <- InputData %>%#Are sample numbers enough? - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% SettingsInfo[["Numerator"]]) %>% - dplyr::select_if(is.numeric)#only keep numeric columns with metabolite values - Denom <- InputData %>% - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% SettingsInfo[["Denominator"]]) %>% - dplyr::select_if(is.numeric) - - Num_Miss <- replace(Num, Num==0, NA) - Num_Miss <- Num_Miss[, (colSums(is.na(Num_Miss)) > 0), drop = FALSE] - - Denom_Miss <- replace(Denom, Denom==0, NA) - Denom_Miss <- Denom_Miss[, (colSums(is.na(Denom_Miss)) > 0), drop = FALSE] - - if((ncol(Num_Miss)>0 & ncol(Denom_Miss)==0)){ - Metabolites_Miss <- colnames(Num_Miss) - }else if(ncol(Num_Miss)==0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- colnames(Denom_Miss) - }else if(ncol(Num_Miss)>0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - }else{ - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - } - - # Comparisons - comparisons <- matrix(c(SettingsInfo[["Numerator"]], SettingsInfo[["Denominator"]])) - - ## ------------ Perform Hypothesis testing ----------- ## - for(column in 1:dim(comparisons)[2]){ - C1 <- InputData %>% # Numerator - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% comparisons[1,column]) %>% - dplyr::select_if(is.numeric)#only keep numeric columns with metabolite values - C2 <- InputData %>% # Denominator - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% comparisons[2,column]) %>% - dplyr::select_if(is.numeric) - } - - # For C1 and C2 we use 0, since otherwise we can not perform the statistical testing. - C1[is.na(C1)] <- 0 - C2[is.na(C2)] <- 0 - - #### 1. p.value and test statistics (=t.val) - T_C1vC2 <-mapply(StatPval, x= as.data.frame(C2), y = as.data.frame(C1), SIMPLIFY = F) - - VecPVAL_C1vC2 <- c() - VecTVAL_C1vC2 <- c() - for(i in 1:length(T_C1vC2)){ - p_value <- unlist(T_C1vC2[[i]][3]) - t_value <- unlist(T_C1vC2[[i]])[1] # Extract the t-value - VecPVAL_C1vC2[i] <- p_value - VecTVAL_C1vC2[i] <- t_value - } - Metabolite <- colnames(C2) - PVal_C1vC2 <- data.frame(Metabolite, p.val = VecPVAL_C1vC2, t.val = VecTVAL_C1vC2) - - #we set p.val= NA, for metabolites that had 1 or more replicates with NA/0 values and remove them prior to p-value adjustment - PVal_C1vC2$`NA/0` <- PVal_C1vC2$Metabolite %in% Metabolites_Miss - PVal_C1vC2 <-PVal_C1vC2%>% - dplyr::mutate(p.val = case_when(`NA/0`== TRUE ~ NA, - TRUE ~ paste(VecPVAL_C1vC2))) - PVal_C1vC2$p.val = as.numeric(as.character(PVal_C1vC2$p.val)) - - #### 2. p.adjusted - #Split data for p.value adjustment to exclude NA - PVal_NA <- PVal_C1vC2[is.na(PVal_C1vC2$p.val), c(1:3)] - PVal_C1vC2 <-PVal_C1vC2[!is.na(PVal_C1vC2$p.val), c(1:3)] - - #perform adjustment - VecPADJ_C1vC2 <- stats::p.adjust((PVal_C1vC2[,2]),method = StatPadj, n = length((PVal_C1vC2[,2]))) #p-adjusted - Metabolite <- PVal_C1vC2[,1] - PADJ_C1vC2 <- data.frame(Metabolite, p.adj = VecPADJ_C1vC2) - STAT_C1vC2 <- merge(PVal_C1vC2,PADJ_C1vC2, by="Metabolite") - - #Add Metabolites that have p.val=NA back into the DF for completeness. - if(nrow(PVal_NA)>0){ - PVal_NA$p.adj <- NA - STAT_C1vC2 <- rbind(STAT_C1vC2, PVal_NA) - } - - #Add Log2FC - if(is.null(Log2FC_table)==FALSE){ - STAT_C1vC2 <- merge(Log2FC_table,STAT_C1vC2[,c(1:2,4,3)], by="Metabolite") - } - - #order for t.value - STAT_C1vC2 <- STAT_C1vC2[order(STAT_C1vC2$t.val,decreasing=TRUE),] # order the df based on the t-value - - #list - results_list <- list() - results_list[[paste(SettingsInfo[["Numerator"]], "_vs_", SettingsInfo[["Denominator"]])]] <- STAT_C1vC2 - - return(invisible(results_list)) +DMA_Stat_single <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo, + Log2FC_table = NULL, + StatPval = "t.test", ## FEAT: add options + StatPadj= p.adjust.methods) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + + ## StatPval <- match.arg(StatPval) ## FEAT: match arguments + StatPadj <- match.arg(StatPadj) + + ## ------------ Check Missingness ------------- ## + cols_num <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% SettingsInfo[["Numerator"]] + Num <- t(assay(se)[, cols_num]) + cols_denom <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% SettingsInfo[["Denominator"]] + Denom <- t(assay(se)[, cols_denom]) + + Num_Miss <- replace(Num, Num == 0, NA) + Num_Miss <- Num_Miss[, colSums(is.na(Num_Miss)) > 0, drop = FALSE] + + Denom_Miss <- replace(Denom, Denom == 0, NA) + Denom_Miss <- Denom_Miss[, colSums(is.na(Denom_Miss) > 0), drop = FALSE] + + if (ncol(Num_Miss) > 0 & ncol(Denom_Miss) == 0) { + Metabolites_Miss <- colnames(Num_Miss) + } else if (ncol(Num_Miss) == 0 & ncol(Denom_Miss) > 0) { + Metabolites_Miss <- colnames(Denom_Miss) + } else if (ncol(Num_Miss) > 0 & ncol(Denom_Miss) > 0) { + Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) |> + unique() + } else{ + Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) |> + unique() + } + + ## Comparisons + comparisons <- matrix(c(SettingsInfo[["Numerator"]], SettingsInfo[["Denominator"]])) + + ## ------------ Perform Hypothesis testing ----------- ## + for (column in seq_len(ncol(comparisons))) { + ## Numerator + cols_num <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% comparisons[1, column] + C1 <- t(assay(se)[, cols_num]) + ## Denominator + cols_denom <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% comparisons[2, column] + C2 <- t(assay(se)[, cols_denom]) + } ## EDIT: What is going on here? Should the for loop be extended to all downstream operations? + + ## For C1 and C2 we use 0, since otherwise we can not perform the statistical testing. + C1[is.na(C1)] <- 0 + C2[is.na(C2)] <- 0 + + #### 1. p.value and test statistics (=t.val) + T_C1vC2 <- mapply(FUN = StatPval, x = as.data.frame(C2), y = as.data.frame(C1), + SIMPLIFY = FALSE) + + VecPVAL_C1vC2 <- c() + VecTVAL_C1vC2 <- c() + for (i in 1:length(T_C1vC2)) { + ## extract p-values and t-values + p_value <- unlist(T_C1vC2[[i]][3]) + t_value <- unlist(T_C1vC2[[i]])[1]## EDIT: I would do this rather by calling explicitly the name instead of indexing + VecPVAL_C1vC2[i] <- p_value ## EDITs: why not write directly to VecPVAL_C1vC2 and VecTVAL_C1vC2? + VecTVAL_C1vC2[i] <- t_value + } + Metabolite <- colnames(C2) + PVal_C1vC2 <- data.frame(Metabolite, p.val = VecPVAL_C1vC2, t.val = VecTVAL_C1vC2) + + ## we set p.val= NA, for metabolites that had 1 or more replicates with + ## NA/0 values and remove them prior to p-value adjustment + PVal_C1vC2$`NA/0` <- PVal_C1vC2$Metabolite %in% Metabolites_Miss + PVal_C1vC2 <- PVal_C1vC2 %>% + dplyr::mutate(p.val = case_when( + `NA/0` ~ NA, + TRUE ~ paste(VecPVAL_C1vC2))) + PVal_C1vC2$p.val <- as.numeric(as.character(PVal_C1vC2$p.val)) + + #### 2. p.adjusted + ## Split data for p.value adjustment to exclude NA + PVal_NA <- PVal_C1vC2[is.na(PVal_C1vC2$p.val), c(1:3)] + PVal_C1vC2 <- PVal_C1vC2[!is.na(PVal_C1vC2$p.val), c(1:3)] + + ## perform adjustment + VecPADJ_C1vC2 <- stats::p.adjust(PVal_C1vC2[, 2], method = StatPadj, + n = length((PVal_C1vC2[, 2]))) ## p-adjusted + Metabolite <- PVal_C1vC2[, 1] + PADJ_C1vC2 <- data.frame(Metabolite, p.adj = VecPADJ_C1vC2) + STAT_C1vC2 <- merge(PVal_C1vC2, PADJ_C1vC2, by = "Metabolite") + + ## add Metabolites that have p.val=NA back into the DF for completeness. + if (nrow(PVal_NA) > 0) { + PVal_NA$p.adj <- NA + STAT_C1vC2 <- rbind(STAT_C1vC2, PVal_NA) + } + + ## Add Log2FC + if (!is.null(Log2FC_table)){ + STAT_C1vC2 <- merge(Log2FC_table, + STAT_C1vC2[, c(1:2, 4, 3)], by = "Metabolite") + } + + ## order the df based on the t-value + STAT_C1vC2 <- STAT_C1vC2[order(STAT_C1vC2$t.val, decreasing = TRUE), ] + + ## create list and store results + results_list <- list() + results_list[[paste(SettingsInfo[["Numerator"]], "_vs_", SettingsInfo[["Denominator"]])]] <- STAT_C1vC2 + + ## return + invisible(results_list) } @@ -860,120 +972,142 @@ DMA_Stat_single <- function(InputData, #' #' @noRd #' -AOV <-function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - Log2FC_table=NULL){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - } - - ############################################################################################# - ## 1. Anova p.val - aov.res= apply(InputData,2,function(x) stats::aov(x~conditions)) - - ## 2. Tukey test p.adj - posthoc.res = lapply(aov.res, stats::TukeyHSD, conf.level=0.95) - Tukey_res <- do.call('rbind', lapply(posthoc.res, function(x) x[1][[1]][,'p adj'])) %>% as.data.frame() - - comps <- paste(comparisons[1, ], comparisons[2, ], sep="-")# normal - opp_comps <- paste(comparisons[2, ], comparisons[1, ], sep="-") - - if(sum(opp_comps %in% colnames(Tukey_res))>0){# if opposite comparisons is true - for (comp in 1: length(opp_comps)){ - colnames(Tukey_res)[colnames(Tukey_res) %in% opp_comps[comp]] <- comps[comp] +AOV <-function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + Log2FC_table = NULL){ + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, + ## one_vs_all or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { ## EDIT: line 1001-1028 is replicated across several functions and should be written as a function + + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <-unique(conditions) + numerator <- unique(conditions) + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + + ## all-vs-one: Generate the pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <- unique(conditions) + + ## remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE } - } - ## 3. t.val - Tukey_res_diff <- do.call('rbind', lapply(posthoc.res, function(x) x[1][[1]][,'diff'])) %>% as.data.frame() + ############################################################################################# + ## 1. Anova p.val + aov.res <- apply(assay(se), 1, function(x) stats::aov(x ~ conditions)) + + ## 2. Tukey test p.adj + posthoc.res <- lapply(aov.res, stats::TukeyHSD, conf.level = 0.95) + Tukey_res <- do.call("rbind", + lapply(posthoc.res, function(x) x[1][[1]][, "p adj"])) %>% + as.data.frame() + + comps <-paste(comparisons[1, ], comparisons[2, ], sep = "-") ## normal + opp_comps <- paste(comparisons[2, ], comparisons[1, ], sep = "-") + + ## if opposite comparisons is true + if (sum(opp_comps %in% colnames(Tukey_res)) > 0) { + for (comp in seq_along(opp_comps)) { + colnames(Tukey_res)[colnames(Tukey_res) %in% opp_comps[comp]] <- comps[comp] + } + } + + ## 3. t.val + Tukey_res_diff <- do.call("rbind", + lapply(posthoc.res, function(x) x[1][[1]][, "diff"])) %>% ## EDIT: could be "recycled" from l1043? + as.data.frame() + + ## if oposite comparisons is true + if (sum(opp_comps %in% colnames(Tukey_res_diff)) > 0) { + for (comp in 1: length(opp_comps)){ + colnames(Tukey_res_diff)[colnames(Tukey_res_diff) %in% opp_comps[comp]] <- comps[comp] + } + } - if (sum(opp_comps %in% colnames(Tukey_res_diff))>0){# if oposite comparisons is true - for (comp in 1: length(opp_comps)){ - colnames(Tukey_res_diff)[colnames(Tukey_res_diff) %in% opp_comps[comp]] <- comps[comp] + ## Make output DFs: + Pval_table <- Tukey_res |> + tibble::rownames_to_column("Metabolite") + Tval_table <- tibble::rownames_to_column(Tukey_res_diff, "Metabolite") + + ## here we need to adapt for one_vs_all or all_vs_all + common_col_names <- setdiff(names(Tukey_res_diff), "row.names") + + results_list <- list() + for(col_name in common_col_names){ + ## create a new data frame by merging the two data frames + merged_df <- merge(Pval_table[, c("Metabolite", col_name)], + Tval_table[,c("Metabolite", col_name)], + by = "Metabolite", all = TRUE) %>% + dplyr::rename("p.adj" = 2, "t.val" = 3) + + ## we need to add _vs_ into the comparison col_name + pattern <- paste(conditions, collapse = "|") + conditions_present <- unique( + unlist(regmatches(col_name, gregexpr(pattern, col_name)))) + modified_col_name <- paste(conditions_present[1], "vs", + conditions_present[2], sep = "_") + + ## add the new data frame to the list with the column name as the + ## list element name + results_list[[modified_col_name]] <- merged_df } - } - - #Make output DFs: - Pval_table <- Tukey_res - Pval_table <- tibble::rownames_to_column(Pval_table,"Metabolite") - - Tval_table <- tibble::rownames_to_column(Tukey_res_diff,"Metabolite") - - common_col_names <- setdiff(names(Tukey_res_diff), "row.names")#Here we need to adapt for one_vs_all or all_vs_all - - results_list <- list() - for(col_name in common_col_names){ - # Create a new data frame by merging the two data frames - merged_df <- merge(Pval_table[,c("Metabolite",col_name)], Tval_table[,c("Metabolite",col_name)], by="Metabolite", all=TRUE)%>% - dplyr::rename("p.adj"=2, - "t.val"=3) - - #We need to add _vs_ into the comparison col_name - pattern <- paste(conditions, collapse = "|") - conditions_present <- unique(unlist(regmatches(col_name, gregexpr(pattern, col_name)))) - modified_col_name <- paste(conditions_present[1], "vs", conditions_present[2], sep = "_") - - # Add the new data frame to the list with the column name as the list element name - results_list[[modified_col_name]] <- merged_df - } - - # Merge the data frames in list1 and list2 based on the "Metabolite" column - if(is.null(Log2FC_table)==FALSE){ - list_names <- names(results_list) - - merged_list <- list() - for(name in list_names){ - # Check if the data frames exist in both lists - if(name %in% names(results_list) && name %in% names(Log2FC_table)){ - merged_df <- merge(results_list[[name]], Log2FC_table[[name]], by = "Metabolite", all = TRUE) - merged_df <- merged_df[,c(1,4,2:3,5:ncol(merged_df))]#reorder the columns - merged_list[[name]] <- merged_df - } + + ## merge the data frames in list1 and list2 based on the "Metabolite" column + if (!is.null(Log2FC_table)) { + list_names <- names(results_list) + + merged_list <- list() + for (name in list_names) { + ## check if the data frames exist in both lists + if (name %in% names(results_list) && name %in% names(Log2FC_table)) { + merged_df <- merge(results_list[[name]], + Log2FC_table[[name]], by = "Metabolite", all = TRUE) + + ## reorder the columns + merged_df <- merged_df[,c(1, 4, 2:3, 5:ncol(merged_df))] + merged_list[[name]] <- merged_df + } + } + } else { + merged_list <- results_list } - }else{ - merged_list <- results_list - } - - # Make sure the right comparisons are returned: - if(all_vs_all==TRUE){ - STAT_C1vC2 <- merged_list - }else if(all_vs_all==FALSE){ - #remove the comparisons that are not needed: - modified_df_list <- list() - for(df_name in names(merged_list)){ - if(endsWith(df_name, SettingsInfo[["Denominator"]])){ - modified_df_list[[df_name]] <- merged_list[[df_name]] - } + + ## make sure the right comparisons are returned: + if (all_vs_all) { + STAT_C1vC2 <- merged_list + } else if (!all_vs_all) { ## EDIT: the additional else is not needed, just use else + ## remove the comparisons that are not needed: + modified_df_list <- list() + for (df_name in names(merged_list)) { + if (endsWith(df_name, SettingsInfo[["Denominator"]])) { + modified_df_list[[df_name]] <- merged_list[[df_name]] + } + } + STAT_C1vC2 <- modified_df_list } - STAT_C1vC2 <- modified_df_list - } - return(invisible(STAT_C1vC2)) + ## return + invisible(STAT_C1vC2) } ########################################################################### @@ -992,7 +1126,7 @@ AOV <-function(InputData, #' #' @keywords Statistical testing, p-value, t-value #' -#' @importFrom stats kruskal.test +#' @importFrom stats kruskal.test p.adjust.methods #' @importFrom rstatix dunn_test #' @importFrom dplyr rename mutate_all mutate select #' @importFrom magrittr %>% @@ -1000,115 +1134,148 @@ AOV <-function(InputData, #' #' @noRd #' -Kruskal <-function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - Log2FC_table = NULL, - StatPadj = "fdr" -){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - } - - ############################################################################################# - # Kruskal test (p.val) - aov.res= apply(InputData,2,function(x) stats::kruskal.test(x~conditions)) - anova_res<-do.call('rbind', lapply(aov.res, function(x) {x["p.value"]})) - anova_res <- as.matrix(dplyr::mutate_all(as.data.frame(anova_res), function(x) as.numeric(as.character(x)))) - colnames(anova_res) = c("Kruskal_p.val") - - # Dunn test (p.adj) - Dunndata <- InputData %>% - dplyr::mutate(conditions = conditions) %>% - dplyr::select(conditions, everything())%>% - as.data.frame() - - # Applying a loop to obtain p.adj and t.val: - Dunn_Pres<- data.frame(comparisons = paste(comparisons[1,], comparisons[2,], sep = "_vs_" )) - Dunn_Tres<- Dunn_Pres - for(col in 2:dim(Dunndata)[2]){ - data = Dunndata[,c(1,col)] - colnames(data)[2] <- gsub("^\\d+", "", colnames(data)[2]) - - ## If a metabolite starts with number remove it - formula <- as.formula(paste(colnames(data)[2], "~ conditions")) - posthoc.res= rstatix::dunn_test(data, formula, p.adjust.method = StatPadj) - - pres <- data.frame(comparisons = c(paste(posthoc.res$group1, posthoc.res$group2, sep = "_vs_" ), paste(posthoc.res$group2, posthoc.res$group1, sep = "_vs_" ))) - pres[[colnames(Dunndata)[col] ]] <- c(posthoc.res$p.adj, posthoc.res$p.adj ) - pres <- pres[pres$comparisons %in% Dunn_Pres$comparisons ,] # take only the comparisons selected - Dunn_Pres <- merge(Dunn_Pres,pres,by="comparisons") - - tres <- data.frame(comparisons = c(paste(posthoc.res$group1, posthoc.res$group2, sep = "_vs_" ), paste(posthoc.res$group2, posthoc.res$group1, sep = "_vs_" ))) - tres[[colnames(Dunndata)[col] ]] <- c(posthoc.res$statistic, -posthoc.res$statistic ) - tres <- tres[tres$comparisons %in% Dunn_Pres$comparisons ,]# take only the comparisons selected - Dunn_Tres <- merge(Dunn_Tres,tres,by="comparisons") - } - - #Make output DFs: - Dunn_Pres <- tibble::column_to_rownames(Dunn_Pres, "comparisons")%>% t() %>% as.data.frame() - Pval_table <- as.matrix(dplyr::mutate_all(as.data.frame(Dunn_Pres), function(x) as.numeric(as.character(x)))) %>% - as.data.frame()%>% - tibble::rownames_to_column("Metabolite") - - Dunn_Tres <- tibble::column_to_rownames(Dunn_Tres, "comparisons")%>% t() %>% as.data.frame() - Tval_table <- as.matrix(dplyr::mutate_all(as.data.frame(Dunn_Tres), function(x) as.numeric(as.character(x))))%>% - as.data.frame()%>% - tibble::rownames_to_column("Metabolite") - - common_col_names <- setdiff(names(Dunn_Pres), "row.names") - - results_list <- list() - for(col_name in common_col_names){ - # Create a new data frame by merging the two data frames - merged_df <- merge(Pval_table[,c("Metabolite",col_name)], Tval_table[,c("Metabolite",col_name)], by="Metabolite", all=TRUE)%>% - dplyr::rename("p.adj"=2, - "t.val"=3) - # Add the new data frame to the list with the column name as the list element name - results_list[[col_name]] <- merged_df - } - - # Merge the data frames in list1 and list2 based on the "Metabolite" column - if(is.null(Log2FC_table)==FALSE){ - merged_list <- list() - for(name in common_col_names){ - # Check if the data frames exist in both lists - if(name %in% names(results_list) && name %in% names(Log2FC_table)){ - merged_df <- merge(results_list[[name]], Log2FC_table[[name]], by = "Metabolite", all = TRUE) - merged_df <- merged_df[,c(1,4,2:3,5:ncol(merged_df))]#reorder the columns - merged_list[[name]] <- merged_df - } +Kruskal <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + Log2FC_table = NULL, + StatPadj = p.adjust.methods) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## match arguments + StatPadj <- match.arg(StatPadj) + + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, + ## one_vs_all or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { ## EDIT: this is replicated and should be written as a function + + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- unique(conditions) + numerator <- unique(conditions) + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + ## all-vs-one: Generate the pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <- unique(conditions) + + ## Remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE + } + + ############################################################################################# + ## Kruskal test (p.val) + aov.res <- apply(assay(se), 2, function(x) stats::kruskal.test(x ~ conditions)) + anova_res <- do.call("rbind", lapply(aov.res, function(x) x["p.value"])) + anova_res <- as.matrix(dplyr::mutate_all(as.data.frame(anova_res), + function(x) as.numeric(as.character(x)))) + colnames(anova_res) = c("Kruskal_p.val") + + ## Dunn test (p.adj) + Dunndata <- assay(se) %>% + dplyr::mutate(conditions = conditions) %>% + dplyr::select(conditions, everything()) %>% + as.data.frame() + + ## applying a loop to obtain p.adj and t.val: + Dunn_Pres <- data.frame( + comparisons = paste(comparisons[1, ],comparisons[2, ], sep = "_vs_" )) + Dunn_Tres <- Dunn_Pres + + for (col in seq_len(ncol(Dunndata))[-1]) { + data <- Dunndata[, c(1, col)] + colnames(data)[2] <- gsub("^\\d+", "", colnames(data)[2]) + + ## If a metabolite starts with number remove it + formula <- as.formula(paste(colnames(data)[2], "~ conditions")) + posthoc.res= rstatix::dunn_test(data, formula, p.adjust.method = StatPadj) + + pres <- data.frame( + comparisons = c(paste(posthoc.res$group1, posthoc.res$group2, sep = "_vs_" ), + paste(posthoc.res$group2, posthoc.res$group1, sep = "_vs_" ))) + pres[[colnames(Dunndata)[col]]] <- c(posthoc.res$p.adj, posthoc.res$p.adj ) + + ## take only the comparisons selected + pres <- pres[pres$comparisons %in% Dunn_Pres$comparisons, ] + Dunn_Pres <- merge(Dunn_Pres, pres, by="comparisons") + + tres <- data.frame( + comparisons <- c(paste(posthoc.res$group1, posthoc.res$group2, sep = "_vs_" ), + paste(posthoc.res$group2, posthoc.res$group1, sep = "_vs_" ))) + tres[[colnames(Dunndata)[col]]] <- c(posthoc.res$statistic, -posthoc.res$statistic) + + ## take only the comparisons selected + tres <- tres[tres$comparisons %in% Dunn_Pres$comparisons, ] + Dunn_Tres <- merge(Dunn_Tres, tres, by = "comparisons") } - STAT_C1vC2 <- merged_list - }else{ - STAT_C1vC2 <- results_list + + ## Make output DFs: + Dunn_Pres <- tibble::column_to_rownames(Dunn_Pres, "comparisons") %>% + t() %>% + as.data.frame() + Pval_table <- as.matrix(dplyr::mutate_all(as.data.frame(Dunn_Pres), + function(x) as.numeric(as.character(x)))) %>% + as.data.frame()%>% + tibble::rownames_to_column("Metabolite") + + Dunn_Tres <- tibble::column_to_rownames(Dunn_Tres, "comparisons") %>% + t() %>% + as.data.frame() + Tval_table <- as.matrix(dplyr::mutate_all(as.data.frame(Dunn_Tres), + function(x) as.numeric(as.character(x)))) %>% + as.data.frame() %>% + tibble::rownames_to_column("Metabolite") + + common_col_names <- setdiff(names(Dunn_Pres), "row.names") + + results_list <- list() + for (col_name in common_col_names) { + ## create a new data frame by merging the two data frames + merged_df <- merge(Pval_table[,c("Metabolite", col_name)], + Tval_table[,c("Metabolite",col_name)], + by = "Metabolite", all = TRUE) %>% + dplyr::rename("p.adj" = 2, "t.val" = 3) + + ## add the new data frame to the list with the column name as the list + ## element name + results_list[[col_name]] <- merged_df } - return(invisible(STAT_C1vC2)) + ## merge the data frames in list1 and list2 based on the "Metabolite" column ## EDIT: this is replicated and could be written as a funciton + if (!is.null(Log2FC_table)) { + merged_list <- list() + for (name in common_col_names) { + ## check if the data frames exist in both lists + if (name %in% names(results_list) && name %in% names(Log2FC_table)) { + merged_df <- merge(results_list[[name]], Log2FC_table[[name]], + by = "Metabolite", all = TRUE) + ## reorder the columns + merged_df <- merged_df[,c(1, 4, 2:3, 5:ncol(merged_df))] ## EDIT: could be written directly to merged_list[[name]] + merged_list[[name]] <- merged_df + } + } + STAT_C1vC2 <- merged_list + } else { + STAT_C1vC2 <- results_list + } + + ## return + invisible(STAT_C1vC2) } @@ -1135,105 +1302,135 @@ Kruskal <-function(InputData, #' #' @noRd #' -Welch <-function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - Log2FC_table=NULL -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - } - - ############################################################################################################### - ## 1. Welch's ANOVA using oneway.test is not used by the Games post.hoc function - #aov.res= apply(Input_data,2,function(x) oneway.test(x~conditions)) - games_data <- merge(SettingsFile_Sample, InputData, by=0)%>% - dplyr::rename("conditions"=SettingsInfo[["Conditions"]]) - games_data$conditions <- conditions - posthoc.res.list <- list() - - ## 2. Games post hoc test - for (col in names(InputData)){ # col = names(Input_data)[1] - posthoc.res <- rstatix::games_howell_test(data = games_data,detailed =TRUE, formula = as.formula(paste0(`col`, " ~ ", "conditions"))) %>% as.data.frame() - - result.df <- rbind(data.frame(p.adj = posthoc.res[,"p.adj"], - t.val = posthoc.res[,"statistic"], - row.names = paste(posthoc.res[["group1"]], posthoc.res[["group2"]], sep = "-")), - data.frame(p.adj = posthoc.res[,"p.adj"], - t.val = -posthoc.res[,"statistic"], - row.names = paste(posthoc.res[["group2"]], posthoc.res[["group1"]], sep = "-"))) - posthoc.res.list[[col]] <- result.df - } - Games_Pres <- do.call('rbind', lapply(posthoc.res.list, function(x) x[,'p.adj'])) %>% as.data.frame() - colnames(Games_Pres) <- rownames(posthoc.res.list[[1]]) - comps <- paste(comparisons[1, ], comparisons[2, ], sep="-")# normal - Games_Pres <- Games_Pres[,colnames(Games_Pres) %in% comps] %>% tibble::rownames_to_column("Metabolite") - # In case of p.adj =0 we change it to 10^-6 - Games_Pres[Games_Pres ==0] <- 0.000001 - - ## 3. t.val - Games_Tres <- do.call('rbind', lapply(posthoc.res.list, function(x) x[,'t.val'])) %>% as.data.frame() - colnames(Games_Tres) <- rownames(posthoc.res.list[[1]]) - Games_Tres <- Games_Tres[,colnames(Games_Tres) %in% comps] %>% tibble::rownames_to_column("Metabolite") - - results_list <- list() - for(col_name in colnames(Games_Pres)){ - # Create a new data frame by merging the two data frames - merged_df <- merge(Games_Pres[,c("Metabolite",col_name)], Games_Tres[,c("Metabolite",col_name)], by="Metabolite", all=TRUE)%>% - dplyr::rename("p.adj"=2, - "t.val"=3) - - #We need to add _vs_ into the comparison col_name - pattern <- paste(conditions, collapse = "|") - conditions_present <- unique(unlist(regmatches(col_name, gregexpr(pattern, col_name)))) - modified_col_name <- paste(conditions_present[1], "vs", conditions_present[2], sep = "_") - - # Add the new data frame to the list with the column name as the list element name - results_list[[modified_col_name]] <- merged_df - } - - # Merge the data frames in list1 and list2 based on the "Metabolite" column - if(is.null(Log2FC_table)==FALSE){ - list_names <- names(results_list) - - merged_list <- list() - for(name in list_names){ - # Check if the data frames exist in both lists - if(name %in% names(results_list) && name %in% names(Log2FC_table)){ - merged_df <- merge(results_list[[name]], Log2FC_table[[name]], by = "Metabolite", all = TRUE) - merged_df <- merged_df[,c(1,4,2:3,5:ncol(merged_df))]#reorder the columns - merged_list[[name]] <- merged_df - } - } - STAT_C1vC2 <- merged_list - }else{ - STAT_C1vC2 <-STAT_C1vC2 <- results_list - } - - return(invisible(STAT_C1vC2)) +Welch <-function(##InputData, + se, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + Log2FC_table = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, + ## one_vs_all or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { ## EDIT: this is replicated and should be written as a function + + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- unique(conditions) + numerator <- unique(conditions) + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + ## all-vs-one: Generate the pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <-unique(conditions) + + ## Remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## Settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE + } + + ############################################################################ + ## 1. Welch's ANOVA using oneway.test is not used by the Games post.hoc + ## function + #aov.res= apply(Input_data,2,function(x) oneway.test(x~conditions)) + games_data <- merge(colData(se), t(assay(se)), by = 0) %>% + dplyr::rename("conditions" = SettingsInfo[["Conditions"]]) + games_data$conditions <- conditions + posthoc.res.list <- list() + + ## 2. Games post hoc test + for (row in rownames(se)) { # col = names(Input_data)[1] + posthoc.res <- rstatix::games_howell_test(data = games_data, ## EDIT: why use :: ?? if you define those in the NAMESPACE, also applies to other instances in the package + detailed =TRUE, + formula = as.formula(paste0(`row`, " ~ ", "conditions"))) %>% + as.data.frame() + + result.df <- rbind( + data.frame(p.adj = posthoc.res[, "p.adj"], + t.val = posthoc.res[, "statistic"], + row.names = paste(posthoc.res[["group1"]], posthoc.res[["group2"]], sep = "-")), + data.frame(p.adj = posthoc.res[,"p.adj"], + t.val = -posthoc.res[,"statistic"], + row.names = paste(posthoc.res[["group2"]], posthoc.res[["group1"]], sep = "-"))) + posthoc.res.list[[row]] <- result.df + } + + Games_Pres <- do.call("rbind", lapply(posthoc.res.list, + function(x) x[, "p.adj"])) %>% + as.data.frame() + colnames(Games_Pres) <- rownames(posthoc.res.list[[1]]) + comps <- paste(comparisons[1, ], comparisons[2, ], sep = "-")# normal + Games_Pres <- Games_Pres[, colnames(Games_Pres) %in% comps] %>% + tibble::rownames_to_column("Metabolite") + + ## in case of p.adj = 0 we change it to 10^-6 + Games_Pres[Games_Pres == 0] <- 0.000001 + + ## 3. t.val + Games_Tres <- do.call("rbind", + lapply(posthoc.res.list, function(x) x[, "t.val"])) %>% + as.data.frame() + colnames(Games_Tres) <- rownames(posthoc.res.list[[1]]) + Games_Tres <- Games_Tres[, colnames(Games_Tres) %in% comps] %>% + tibble::rownames_to_column("Metabolite") + + results_list <- list() + for (col_name in colnames(Games_Pres)) { + ## create a new data frame by merging the two data frames + merged_df <- merge(Games_Pres[, c("Metabolite", col_name)], + Games_Tres[, c("Metabolite", col_name)], + by = "Metabolite", all = TRUE) %>% + dplyr::rename("p.adj" = 2, "t.val" = 3) + + ## add _vs_ into the comparison col_name + pattern <- paste(conditions, collapse = "|") + conditions_present <- unique( + unlist(regmatches(col_name, gregexpr(pattern, col_name)))) + modified_col_name <- paste(conditions_present[1], "vs", + conditions_present[2], sep = "_") + + ## Add the new data frame to the list with the column name as the list + ##element name + results_list[[modified_col_name]] <- merged_df + } + + ## merge the data frames in list1 and list2 based on the "Metabolite" column ## EDIT: this is replicated and could be written as a funciton + if (!is.null(Log2FC_table)) { + list_names <- names(results_list) + + merged_list <- list() + for (name in list_names) { + ## check if the data frames exist in both lists + if (name %in% names(results_list) && name %in% names(Log2FC_table)) { + merged_df <- merge(results_list[[name]], Log2FC_table[[name]], + by = "Metabolite", all = TRUE) + + ## reorder the columns + merged_df <- merged_df[, c(1, 4, 2:3, 5:ncol(merged_df))] + merged_list[[name]] <- merged_df + } + } + STAT_C1vC2 <- merged_list + } else { + STAT_C1vC2 <- results_list + } + + ## return + invisible(STAT_C1vC2) } @@ -1263,247 +1460,310 @@ Welch <-function(InputData, #' #' @noRd #' -DMA_Stat_limma <- function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - Log2FC_table = NULL, - StatPadj ="fdr", - CoRe=FALSE, - Transform= TRUE){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - MultipleComparison = TRUE - all_vs_all = FALSE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==TRUE){ - MultipleComparison = FALSE - all_vs_all = FALSE - } - - ####------ Ensure that Input_data is ordered by conditions and sample names are the same as in Input_SettingsFile_Sample: - targets <- SettingsFile_Sample%>% - tibble::rownames_to_column("sample") - targets<- targets[,c("sample", SettingsInfo[["Conditions"]])]%>% - dplyr::rename("condition"=2)%>% - dplyr::arrange(sample)#Order the column "sample" alphabetically - targets$condition_limma_compatible <-make.names(targets$condition)#make appropriate condition names accepted by limma - - if(MultipleComparison==FALSE){ - #subset the data: - targets<-targets%>% - subset(condition==SettingsInfo[["Numerator"]] | condition==SettingsInfo[["Denominator"]])%>% - dplyr::arrange(sample)#Order the column "sample" alphabetically - - Limma_input <- InputData%>%tibble::rownames_to_column("sample") - Limma_input <-merge(targets[,1:2], Limma_input, by="sample", all.x=TRUE) - Limma_input <- Limma_input[,-2]%>% - arrange(sample)#Order the column "sample" alphabetically - }else if(MultipleComparison==TRUE){ - Limma_input <- InputData%>%tibble::rownames_to_column("sample")%>% - dplyr::arrange(sample)#Order the column "sample" alphabetically - } - - #Check if the order of the "sample" column is the same in both data frames - if(identical(targets$sample, Limma_input$sample)==FALSE){ - stop("The order of the 'sample' column is different in both data frames. Please make sure that Input_SettingsFile_Sample and Input_data contain the same rownames and sample numbers.") - } - - targets_limma <-targets[,-2]%>% - dplyr::rename("condition"="condition_limma_compatible") - - #We need to transpose the df to run limma. Also, if the data is not log2 transformed, we will not calculate the Log2FC as limma just substracts one condition from the other - Limma_input <- as.data.frame(t(Limma_input%>%tibble::column_to_rownames("sample"))) - - if(Transform==TRUE){ - Limma_input <- log2(Limma_input) # communicate the log2 transformation --> how does limma deals with NA when calculating the change? - } - - #### ------Run limma: - #### Make design matrix: - fcond <- as.factor(targets_limma$condition)#all versus all - - design <- model.matrix(~0 + fcond)# Create the design matrix - colnames(design) <- levels(fcond) # Give meaningful column names to the design matrix - - #### Fit the linear model - fit <- limma::lmFit(Limma_input, design) - - #### Make contrast matrix: - if(all_vs_all ==TRUE & MultipleComparison==TRUE){ - unique_conditions <- levels(fcond)# Get unique conditions - - # Create an empty contrast matrix - num_conditions <- length(unique_conditions) - num_comparisons <- num_conditions * (num_conditions - 1) / 2 - cont.matrix <- matrix(0, nrow = num_comparisons, ncol = num_conditions) - - # Initialize an index for the column in the contrast matrix - i <- 1 - - # Initialize column and row names - colnames(cont.matrix) <- unique_conditions - rownames(cont.matrix) <- character(num_comparisons) - - # Loop through all pairwise combinations of unique conditions - for (condition1 in 1:(num_conditions - 1)) { - for (condition2 in (condition1 + 1):num_conditions) { - # Create the pairwise comparison vector - comparison <- rep(0, num_conditions) - - comparison[condition2] <- -1 - comparison[condition1] <- 1 - # Add the comparison vector to the contrast matrix - cont.matrix[i, ] <- comparison - # Set row name - rownames(cont.matrix)[i] <- paste(unique_conditions[condition1], "_vs_", unique_conditions[condition2], sep="") - i <- i + 1 - } +DMA_Stat_limma <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + Log2FC_table = NULL, + StatPadj = p.adjust.methods, + CoRe = FALSE, + Transform = TRUE){ + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + StatPadj <- match.arg(StatPadj) + + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, one_vs_all + ## or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { ## EDIT: can be simplified, define MultiComarison = TRUE and only when '"Denominator" %in% names(SettingsInfo)' adjust the values + MultipleComparison = TRUE + all_vs_all = TRUE + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + MultipleComparison = TRUE + all_vs_all = FALSE + } else if ("Denominator" %in% names(SettingsInfo) & "Numerator" %in% names(SettingsInfo)) { + MultipleComparison = FALSE + all_vs_all = FALSE + } + + ## ensure that Input_data is ordered by conditions and sample names are + ## the same as in Input_SettingsFile_Sample: + targets <- colData(se) |> + as.data.frame() |> + tibble::rownames_to_column("sample") + targets <- targets[, c("sample", SettingsInfo[["Conditions"]])] %>% + dplyr::rename("condition" = 2) |># %>% + ### order the column "sample" alphabetically + #dplyr::arrange(sample) + ## make appropriate condition names accepted by limma + mutate(condition_limma_compatible = make.names(condition)) + + ## create Limma_input + Limma_input <- assay(se) %>% + t() |> + as.data.frame() |> + tibble::rownames_to_column("sample") + + ## update Limma_input if MultipleComparison == FALSE + if (!MultipleComparison) { + ## subset the data: + targets <- targets %>% + subset(condition == SettingsInfo[["Numerator"]] | condition == SettingsInfo[["Denominator"]]) #%>% + ## order the column "sample" alphabetically ## EDIT: is this actually needed after the arrange(smaple) step above? + #dplyr::arrange(sample) + + #Limma_input <- assay(se) %>% + # tibble::rownames_to_column("sample") + Limma_input <- merge(targets[, 1:2], Limma_input, + by = "sample", all.x = TRUE) ## EDIT: more robust to use column names instead of column indices + Limma_input <- Limma_input[, -2] %>% + ## Order the column "sample" alphabetically + arrange(sample) + }# else if (MultipleComparison) { ## EDIT: the other if statement is not needed, only else + # Limma_input <- assay(se) %>% + # t() |> + # as.data.frame() |> + # tibble::rownames_to_column("sample") %>% + # dplyr::arrange(sample)#Order the column "sample" alphabetically + #} + + ## check if the order of the "sample" column is the same in both data frames + #if (!identical(targets$sample, Limma_input$sample)) { + # stop("The order of the 'sample' column is different in both data frames. Please make sure that Input_SettingsFile_Sample and Input_data contain the same rownames and sample numbers.") + #} + + targets_limma <- targets |> + dplyr::select(-c("condition")) %>% + dplyr::rename("condition" = "condition_limma_compatible") + + ## we need to transpose the df to run limma. Also, if the data is not + ## log2 transformed, we will not calculate the Log2FC as limma just + ## substracts one condition from the other + Limma_input <- tibble::column_to_rownames(Limma_input, "sample") |> + t() |> + as.data.frame() + + if (Transform) { + ## communicate the log2 transformation --> how does limma deals with NA when calculating the change? + Limma_input <- log2(Limma_input) + } + + #### ------Run limma: + #### Make design matrix: + ## all versus all + fcond <- as.factor(targets_limma$condition) + + ## create the design matrix + design <- model.matrix(~ 0 + fcond) + ## give meaningful column names to the design matrix + colnames(design) <- levels(fcond) + + ## fit the linear model + fit <- limma::lmFit(Limma_input, design) + + ## make contrast matrix: + if (all_vs_all & MultipleComparison) { + ## get unique conditions + unique_conditions <- levels(fcond) + + ## create an empty contrast matrix + num_conditions <- length(unique_conditions) + num_comparisons <- num_conditions * (num_conditions - 1) / 2 + cont.matrix <- matrix(0, nrow = num_comparisons, ncol = num_conditions) + + ## initialize an index for the column in the contrast matrix + i <- 1 + + ## initialize column and row names + colnames(cont.matrix) <- unique_conditions + rownames(cont.matrix) <- character(num_comparisons) + + ## Loop through all pairwise combinations of unique conditions + for (condition1 in seq_len(num_conditions - 1)) { + for (condition2 in (condition1 + 1):num_conditions) { + + ## create the pairwise comparison vector + comparison <- rep(0, num_conditions) + + comparison[condition2] <- -1 + comparison[condition1] <- 1 + ## add the comparison vector to the contrast matrix + cont.matrix[i, ] <- comparison + ## set row name + rownames(cont.matrix)[i] <- paste(unique_conditions[condition1], + "_vs_", unique_conditions[condition2], sep = "") + i <- i + 1 + } + } + cont.matrix <- t(cont.matrix) + } else if (!all_vs_all & MultipleComparison) { + ## get unique conditions + unique_conditions <- levels(fcond) + denominator <- make.names(SettingsInfo[["Denominator"]]) + + ## create an empty contrast matrix + num_conditions <- length(unique_conditions) + num_comparisons <- num_conditions - 1 + cont.matrix <- matrix(0, nrow = num_comparisons, ncol = num_conditions) + + ## initialize an index for the column in the contrast matrix + i <- 1 + + ## initialize column and row names + colnames(cont.matrix) <- unique_conditions + rownames(cont.matrix) <- character(num_comparisons) + + ## loop through all pairwise combinations of unique conditions + for(condition in seq_len(num_conditions)[-1]) { + + ## create the pairwise comparison vector + comparison <- rep(0, num_conditions) + + if (unique_conditions[1] == make.names(SettingsInfo[["Denominator"]])) { + comparison[1] <- -1 + comparison[condition] <- 1 + + ## add the comparison vector to the contrast matrix + cont.matrix[i, ] <- comparison + + ## set row name + rownames(cont.matrix)[i] <- paste(unique_conditions[condition], + "_vs_", unique_conditions[1], sep = "") + } else { + + comparison[1] <- 1 + comparison[condition] <- -1 + + ## add the comparison vector to the contrast matrix + cont.matrix[i, ] <- comparison + + ## set row name + rownames(cont.matrix)[i] <- paste(unique_conditions[1], + "_vs_", unique_conditions[condition], sep = "") + + } + i <- i + 1 + } + + cont.matrix <- t(cont.matrix) + } else if (!all_vs_all & !MultipleComparison) { + + Name_Comp <- paste(make.names(SettingsInfo[["Numerator"]]), "-", make.names(SettingsInfo[["Denominator"]]), sep = "") + cont.matrix <- as.data.frame( + limma::makeContrasts(contrasts = Name_Comp, levels = colnames(design))) %>% + dplyr::rename(!!paste(make.names(SettingsInfo[["Numerator"]]), + "_vs_", make.names(SettingsInfo[["Denominator"]]), sep = "") := 1) + cont.matrix <- as.matrix(cont.matrix) + } + + ## fit the linear model with contrasts + fit2 <- limma::contrasts.fit(fit, cont.matrix) + + ## Perform empirical Bayes moderation + fit2 <- limma::eBayes(fit2) + + #### ------Extract results: + ## get all contrast names + contrast_names <- colnames(fit2$coefficients) + + ## create an empty list to store results data frames + results_list <- list() + for (contrast_name in contrast_names) { + ## extract results for the current contrast + res.t <- limma::topTable(fit2, coef = contrast_name, n = Inf, ## EDIT: . should be avoided in object names, better use _ instead + sort.by = "n", adjust.method = StatPadj) %>% # coef= the comparison the test is done for! + dplyr::rename("Log2FC" = 1, "t.val" = 3, "p.val" = 4, "p.adj" = 5) + + res.t <- res.t %>% + tibble::rownames_to_column("Metabolite") + + ## store the data frame in the results list, named after the contrast + results_list[[contrast_name]] <- res.t } - cont.matrix<- t(cont.matrix) - }else if(all_vs_all ==FALSE & MultipleComparison==TRUE){ - unique_conditions <- levels(fcond)# Get unique conditions - denominator <- make.names(SettingsInfo[["Denominator"]]) - - # Create an empty contrast matrix - num_conditions <- length(unique_conditions) - num_comparisons <- num_conditions - 1 - cont.matrix <- matrix(0, nrow = num_comparisons, ncol = num_conditions) - - - # Initialize an index for the column in the contrast matrix - i <- 1 - - # Initialize column and row names - colnames(cont.matrix) <- unique_conditions - rownames(cont.matrix) <- character(num_comparisons) - - # Loop through all pairwise combinations of unique conditions - for(condition in 2:num_conditions){ - # Create the pairwise comparison vector - comparison <- rep(0, num_conditions) - if(unique_conditions[1]== make.names(SettingsInfo[["Denominator"]])){ - comparison[1] <- -1 - comparison[condition] <- 1 - # Add the comparison vector to the contrast matrix - cont.matrix[i, ] <- comparison - # Set row name - rownames(cont.matrix)[i] <- paste(unique_conditions[condition], "_vs_", unique_conditions[1], sep = "") - }else{ - comparison[1] <- 1 - comparison[condition] <- -1 - # Add the comparison vector to the contrast matrix - cont.matrix[i, ] <- comparison - # Set row name - rownames(cont.matrix)[i] <- paste(unique_conditions[1], "_vs_", unique_conditions[condition], sep = "") - - } - i <- i + 1 + + ## make the name_match_df + name_match_df <- as.data.frame(names(results_list)) %>% + tidyr::separate("names(results_list)", into = c("a", "b"), + sep = "_vs_", remove = FALSE) + + name_match_df <- merge(name_match_df, targets[, -c(1)] , by.x = "a", + by.y = "condition_limma_compatible", all.x = TRUE) %>% + dplyr::rename("Condition1" = 4) + name_match_df <- merge(name_match_df, targets[, -c(1)] , by.x = "b", ## EDIT: why assign here again to name_match_df and not do everything in one go + by.y = "condition_limma_compatible", all.x = TRUE) %>% + dplyr::rename("Condition2" = 5) %>% + tidyr::unite("New", "Condition1", "Condition2", sep = "_vs_", + remove = FALSE) + + name_match_df<- name_match_df[, c(3,4)] %>% + dplyr::distinct(New, .keep_all = TRUE) + + results_list_new <- list() + + ## match the lists using name_match_df + for (i in seq_len(nrow(name_match_df))) { + old_name <- name_match_df$`names(results_list)`[i] + new_name <- name_match_df$New[i] + results_list_new[[new_name]] <- results_list[[old_name]] } - cont.matrix<- t(cont.matrix) - }else if(all_vs_all ==FALSE & MultipleComparison==FALSE){ - Name_Comp <- paste(make.names(SettingsInfo[["Numerator"]]), "-", make.names(SettingsInfo[["Denominator"]]), sep="") - cont.matrix <- as.data.frame(limma::makeContrasts(contrasts=Name_Comp, levels=colnames(design)))%>% - dplyr::rename(!!paste(make.names(SettingsInfo[["Numerator"]]), "_vs_", make.names(SettingsInfo[["Denominator"]]), sep="") := 1) - cont.matrix <-as.matrix(cont.matrix) - } - - # Fit the linear model with contrasts - #fit2 <- limma::contrasts.fit(fit, cont.matrix) - fit2 <- limma::contrasts.fit(fit, cont.matrix) - fit2 <- limma::eBayes(fit2)# Perform empirical Bayes moderation - - #### ------Extract results: - contrast_names <- colnames(fit2$coefficients) # Get all contrast names - - results_list <- list()# Create an empty list to store results data frames - for (contrast_name in contrast_names) { - # Extract results for the current contrast - res.t <- limma::topTable(fit2, coef=contrast_name, n=Inf, sort.by="n", adjust.method = StatPadj)%>% # coef= the comparison the test is done for! - dplyr::rename("Log2FC"=1, - "t.val"=3, - "p.val"=4, - "p.adj"=5) - - res.t <- res.t%>% - tibble::rownames_to_column("Metabolite") - - # Store the data frame in the results list, named after the contrast - results_list[[contrast_name]] <- res.t - } - - #Make the name_match_df - name_match_df <- as.data.frame(names(results_list))%>% - tidyr::separate("names(results_list)", into=c("a", "b"), sep="_vs_", remove=FALSE) - - name_match_df <-merge(name_match_df, targets[,-c(1)] , by.x="a", by.y="condition_limma_compatible", all.x=TRUE)%>% - dplyr::rename("Condition1"=4) - name_match_df <- merge(name_match_df, targets[,-c(1)] , by.x="b", by.y="condition_limma_compatible", all.x=TRUE)%>% - dplyr::rename("Condition2"=5)%>% - tidyr::unite("New", "Condition1", "Condition2", sep="_vs_", remove=FALSE) - - name_match_df<- name_match_df[,c(3,4)]%>% - dplyr::distinct(New, .keep_all = TRUE) - - results_list_new <- list() - #Match the lists using name_match_df - for(i in 1:nrow(name_match_df)){ - old_name <- name_match_df$`names(results_list)`[i] - new_name <- name_match_df$New[i] - results_list_new[[new_name]] <- results_list[[old_name]] + + if (!is.null(Log2FC_table)) { + if (CoRe) { + ##If CoRe=TRUE, we need to exchange the Log2FC with the Distance + ## and we need to combine the lists + ## Merge the data frames in list1 and list2 based on the + ## "Metabolite" column + merged_list <- list() + for (i in seq_len(nrow(name_match_df))) { + list_dfs <- name_match_df$New[i] + + ## Check if the data frames exist in both lists + if (list_dfs %in% names(results_list_new) && list_dfs %in% names(Log2FC_table)) { + merged_df <- merge(results_list_new[[list_dfs]], + Log2FC_table[[list_dfs]], by = "Metabolite", all = TRUE) + merged_list[[list_dfs]] <- merged_df + } + } + STAT_C1vC2 <- merged_list + } else { + STAT_C1vC2 <- results_list_new + } } - if(is.null(Log2FC_table)==FALSE){ - if(CoRe==TRUE){#If CoRe=TRUE, we need to exchange the Log2FC with the Distance and we need to combine the lists - # Merge the data frames in list1 and list2 based on the "Metabolite" column - merged_list <- list() - for(i in 1:nrow(name_match_df)){ - list_dfs <- name_match_df$New[i] - - # Check if the data frames exist in both lists - if(list_dfs %in% names(results_list_new) && list_dfs %in% names(Log2FC_table)){ - merged_df <- merge(results_list_new[[list_dfs]], Log2FC_table[[list_dfs]], by = "Metabolite", all = TRUE) - merged_list[[list_dfs]] <- merged_df + ## add input data + Cond <- colData(se) |> + as.data.frame() |> + tibble::rownames_to_column("Code") + + limma_return <- merge(Cond[, c("Code", SettingsInfo[["Conditions"]])], + as.data.frame(t(Limma_input)), by.x = "Code", by.y = 0, all.y = TRUE) + + for (DFs in names(STAT_C1vC2)) { + + parts <- unlist(strsplit(DFs, "_vs_")) + C1 <- parts[1] + C2 <- parts[2] + limma_return_filt <- limma_return %>% + dplyr::filter(get(SettingsInfo[["Conditions"]]) == C1 | get(SettingsInfo[["Conditions"]]) == C2) %>% + tibble::column_to_rownames("Code") + limma_return_filt <- as.data.frame(t(limma_return_filt[, -c(1)])) + + if (Transform) { + ## add prefix & suffix to each column since the data have been + ## log2 transformed! + colnames(limma_return_filt) <- paste0("log2(", + colnames(limma_return_filt), ")") } - } - STAT_C1vC2 <- merged_list - }else{ - STAT_C1vC2 <- results_list_new - } - } - - #Add input data - Cond <- SettingsFile_Sample%>% - tibble::rownames_to_column("Code") - - InputReturn <- merge(Cond[,c("Code",SettingsInfo[["Conditions"]])], as.data.frame(t(Limma_input)),by.x="Code", by.y=0, all.y=TRUE) - - for(DFs in names(STAT_C1vC2)){ - parts <- unlist(strsplit(DFs, "_vs_")) - C1 <- parts[1] - C2 <- parts[2] - InputReturn_Filt <- InputReturn%>% - dplyr::filter(get(SettingsInfo[["Conditions"]])==C1 | get(SettingsInfo[["Conditions"]])==C2)%>% - tibble::column_to_rownames("Code") - InputReturn_Filt <-as.data.frame(t(InputReturn_Filt[,-c(1)])) - - if(Transform==TRUE){#Add prefix & suffix to each column since the data have been log2 transformed! - colnames(InputReturn_Filt) <- paste0("log2(", colnames(InputReturn_Filt), ")") - } - - InputReturn_Merge <- merge(STAT_C1vC2[[DFs]], InputReturn_Filt, by.x="Metabolite", by.y=0, all.x=TRUE) - - STAT_C1vC2[[DFs]] <- InputReturn_Merge - } - - #return - return(invisible(STAT_C1vC2)) + + limma_return_merge <- merge(STAT_C1vC2[[DFs]], limma_return_filt, + by.x = "Metabolite", by.y = 0, all.x = TRUE) + + STAT_C1vC2[[DFs]] <- limma_return_merge + } + + ## return + invisible(STAT_C1vC2) } @@ -1531,225 +1791,299 @@ DMA_Stat_limma <- function(InputData, #' #' @noRd #' -Shapiro <-function(InputData, - SettingsFile_Sample, - SettingsInfo=c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - StatPval= "t-test", - QQplots=TRUE -){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------- Checks --------------## - if(grepl("[[:space:]()-./\\\\]", SettingsInfo[["Conditions"]])==TRUE){ - message("In SettingsInfo=c(Conditions= ColumnName): ColumnName contains special charaters, hence this is renamed.") - ColumnNameCondition_clean <- gsub("[[:space:]()-./\\\\]", "_", SettingsInfo[["Conditions"]]) - SettingsFile_Sample <- SettingsFile_Sample%>% - dplyr::rename(!!paste(ColumnNameCondition_clean):= SettingsInfo[["Conditions"]]) - - SettingsInfo[["Conditions"]] <- ColumnNameCondition_clean - } - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==TRUE){ - # one-vs-one: Generate the comparisons - denominator <- SettingsInfo[["Denominator"]] - numerator <- SettingsInfo[["Numerator"]] - comparisons <- matrix(c(SettingsInfo[["Denominator"]], SettingsInfo[["Numerator"]])) - #Settings: - MultipleComparison = FALSE - all_vs_all = FALSE - } - - ################################################################################################################################################################################################ - ## ------------ Check data normality and statistical test chosen and generate Output DF----------- ## - # Before Hypothesis testing, we have to decide whether to use a parametric or a non parametric test. We can test the data normality using the Shapiro test. - ##-------- First: Load the data and perform the shapiro.test on each metabolite across the samples of one condition. this needs to be repeated for each condition: - #Prepare the input: - Input_shaptest <- replace(InputData, is.na(InputData), 0)%>% #Shapiro test can not handle NAs! - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% numerator | SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% denominator)%>% - dplyr::select_if(is.numeric) - temp<- sapply(Input_shaptest, function(x, na.rm = TRUE) var(x)) == 0# we have to remove features with zero variance if there are any. - temp <- temp[complete.cases(temp)] # Remove NAs from temp - columns_with_zero_variance <- names(temp[temp])# Extract column names where temp is TRUE - - if(length(Input_shaptest)==1){#handle a specific case where after filtering and selecting numeric variables, there's only one column left in Input_shaptest - Input_shaptest <-InputData - }else{ - if(length(columns_with_zero_variance)==0){ - Input_shaptest <-Input_shaptest - }else{ - message("The following features have zero variance and are removed prior to performing the shaprio test: ",columns_with_zero_variance) - Input_shaptest <- Input_shaptest[,!(names(Input_shaptest) %in% columns_with_zero_variance), drop = FALSE]#drop = FALSE argument is used to ensure that the subset operation doesn't simplify the result to a vector, preserving the data frame structure +Shapiro <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + StatPval = "t-test", ## EDIT: the options should be outlined here and match.arg should be used to improve robustness + QQplots = TRUE) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------- Checks --------------## + if (grepl("[[:space:]()-./\\\\]", SettingsInfo[["Conditions"]])) { ## EDIT: for such complex regex a comment should be added + message("In SettingsInfo=c(Conditions= ColumnName): ColumnName contains special charaters, hence this is renamed.") + ColumnNameCondition_clean <- gsub("[[:space:]()-./\\\\]", "_", SettingsInfo[["Conditions"]]) + SettingsFile_Sample <- SettingsFile_Sample %>% + dplyr::rename(!!paste(ColumnNameCondition_clean) := SettingsInfo[["Conditions"]]) + SettingsInfo[["Conditions"]] <- ColumnNameCondition_clean } - } - - Input_shaptest_Cond <-merge(data.frame(Conditions = SettingsFile_Sample[, SettingsInfo[["Conditions"]], drop = FALSE]), Input_shaptest, by=0, all.y=TRUE) - - UniqueConditions <- SettingsFile_Sample%>% - subset(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% numerator | SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% denominator, select = c(SettingsInfo[["Conditions"]])) - UniqueConditions <- unique(UniqueConditions[[SettingsInfo[["Conditions"]]]]) - - #Generate the results - shapiro_results <- list() - for (i in UniqueConditions) { - # Subset the data for the current condition - subset_data <- Input_shaptest_Cond%>% - tibble::column_to_rownames("Row.names")%>% - subset(get(SettingsInfo[["Conditions"]]) == i, select = -c(1)) - - #Check the sample size (shapiro.test(x) : sample size must be between 3 and 5000): - if(nrow(subset_data)<3){ - warning("shapiro.test(x) : sample size must be between 3 and 5000. You have provided <3 Samples for condition ", i, ". Hence Shaprio test can not be performed for this condition.", sep="") - }else if(nrow(subset_data)>5000){ - warning("shapiro.test(x) : sample size must be between 3 and 5000. You have provided >5000 Samples for condition ", i, ". Hence Shaprio test will not be performed for this condition.", sep="") - }else{ - # Apply Shapiro-Wilk test to each feature in the subset - shapiro_results[[i]] <- as.data.frame(sapply(subset_data, function(x) stats::shapiro.test(x))) - } - } - - if(nrow(subset_data)>=3 & nrow(subset_data)<=5000){ - #Make the output DF - DF_shapiro_results <- as.data.frame(matrix(NA, nrow = length(UniqueConditions), ncol = ncol(Input_shaptest))) - rownames(DF_shapiro_results) <- UniqueConditions - colnames(DF_shapiro_results) <- colnames(Input_shaptest) - for(k in 1:length(UniqueConditions)){ - for(l in 1:ncol(Input_shaptest)){ - DF_shapiro_results[k, l] <- shapiro_results[[UniqueConditions[k]]][[l]]$p.value - } - } - colnames(DF_shapiro_results) <- paste("Shapiro p.val(", colnames(DF_shapiro_results),")", sep = "") - ##------ Second: Give feedback to the user if the chosen test fits the data distribution. The data are normal if the p-value of the shapiro.test > 0.05. - Density_plots <- list() - if(QQplots==TRUE){ - QQ_plots <- list() + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. + if (!"Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { ## EDIT: this is replicated across several functions and should be written as fct + + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- unique(conditions) + numerator <- unique(conditions) + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + } else if ("Denominator" %in% names(SettingsInfo) & !"Numerator" %in% names(SettingsInfo)) { + + ## all-vs-one: Generate the pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <- unique(conditions) + + ## remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE + } else if ("Denominator" %in% names(SettingsInfo) & "Numerator" %in% names(SettingsInfo)) { + + ## one-vs-one: Generate the comparisons + denominator <- SettingsInfo[["Denominator"]] + numerator <- SettingsInfo[["Numerator"]] + comparisons <- matrix(c(SettingsInfo[["Denominator"]], SettingsInfo[["Numerator"]])) + + ## Settings: + MultipleComparison <- FALSE + all_vs_all <- FALSE } - for(x in 1:nrow(DF_shapiro_results)){ - #### Generate Results Table - transpose <- as.data.frame(t(DF_shapiro_results[x,])) - Norm <- format((round(sum(transpose[[1]] > 0.05)/nrow(transpose),4))*100, nsmall = 2) # Percentage of normally distributed metabolites across samples - NotNorm <- format((round(sum(transpose[[1]] < 0.05)/nrow(transpose),4))*100, nsmall = 2) # Percentage of not-normally distributed metabolites across samples - if(StatPval =="kruskal.test" | StatPval =="wilcox.test"){ - message("For the condition ", colnames(transpose) ," ", Norm, " % of the metabolites follow a normal distribution and ", NotNorm, " % of the metabolites are not-normally distributed according to the shapiro test. You have chosen ",paste(StatPval), ", which is for non parametric Hypothesis testing. `shapiro.test` ignores missing values in the calculation.") - }else{ - message("For the condition ", colnames(transpose) ," ", Norm, " % of the metabolites follow a normal distribution and ", NotNorm, " % of the metabolites are not-normally distributed according to the shapiro test. You have chosen ",paste(StatPval), ", which is for parametric Hypothesis testing. `shapiro.test` ignores missing values in the calculation.") - } - - # Assign the calculated values to the corresponding rows in result_df - DF_shapiro_results$`Metabolites with normal distribution [%]`[x] <- Norm - DF_shapiro_results$`Metabolites with not-normal distribution [%]`[x] <- NotNorm - - #Reorder the DF: - all_columns <- colnames(DF_shapiro_results) - include_columns <- c("Metabolites with normal distribution [%]", "Metabolites with not-normal distribution [%]") - exclude_columns <- setdiff(all_columns, include_columns) - DF_shapiro_results <- DF_shapiro_results[, c(include_columns, exclude_columns)] - - #### Make Group wise data distribution plot and QQ plots - subset_data <- Input_shaptest_Cond%>% - tibble::column_to_rownames("Row.names")%>% - subset(get(SettingsInfo[["Conditions"]]) == colnames(transpose), select = -c(1)) - all_data <- unlist(subset_data) - - plot <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + - ggplot2::geom_histogram(ggplot2::aes(y=after_stat(density)), binwidth=.5, colour="black", fill="white") + - ggplot2::geom_density(alpha = 0.2, fill = "grey45") - - density_values <- ggplot2::ggplot_build(plot)$data[[2]] - - plot <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + - ggplot2::geom_histogram( ggplot2::aes(y=after_stat(density)), binwidth=.5, colour="black", fill="white") + - ggplot2::geom_density(alpha=.2, fill="grey45") + - ggplot2::scale_x_continuous(limits = c(0, density_values$x[max(which(density_values$scaled >= 0.1))])) - - density_values2 <- ggplot2::ggplot_build(plot)$data[[2]] - - suppressWarnings(sampleDist <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + - ggplot2::geom_histogram(aes(y=after_stat(density)), binwidth=.5, colour="black", fill="white") + - ggplot2::geom_density(alpha=.2, fill="grey45") + - ggplot2::scale_x_continuous(limits = c(0, density_values$x[max(which(density_values$scaled >= 0.1))])) + - ggplot2::theme_minimal()+ - ggplot2::labs(title=paste("Data distribution ", colnames(transpose)), subtitle = paste(NotNorm, " of metabolites not normally distributed based on Shapiro test"),x="Abundance", y = "Density") - ) - - Density_plots[[paste(colnames(transpose))]] <- sampleDist - - # QQ plots - if(QQplots==TRUE){ - # Make folders - conds <- unique(c(numerator, denominator)) - - #QQ plots for each groups for each metabolite for normality visual check - qq_plot_list <- list() - for (col_name in colnames(subset_data)){ - qq_plot <- ggplot2::ggplot(data.frame(x = subset_data[[col_name]]), aes(sample = x)) + - ggplot2::geom_qq() + - ggplot2::geom_qq_line(color = "red") + - ggplot2::labs(title = paste("QQPlot for", col_name),x = "Theoretical", y="Sample")+ theme_minimal() - - plot.new() - plot(qq_plot) - qq_plot_list[[col_name]] <- recordPlot() - - col_name2 <- (gsub("/","_",col_name))#remove "/" cause this can not be safed in a PDF name - col_name2 <- gsub("-", "", col_name2) - col_name2 <- gsub("/", "", col_name2) - col_name2 <- gsub(" ", "", col_name2) - col_name2 <- gsub("\\*", "", col_name2) - col_name2 <- gsub("\\+", "", col_name2) - col_name2 <- gsub(",", "", col_name2) - col_name2 <- gsub("\\(", "", col_name2) - col_name2 <- gsub("\\)", "", col_name2) - - dev.off() - } - QQ_plots[[paste(colnames(transpose))]] <- qq_plot_list - } + ############################################################################ + ## Check data normality and statistical test chosen and generate Output DF + ## Before Hypothesis testing, we have to decide whether to use a + ## parametric or a non parametric test. We can test the data normality + ## using the Shapiro test. + ## First: Load the data and perform the shapiro.test on each metabolite + ## across the samples of one condition. this needs to be repeated for + ## each condition: + ## prepare the input (Shapiro test can not handle NAs): + cols <- colData(se)[[SettingsInfo[["Conditions"]]]] %in% numerator | + colData(se)[[SettingsInfo[["Conditions"]]]] %in% denominator + se_shaptest <- se[, cols] + assay(se_shaptest)[is.na(assay(se_shaptest))] <- 0 + + ## we have to remove features with zero variance if there are any. + ##temp <- sapply(Input_shaptest, function(x, na.rm = TRUE) var(x)) == 0 + rows <- apply(assay(se_shaptest), MARGIN = 1, function(row) var(row, na.rm = TRUE)) != 0 ## EDIT: is this easier? + se_shaptest <- se_shaptest[rows, ] + + ## remove NAs from temp + ##temp <- temp[complete.cases(temp)] + + ## extract column names where temp is TRUE + ##columns_with_zero_variance <- names(temp[temp]) + + #handle a specific case where after filtering and selecting numeric + ## variables, there's only one column left in Input_shaptest + if (nrow(se_shaptest) == 1) { + se_shaptest <- se + } else { + if (!any(rows)) { + message( + "The following features have zero variance and are removed prior to performing the shapiro test: ", + names(rows[!rows])) + } } - ###################################### - ##-------- Return - #Here we make a list - if(QQplots==TRUE){ - Shapiro_output_list <- list("DF" = list("Shapiro_result"=DF_shapiro_results%>%tibble::rownames_to_column("Code")),"Plot"=list( "Distributions"=Density_plots, "QQ_plots" = QQ_plots)) - }else{ - Shapiro_output_list <- list("DF" = list("Shapiro_result"=DF_shapiro_results%>%tibble::rownames_to_column("Code")),"Plot"=list( "Distributions"=Density_plots)) + #Input_shaptest_Cond <- merge( + # data.frame(Conditions = SettingsFile_Sample[, SettingsInfo[["Conditions"]], drop = FALSE]), + # Input_shaptest, by = 0, all.y = TRUE) + + UniqueConditions <- colData(se_shaptest)[, SettingsInfo[["Conditions"]]] |> + unique() + #UniqueConditions <- SettingsFile_Sample %>% + # subset(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% numerator | SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% denominator, select = c(SettingsInfo[["Conditions"]])) + #UniqueConditions <- unique(UniqueConditions[[SettingsInfo[["Conditions"]]]]) + + ## Generate the results + shapiro_results <- list() + for (i in UniqueConditions) { + ## Subset the data for the current condition + cols_i <- colData(se_shaptest)[, SettingsInfo[["Conditions"]]] == i + subset_data <- assay(se_shaptest)[, cols_i] |> + t() |> + as.data.frame() + + #Input_shaptest_Cond %>% + # tibble::column_to_rownames("Row.names") %>% + # subset(get(SettingsInfo[["Conditions"]]) == i, select = -c(1)) + + ## check the sample size (shapiro.test(x) : sample size must be + ## between 3 and 5000): + if (nrow(subset_data) < 3) { + warning("shapiro.test(x) : sample size must be between 3 and 5000. You have provided <3 Samples for condition ", + i, + ". Hence Shaprio test can not be performed for this condition.", + sep = "") + } else if (nrow(subset_data) > 5000) { + warning("shapiro.test(x) : sample size must be between 3 and 5000. You have provided >5000 Samples for condition ", + i, + ". Hence Shaprio test will not be performed for this condition.", + sep = "") + } else { + ## apply Shapiro-Wilk test to each feature in the subset + shapiro_results[[i]] <- as.data.frame( + sapply(subset_data, function(x) stats::shapiro.test(x))) + } } - suppressWarnings(invisible(return(Shapiro_output_list))) - } -} + if (nrow(subset_data) >= 3 & nrow(subset_data) <= 5000) { + ## make the output DF + DF_shapiro_results <- as.data.frame( + matrix(NA, nrow = length(UniqueConditions), ncol = nrow(se_shaptest))) + rownames(DF_shapiro_results) <- UniqueConditions + colnames(DF_shapiro_results) <- rownames(se_shaptest) + for (k in seq_along(UniqueConditions)) { + for (l in seq_len(ncol(se_shaptest))) { + DF_shapiro_results[k, l] <- shapiro_results[[UniqueConditions[k]]][[l]]$p.value + } + } + colnames(DF_shapiro_results) <- paste("Shapiro p.val(", + colnames(DF_shapiro_results), ")", sep = "") + + ## Second: Give feedback to the user if the chosen test fits the + ## data distribution. The data are normal if the p-value of the + ## shapiro.test > 0.05. + Density_plots <- list() + if (QQplots) { + QQ_plots <- list() + } + for (x in seq_len(nrow(DF_shapiro_results))) { + + ## Generate Results Table + transpose <- as.data.frame(t(DF_shapiro_results[x, ])) + ## calculate percentage of normally distributed metabolites + ## across samples + Norm <- format( + round(sum(transpose[[1]] > 0.05) / nrow(transpose), 4) * 100, + nsmall = 2) + ## calculate percentage of not-normally distributed metabolites across samples + NotNorm <- format( + round(sum(transpose[[1]] < 0.05) / nrow(transpose), 4) * 100, + nsmall = 2) + + if (StatPval == "kruskal.test" | StatPval == "wilcox.test") { + message("For the condition ", colnames(transpose) ," ", Norm, + " % of the metabolites follow a normal distribution and ", + NotNorm, + " % of the metabolites are not-normally distributed according to the shapiro test. You have chosen ", + paste(StatPval), + ", which is for non parametric Hypothesis testing. `shapiro.test` ignores missing values in the calculation.") + } else { + message("For the condition ", colnames(transpose) ," ", Norm, + " % of the metabolites follow a normal distribution and ", + NotNorm, + " % of the metabolites are not-normally distributed according to the shapiro test. You have chosen ", + paste(StatPval), + ", which is for parametric Hypothesis testing. `shapiro.test` ignores missing values in the calculation.") + } + + ## assign the calculated values to the corresponding rows in result_df + DF_shapiro_results$`Metabolites with normal distribution [%]`[x] <- Norm + DF_shapiro_results$`Metabolites with not-normal distribution [%]`[x] <- NotNorm + + ## reorder the DF: + all_columns <- colnames(DF_shapiro_results) + include_columns <- c("Metabolites with normal distribution [%]", "Metabolites with not-normal distribution [%]") + exclude_columns <- setdiff(all_columns, include_columns) + DF_shapiro_results <- DF_shapiro_results[, c(include_columns, exclude_columns)] + + ## make Group wise data distribution plot and QQ plots + cols <- colData(se_shaptest)[, SettingsInfo[["Conditions"]]] == colnames(transpose) + subset_data <- assay(se_shaptest)[, cols] + #subset_data <- %>% + # tibble::column_to_rownames("Row.names") %>% + # subset(get(SettingsInfo[["Conditions"]]) == colnames(transpose), + # select = -c(1)) + all_data <- unlist(subset_data) + + plot <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + + ggplot2::geom_histogram(ggplot2::aes(y = after_stat(density)), + binwidth = .5, colour = "black", fill = "white") + + ggplot2::geom_density(alpha = 0.2, fill = "grey45") + + density_values <- ggplot2::ggplot_build(plot)$data[[2]] + + plot <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + ## EDIT: why replot, what about plot + scale_x_continous(...) + ggplot2::geom_histogram(ggplot2::aes(y = after_stat(density)), + binwidth = .5, colour = "black", fill = "white") + + ggplot2::geom_density(alpha = .2, fill = "grey45") + + ggplot2::scale_x_continuous(limits = c(0, density_values$x[max(which(density_values$scaled >= 0.1))])) + + density_values2 <- ggplot2::ggplot_build(plot)$data[[2]] + + suppressWarnings( + sampleDist <- ggplot2::ggplot(data.frame(x = all_data), aes(x = x)) + ## EDIT: why replot, what about plot + theme_minimal(...) + labs(...) + ggplot2::geom_histogram(aes(y = after_stat(density)), binwidth = .5, colour = "black", fill = "white") + + ggplot2::geom_density(alpha = .2, fill = "grey45") + + ggplot2::scale_x_continuous(limits = c(0, density_values$x[max(which(density_values$scaled >= 0.1))])) + + ggplot2::theme_minimal()+ + ggplot2::labs(title=paste("Data distribution ", colnames(transpose)), subtitle = paste(NotNorm, " of metabolites not normally distributed based on Shapiro test"),x="Abundance", y = "Density") + ) + + Density_plots[[paste(colnames(transpose))]] <- sampleDist + + # QQ plots + if (QQplots) { + ## make folders + conds <- unique(c(numerator, denominator)) + + ## QQ plots for each groups for each metabolite for normality visual check + qq_plot_list <- list() + for (row_name in rownames(subset_data)) { + qq_plot <- ggplot2::ggplot( + data.frame(x = subset_data[row_name,]), + aes(sample = x)) + + ggplot2::geom_qq() + + ggplot2::geom_qq_line(color = "red") + + ggplot2::labs(title = paste("QQPlot for", row_name), + x = "Theoretical", y = "Sample") + + theme_minimal() + plot.new() + plot(qq_plot) + qq_plot_list[[row_name]] <- recordPlot() ## EDIT: not sure if it works but could it be just qq_plot_list[[col_name]] <- qq_plot (delete plot.new, recordPlot) + + row_name2 <- (gsub("/", "_", row_name))#remove "/" cause this can not be safed in a PDF name + row_name2 <- gsub("-", "", row_name2) + row_name2 <- gsub("/", "", row_name2) + row_name2 <- gsub(" ", "", row_name2) + row_name2 <- gsub("\\*", "", row_name2) + row_name2 <- gsub("\\+", "", row_name2) + row_name2 <- gsub(",", "", row_name2) + row_name2 <- gsub("\\(", "", row_name2) + row_name2 <- gsub("\\)", "", row_name2) ## EDIT: row_name2 not used in the function? + + dev.off() ## EDIT: is this needed? + } + QQ_plots[[paste(colnames(transpose))]] <- qq_plot_list + } + } + ###################################### + ##-------- Return + + ## here we make a list + l_shapiro <- list( + "data" = list( + "Shapiro_result" = tibble::rownames_to_column( + DF_shapiro_results, "Code")), + "plot" = list( + "Distributions" = Density_plots)) + + if (QQplots) { + l_shapiro[["plot"]][["QQ_plots"]] <- QQ_plots + } + ## return + suppressWarnings(invisible(l_shapiro)) + } +} -########################################################################################### -### ### ### Bartlett function: Internal Function to perform Bartlett test and plots ### ### -########################################################################################### +################################################################################ +### Bartlett function: Internal Function to perform Bartlett test and plots ### +################################################################################ #' This helper function perform the Bartlett test to check the homogeneity of variances across groups #' @@ -1769,48 +2103,65 @@ Shapiro <-function(InputData, #' #' @noRd #' -Bartlett <-function(InputData, - SettingsFile_Sample, - SettingsInfo){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ################################################################################################################################################################################################ - - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] +Bartlett <-function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo) { - # Use Bartletts test - bartlett_res = apply(InputData,2,function(x) stats::bartlett.test(x~conditions)) + ## ------------ Create log file ----------- ## + MetaProViz_Init() - #Make the output DF - DF_bartlett_results <- as.data.frame(matrix(NA, nrow = ncol(InputData)), ncol = 1) - rownames(DF_bartlett_results) <- colnames(InputData) - colnames(DF_bartlett_results) <- "Bartlett p.val" + ############################################################################ - for(l in 1:length(bartlett_res)){ - DF_bartlett_results[l, 1] <-bartlett_res[[l]]$p.value - } - DF_bartlett_results <- DF_bartlett_results %>% dplyr::mutate(`Var homogeneity`= case_when(`Bartlett p.val`< 0.05~ FALSE, - `Bartlett p.val`>=0.05 ~ TRUE)) - # if p<0.05 then unequal variances - message("For ",round(sum(DF_bartlett_results$`Var homogeneity`)/ nrow(DF_bartlett_results), digits = 4) * 100, "% of metabolites the group variances are equal.") + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] - DF_bartlett_results <- DF_bartlett_results %>% tibble::rownames_to_column("Metabolite") %>% relocate("Metabolite") - DF_Bartlett_results_out <- DF_bartlett_results + # Use Bartletts test + bartlett_res <- apply(assay(se), 1, + function(x) stats::bartlett.test(x ~ conditions)) - #### Plots: - #Make density plots - Bartlettplot <- ggplot2::ggplot(data.frame(x = DF_Bartlett_results_out), aes(x =DF_Bartlett_results_out$`Bartlett p.val`)) + - ggplot2::geom_histogram(aes(y=..density..), colour="black", fill="white") + - ggplot2::geom_density(alpha = 0.2, fill = "grey45")+ - ggplot2::ggtitle("Bartlett's test p.value distribution") + - ggplot2::xlab("p.value")+ - ggplot2::geom_vline(aes(xintercept = 0.05, color="darkred")) + ## make the output DF + DF_bartlett_results <- data.frame("Bartlett_pvalue" = rep(NA, nrow(se))) + #matrix(NA, nrow = nrow(InputData)), ncol = 1) + rownames(DF_bartlett_results) <- rownames(se) + ##colnames(DF_bartlett_results) <- "Bartlett p.val" - Bartlett_output_list<- list("DF"=list("Bartlett_result"=DF_Bartlett_results_out) , "Plot"=list("Histogram"=Bartlettplot)) - - suppressWarnings(invisible(return(Bartlett_output_list))) + for (i in seq_along(bartlett_res)) { + DF_bartlett_results[i, "Bartlett_pvalue"] <- bartlett_res[[i]]$p.value + } + DF_bartlett_results <- DF_bartlett_results %>% + dplyr::mutate( + Variance_homogeneity = case_when( + Bartlett_pvalue < 0.05 ~ FALSE, + Bartlett_pvalue >= 0.05 ~ TRUE)) + + ## if p < 0.05 then unequal variances + message("For ", + round( + sum(DF_bartlett_results$Variance_homogeneity) / nrow(DF_bartlett_results), + digits = 4) * 100, + "% of metabolites the group variances are equal.") + + DF_bartlett_results <- DF_bartlett_results %>% + tibble::rownames_to_column("Metabolite") %>% + relocate("Metabolite") + + #### Plots: + ## Make density plots + Bartlettplot <- ggplot2::ggplot( + data.frame(x = DF_bartlett_results), + aes(x = DF_bartlett_results$Bartlett_pvalue)) + + ggplot2::geom_histogram(aes(y = ..density..), + colour = "black", fill = "white") + + ggplot2::geom_density(alpha = 0.2, fill = "grey45")+ + ggplot2::ggtitle("Bartlett's test p.value distribution") + + ggplot2::xlab("p.value")+ + ggplot2::geom_vline(aes(xintercept = 0.05, color = "darkred")) + + Bartlett_output_list <- list( + "data" = list("Bartlett_result" = DF_bartlett_results), + "plot" = list("Histogram" = Bartlettplot)) + + ## return + suppressWarnings(invisible(Bartlett_output_list)) } @@ -1819,11 +2170,17 @@ Bartlett <-function(InputData, ### ### ### Variance stabilizing transformation function ### ### ################################################################ -#' This function performs a variance stabilizing transformation (VST) on the input data. +#' @title Variance stabilizing transformation (VST) on assay of SummarizedExperiment +#' +#' @description This function performs a variance stabilizing transformation +#' (VST) on the assay of a SummarizedExperiment. #' -#' @param InputData DF with unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. +#' @param se SummarizedExperiment with unique sample identifiers as colnames +#' and metabolite numerical values in columns with metabolite identifiers +#' as rownames. Use NA for metabolites that were not detected. #' -#' @return List with two entries: DF (including the results DF) and Plots (including the scedasticity_plot) +#' @return list with two entries: "data" (including the vst-adjusted assay) and +#' "plot" (including the scedasticity_plot) #' #' @keywords Heteroscedasticity, variance stabilizing transformation #' @@ -1837,64 +2194,82 @@ Bartlett <-function(InputData, #' #' @noRd #' -vst <- function(InputData){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - # model the mean and variance relationship on the data - suppressMessages(melted <- reshape2::melt(InputData)) - het.data <- melted %>% - dplyr::group_by(variable) %>% # make a dataframe to save the values - dplyr::summarise(mean=mean(value), sd=sd(value)) - het.data$lm <- 1 # add a common group for the lm function to account for the whole data together - - invisible(het_plot <- - ggplot2::ggplot(het.data, ggplot2::aes(x = mean, y = sd)) + - ggplot2::geom_point() + - ggplot2::theme_bw() + - ggplot2::scale_x_continuous(trans='log2') + - ggplot2::scale_y_continuous(trans='log2') + - ggplot2::xlab("log(mean)") + - ggplot2::ylab("log(sd)") + - ggplot2::geom_abline(intercept = 0, slope = 1) + - ggplot2::ggtitle(" Data heteroscedasticity") + - ggplot2::geom_smooth(ggplot2::aes(group=lm),method='lm', formula= y~x, color = "red")) - - # select data - prevst.data <- het.data - prevst.data$mean <- log(prevst.data$mean) - prevst.data$sd <- log(prevst.data$sd) - - # calculate the slope of the log data - data.fit <- stats::lm(sd~mean, prevst.data) - coef(data.fit) - - # Make the vst transformation - data.vst <- as.data.frame(InputData^(1-coef(data.fit)['mean'][1])) - - # Heteroscedasticity visual check again - suppressMessages(melted.vst <- reshape::melt(data.vst)) - het.vst.data <- melted.vst %>% - dplyr::group_by(variable) %>% # make a dataframe to save the values - dplyr::summarise(mean=mean(value), sd=sd(value)) - het.vst.data$lm <- 1 # add a common group for the lm function to account for the whole data together - - # plot variable stadard deviation as a function of the mean - invisible(hom_plot <- - ggplot2::ggplot(het.vst.data, ggplot2::aes(x = mean, y = sd)) + - ggplot2::geom_point() + - ggplot2::theme_bw() + - ggplot2::scale_x_continuous(trans='log2') + - ggplot2::scale_y_continuous(trans='log2') + - ggplot2::xlab("log(mean)") + - ggplot2::ylab("log(sd)") + - ggplot2::geom_abline(intercept = 0) + - ggplot2::ggtitle("Vst transformed data") + - ggplot2::geom_smooth(ggplot2::aes(group=lm),method='lm', formula= y~x, color = "red")) - - invisible(scedasticity_plot <- patchwork::wrap_plots(het_plot,hom_plot)) - - return(invisible(list("DFs" = list("Corrected_data" = data.vst), "Plots" = list("scedasticity_plot" = scedasticity_plot)))) +vst <- function(se) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## model the mean and variance relationship on the data + suppressMessages( + melted <- assay(se) |> + t() |> + reshape2::melt()) + het_data <- melted %>% + ## make a dataframe to save the values + dplyr::group_by(Var2) %>% ## EDIT: should this be according to metabolites? ## was: variable + dplyr::summarise(mean = mean(value), sd = sd(value)) + ## add a common group for the lm function to account for the whole data together + het_data$lm <- 1 + + invisible(het_plot <- ggplot2::ggplot(het_data, ggplot2::aes(x = mean, y = sd)) + + ggplot2::geom_point() + + ggplot2::theme_bw() + + ggplot2::scale_x_continuous(trans='log2') + + ggplot2::scale_y_continuous(trans='log2') + + ggplot2::xlab("log(mean)") + + ggplot2::ylab("log(sd)") + + ggplot2::geom_abline(intercept = 0, slope = 1) + + ggplot2::ggtitle(" Data heteroscedasticity") + + ggplot2::geom_smooth(ggplot2::aes(group = lm), method = "lm", + formula = y~x, color = "red")) + + # select data + prevst_data <- het_data + prevst_data$mean <- log(prevst_data$mean) + prevst_data$sd <- log(prevst_data$sd) + + ## calculate the slope of the log data ## EDIT: why are you not using some prebuild function from e.g. vsn2? + data_fit <- stats::lm(sd ~ mean, prevst_data) + coef(data_fit) + + ## make the vst transformation + data_vst <- as.data.frame(t(assay(se)) ^ (1 - coef(data_fit)["mean"][1])) + + ## heteroscedasticity visual check again + suppressMessages(melted_vst <- reshape::melt(data_vst)) + het_vst_data <- melted_vst %>% + ## make a dataframe to save the values + dplyr::group_by(variable) %>% + dplyr::summarise(mean = mean(value), sd = sd(value)) + ## add a common group for the lm function to account for the whole data together + het_vst_data$lm <- 1 + + ## plot variable stadard deviation as a function of the mean + invisible(hom_plot <- ggplot2::ggplot(het_vst_data, + ggplot2::aes(x = mean, y = sd)) + + ggplot2::geom_point() + + ggplot2::theme_bw() + + ggplot2::scale_x_continuous(trans = "log2") + + ggplot2::scale_y_continuous(trans = "log2") + + ggplot2::xlab("log(mean)") + + ggplot2::ylab("log(sd)") + + ggplot2::geom_abline(intercept = 0) + + ggplot2::ggtitle("Vst transformed data") + + ggplot2::geom_smooth(ggplot2::aes(group = lm), method='lm', + formula = y ~ x, color = "red")) + + scedasticity_plot <- patchwork::wrap_plots(het_plot, hom_plot) + + ## assemble the object to return + assay(se) <- t(data_vst) + l <- list( + "data" = list( + "se" = se, + "assay" = data_vst), + "plot" = list( + "scedasticity_plot" = scedasticity_plot)) + + ## return + invisible(l) } diff --git a/R/GetPriorKnoweldge.R b/R/GetPriorKnoweldge.R index 9badeab4..bf135871 100644 --- a/R/GetPriorKnoweldge.R +++ b/R/GetPriorKnoweldge.R @@ -28,95 +28,109 @@ #' @title KEGG #' @description Import and process KEGG. #' @importFrom utils read.csv +#' @importFrom tidyr separate_longer_delim #' @importFrom KEGGREST keggGet keggList #' @return A data frame containing the KEGG pathways for ORA. #' #' @examples -#' KEGG_Pathways <- MetaProViz::LoadKEGG() +#' KEGG_Pathways <- LoadKEGG() #' #' @export #' LoadKEGG <- function(){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - logger::log_info("Load KEGG.") - - #------------------------------------------------------------------ - #Get the directory and filepath of cache results of R - directory <- rappdirs::user_cache_dir()#get chache directory - File_path <-paste(directory, "/KEGG_Metabolite.rds", sep="") - - if(file.exists(File_path)==TRUE){# First we will check the users chache directory and weather there are rds files with KEGG_pathways already: - KEGG_Metabolite <- readRDS(File_path) - message("Cached file loaded from: ", File_path) - }else{# load from KEGG - RequiredPackages <- c("KEGGREST") - new.packages <- RequiredPackages[!(RequiredPackages %in% installed.packages()[,"Package"])] - if(length(new.packages)) install.packages(new.packages) - - suppressMessages(library(KEGGREST)) - - # 1. Make a list of all available human pathways in KEGG - Pathways_H <- as.data.frame(KEGGREST::keggList("pathway", "hsa")) # hsa = human - - # 2. Initialize the result data frame - KEGG_H <- data.frame(KEGGPathway = character(nrow(Pathways_H)), - #PathID = 1:nrow(Pathways_H), - Compound = 1:nrow(Pathways_H), - KEGG_CompoundID = 1:nrow(Pathways_H), - stringsAsFactors = FALSE) - - # 3. Iterate over each pathway and extract the needed information - for (k in 1:nrow(Pathways_H)) { - path <- rownames(Pathways_H)[k] - - tryCatch({#try-catch block is used to catch any errors that occur during the query process - # Query the pathway information - query <- KEGGREST::keggGet(path) - - # Extract the necessary information and store it in the result data frame - KEGG_H[k, "KEGGPathway"] <- Pathways_H[k,] - #KEGG_H[k, "PathID"] <- path - KEGG_H[k, "Compound"] <- paste(query[[1]]$COMPOUND, collapse = ";") - KEGG_H[k, "KEGG_CompoundID"] <- paste(names(query[[1]]$COMPOUND), collapse = ";") - }, error = function(e) { - # If an error occurs, store "error" in the corresponding row and continue to the next query - KEGG_H[k, "KEGGPathway"] <- "error" - message(paste("`Error in .getUrl(url, .flatFileParser) : Not Found (HTTP 404).` for pathway", path, "- Skipping and continuing to the next query.")) - }) + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + logger::log_info("Load KEGG.") + + #------------------------------------------------------------------ + ## get the directory and filepath of cache results of R + directory <- rappdirs::user_cache_dir()#get chache directory + File_path <-paste0(directory, "/KEGG_Metabolite.rds") + + if (file.exists(File_path)) { + ## first we will check the users chache directory and whether there + ## are rds files with KEGG_pathways already: + KEGG_Metabolite <- readRDS(File_path) + message("Cached file loaded from: ", File_path) + + } else {# load from KEGG + RequiredPackages <- c("KEGGREST") + new.packages <- RequiredPackages[!(RequiredPackages %in% installed.packages()[,"Package"])] + if (length(new.packages)) ## EDIT: what about if (!require("KEGGREST", quietly = TRUE)) install.packages("KEGGREST") ## EDIT: I would advise against installing some packages from within a fct, normally this should be controlled via your NAMESPACE + install.packages(new.packages) + + suppressMessages(library(KEGGREST)) ## EDIT: same here, this should be controlled via the NAMESPACE + + ## 1. Make a list of all available human pathways in KEGG + Pathways_H <- as.data.frame(KEGGREST::keggList("pathway", "hsa")) # hsa = human + + ## 2. Initialize the result data frame + KEGG_H <- data.frame(KEGGPathway = character(nrow(Pathways_H)), + #PathID = 1:nrow(Pathways_H), + Compound = seq_len(nrow(Pathways_H)), + KEGG_CompoundID = seq_len(nrow(Pathways_H)), + stringsAsFactors = FALSE) + + ## 3. Iterate over each pathway and extract the needed information + for (k in seq_len(nrow(Pathways_H))) { + path <- rownames(Pathways_H)[k] + + tryCatch({#try-catch block is used to catch any errors that occur during the query process + ## Query the pathway information + query <- KEGGREST::keggGet(path) + + ## Extract the necessary information and store it in the result data frame + KEGG_H[k, "KEGGPathway"] <- Pathways_H[k,] + #KEGG_H[k, "PathID"] <- path + KEGG_H[k, "Compound"] <- paste(query[[1]]$COMPOUND, collapse = ";") + KEGG_H[k, "KEGG_CompoundID"] <- paste(names(query[[1]]$COMPOUND), collapse = ";") + }, error = function(e) { + # If an error occurs, store "error" in the corresponding row and continue to the next query + KEGG_H[k, "KEGGPathway"] <- "error" + message(paste("`Error in .getUrl(url, .flatFileParser) : Not Found (HTTP 404).` for pathway", path, "- Skipping and continuing to the next query.")) + }) + } + + ## 3. Remove the pathways that do not have any metabolic compounds associated to them + KEGG_H_Select <-KEGG_H %>% + subset(!KEGG_CompoundID == "") %>% + subset(!KEGGPathway == "") + + ## 4. Make the Metabolite DF + KEGG_Metabolite <- separate_longer_delim(KEGG_H_Select[, -5], + c(Compound, KEGG_CompoundID), delim = ";") + + ## 5. Remove Metabolites + ## 5.1. Ions should be removed + Remove_Ions <- c("Calcium cation", "Potassium cation", "Sodium cation", + "H+", "Cl-", "Fatty acid", "Superoxide", "H2O", "CO2", "Copper", + "Fe2+", "Magnesium cation", "Fe3+", "Zinc cation", "Nickel", "NH4+") + ## 5.2. Unspecific small molecules + Remove_Small <- c("Nitric oxide", "Hydrogen peroxide", "Superoxide", + "H2O", "CO2", "Hydroxyl radical", "Ammonia", "HCO3-", "Oxygen", + "Diphosphate", "Reactive oxygen species", "Nitrite", "Nitrate", + "Hydrogen", "RX", "Hg") + + KEGG_Metabolite <- KEGG_Metabolite[!(KEGG_Metabolite$Compound %in% c(Remove_Ions, Remove_Small)), ] + + ## change syntax as required for ORA + KEGG_Metabolite <- KEGG_Metabolite %>% + dplyr::rename("term" = 1, + "Metabolite" = 2, + "MetaboliteID" = 3) + KEGG_Metabolite$Description <- KEGG_Metabolite$term + + ##Save the results as an RDS file in the Cache directory of R + if (!dir.exists(directory)) { + dir.create(directory) + } + saveRDS(KEGG_Metabolite, file = paste0(directory, "/KEGG_Metabolite.rds")) } - # 3. Remove the pathways that do not have any metabolic compounds associated to them - KEGG_H_Select <-KEGG_H%>% - subset(!KEGG_CompoundID=="")%>% - subset(!KEGGPathway=="") - - # 4. Make the Metabolite DF - KEGG_Metabolite <- separate_longer_delim(KEGG_H_Select[,-5], c(Compound, KEGG_CompoundID), delim = ";") - - # 5. Remove Metabolites - ### 5.1. Ions should be removed - Remove_Ions <- c("Calcium cation","Potassium cation","Sodium cation","H+","Cl-", "Fatty acid", "Superoxide","H2O", "CO2", "Copper", "Fe2+", "Magnesium cation", "Fe3+", "Zinc cation", "Nickel", "NH4+") - ### 5.2. Unspecific small molecules - Remove_Small <- c("Nitric oxide","Hydrogen peroxide", "Superoxide","H2O", "CO2", "Hydroxyl radical", "Ammonia", "HCO3-", "Oxygen", "Diphosphate", "Reactive oxygen species", "Nitrite", "Nitrate", "Hydrogen", "RX", "Hg") - - KEGG_Metabolite <- KEGG_Metabolite[!(KEGG_Metabolite$Compound %in% c(Remove_Ions, Remove_Small)), ] - - #Change syntax as required for ORA - KEGG_Metabolite <- KEGG_Metabolite%>% - dplyr::rename("term"=1, - "Metabolite"=2, - "MetaboliteID"=3) - KEGG_Metabolite$Description <- KEGG_Metabolite$term - - #Save the results as an RDS file in the Cache directory of R - if(!dir.exists(directory)) {dir.create(directory)} - saveRDS(KEGG_Metabolite, file = paste(directory, "/KEGG_Metabolite.rds", sep="")) - } - - #Return into environment - assign("KEGG_Pathways", KEGG_Metabolite, envir=.GlobalEnv) + ## return into environment ## EDIT: I would advise against assigning an object to the Global env, lets assume there is already a "precious" object with that same name, it will be lost, why not just return the object? + assign("KEGG_Pathways", KEGG_Metabolite, envir=.GlobalEnv) } @@ -132,15 +146,15 @@ LoadKEGG <- function(){ #' @export #' LoadHallmarks <- function() { - ## ------------ Create log file ----------- ## - MetaProViz_Init() + ## ------------ Create log file ----------- ## + MetaProViz_Init() - # Read the .csv files - Hallmark <- system.file("data", "Hallmarks.csv", package = "MetaProViz") - Hallmark <- read.csv(Hallmark, check.names=FALSE) + ## read the .csv files + Hallmark <- system.file("data", "Hallmarks.csv", package = "MetaProViz") + Hallmark <- read.csv(Hallmark, check.names=FALSE) - # Return into environment - assign("Hallmark_Pathways", Hallmark, envir=.GlobalEnv) + # Return into environment + assign("Hallmark_Pathways", Hallmark, envir = .GlobalEnv) ## EDIT: I would advise against assigning an object to the Global env, lets assume there is already a "precious" object with that same name, it will be lost, why not just return the object? } ########################################################################################## @@ -154,15 +168,16 @@ LoadHallmarks <- function() { #' @export #' LoadGaude <- function() { - ## ------------ Create log file ----------- ## - MetaProViz_Init() + + ## ------------ Create log file ----------- ## + MetaProViz_Init() - # Read the .csv files - MetabolicSig <- system.file("data", "Compilled_MetabolicSig_2025-01-07.csv", package = "MetaProViz") - MetabolicSig <- read.csv(MetabolicSig, check.names=FALSE) + ## Read the .csv files + MetabolicSig <- system.file("data", "Compilled_MetabolicSig_2025-01-07.csv", package = "MetaProViz") + MetabolicSig <- read.csv(MetabolicSig, check.names=FALSE) - # Return into environment - assign("Gaude_Pathways", MetabolicSig, envir=.GlobalEnv) + ## Return into environment + assign("Gaude_Pathways", MetabolicSig, envir = .GlobalEnv) ## EDIT: I would advise against assigning an object to the Global env, lets assume there is already a "precious" object with that same name, it will be lost, why not just return the object? } ########################################################################################## @@ -184,76 +199,96 @@ LoadGaude <- function() { #' @return A data frame containing the Prior Knowledge. #' #' @examples -#' ChemicalClass <- MetaProViz::LoadRAMP() +#' ChemicalClass <- LoadRAMP() #' #' @export #' LoadRAMP <- function(version = "2.5.4", - SaveAs_Table="csv", - FolderPath=NULL){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "MetaboliteSet") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - - ###################################################### - #Get the directory and filepath of cache results of R - directory <- rappdirs::user_cache_dir()#get chache directory - File_path <-paste(directory, "/RaMP-ChemicalClass_Metabolite.rds", sep="") - - if(file.exists(File_path)==TRUE){# First we will check the users chache directory and weather there are rds files with KEGG_pathways already: - HMDB_ChemicalClass <- readRDS(File_path) - message("Cached file loaded from: ", File_path) - }else{# load from OmniPath - # Get RaMP via OmnipathR and extract ClassyFire classes - Structure <- OmnipathR::ramp_table( "metabolite_class" , version = version) - Class <- OmnipathR::ramp_table( "chem_props" , version = version) - - HMDB_ChemicalClass <- merge(Structure, Class[,c(1:3,10)], by="ramp_id", all.x=TRUE)%>% - dplyr::filter(stringr::str_starts(class_source_id, "hmdb:"))%>% # Select HMDB only! - dplyr::filter(stringr::str_starts(chem_source_id, "hmdb:"))%>% # Select HMDB only! - dplyr::select(-c("chem_data_source", "chem_source_id"))%>% - tidyr::pivot_wider( - names_from = class_level_name, # Use class_level_name as the new column names - values_from = class_name, # Use class_name as the values for the new columns - values_fn = list(class_name = ~paste(unique(.), collapse = ", ")) # Combine duplicate values - )%>% - dplyr::group_by(across(-common_name))%>% - dplyr::summarise( - common_name = paste(unique(common_name), collapse = "; "), # Combine all common names into one - .groups = "drop" # Ungroup after summarising - )%>% - dplyr::mutate(class_source_id = stringr::str_remove(class_source_id, "^hmdb:"))%>% # Remove 'hmdb:' prefix - dplyr::select(class_source_id, common_name, ClassyFire_class, ClassyFire_super_class, ClassyFire_sub_class) # Reorder columns - - #Save the results as an RDS file in the Cache directory of R - if(!dir.exists(directory)) {dir.create(directory)} - saveRDS(HMDB_ChemicalClass, file = paste(directory, "/RaMP-ChemicalClass_Metabolite.rds", sep="")) + SaveAs_Table = "csv", + FolderPath = NULL){ + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Folder ----------- ## + if(!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", + FolderPath = FolderPath) + + SubFolder <- file.path(Folder, "MetaboliteSet") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } - } + ###################################################### + ## get the directory and filepath of cache results of R + ## get chache directory + directory <- rappdirs::user_cache_dir() + File_path <-paste0(directory, "/RaMP-ChemicalClass_Metabolite.rds") + + ## first we will check the users chache directory and whether there + ## are rds files with KEGG_pathways already: + if (file.exists(File_path)) { + HMDB_ChemicalClass <- readRDS(File_path) + message("Cached file loaded from: ", File_path) + } else { + ## load from OmniPath + ## get RaMP via OmnipathR and extract ClassyFire classes + Structure <- OmnipathR::ramp_table("metabolite_class", version = version) ## EDIT: is the version the package version? Is there any reason to use a specific version here? + Class <- OmnipathR::ramp_table("chem_props", version = version) + + HMDB_ChemicalClass <- merge(Structure, Class[, c(1:3, 10)], + by = "ramp_id", all.x = TRUE) %>% + ## select HMDB only! + dplyr::filter(stringr::str_starts(class_source_id, "hmdb:")) %>% + ## select HMDB only! + dplyr::filter(stringr::str_starts(chem_source_id, "hmdb:")) %>% + dplyr::select(-c("chem_data_source", "chem_source_id")) %>% + tidyr::pivot_wider( + ## Use class_level_name as the new column names + names_from = class_level_name, + ## use class_name as the values for the new columns + values_from = class_name, + ## combine duplicate values + values_fn = list(class_name = ~ paste(unique(.), collapse = ", "))) %>% + dplyr::group_by(across(-common_name)) %>% + dplyr::summarise( + ## combine all common names into one + common_name = paste(unique(common_name), collapse = "; "), + ## ungroup after summarising + .groups = "drop") %>% + ## remove 'hmdb:' prefix + dplyr::mutate( + class_source_id = stringr::str_remove(class_source_id, "^hmdb:")) %>% + ## reorder columns + dplyr::select(class_source_id, common_name, + ClassyFire_class, ClassyFire_super_class, ClassyFire_sub_class) + + #Save the results as an RDS file in the Cache directory of R + if (!dir.exists(directory)) { + dir.create(directory) + } + saveRDS(HMDB_ChemicalClass, + file = paste0(directory, "/RaMP-ChemicalClass_Metabolite.rds")) + } - ##-------------- Save and return - DF_List <- list("ChemicalClass_MetabSet"=HMDB_ChemicalClass) - suppressMessages(suppressWarnings( - SaveRes(InputList_DF= DF_List,#This needs to be a list, also for single comparisons - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "ChemicalClass", - CoRe=FALSE, - PrintPlot=FALSE))) - - # Return into environment - assign("ChemicalClass_MetabSet", HMDB_ChemicalClass, envir=.GlobalEnv) + ##-------------- Save and return + DF_List <- list("ChemicalClass_MetabSet" = HMDB_ChemicalClass) + suppressMessages(suppressWarnings( + SaveRes( + ## This needs to be a list, also for single comparisons + data = DF_List, + plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "ChemicalClass", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return into environment + assign("ChemicalClass_MetabSet", HMDB_ChemicalClass, envir = .GlobalEnv) ## EDIT: I would advise against assigning an object to the Global env, lets assume there is already a "precious" object with that same name, it will be lost, why not just return the object? } @@ -272,97 +307,106 @@ LoadRAMP <- function(version = "2.5.4", #' @export Make_GeneMetabSet <- function(Input_GeneSet, - SettingsInfo=c(Target="gene"), - PKName= NULL, - SaveAs_Table = "csv", - FolderPath = NULL){ + SettingsInfo = c(Target = "gene"), + PKName = NULL, + SaveAs_Table = "csv", + FolderPath = NULL) { - ## ------------ Create log file ----------- ## - MetaProViz_Init() + ## ------------ Create log file ----------- ## + MetaProViz_Init() - logger::log_info("Make_GeneMetabSet.") + logger::log_info("Make_GeneMetabSet.") - ## ------------ Check Input files ----------- ## - # 1. The input data: - if(is.data.frame(Input_GeneSet)==FALSE){ - stop("`Input_GeneSet` must be of class data.frame with columns for source (=term) and Target (=gene). Please check your input") - } - # 2. Target: - if("Target" %in% names(SettingsInfo)){ - if(SettingsInfo[["Target"]] %in% colnames(Input_GeneSet)== FALSE){ - stop("The ", SettingsInfo[["Target"]], " column selected as Conditions in SettingsInfo was not found in Input_GeneSet. Please check your input.") + ## ------------ Check Input files ----------- ## + ## 1. The input data: + if(!is.data.frame(Input_GeneSet)) { + stop("`Input_GeneSet` must be of class data.frame with columns for source (=term) and Target (=gene). Please check your input") + } + ## 2. Target: + if ("Target" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Target"]] %in% colnames(Input_GeneSet)) { + stop("The ", SettingsInfo[["Target"]], + " column selected as Conditions in SettingsInfo was not found in Input_GeneSet. Please check your input.") + } + } else { + stop("Please provide a column name for the Target in SettingsInfo.") } - }else{ - stop("Please provide a column name for the Target in SettingsInfo.") - } - - if(is.null(PKName)){ - PKName <- "GeneMetabSet" - } - - ## ------------ Folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "MetaboliteSet") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - - ###################################################### - ##-------------- Cosmos PKN - #load the network from cosmos - data("meta_network", package = "cosmosR") - meta_network <- meta_network[which(meta_network$source != meta_network$target),] - - #adapt to our needs extracting the metabolites: - meta_network_metabs <- meta_network[grepl("Metab__", meta_network$source) | grepl("Metab__HMDB", meta_network$target),-2]#extract entries with metabolites in source or Target - meta_network_metabs <- meta_network_metabs[grepl("Gene", meta_network_metabs$source) | grepl("Gene", meta_network_metabs$target),]#extract entries with genes in source or Target - - #Get reactant and product - meta_network_metabs_reactant <- meta_network_metabs[grepl("Metab__HMDB", meta_network_metabs$source),]%>% dplyr::rename("metab"=1, "gene"=2) - meta_network_metabs_products <- meta_network_metabs[grepl("Metab__HMDB", meta_network_metabs$target),]%>% dplyr::rename("gene"=1, "metab"=2) - - meta_network_metabs <- as.data.frame(rbind(meta_network_metabs_reactant, meta_network_metabs_products)) - meta_network_metabs$gene <- gsub("Gene.*__","",meta_network_metabs$gene) - meta_network_metabs$metab <- gsub("_[a-z]$","",meta_network_metabs$metab) - meta_network_metabs$metab <- gsub("Metab__","",meta_network_metabs$metab) - - ##--------------metalinks transporters - #Add metalinks transporters to Cosmos PKN - - ##-------------- Combine with Input_GeneSet - #add pathway names --> File that can be used for metabolite pathway analysis - MetabSet <- merge(meta_network_metabs,Input_GeneSet, by.x="gene", by.y=SettingsInfo[["Target"]]) - - #combine with pathways --> File that can be used for combined pathway analysis (metabolites and gene t.vals) - GeneMetabSet <- unique(as.data.frame(rbind(Input_GeneSet%>%dplyr::rename("feature"=SettingsInfo[["Target"]]), MetabSet[,-1]%>%dplyr::rename("feature"=1)))) - - ##------------ Select metabolites only - MetabSet <- GeneMetabSet %>% - filter(grepl("HMDB", feature)) + if (is.null(PKName)) { + PKName <- "GeneMetabSet" + } + ## ------------ Folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", + FolderPath = FolderPath) - ##-------------- Save and return - DF_List <- list("GeneMetabSet"=GeneMetabSet, - "MetabSet"=MetabSet) - suppressMessages(suppressWarnings( - SaveRes(InputList_DF= DF_List,#This needs to be a list, also for single comparisons - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= PKName, - CoRe=FALSE, - PrintPlot=FALSE))) + SubFolder <- file.path(Folder, "MetaboliteSet") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } - return(invisible(DF_List)) + ##-------------- Cosmos PKN + ## load the network from cosmos + data("meta_network", package = "cosmosR") + meta_network <- meta_network[which(meta_network$source != meta_network$target), ] + + ## adapt to our needs extracting the metabolites: + ## extract entries with metabolites in source or Target + meta_network_metabs <- meta_network[ + grepl("Metab__", meta_network$source) | grepl("Metab__HMDB", meta_network$target), -2] + ## extract entries with genes in source or Target + meta_network_metabs <- meta_network_metabs[ + grepl("Gene", meta_network_metabs$source) | grepl("Gene", meta_network_metabs$target),] + + ## get reactant and product + meta_network_metabs_reactant <- meta_network_metabs[ + grepl("Metab__HMDB", meta_network_metabs$source), ] %>% + dplyr::rename("metab"=1, "gene"=2) + meta_network_metabs_products <- meta_network_metabs[ + grepl("Metab__HMDB", meta_network_metabs$target), ] %>% + dplyr::rename("gene" = 1, "metab" = 2) + + meta_network_metabs <- as.data.frame( + rbind(meta_network_metabs_reactant, meta_network_metabs_products)) + meta_network_metabs$gene <- gsub("Gene.*__", "", meta_network_metabs$gene) + meta_network_metabs$metab <- gsub("_[a-z]$", "", meta_network_metabs$metab) + meta_network_metabs$metab <- gsub("Metab__", "", meta_network_metabs$metab) + + ##--------------metalinks transporters + ## add metalinks transporters to Cosmos PKN + + ##-------------- Combine with Input_GeneSet + ## add pathway names --> File that can be used for metabolite pathway analysis + MetabSet <- merge(meta_network_metabs, Input_GeneSet, by.x = "gene", + by.y = SettingsInfo[["Target"]]) + + ## combine with pathways --> File that can be used for combined pathway analysis (metabolites and gene t.vals) + GeneMetabSet <- unique(as.data.frame( + rbind(dplyr::rename(Input_GeneSet, "feature" = SettingsInfo[["Target"]]), + dplyr::rename(MetabSet[,-1], "feature" = 1)))) + + ##------------ Select metabolites only + MetabSet <- GeneMetabSet %>% + filter(grepl("HMDB", feature)) + + ##-------------- Save and return + DF_List <- list("GeneMetabSet" = GeneMetabSet, "MetabSet" = MetabSet) + suppressMessages(suppressWarnings( + SaveRes(data = DF_List, ##This needs to be a list, also for single comparisons + plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = PKName, + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(DF_List) } - - ########################################################################################## ### ### ### Load MetaLinksDB prior knowledge ### ### ### ########################################################################################## @@ -381,269 +425,293 @@ Make_GeneMetabSet <- function(Input_GeneSet, #' @param FolderPath \emph{Optional:} Path to the folder the results should be saved at. \strong{default: NULL} #' @export - LoadMetalinks <- function(types = NULL, - cell_location = NULL, - tissue_location = NULL, - biospecimen_location = NULL, - disease = NULL, - pathway = NULL, - hmdb_ids = NULL, - uniprot_ids = NULL, - SaveAs_Table="csv", - FolderPath=NULL){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - logger::log_info("MetaLinksDB.") - - - #------------------------------------------------------------------ - if((any(c(types, cell_location, tissue_location, biospecimen_location, disease, pathway, hmdb_ids, uniprot_ids)=="?"))==FALSE){ - #Check Input parameters - - - + cell_location = NULL, + tissue_location = NULL, + biospecimen_location = NULL, + disease = NULL, + pathway = NULL, + hmdb_ids = NULL, + uniprot_ids = NULL, + SaveAs_Table = "csv", ## EDIT: name the options here and use match.arg + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + #MetaProViz_Init() + + logger::log_info("MetaLinksDB.") + #------------------------------------------------------------------ + if (!any( + c(types, cell_location, tissue_location, biospecimen_location, disease, + pathway, hmdb_ids, uniprot_ids) == "?")) { + + ## check Input parameters + } - #Python version enables the user to add their own link to the database dump (probably to obtain a specific version. Lets check how the link was generated and see if it would make sense for us to do the same.) - # --> At the moment arbitrary! - # We could provide the user the ability to point to their own path were they already dumpled/stored QA version of metalinks they like to use! - - ## ------------ Folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "MetaboliteSet") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} + ## Python version enables the user to add their own link to the database + ## dump (probably to obtain a specific version. Lets check how the link + ## was generated and see if it would make sense for us to do the same.) + ## --> At the moment arbitrary! + ## we could provide the user the ability to point to their own path were + ## they already dumpled/stored QA version of metalinks they like to use! + + ## ------------ Folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", + FolderPath = FolderPath) + SubFolder <- file.path(Folder, "MetaboliteSet") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } } - #------------------------------------------------------------------ - #Get the directory and filepath of cache results of R - directory <- rappdirs::user_cache_dir()#get chache directory - File_path <-paste(directory, "/metalinks.db", sep="") - - if(file.exists(File_path)==TRUE){# First we will check the users chache directory and weather there are rds files with KEGG_pathways already: - # Connect to the SQLite database - con <- DBI::dbConnect(RSQLite::SQLite(), File_path, synchronous = NULL) - message("Cached file loaded from: ", File_path) - }else{# load from API - RequiredPackages <- c("tidyverse", "RSQLite", "DBI") - new.packages <- RequiredPackages[!(RequiredPackages %in% installed.packages()[,"Package"])] - if(length(new.packages)) install.packages(new.packages) - - suppressMessages(library(tidyverse)) - - #-------------------------------------------------------------------------------------------- - #Python availability via Liana: https://github.com/saezlab/liana-py/blob/main/liana/resource/get_metalinks.py - metalinks_db_url <- "https://figshare.com/ndownloader/files/47567597" - # Download the Metalinks database file and save where the cache is stored - download.file(metalinks_db_url, destfile = File_path , mode = "wb")#WB: This mode is used for writing binary files. It opens the destination file for writing in binary mode. - message("Metalinks database downloaded and saved to: ", File_path) - - # Connect to the SQLite database - con <- DBI::dbConnect(RSQLite::SQLite(), File_path, synchronous = NULL) - } + #------------------------------------------------------------------ + ##Get the directory and filepath of cache results of R + ## get chache directory + directory <- rappdirs::user_cache_dir() + File_path <- paste(directory, "/metalinks.db", sep = "") + + if (file.exists(File_path)) { + ## First we will check the users chache directory and whether there are rds files with KEGG_pathways already: + ## connect to the SQLite database + con <- DBI::dbConnect(RSQLite::SQLite(), File_path, synchronous = NULL) + message("Cached file loaded from: ", File_path) + } else { + ## load from API + RequiredPackages <- c("tidyverse", "RSQLite", "DBI") + new.packages <- RequiredPackages[!(RequiredPackages %in% installed.packages()[,"Package"])] + if(length(new.packages)) + install.packages(new.packages) ## EDIT: see above, controll via NAMESPACE + + suppressMessages(library(tidyverse)) + + ##---------------------------------------------------------------------- + ## Python availability via Liana: https://github.com/saezlab/liana-py/blob/main/liana/resource/get_metalinks.py + metalinks_db_url <- "https://figshare.com/ndownloader/files/47567597" + ## Download the Metalinks database file and save where the cache is stored + ##WB: This mode is used for writing binary files. It opens the destination file for writing in binary mode. + download.file(metalinks_db_url, destfile = File_path , mode = "wb") + + message("Metalinks database downloaded and saved to: ", File_path) + + ## connect to the SQLite database + con <- DBI::dbConnect(RSQLite::SQLite(), File_path, synchronous = NULL) + } - #------------------------------------------------------------------ - #Query the database for a specific tables - tables <- DBI::dbListTables(con) + ##------------------------------------------------------------------ + ## Query the database for a specific tables + tables <- DBI::dbListTables(con) - TablesList <- list() - for(table in tables){ - query <- paste("SELECT * FROM", table) - data <- DBI::dbGetQuery(con, query) - TablesList[[table]] <- data - } + TablesList <- list() + for (table in tables) { + query <- paste("SELECT * FROM", table) + data <- DBI::dbGetQuery(con, query) + TablesList[[table]] <- data + } - # Close the connection - DBI::dbDisconnect(con) - - MetalinksDB <- TablesList[["edges"]]#extract the edges table - #------------------------------------------------------------------ - # Answer questions about the database - #if any parameter is ? then return the data - if(any(c(types, cell_location, tissue_location, biospecimen_location, disease, pathway, hmdb_ids, uniprot_ids)=="?")){ - Questions <- which(c(types, cell_location, tissue_location, biospecimen_location, disease, pathway, hmdb_ids, uniprot_ids)=="?") - #Check tables where the user has questions - if(length(Questions)>0){ - for(i in Questions){ - if(i==1){ - print("Types:") - print(unique(MetalinksDB$type)) - } - if(i==2){ - print("Cell Location:") - CellLocation <- TablesList[["cell_location"]] - print(unique(CellLocation$cell_location)) - } - if(i==3){ - print("Tissue Location:") - TissueLocation <- TablesList[["tissue_location"]] - print(unique(TissueLocation$tissue_location)) - } - if(i==4){ - print("Biospecimen Location:") - BiospecimenLocation <- TablesList[["biospecimen_location"]] - print(unique(BiospecimenLocation$biospecimen_location)) - } - if(i==5){ - print("Disease:") - Disease <- TablesList[["disease"]] - print(unique(Disease$disease)) + ## Close the connection + DBI::dbDisconnect(con) + + ## extract the edges table + MetalinksDB <- TablesList[["edges"]] + + ##------------------------------------------------------------------ + ## Answer questions about the database + ##if any parameter is ? then return the data + if(any( + c(types, cell_location, tissue_location, biospecimen_location, disease, + pathway, hmdb_ids, uniprot_ids) == "?")) { ## EDIT: this vector is used several times, should be defined once and then object be used + + Questions <- which( + c(types, cell_location, tissue_location, biospecimen_location, disease, + pathway, hmdb_ids, uniprot_ids) == "?") + + ## check tables where the user has questions + if (length(Questions) > 0) { + for (i in Questions) { + if(i == 1) { + print("Types:") + print(unique(MetalinksDB$type)) + } + if(i == 2) { + print("Cell Location:") + CellLocation <- TablesList[["cell_location"]] + print(unique(CellLocation$cell_location)) + } + if (i == 3) { + print("Tissue Location:") + TissueLocation <- TablesList[["tissue_location"]] + print(unique(TissueLocation$tissue_location)) + } + if (i == 4) { + print("Biospecimen Location:") + BiospecimenLocation <- TablesList[["biospecimen_location"]] + print(unique(BiospecimenLocation$biospecimen_location)) + } + if (i == 5) { + print("Disease:") + Disease <- TablesList[["disease"]] + print(unique(Disease$disease)) + } + if (i == 6) { + print("Pathway:") + Pathway <- TablesList[["pathway"]] + print(unique(Pathway$pathway)) + } + if (i == 7) { + print("HMDB IDs:") + print(unique(MetalinksDB$hmdb)) + } + if(i == 8) { + print("UniProt IDs:") + print(unique(MetalinksDB$uniprot)) + } + } } - if(i==6){ - print("Pathway:") - Pathway <- TablesList[["pathway"]] - print(unique(Pathway$pathway)) - } - if(i==7){ - print("HMDB IDs:") - print(unique(MetalinksDB$hmdb)) - } - if(i==8){ - print("UniProt IDs:") - print(unique(MetalinksDB$uniprot)) - } - } + message("No result is returned unless correct options for your selections are used. `?` is not a valid option, but only returns you the list of options.") + return() ## EDIT: needed? } - message("No result is returned unless correct options for your selections are used. `?` is not a valid option, but only returns you the list of options.") - return() - } - - #------------------------------------------------------------------ - #Extract specific connections based on parameter settings. If any parameter is not NULL, filter the data: - ## types - if(!is.null(types)){ - MetalinksDB <- MetalinksDB[MetalinksDB$type %in% types,] - } - - ## cell_location - if(!is.null(cell_location)){ - CellLocation <- TablesList[["cell_location"]] - CellLocation <- CellLocation[CellLocation$cell_location %in% cell_location,]#Filter the cell location - - #Get unique HMDB IDs - CellLocation_HMDB <- unique(CellLocation$hmdb) - - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% CellLocation_HMDB,] - } - - ## tissue_location - if(!is.null(tissue_location)){# "All Tissues"? - TissueLocation <- TablesList[["tissue_location"]] - TissueLocation <- TissueLocation[TissueLocation$tissue_location %in% tissue_location,]#Filter the tissue location - #Get unique HMDB IDs - TissueLocation_HMDB <- unique(TissueLocation$hmdb) - - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% TissueLocation_HMDB,] - } + #------------------------------------------------------------------ + ## extract specific connections based on parameter settings. If any parameter is not NULL, filter the data: + ## types + if (!is.null(types)) { + MetalinksDB <- MetalinksDB[MetalinksDB$type %in% types, ] + } - ## biospecimen_location - if(!is.null(biospecimen_location)){ - BiospecimenLocation <- TablesList[["biospecimen_location"]] - BiospecimenLocation <- BiospecimenLocation[BiospecimenLocation$biospecimen_location %in% biospecimen_location,]#Filter the biospecimen location + ## cell_location + if (!is.null(cell_location)) { + + CellLocation <- TablesList[["cell_location"]] + ## filter the cell location + CellLocation <- CellLocation[CellLocation$cell_location %in% cell_location, ] - #Get unique HMDB IDs - BiospecimenLocation_HMDB <- unique(BiospecimenLocation$hmdb) + ## get unique HMDB IDs + CellLocation_HMDB <- unique(CellLocation$hmdb) - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% BiospecimenLocation_HMDB,] - } + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% CellLocation_HMDB, ] + } - ## disease - if(!is.null(disease)){ - Disease <- TablesList[["disease"]] - Disease <- Disease[Disease$disease %in% disease,]#Filter the disease + ## tissue_location + if (!is.null(tissue_location)) {# "All Tissues"? + TissueLocation <- TablesList[["tissue_location"]] + ## filter the tissue location + TissueLocation <- TissueLocation[TissueLocation$tissue_location %in% tissue_location, ] - #Get unique HMDB IDs - Disease_HMDB <- unique(Disease$hmdb) + ## get unique HMDB IDs + TissueLocation_HMDB <- unique(TissueLocation$hmdb) - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% Disease_HMDB,] - } + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% TissueLocation_HMDB, ] + } - ## pathway - if(!is.null(pathway)){ - Pathway <- TablesList[["pathway"]] - Pathway <- Pathway[Pathway$pathway %in% pathway,]#Filter the pathway + ## biospecimen_location + if (!is.null(biospecimen_location)) { + BiospecimenLocation <- TablesList[["biospecimen_location"]] + ## filter the biospecimen location + BiospecimenLocation <- BiospecimenLocation[BiospecimenLocation$biospecimen_location %in% biospecimen_location, ] + + ## get unique HMDB IDs + BiospecimenLocation_HMDB <- unique(BiospecimenLocation$hmdb) + + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% BiospecimenLocation_HMDB, ] + } - #Get unique HMDB IDs - Pathway_HMDB <- unique(Pathway$hmdb) + ## disease + if (!is.null(disease)) { + Disease <- TablesList[["disease"]] + ## Filter the disease + Disease <- Disease[Disease$disease %in% disease, ] + + ## get unique HMDB IDs + Disease_HMDB <- unique(Disease$hmdb) + + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% Disease_HMDB, ] + } - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% Pathway_HMDB,] - } + ## pathway + if (!is.null(pathway)) { + + Pathway <- TablesList[["pathway"]] + ## filter the pathway + Pathway <- Pathway[Pathway$pathway %in% pathway, ] + + ## get unique HMDB IDs + Pathway_HMDB <- unique(Pathway$hmdb) + + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% Pathway_HMDB, ] + } - ## hmdb_ids - if(!is.null(hmdb_ids)){ - #Only keep selected HMDB IDs - MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% hmdb_ids,] - } + ## hmdb_ids + if (!is.null(hmdb_ids)) { + ## only keep selected HMDB IDs + MetalinksDB <- MetalinksDB[MetalinksDB$hmdb %in% hmdb_ids, ] + } - ## uniprot_ids - if(!is.null(uniprot_ids)){ - #Only keep selected UniProt IDs - MetalinksDB <- MetalinksDB[MetalinksDB$uniprot %in% uniprot_ids,] - } + ## uniprot_ids + if (!is.null(uniprot_ids)) { + ## only keep selected UniProt IDs + MetalinksDB <- MetalinksDB[MetalinksDB$uniprot %in% uniprot_ids, ] + } - #------------------------------------------------------------------ - #Add other ID types: - ## Metabolite Name - MetalinksDB <- merge(MetalinksDB, TablesList[["metabolites"]], by="hmdb", all.x=TRUE) - - ## Gene Name - MetalinksDB <- merge(MetalinksDB, TablesList[["proteins"]], by="uniprot", all.x=TRUE) - - - ## Rearrange columns: - MetalinksDB <- MetalinksDB[,c(2,10:12, 1, 13:14, 3:9)]%>% - dplyr::mutate(type = dplyr::case_when( - type == "lr" ~ "Ligand-Receptor", - type == "pd" ~ "Production-Degradation", - TRUE ~ type # this keeps the original value if it doesn't match any condition - ))%>% - dplyr::mutate(mode_of_regulation = dplyr::case_when( - mor == -1 ~ "Inhibiting", - mor == 1 ~ "Activating", - mor == 0 ~ "Binding", - TRUE ~ as.character(mor) # this keeps the original value if it doesn't match any condition - )) - #-------------------------------------------------------- - #Remove metabolites that are not detectable by mass spectrometry - - - #------------------------------------------------------------------ - #Decide on useful selections term-metabolite for MetaProViz. - #MetalinksDB_Pathways <- merge(MetalinksDB[, c(1:3)], TablesList[["pathway"]], by="hmdb", all.x=TRUE) - - MetalinksDB_Type <-MetalinksDB[, c(1:3, 7,13)]%>% - subset(!is.na(protein_type))%>% - dplyr::mutate(term = gsub('\"', '', protein_type))%>% - unite(term_specific, c("term", "type"), sep = "_", remove = FALSE)%>% - dplyr::select(-"type", -"protein_type") - - #------------------------------------------------------------------ - #Save results in folder - ##-------------- Save and return - DF_List <- list("MetalinksDB"=MetalinksDB, - "MetalinksDB_Type"=MetalinksDB_Type) - suppressMessages(suppressWarnings( - SaveRes(InputList_DF= DF_List,#This needs to be a list, also for single comparisons - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "MetaLinksDB", - CoRe=FALSE, - PrintPlot=FALSE))) - - #Return into environment - return(invisible(DF_List)) + #------------------------------------------------------------------ + ## add other ID types: + ## Metabolite Name + MetalinksDB <- merge(MetalinksDB, TablesList[["metabolites"]], + by = "hmdb", all.x = TRUE) + + ## Gene Name + MetalinksDB <- merge(MetalinksDB, TablesList[["proteins"]], + by = "uniprot", all.x = TRUE) + + ## Rearrange columns: + MetalinksDB <- MetalinksDB[, c(2, 10:12, 1, 13:14, 3:9)] %>% + dplyr::mutate(type = dplyr::case_when( + type == "lr" ~ "Ligand-Receptor", + type == "pd" ~ "Production-Degradation", + # this keeps the original value if it doesn't match any condition + TRUE ~ type)) %>% + dplyr::mutate(mode_of_regulation = dplyr::case_when( + mor == -1 ~ "Inhibiting", + mor == 1 ~ "Activating", + mor == 0 ~ "Binding", + ## this keeps the original value if it doesn't match any condition + TRUE ~ as.character(mor))) + #-------------------------------------------------------- + ## remove metabolites that are not detectable by mass spectrometry + + ##------------------------------------------------------------------ + ## decide on useful selections term-metabolite for MetaProViz. + ## MetalinksDB_Pathways <- merge(MetalinksDB[, c(1:3)], TablesList[["pathway"]], by="hmdb", all.x=TRUE) + + MetalinksDB_Type <- MetalinksDB[, c(1:3, 7,13)] %>% + subset(!is.na(protein_type)) %>% + dplyr::mutate(term = gsub('\"', '', protein_type)) %>% + unite(term_specific, c("term", "type"), sep = "_", remove = FALSE) %>% + dplyr::select(-"type", -"protein_type") + + ##------------------------------------------------------------------ + ## save results in folder + ##-------------- Save and return + DF_List <- list("MetalinksDB" = MetalinksDB, + "MetalinksDB_Type" = MetalinksDB_Type) + suppressMessages(suppressWarnings( + SaveRes(data = DF_List, #This needs to be a list, also for single comparisons + plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "MetaLinksDB", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(DF_List) } diff --git a/R/HelperChecks.R b/R/HelperChecks.R index f6950e4f..1e4dd52d 100644 --- a/R/HelperChecks.R +++ b/R/HelperChecks.R @@ -45,283 +45,356 @@ #' #' @noRd #' -CheckInput <- function(InputData, - InputData_Num=TRUE, - SettingsFile_Sample=NULL, - SettingsFile_Metab=NULL, - SettingsInfo=NULL, - SaveAs_Plot=NULL, - SaveAs_Table=NULL, - CoRe=FALSE, - PrintPlot=FALSE, - Theme=NULL, - PlotSettings=NULL){ - ############## Parameters valid for multiple MetaProViz functions - - #-------------InputData - if(is.data.frame(InputData)==FALSE){ - message <- paste0("InputData should be a data.frame. It's currently a ", paste(class(InputData)), ".", sep = "") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(any(duplicated(row.names(InputData)))==TRUE){ - message <- paste0("Duplicated row.names of InputData, whilst row.names must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(InputData_Num==TRUE){ - Test_num <- apply(InputData, 2, function(x) is.numeric(x)) - if((any(Test_num) == FALSE) == TRUE){ - message <- paste0("InputData needs to be of class numeric") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - if(sum(duplicated(colnames(InputData))) > 0){ - message <- paste0("InputData contained duplicates column names, whilst col.names must be unique.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - #-------------SettingsFile - if(is.null(SettingsFile_Sample)==FALSE){ - Test_match <- merge(SettingsFile_Sample, InputData, by = "row.names", all = FALSE) - if(nrow(Test_match) == 0){ - message <- paste0("row.names InputData need to match row.names SettingsFile_Sample.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - if(is.null(SettingsFile_Metab)==FALSE){ - Test_match <- merge(SettingsFile_Metab, as.data.frame(t(InputData)), by = "row.names", all = FALSE) - if(nrow(Test_match) == 0){ - stop("col.names InputData need to match row.names SettingsFile_Metab.") - } - } - - #-------------SettingsInfo - if(is.vector(SettingsInfo)==FALSE & is.null(SettingsInfo)==FALSE){ - message <- paste0("SettingsInfo should be NULL or a vector. It's currently a ", paste(class(SettingsInfo), ".", sep = "")) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(SettingsInfo)==FALSE){ - #Conditions - if("Conditions" %in% names(SettingsInfo)){ - if(SettingsInfo[["Conditions"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ", SettingsInfo[["Conditions"]], " column selected as Conditions in SettingsInfo was not found in SettingsFile. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) +CheckInput <- function( + se, + ##InputData, + InputData_Num = TRUE, + ##SettingsFile_Sample = NULL, + ##SettingsFile_Metab = NULL, + SettingsInfo = NULL, + SaveAs_Plot = NULL, + SaveAs_Table = NULL, + CoRe = FALSE, + PrintPlot = FALSE, + Theme = NULL, + PlotSettings = NULL) { + + ############## Parameters valid for multiple MetaProViz functions + + ## obtain colnames and rownames from se + cols_se <- colnames(se) + rows_se <- rownames(se) + cols_a <- colnames(assay(se)) + rows_a <- rownames(assay(se)) + cols_cD <- colnames(colData(se)) + rows_cD <- rownames(colData(se)) + cols_rD <- colnames(rowData(se)) + rows_rD <- rownames(rowData(se)) + + #-------------InputData + if (!is(se, "SummarizedExperiment")) { + message <- paste0("InputData should be a SummarizedExperiment object. It is currently a ", + paste(class(se)), ".") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - - #Biological replicates - if("Biological_Replicates" %in% names(SettingsInfo)){ - if(SettingsInfo[["Biological_Replicates"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ", SettingsInfo[["Biological_Replicates"]], " column selected as Biological_Replicates in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + # if (!is.data.frame(InputData)) { + # message <- paste0("InputData should be a data.frame. It's currently a ", + # paste(class(InputData)), ".") + # logger::log_trace(paste0("Error ", message)) + # stop(message) + # } + if (any(duplicated(rows_se))) { + message <- paste0("Duplicated rownames of se, whilst rownames must be unique") + logger::log_trace(paste0("Error ", message)) stop(message) - } + } + # if (any(duplicated(row.names(InputData)))) { + # message <- paste0("Duplicated row.names of InputData, whilst row.names must be unique") + # logger::log_trace(paste0("Error ", message)) + # stop(message) + # } + + if (InputData_Num) { + Test_num <- apply(assay(se), 2, function(x) is.numeric(x)) + ##Test_num <- apply(InputData, 2, function(x) is.numeric(x)) + if (!any(Test_num)) { + message <- paste0("InputData needs to be of class numeric") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - #Numerator - if("Numerator" %in% names(SettingsInfo)==TRUE){ - if(SettingsInfo[["Numerator"]] %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]==FALSE){ - message <- paste0("The ",SettingsInfo[["Numerator"]], " column selected as numerator in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + if (any(duplicated(cols_se))) { + message <- paste0("se contains duplicates column names, whilst colnames must be unique.") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - - #Denominator - if("Denominator" %in% names(SettingsInfo)==TRUE){ - if(SettingsInfo[["Denominator"]] %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]==FALSE){ - message <- paste0("The ",SettingsInfo[["Denominator"]], " column selected as denominator in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + # if (sum(duplicated(colnames(InputData))) > 0) { + # message <- paste0("InputData contained duplicates column names, whilst col.names must be unique.") + # logger::log_trace(paste0("Error ", message)) + # stop(message) + # } + + #-------------SettingsFile + if (!all(cols_se == rows_cD)) { + message <- paste0("colnames assay(se) need to match rownames colData(se).") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - - #Denominator & Numerator - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==TRUE){ - message <- paste0("Check input. The selected denominator option is empty while ",paste(SettingsInfo[["Numerator"]])," has been selected as a numerator. Please add a denominator for 1-vs-1 comparison or remove the numerator for all-vs-all comparison.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + # if (!is.null(SettingsFile_Sample)) { + # Test_match <- merge(SettingsFile_Sample, InputData, + # by = "row.names", all = FALSE) + # if (nrow(Test_match) == 0) { + # message <- paste0("row.names InputData need to match row.names SettingsFile_Sample.") + # logger::log_trace(paste0("Error ", message)) + # stop(message) + # } + # } + + if (!all(rows_a == rows_rD)) { + message <- paste0("rownames assay(se) need to match rownames rowData(se).") + logger::log_trace(paste0("Error ", message)) + stop(message) } + # if (!is.null(SettingsFile_Metab)) { + # Test_match <- merge(SettingsFile_Metab, as.data.frame(t(InputData)), + # by = "row.names", all = FALSE) + # if (nrow(Test_match) == 0) { + # stop("col.names InputData need to match row.names SettingsFile_Metab.") + # } + # } - #Superplot - if("Superplot" %in% names(SettingsInfo)){ - if(SettingsInfo[["Superplot"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["Superplot"]], " column selected as Superplot column in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + #-------------SettingsInfo + if (!is.vector(SettingsInfo) & !is.null(SettingsInfo)) { + message <- paste0("SettingsInfo should be NULL or a vector. It's currently a ", + paste(class(SettingsInfo), ".")) + logger::log_trace(paste0("Error ", message)) stop(message) - } } - if(is.null(PlotSettings)==FALSE){ - if(PlotSettings== "Sample"){ - #Plot colour - if("color" %in% names(SettingsInfo)){ - if(SettingsInfo[["color"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["color"]], " column selected as color in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (!is.null(SettingsInfo)) { + + ## Conditions + if ("Conditions" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Conditions"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["Conditions"]], + " column selected as Conditions in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - #Plot shape - if("shape" %in% names(SettingsInfo)){ - if(SettingsInfo[["shape"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["shape"]], " column selected as shape in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + ## Biological replicates + if ("Biological_Replicates" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Biological_Replicates"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["Biological_Replicates"]], + " column selected as Biological_Replicates in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - #Plot individual - if("individual" %in% names(SettingsInfo)){ - if(SettingsInfo[["individual"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["individual"]], " column selected as individual in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - }else if(PlotSettings== "Feature"){ - if("color" %in% names(SettingsInfo)){ - if(SettingsInfo[["color"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["color"]], " column selected as color in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + ## Numerator + if ("Numerator" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Numerator"]] %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + message <- paste0("The ", SettingsInfo[["Numerator"]], + " column selected as numerator in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - #Plot shape - if("shape" %in% names(SettingsInfo)){ - if(SettingsInfo[["shape"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["shape"]], " column selected as shape in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + ## Denominator + if ("Denominator" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Denominator"]] %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + message <- paste0("The ", SettingsInfo[["Denominator"]], + " column selected as denominator in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - #Plot individual - if("individual" %in% names(SettingsInfo)){ - if(SettingsInfo[["individual"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["individual"]], " column selected as individual in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + ## Denominator & Numerator + if (!("Denominator" %in% names(SettingsInfo)) & "Numerator" %in% names(SettingsInfo)) { + message <- paste0("Check input. The selected denominator option is empty while ", + paste(SettingsInfo[["Numerator"]]), + " has been selected as a numerator. Please add a denominator for 1-vs-1 comparison or remove the numerator for all-vs-all comparison.") + logger::log_trace(paste0("Error ", message)) stop(message) - } - } - }else if(PlotSettings== "Both"){ - #Plot colour sample - if("color_Sample" %in% names(SettingsInfo)){ - if(SettingsInfo[["color_Sample"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["color_Sample"]], " column selected as color_Sample in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } } - #Plot colour Metab - if("color_Metab" %in% names(SettingsInfo)){ - if(SettingsInfo[["color_Metab"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["color_Metab"]], " column selected as color_Metab in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(sum(colnames(InputData) %in% SettingsFile_Metab$Metabolite) < length(InputData) ){ - message <- paste0("The InputData contains metabolites not found in SettingsFile_Metab.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } + ## Superplot + if ("Superplot" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Superplot"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["Superplot"]], + " column selected as Superplot column in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - # Plot shape_metab - if("shape_Metab" %in% names(SettingsInfo)){ - if(SettingsInfo[["shape_Metab"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["shape_Metab"]], " column selected as shape_Metab in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (!is.null(PlotSettings)) { + + if (PlotSettings == "Sample") { + + ## plot colour + if ("color" %in% names(SettingsInfo)) { + if (!SettingsInfo[["color"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["color"]], + " column selected as color in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot shape + if ("shape" %in% names(SettingsInfo)) { + if (!SettingsInfo[["shape"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["shape"]], + " column selected as shape in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot individual + if ("individual" %in% names(SettingsInfo)) { + if (!SettingsInfo[["individual"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["individual"]], " column selected as individual in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + } else if (PlotSettings == "Feature") { + + ## plot color + if ("color" %in% names(SettingsInfo)) { + if (!SettingsInfo[["color"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["color"]], + " column selected as color in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot shape + if ("shape" %in% names(SettingsInfo)) { + if (!SettingsInfo[["shape"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["shape"]], + " column selected as shape in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## Plot individual + if ("individual" %in% names(SettingsInfo)) { + if (!SettingsInfo[["individual"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["individual"]], + " column selected as individual in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + } else if (PlotSettings == "Both") { + + # plot colour sample + if ("color_Sample" %in% names(SettingsInfo)) { + if (!SettingsInfo[["color_Sample"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["color_Sample"]], + " column selected as color_Sample in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot colour Metab + if ("color_Metab" %in% names(SettingsInfo)) { + if (!SettingsInfo[["color_Metab"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["color_Metab"]], + " column selected as color_Metab in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!all(rows_a == rows_rD)) { + message <- paste0("assay(se) has to contain the same metabolites as in rowData(se).") + logger::log_trace(paste0("Warning ", message)) + warning(message) + } + } + + ## plot shape_metab + if ("shape_Metab" %in% names(SettingsInfo)) { + if (!SettingsInfo[["shape_Metab"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["shape_Metab"]], + " column selected as shape_Metab in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot shape_metab + if ("shape_Sample" %in% names(SettingsInfo)) { + if (!SettingsInfo[["shape_Sample"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["shape_Sample"]], + " column selected as shape_Metab in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot individual_Metab + if ("individual_Metab" %in% names(SettingsInfo)) { + if (!SettingsInfo[["individual_Metab"]] %in% cols_rD) { + message <- paste0("The ", SettingsInfo[["individual_Metab"]], + " column selected as individual_Metab in SettingsInfo was not found in rowData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## plot individual_Sample + if ("individual_Sample" %in% names(SettingsInfo)) { + if (!SettingsInfo[["individual_Sample"]] %in% cols_cD) { + message <- paste0("The ", SettingsInfo[["individual_Sample"]], + " column selected as individual_Sample in SettingsInfo was not found in colData(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + } } + } - # Plot shape_metab - if("shape_Sample" %in% names(SettingsInfo)){ - if(SettingsInfo[["shape_Sample"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["shape_Sample"]], " column selected as shape_Metab in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + #-------------SaveAs + Save_as_Plot_options <- c("svg","pdf", "png") ## EDIT: this should be rewritten with match.arg + if (!is.null(SaveAs_Plot)) { + if (!SaveAs_Plot %in% Save_as_Plot_options) { + message <- paste0("Check input. The selected SaveAs_Plot option is not valid. Please select one of the following: ", + paste(Save_as_Plot_options, collapse = ", "), + " or set to NULL if no plots should be saved.") + logger::log_trace(paste0("Error ", message)) stop(message) - } } + } - #Plot individual_Metab - if("individual_Metab" %in% names(SettingsInfo)){ - if(SettingsInfo[["individual_Metab"]] %in% colnames(SettingsFile_Metab)== FALSE){ - message <- paste0("The ",SettingsInfo[["individual_Metab"]], " column selected as individual_Metab in SettingsInfo was not found in SettingsFile_Metab. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + SaveAs_Table_options <- c("txt","csv", "xlsx", "RData")#RData = SummarizedExperiment (?) ## EDIT: this should be rewritten with match.arg + if (!is.null(SaveAs_Table)) { + if (!(SaveAs_Table %in% SaveAs_Table_options) | is.null(SaveAs_Table)) { + message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the following: ", + paste(SaveAs_Table_options,collapse = ", "), + " or set to NULL if no tables should be saved.") + logger::log_trace(paste0("Error ", message)) stop(message) - } } + } - #Plot individual_Sample - if("individual_Sample" %in% names(SettingsInfo)){ - if(SettingsInfo[["individual_Sample"]] %in% colnames(SettingsFile_Sample)== FALSE){ - message <- paste0("The ",SettingsInfo[["individual_Sample"]], " column selected as individual_Sample in SettingsInfo was not found in SettingsFile_Sample. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + #-------------CoRe + if (!is.logical(CoRe)) { + message <- paste0("Check input. The CoRe value should be either TRUE for preprocessing of Consumption/Release experiment or FALSE if not.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + #-------------Theme + if (!is.null(Theme)) { ## EDIT: this should be rewritten with match.arg + Theme_options <- c("theme_grey()", "theme_gray()", "theme_bw()", "theme_linedraw()", "theme_light()", "theme_dark()", "theme_minimal()", "theme_classic()", "theme_void()", "theme_test()") + if (!Theme %in% Theme_options) { + message <- paste0("Check input. Theme option is incorrect. You can check for complete themes here: https://ggplot2.tidyverse.org/reference/ggtheme.html. Options are the following: ", + paste(Theme_options, collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) stop(message) - } } - - } - } - } - - #-------------SaveAs - Save_as_Plot_options <- c("svg","pdf", "png") - if(is.null(SaveAs_Plot)==FALSE){ - if(SaveAs_Plot %in% Save_as_Plot_options == FALSE){ - message <- paste0("Check input. The selected SaveAs_Plot option is not valid. Please select one of the folowwing: ",paste(Save_as_Plot_options,collapse = ", ")," or set to NULL if no plots should be saved.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - SaveAs_Table_options <- c("txt","csv", "xlsx", "RData")#RData = SummarizedExperiment (?) - if(is.null(SaveAs_Table)==FALSE){ - if((SaveAs_Table %in% SaveAs_Table_options == FALSE)| (is.null(SaveAs_Table)==TRUE)){ - message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the folowwing: ",paste(SaveAs_Table_options,collapse = ", ")," or set to NULL if no tables should be saved.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - #-------------CoRe - if(is.logical(CoRe) == FALSE){ - message <- paste0("Check input. The CoRe value should be either =TRUE for preprocessing of Consuption/Release experiment or =FALSE if not.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - #-------------Theme - if(is.null(Theme)==FALSE){ - Theme_options <- c("theme_grey()", "theme_gray()", "theme_bw()", "theme_linedraw()", "theme_light()", "theme_dark()", "theme_minimal()", "theme_classic()", "theme_void()", "theme_test()") - if (Theme %in% Theme_options == FALSE){ - message <- paste0("Check input. Theme option is incorrect. You can check for complete themes here: https://ggplot2.tidyverse.org/reference/ggtheme.html. Options are the following: ",paste(Theme_options, collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + #------------- general + if (!is.logical(PrintPlot)) { + message <- paste0("Check input. PrintPlot should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - } - #------------- general - if(is.logical(PrintPlot) == FALSE){ - message <- paste0("Check input. PrintPlot should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } } ################################################################################################ @@ -348,71 +421,87 @@ CheckInput <- function(InputData, #' #' @noRd #' -CheckInput_PreProcessing <- function(SettingsFile_Sample, - SettingsInfo, - CoRe=FALSE, - FeatureFilt = "Modified", - FeatureFilt_Value = 0.8, - TIC = TRUE, - MVI= TRUE, - MVI_Percentage=50, - HotellinsConfidence = 0.99){ - if(is.vector(SettingsInfo)==TRUE){ - #-------------SettingsInfo - #CoRe - if(CoRe == TRUE){ # parse CoRe normalisation factor - message <- paste0("For Consumption Release experiment we are using the method from Jain M. REF: Jain et. al, (2012), Science 336(6084):1040-4, doi: 10.1126/science.1218595.") - logger::log_trace(paste("Message ", message, sep="")) - message(message) - if("CoRe_media" %in% names(SettingsInfo)){ - if(length(grep(SettingsInfo[["CoRe_media"]], SettingsFile_Sample[[SettingsInfo[["Conditions"]]]])) < 1){ # Check for CoRe_media samples - message <- paste0("No CoRe_media samples were provided in the 'Conditions' in the SettingsFile_Sample. For a CoRe experiment control media samples without cells have to be measured and be added in the 'Conditions' - column labeled as 'CoRe_media' (see @param section). Please make sure that you used the correct labelling or whether you need CoRe = FALSE for your analysis") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) +CheckInput_PreProcessing <- function(se, + SettingsInfo, + CoRe = FALSE, + FeatureFilt = "Modified", + FeatureFilt_Value = 0.8, + TIC = TRUE, + MVI = TRUE, + MVI_Percentage = 50, + HotellinsConfidence = 0.99) { + + if (is.vector(SettingsInfo)) { + + #-------------SettingsInfo + ## CoRe + if (CoRe) { + ## parse CoRe normalisation factor + message <- paste0("For Consumption Release experiment we are using the method from Jain M. REF: Jain et. al, (2012), Science 336(6084):1040-4, doi: 10.1126/science.1218595.") + logger::log_trace(paste0("Message ", message)) + message(message) + + if ("CoRe_media" %in% names(SettingsInfo)) { + if (length(grep(SettingsInfo[["CoRe_media"]], colData(se)[[SettingsInfo[["Conditions"]]]])) < 1) { + ## check for CoRe_media samples + message <- paste0("No CoRe_media samples were provided in the 'Conditions' in colData(se). ", + "For a CoRe experiment control media samples without cells have to be measured and be added ", + "in the 'Conditions' column labeled as 'CoRe_media' (see @param section). Please make sure ", + "that you used the correct labelling or whether you need CoRe = FALSE for your analysis") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + if (!"CoRe_norm_factor" %in% names(SettingsInfo)) { + message <- paste0("No growth rate or growth factor provided for ", + "normalising the CoRe result, hence CoRe_norm_factor set to ", + "1 for each sample") + logger::log_trace(paste0("Warning ", message)) + warning(message) + } } - } + } - if ("CoRe_norm_factor" %in% names(SettingsInfo)==FALSE){ - message <- paste0("No growth rate or growth factor provided for normalising the CoRe result, hence CoRe_norm_factor set to 1 for each sample") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } + #-------------General parameters + Feature_Filtering_options <- c("Standard", "Modified") + if (!FeatureFilt %in% Feature_Filtering_options & !is.null(FeatureFilt)) { + message <- paste0("Check input. The selected FeatureFilt option is not valid. ", + "Please set to NULL or select one of the folowwing: ", + paste(Feature_Filtering_options,collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + if (!is.numeric(FeatureFilt_Value) |FeatureFilt_Value > 1 | FeatureFilt_Value < 0) { + message <- paste0("Check input. The selected FeatureFilt_Value should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(TIC)) { + message <- paste0("Check input. The TIC value should be either `TRUE` if ", + "TIC normalization is to be performed or `FALSE` if no data ", + "normalization is to be applied.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(MVI)) { + message <- paste0("Check input. The MVI value should be either `TRUE` if ", + "missing value imputation should be performed or `FALSE` if not.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.numeric(MVI_Percentage) | HotellinsConfidence > 100 | HotellinsConfidence < 0) { + message <- paste0("Check input. The selected MVI_Percentage value should be numeric and between 0 and 100.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.numeric(HotellinsConfidence) | HotellinsConfidence > 1 | HotellinsConfidence < 0) { + message <- paste0("Check input. The selected HotellinsConfidence value ", + "should be numeric and between 0 and 1.") + logger::log_trace(paste("Error ", message, sep="")) + stop(message) } - } - - #-------------General parameters - Feature_Filtering_options <- c("Standard","Modified") - if(FeatureFilt %in% Feature_Filtering_options == FALSE & is.null(FeatureFilt)==FALSE){ - message <- paste0("Check input. The selected FeatureFilt option is not valid. Please set to NULL or select one of the folowwing: ",paste(Feature_Filtering_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.numeric(FeatureFilt_Value) == FALSE |FeatureFilt_Value > 1 | FeatureFilt_Value < 0){ - message <- paste0("Check input. The selected FeatureFilt_Value should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.logical(TIC) == FALSE){ - message <- paste0("Check input. The TIC value should be either `TRUE` if TIC normalization is to be performed or `FALSE` if no data normalization is to be applied.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.logical(MVI) == FALSE){ - message <- paste0("Check input. The MVI value should be either `TRUE` if mising value imputation should be performed or `FALSE` if not.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.numeric(MVI_Percentage)== FALSE |HotellinsConfidence > 100 | HotellinsConfidence < 0){ - message <- paste0("Check input. The selected MVI_Percentage value should be numeric and between 0 and 100.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if( is.numeric(HotellinsConfidence)== FALSE |HotellinsConfidence > 1 | HotellinsConfidence < 0){ - message <- paste0("Check input. The selected HotellinsConfidence value should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } } ################################################################################################ @@ -438,180 +527,236 @@ CheckInput_PreProcessing <- function(SettingsFile_Sample, #' @importFrom logger log_trace #' @importFrom dplyr filter select_if #' @importFrom magrittr %>% +#' @importFrom stats p.adjust.methods #' @importFrom utils combn #' #' @noRd #' -CheckInput_DMA <- function(InputData, - SettingsFile_Sample, - SettingsInfo= c(Conditions="Conditions", Numerator = NULL, Denominator = NULL), - StatPval ="lmFit", - StatPadj="fdr", - VST=FALSE, - PerformShapiro =TRUE, - PerformBartlett =TRUE, - Transform=TRUE){ - - #-------------SettingsInfo - if(is.null(SettingsInfo)==TRUE){ - message <- paste0("You have to provide SettingsInfo's for Conditions.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - ## ------------ Denominator/numerator ----------- ## - # Denominator and numerator: Define if we compare one_vs_one, one_vs_all or all_vs_all. - if("Denominator" %in% names(SettingsInfo)==FALSE & "Numerator" %in% names(SettingsInfo) ==FALSE){ - # all-vs-all: Generate all pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - comparisons <- utils::combn(unique(conditions), 2) %>% as.matrix() - #Settings: - MultipleComparison = TRUE - all_vs_all = TRUE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==FALSE){ - #all-vs-one: Generate the pairwise combinations - conditions = SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - denominator <- SettingsInfo[["Denominator"]] - numerator <-unique(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]) - # Remove denom from num - numerator <- numerator[!numerator %in% denominator] - comparisons <- t(expand.grid(numerator, denominator)) %>% as.data.frame() - #Settings: - MultipleComparison = TRUE - all_vs_all = FALSE - }else if("Denominator" %in% names(SettingsInfo)==TRUE & "Numerator" %in% names(SettingsInfo)==TRUE){ - # one-vs-one: Generate the comparisons - denominator <- SettingsInfo[["Denominator"]] - numerator <- SettingsInfo[["Numerator"]] - comparisons <- matrix(c(SettingsInfo[["Denominator"]], SettingsInfo[["Numerator"]])) - #Settings: - MultipleComparison = FALSE - all_vs_all = FALSE - } - - ## ------------ Test statistics ----------- ## - if(MultipleComparison==FALSE){ - STAT_pval_options <- c("t.test", "wilcox.test","chisq.test", "cor.test", "lmFit") - if(StatPval %in% STAT_pval_options == FALSE){ - message <- paste0("Check input. The selected StatPval option for Hypothesis testing is not valid for multiple comparison (one-vs-all or all-vs-all). Please select one of the following: ",paste(STAT_pval_options,collapse = ", ")," or specify numerator and denumerator." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) +CheckInput_DMA <- function( + se, + #InputData, + #SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), + StatPval = "lmFit", ## EDIT: show here the options and match with match.arg + StatPadj = p.adjust.methods, + VST = FALSE, + PerformShapiro = TRUE, + PerformBartlett = TRUE, + Transform = TRUE) { + + ## match arguments + StatPadj <- match.arg(StatPadj) + + ##-------------SettingsInfo + if (is.null(SettingsInfo)) { + message <- paste0("You have to provide SettingsInfo's for Conditions.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - }else{ - STAT_pval_options <- c("aov", "kruskal.test", "welch" ,"lmFit") - if(StatPval %in% STAT_pval_options == FALSE){ - message <- paste0("Check input. The selected StatPval option for Hypothesis testing is not valid for one-vs-one comparsion. Multiple comparison is selected. Please select one of the following: ",paste(STAT_pval_options,collapse = ", ")," or change numerator and denumerator." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + ## ------------ Denominator/numerator ----------- ## + ## Denominator and numerator: Define if we compare one_vs_one, + ## one_vs_all or all_vs_all. + if (!("Denominator" %in% names(SettingsInfo)) & !("Numerator" %in% names(SettingsInfo))) { ## EDIT: written several times in the funciton, write a function + + ## all-vs-all: Generate all pairwise combinations + conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- unique(conditions) + numerator <- unique(conditions) + comparisons <- utils::combn(unique(conditions), 2) %>% + as.matrix() + + ## settings: + MultipleComparison <- TRUE + all_vs_all <- TRUE + + } else if ("Denominator" %in% names(SettingsInfo) & !("Numerator" %in% names(SettingsInfo))) { + + ## all-vs-one: Generate the pairwise combinations + conditions = colData(se)[[SettingsInfo[["Conditions"]]]] + denominator <- SettingsInfo[["Denominator"]] + numerator <-unique(conditions) + + ## remove denom from num + numerator <- numerator[!numerator %in% denominator] + comparisons <- t(expand.grid(numerator, denominator)) %>% + as.data.frame() + + ## settings: + MultipleComparison <- TRUE + all_vs_all <- FALSE + + } else if ("Denominator" %in% names(SettingsInfo) & "Numerator" %in% names(SettingsInfo)) { + + ## one-vs-one: Generate the comparisons + denominator <- SettingsInfo[["Denominator"]] + numerator <- SettingsInfo[["Numerator"]] + comparisons <- matrix(c(SettingsInfo[["Denominator"]], SettingsInfo[["Numerator"]])) + + ## settings: + MultipleComparison <- FALSE + all_vs_all <- FALSE } - } - - STAT_padj_options <- c("holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none") - if(StatPadj %in% STAT_padj_options == FALSE){ - message <- paste0("Check input. The selected StatPadj option for multiple Hypothesis testing correction is not valid. Please select one of the folowing: ",paste(STAT_padj_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - ## ------------ Sample Numbers ----------- ## - Num <- InputData %>%#Are sample numbers enough? - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% numerator) %>% - dplyr::select_if(is.numeric)#only keep numeric columns with metabolite values - Denom <- InputData %>% - dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] %in% denominator) %>% - dplyr::select_if(is.numeric) - - if(nrow(Num)==1){ - message <- paste0("There is only one sample available for ", numerator, ", so no statistical test can be performed.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } else if(nrow(Denom)==1){ - message <- paste0("There is only one sample available for ", denominator, ", so no statistical test can be performed.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - }else if(nrow(Num)==0){ - message <- paste0("There is no sample available for ", numerator, ".") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - }else if(nrow(Denom)==0){ - message <- paste0("There is no sample available for ", denominator, ".") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - ## ------------ Check Missingness ------------- ## - Num_Miss <- replace(Num, Num==0, NA) - Num_Miss <- Num_Miss[, (colSums(is.na(Num_Miss)) > 0), drop = FALSE] - - Denom_Miss <- replace(Denom, Denom==0, NA) - Denom_Miss <- Denom_Miss[, (colSums(is.na(Denom_Miss)) > 0), drop = FALSE] - - if((ncol(Num_Miss)>0 & ncol(Denom_Miss)==0)){ - Metabolites_Miss <- colnames(Num_Miss) - if(ncol(Num_Miss)<=10){ - message <- paste0("In `Numerator` ",paste0(toString(numerator)), ", NA/0 values exist in ", ncol(Num_Miss), " Metabolite(s): ", paste0(colnames(Num_Miss), collapse = ", "), ". Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") - logger::log_info(message) - message(message) - }else{ - message <- paste0("In `Numerator` ",paste0(toString(numerator)), ", NA/0 values exist in ", ncol(Num_Miss), " Metabolite(s).", " Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") - logger::log_info(message) - message(message) + + ## ------------ Test statistics ----------- ## + if (!MultipleComparison) { + STAT_pval_options <- c("t.test", "wilcox.test","chisq.test", "cor.test", "lmFit") + + if (!StatPval %in% STAT_pval_options) { + message <- paste0("Check input. The selected StatPval option for ", + "Hypothesis testing is not valid for multiple comparison ", + "(one-vs-all or all-vs-all). Please select one of the following: ", + paste(STAT_pval_options,collapse = ", "), + " or specify numerator and denumerator." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } else { + STAT_pval_options <- c("aov", "kruskal.test", "welch" ,"lmFit") + + if (!StatPval %in% STAT_pval_options) { + message <- paste0("Check input. The selected StatPval option for Hypothesis testing is not valid for one-vs-one comparsion. Multiple comparison is selected. Please select one of the following: ",paste(STAT_pval_options,collapse = ", ")," or change numerator and denumerator." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + STAT_padj_options <- c("holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none") + if (!StatPadj %in% STAT_padj_options) { + message <- paste0("Check input. The selected StatPadj option for ", + "multiple Hypothesis testing correction is not valid. Please ", + "select one of the folowing: ", + paste(STAT_padj_options,collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + ## ------------ Sample Numbers ----------- ## + Num <- assay(se)[, colData(se)[[SettingsInfo[["Conditions"]]]] %in% numerator]## %>% + ## are sample numbers enough? + ##dplyr::filter(colData(se)[[SettingsInfo[["Conditions"]]]] %in% numerator) %>% + ## only keep numeric columns with metabolite values + #dplyr::select_if (is.numeric) + Denom <- assay(se)[, colData(se)[[SettingsInfo[["Conditions"]]]] %in% denominator]## %>% + ##as.data.frame() |> + #dplyr::select(colData(se)[[SettingsInfo[["Conditions"]]]] %in% denominator) %>% + ##dplyr::select_if (is.numeric) + + if (ncol(Num) == 1) { + message <- paste0("There is only one sample available for ", + numerator, ". No statistical test can be performed.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } else if (ncol(Denom) == 1) { + message <- paste0("There is only one sample available for ", + denominator, ". No statistical test can be performed.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } else if (ncol(Num) == 0) { + message <- paste0("There is no sample available for ", numerator, ".") + logger::log_trace(paste0("Error ", message)) + stop(message) + } else if (ncol(Denom) == 0) { + message <- paste0("There is no sample available for ", denominator, ".") + logger::log_trace(paste0("Error ", message)) + stop(message) } - } else if(ncol(Num_Miss)==0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- colnames(Denom_Miss) - if(ncol(Num_Miss)<=10){ - message <- paste0("In `Denominator` ",paste0(toString(denominator)), ", NA/0 values exist in ", ncol(Denom_Miss), " Metabolite(s): ", paste0(colnames(Denom_Miss), collapse = ", "), ". Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") - logger::log_info(message) - message(message) - }else{ - message <- paste0("In `Denominator` ",paste0(toString(denominator)), ", NA/0 values exist in ", ncol(Denom_Miss), " Metabolite(s).", " Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") - logger::log_info(message) - message(message)# + + ## ------------ Check Missingness ------------- ## + Num_Miss <- replace(Num, Num == 0, NA) + Num_Miss <- Num_Miss[rowSums(is.na(Num_Miss)) > 0, , drop = FALSE] + + Denom_Miss <- replace(Denom, Denom == 0, NA) + Denom_Miss <- Denom_Miss[rowSums(is.na(Denom_Miss)) > 0, , drop = FALSE] + + if (nrow(Num_Miss) > 0 & nrow(Denom_Miss) == 0) { + Metabolites_Miss <- rownames(Num_Miss) + if (nrow(Num_Miss) <= 10) { + message <- paste0("In `Numerator` ", paste0(toString(numerator)), + ", NA/0 values exist in ", nrow(Num_Miss), " Metabolite(s): ", + paste0(rownames(Num_Miss), collapse = ", "), + ". Those metabolite(s) might return p.val= NA, p.adj.= NA, ", + "t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") + logger::log_info(message) + message(message) + } else { + message <- paste0("In `Numerator` ", paste0(toString(numerator)), + ", NA/0 values exist in ", nrow(Num_Miss), " Metabolite(s).", + " Those metabolite(s) might return p.val= NA, p.adj.= NA, ", + "t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") + logger::log_info(message) + message(message) + } + } else if (nrow(Num_Miss) == 0 & nrow(Denom_Miss) > 0) { + Metabolites_Miss <- rownames(Denom_Miss) + if (nrow(Num_Miss) <= 10) { + message <- paste0("In `Denominator` ", paste0(toString(denominator)), + ", NA/0 values exist in ", nrow(Denom_Miss), " Metabolite(s): ", + paste0(rownames(Denom_Miss), collapse = ", "), + ". Those metabolite(s) might return p.val= NA, p.adj.= NA, ", + "t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") + logger::log_info(message) + message(message) + } else { + message <- paste0("In `Denominator` ", + paste0(toString(denominator)), + ", NA/0 values exist in ", nrow(Denom_Miss), " Metabolite(s).", + " Those metabolite(s) might return p.val= NA, p.adj.= NA, ", + "t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") + logger::log_info(message) + message(message) + } + } else if (nrow(Num_Miss) > 0 & nrow(Denom_Miss) > 0) { + Metabolites_Miss <- c(rownames(Num_Miss), rownames(Denom_Miss)) + Metabolites_Miss <- unique(Metabolites_Miss) + + message <- paste0("In `Numerator` ", paste0(toString(numerator)), + ", NA/0 values exist in ", nrow(Num_Miss), " Metabolite(s).", + " and in `denominator`",paste0(toString(denominator)), " ", + ncol(Denom_Miss), " Metabolite(s).", + ". Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. ", + "The Log2FC = Inf, if all replicates are 0/NA.") + logger::log_info(message) + message(message) + } else { + message <- paste0("There are no NA/0 values") + logger::log_info(message) + message(message) + + Metabolites_Miss <- c(rownames(Num_Miss), rownames(Denom_Miss)) + Metabolites_Miss <- unique(Metabolites_Miss) + } + + #-------------General parameters + if (!is.logical(VST)) { + message <- paste0("Check input. The VST value should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + if (!is.logical(PerformShapiro)) { + message <- paste0("Check input. The Shapiro value should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(PerformBartlett)) { + message <- paste0("Check input. The Bartlett value should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(Transform)) { + message <- paste0("Check input. `Transform` should be either =TRUE or =FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - } else if(ncol(Num_Miss)>0 & ncol(Denom_Miss)>0){ - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - - message <- paste0("In `Numerator` ",paste0(toString(numerator)), ", NA/0 values exist in ", ncol(Num_Miss), " Metabolite(s).", " and in `denominator`",paste0(toString(denominator)), " ",ncol(Denom_Miss), " Metabolite(s).", - ". Those metabolite(s) might return p.val= NA, p.adj.= NA, t.val= NA. The Log2FC = Inf, if all replicates are 0/NA.") - logger::log_info(message) - message(message) - } else{ - message <- paste0("There are no NA/0 values") - logger::log_info(message) - message(message) - - Metabolites_Miss <- c(colnames(Num_Miss), colnames(Denom_Miss)) - Metabolites_Miss <- unique(Metabolites_Miss) - } - - #-------------General parameters - if(is.logical(VST) == FALSE){ - message <- paste0("Check input. The VST value should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.logical(PerformShapiro) == FALSE){ - message <- paste0("Check input. The Shapiro value should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.logical(PerformBartlett) == FALSE){ - message <- paste0("Check input. The Bartlett value should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.logical(Transform) == FALSE){ - message <- paste0("Check input. `Transform` should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - Settings <- list("comparisons"=comparisons, "MultipleComparison"=MultipleComparison, "all_vs_all"=all_vs_all, "Metabolites_Miss"=Metabolites_Miss, "denominator"=denominator, "numerator"=numerator) - return(invisible(Settings)) + + Settings <- list( + "comparisons" = comparisons, "MultipleComparison" = MultipleComparison, + "all_vs_all" = all_vs_all, "Metabolites_Miss" = Metabolites_Miss, + "denominator" = denominator, "numerator" = numerator) + + ## return + invisible(Settings) } ################################################################################################ @@ -640,164 +785,187 @@ CheckInput_DMA <- function(InputData, #' #' @noRd #' -CheckInput_ORA <- function(InputData, - SettingsInfo=c(pvalColumn="p.adj", PercentageColumn="t.val", PathwayTerm= "term", PathwayFeature= "Metabolite"), - pCutoff=0.05, - PercentageCutoff=10, - PathwayFile, - PathwayName="", - minGSSize=10, - maxGSSize=1000 , - SaveAs_Table="csv", - RemoveBackground -){ - # 1. The input data: - if(class(InputData) != "data.frame"){ - message <- paste0("InputData should be a data.frame. It's currently a ", paste(class(InputData), ".",sep = "")) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(any(duplicated(row.names(InputData)))==TRUE){ - message <- paste0("Duplicated row.names of InputData, whilst row.names must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - # 2. Settings Columns: - if(is.vector(SettingsInfo)==FALSE & is.null(SettingsInfo)==FALSE){ - message <- paste0("SettingsInfo should be NULL or a vector. It's currently a ", paste(class(SettingsInfo), ".", sep = "")) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(SettingsInfo)==FALSE){ - #"ClusterColumn" - if("ClusterColumn" %in% names(SettingsInfo)){ - if(SettingsInfo[["ClusterColumn"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["ClusterColumn"]], " column selected as ClusterColumn in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) +CheckInput_ORA <- function( + se, + ##InputData, + SettingsInfo = c(pvalColumn = "p.adj", PercentageColumn = "t.val", + PathwayTerm = "term", PathwayFeature = "Metabolite"), + pCutoff = 0.05, + PercentageCutoff = 10, + PathwayFile, + PathwayName = "", + minGSSize = 10, + maxGSSize = 1000 , + SaveAs_Table = "csv", ## EDIT: name here the options and use match.arg + RemoveBackground) { + + ## obtain colnames and rownames from assay(se) + cols_a <- colnames(assay(se)) + rows_a <- rownames(assay(se)) + + ## 1. The input data: + if (is(assay(se), "matrix")) { + message <- paste0( + "assay(se) should be a matrix. It's currently a ", + paste(class(assay(se)), ".")) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (any(duplicated(rows_a))) { + message <- paste0("Duplicated rownames of assay(se), whilst rownames must be unique") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - #"BackgroundColumn" - if("BackgroundColumn" %in% names(SettingsInfo)){ - if(SettingsInfo[["BackgroundColumn"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["BackgroundColumn"]], " column selected as BackgroundColumn in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + # 2. Settings Columns: + if (!is.vector(SettingsInfo) & !is.null(SettingsInfo)) { + message <- paste0( + "SettingsInfo should be NULL or a vector. It's currently a ", + paste0(class(SettingsInfo), ".")) + logger::log_trace(paste0("Error ", message)) stop(message) - } } - #"pvalColumn" - if("pvalColumn" %in% names(SettingsInfo)){ - if(SettingsInfo[["pvalColumn"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["pvalColumn"]], " column selected as pvalColumn in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + if (!is.null(SettingsInfo)) { + ## "ClusterColumn" + if ("ClusterColumn" %in% names(SettingsInfo)) { + if (!SettingsInfo[["ClusterColumn"]] %in% cols_a) { + message <- paste0("The ", SettingsInfo[["ClusterColumn"]], + " column selected as ClusterColumn in SettingsInfo was not ", + "found in assay(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## "BackgroundColumn" + if ("BackgroundColumn" %in% names(SettingsInfo)) { + if (!SettingsInfo[["BackgroundColumn"]] %in% cols_a) { + message <- paste0("The ", SettingsInfo[["BackgroundColumn"]], + " column selected as BackgroundColumn in SettingsInfo was ", + "not found in assay(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## "pvalColumn" + if ("pvalColumn" %in% names(SettingsInfo)) { + if (!SettingsInfo[["pvalColumn"]] %in% cols_a) { + message <- paste0("The ", SettingsInfo[["pvalColumn"]], + " column selected as pvalColumn in SettingsInfo was not ", + "found in assay(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## "PercentageColumn" + if ("PercentageColumn" %in% names(SettingsInfo)) { + if (!SettingsInfo[["PercentageColumn"]] %in% cols_a) { + message <- paste0("The ", SettingsInfo[["PercentageColumn"]], + " column selected as PercentageColumn in SettingsInfo was ", + "not found in assay(se). Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## "PathwayTerm" + if ("PathwayTerm" %in% names(SettingsInfo)) { + if (!SettingsInfo[["PathwayTerm"]] %in% colnames(PathwayFile)) { + message <- paste0("The ", SettingsInfo[["PathwayTerm"]], + " column selected as PathwayTerm in SettingsInfo was not ", + "found in PathwayFile. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } else { + PathwayFile <- PathwayFile%>% + dplyr::rename("term" = SettingsInfo[["PathwayTerm"]]) + PathwayFile$Description <- PathwayFile$term + } + } else { + message <- paste0("SettingsInfo must provide the column name for PathwayTerm in PathwayFile") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + ## PathwayFeature + if ("PathwayFeature" %in% names(SettingsInfo)) { + if (!SettingsInfo[["PathwayFeature"]] %in% colnames(PathwayFile)) { + message <- paste0("The ", SettingsInfo[["PathwayFeature"]], + " column selected as PathwayFeature in SettingsInfo was not ", + "found in PathwayFile. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } else { + PathwayFile <- PathwayFile %>% + dplyr::rename("gene" = SettingsInfo[["PathwayFeature"]]) + } + } else { + message <- paste0("SettingsInfo must provide the column name for PathwayFeature in PathwayFile") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + } else { + message <- paste0("You must provide SettingsInfo.") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - #"PercentageColumn" - if("PercentageColumn" %in% names(SettingsInfo)){ - if(SettingsInfo[["PercentageColumn"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["PercentageColumn"]], " column selected as PercentageColumn in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + ## 3. General Settings + if (!is.character(PathwayName)) { + message <- paste0("Check input. PathwayName must be a character of syntax 'example'.") + logger::log_trace(paste0("Error ", message)) stop(message) - } } - #"PathwayTerm" - if("PathwayTerm" %in% names(SettingsInfo)){ - if(SettingsInfo[["PathwayTerm"]] %in% colnames(PathwayFile)== FALSE){ - message <- paste0("The ", SettingsInfo[["PathwayTerm"]], " column selected as PathwayTerm in SettingsInfo was not found in PathwayFile. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + if (!is.logical(RemoveBackground)) { + message <- paste0("Check input. RemoveBackground value should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) stop(message) - }else{ - PathwayFile <- PathwayFile%>% - dplyr::rename("term"=SettingsInfo[["PathwayTerm"]]) - PathwayFile$Description <- PathwayFile$term - } - }else{ - message <- paste0("SettingsInfo must provide the column name for PathwayTerm in PathwayFile") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) } - # PathwayFeature - if("PathwayFeature" %in% names(SettingsInfo)){ - if(SettingsInfo[["PathwayFeature"]] %in% colnames(PathwayFile)== FALSE){ - message <- paste0("The ", SettingsInfo[["PathwayFeature"]], " column selected as PathwayFeature in SettingsInfo was not found in PathwayFile. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) + if (!is.numeric(minGSSize)) { + message <- paste0("Check input. The selected minGSSize value should be numeric.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + if (!is.numeric(maxGSSize)) { + message <- paste0("Check input. The selected maxGSSize value should be numeric.") + logger::log_trace(paste0("Error ", message)) stop(message) - }else{ - PathwayFile <- PathwayFile%>% - dplyr::rename("gene"=SettingsInfo[["PathwayFeature"]]) - } - }else{ - message <- paste0("SettingsInfo must provide the column name for PathwayFeature in PathwayFile") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) } - }else{ - message <- paste0("You must provide SettingsInfo.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - # 3. General Settings - if(is.character(PathwayName)==FALSE){ - message <- paste0("Check input. PathwayName must be a character of syntax 'example'.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.logical(RemoveBackground) == FALSE){ - message <- paste0("Check input. RemoveBackground value should be either =TRUE or = FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.numeric(minGSSize)== FALSE){ - message <- paste0("Check input. The selected minGSSize value should be numeric.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.numeric(maxGSSize)== FALSE){ - message <- paste0("Check input. The selected maxGSSize value should be numeric.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - SaveAs_Table_options <- c("txt","csv", "xlsx") - if(is.null(SaveAs_Table)==FALSE){ - if((SaveAs_Table %in% SaveAs_Table_options == FALSE)| (is.null(SaveAs_Table)==TRUE)){ - message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the folowing: ",paste(SaveAs_Table_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + SaveAs_Table_options <- c("txt","csv", "xlsx") + if (!is.null(SaveAs_Table)) { + if (!(SaveAs_Table %in% SaveAs_Table_options)| is.null(SaveAs_Table)) { + message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the folowing: ",paste(SaveAs_Table_options,collapse = ", "),"." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - if(is.null(pCutoff)== FALSE){ - if(is.numeric(pCutoff)== FALSE | pCutoff > 1 | pCutoff < 0){ - message <- paste0("Check input. The selected pCutoff value should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + if (!is.null(pCutoff)) { + if (!is.numeric(pCutoff) | pCutoff > 1 | pCutoff < 0) { + message <- paste0("Check input. The selected pCutoff value should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - if(is.null(PercentageCutoff)== FALSE){ - if( is.numeric(PercentageCutoff)== FALSE | PercentageCutoff > 100 | PercentageCutoff < 0){ - message <- paste0("Check input. The selected PercentageCutoff value should be numeric and between 0 and 100.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + if (!is.null(PercentageCutoff)) { + if (!is.numeric(PercentageCutoff) | PercentageCutoff > 100 | PercentageCutoff < 0) { + message <- paste0("Check input. The selected PercentageCutoff value should be numeric and between 0 and 100.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - ## -------- Return Pathways ---------## - return(invisible(PathwayFile)) + ## -------- Return Pathways ---------## + invisible(PathwayFile) } @@ -828,246 +996,247 @@ CheckInput_ORA <- function(InputData, #' @noRd #' CheckInput_MCA <- function(InputData_C1, - InputData_C2, - InputData_CoRe, - InputData_Intra, - SettingsInfo_C1, - SettingsInfo_C2, - SettingsInfo_CoRe, - SettingsInfo_Intra, - FeatureID= "Metabolite", - BackgroundMethod="Intra&CoRe", - SaveAs_Table = "csv" -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - #------------- InputData - if(is.null(InputData_C1)==FALSE){ - if(class(InputData_C1) != "data.frame"| class(InputData_C2) != "data.frame"){ - message <- paste0("InputData_C1 and InputData_C2 should be a data.frame. It's currently a ", paste(class(InputData_C1)), paste(class(InputData_C2)), ".",sep = "") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(length(InputData_C1[duplicated(InputData_C1[[FeatureID]]), FeatureID]) > 0){ - message <- paste0("Duplicated FeatureIDs of InputData_C1, whilst features must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(length(InputData_C2[duplicated(InputData_C2[[FeatureID]]), FeatureID]) > 0){ - message <- paste0("Duplicated FeatureIDs of InputData_C2, whilst features must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + InputData_C2, + InputData_CoRe, + InputData_Intra, + SettingsInfo_C1, + SettingsInfo_C2, + SettingsInfo_CoRe, + SettingsInfo_Intra, + FeatureID = "Metabolite", + BackgroundMethod = "Intra&CoRe", + SaveAs_Table = "csv") { ## EDIT: provide options here + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + #------------- InputData ## EDIT: this can be simplified, when you are checking for C1 and C2 for the same attributes, write a function and apply on C1 and C2 separately + if (!is.null(InputData_C1)) { + if (class(InputData_C1) != "data.frame"| class(InputData_C2) != "data.frame") { + message <- paste0( + "InputData_C1 and InputData_C2 should be a data.frame. It's currently a ", + paste(class(InputData_C1)), paste(class(InputData_C2)), ".") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (length(InputData_C1[duplicated(InputData_C1[[FeatureID]]), FeatureID]) > 0) { + message <- paste0("Duplicated FeatureIDs of InputData_C1, whilst features must be unique") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (length(InputData_C2[duplicated(InputData_C2[[FeatureID]]), FeatureID]) > 0) { + message <- paste0("Duplicated FeatureIDs of InputData_C2, whilst features must be unique") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - }else{ - if(class(InputData_Intra) != "data.frame"| class(InputData_CoRe) != "data.frame"){ - message <- paste0("InputData_Intra and InputData_CoRe should be a data.frame. It's currently a ", paste(class(InputData_Intra)), paste(class(InputData_CoRe)), ".",sep = "") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(length(InputData_Intra[duplicated(InputData_Intra[[FeatureID]]), FeatureID]) > 0){ - message <- paste0("Duplicated FeatureIDs of InputData_Intra, whilst features must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(length(InputData_CoRe[duplicated(InputData_CoRe[[FeatureID]]), FeatureID]) > 0){ - message <- paste0("Duplicated FeatureIDs of InputData_CoRe, whilst features must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - #------------- SettingsInfo - if(is.null(SettingsInfo_C1)==FALSE){ - ## C1 - #ValueCol - if("ValueCol" %in% names(SettingsInfo_C1)){ - if(SettingsInfo_C1[["ValueCol"]] %in% colnames(InputData_C1)== FALSE){ - message <- paste0("The ", SettingsInfo_C1[["ValueCol"]], " column selected as ValueCol in SettingsInfo_C1 was not found in InputData_C1. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - #StatCol - if("StatCol" %in% names(SettingsInfo_C1)){ - if(SettingsInfo_C1[["StatCol"]] %in% colnames(InputData_C1)== FALSE){ - message <- paste0("The ", SettingsInfo_C1[["StatCol"]], " column selected as StatCol in SettingsInfo_C1 was not found in InputData_C1. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + } else { + if (class(InputData_Intra) != "data.frame"| class(InputData_CoRe) != "data.frame") { + message <- paste0("InputData_Intra and InputData_CoRe should be a data.frame. It's currently a ", paste(class(InputData_Intra)), paste(class(InputData_CoRe)), ".",sep = "") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (length(InputData_Intra[duplicated(InputData_Intra[[FeatureID]]), FeatureID]) > 0) { + message <- paste0("Duplicated FeatureIDs of InputData_Intra, whilst features must be unique") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (length(InputData_CoRe[duplicated(InputData_CoRe[[FeatureID]]), FeatureID]) > 0) { + message <- paste0("Duplicated FeatureIDs of InputData_CoRe, whilst features must be unique") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - ## C2 - #ValueCol - if("ValueCol" %in% names(SettingsInfo_C2)){ - if(SettingsInfo_C2[["ValueCol"]] %in% colnames(InputData_C2)== FALSE){ - message <- paste0("The ", SettingsInfo_C2[["ValueCol"]], " column selected as ValueCol in SettingsInfo_C2 was not found in InputData_C2. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - #StatCol - if("StatCol" %in% names(SettingsInfo_C2)){ - if(SettingsInfo_C2[["StatCol"]] %in% colnames(InputData_C2)== FALSE){ - message <- paste0("The ", SettingsInfo_C2[["StatCol"]], " column selected as StatCol in SettingsInfo_C2 was not found in InputData_C2. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - }else{ - ## Intra - #ValueCol - if("ValueCol" %in% names(SettingsInfo_Intra)){ - if(SettingsInfo_Intra[["ValueCol"]] %in% colnames(InputData_Intra)== FALSE){ - message <- paste0("The ", SettingsInfo_Intra[["ValueCol"]], " column selected as ValueCol in SettingsInfo_Intra was not found in InputData_Intra. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - #StatCol - if("StatCol" %in% names(SettingsInfo_Intra)){ - if(SettingsInfo_Intra[["StatCol"]] %in% colnames(InputData_Intra)== FALSE){ - message <- paste0("The ", SettingsInfo_Intra[["StatCol"]], " column selected as StatCol in SettingsInfo_Intra was not found in InputData_Intra. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } + #------------- SettingsInfo + if (!is.null(SettingsInfo_C1)) { + ## C1 + ## ValueCol + if ("ValueCol" %in% names(SettingsInfo_C1)) { + if (!SettingsInfo_C1[["ValueCol"]] %in% colnames(InputData_C1)) { + message <- paste0("The ", SettingsInfo_C1[["ValueCol"]], " column selected as ValueCol in SettingsInfo_C1 was not found in InputData_C1. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + ## StatCol + if ("StatCol" %in% names(SettingsInfo_C1)) { + if (!SettingsInfo_C1[["StatCol"]] %in% colnames(InputData_C1)) { + message <- paste0("The ", SettingsInfo_C1[["StatCol"]], " column selected as StatCol in SettingsInfo_C1 was not found in InputData_C1. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } - ## CoRe - #ValueCol - if("ValueCol" %in% names(SettingsInfo_CoRe)){ - if(SettingsInfo_CoRe[["ValueCol"]] %in% colnames(InputData_CoRe)== FALSE){ - message <- paste0("The ", SettingsInfo_CoRe[["ValueCol"]], " column selected as ValueCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - #StatCol - if("StatCol" %in% names(SettingsInfo_CoRe)){ - if(SettingsInfo_CoRe[["StatCol"]] %in% colnames(InputData_CoRe)== FALSE){ - message <- paste0("The ", SettingsInfo_CoRe[["StatCol"]], " column selected as StatCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } + ## C2 + ## ValueCol + if ("ValueCol" %in% names(SettingsInfo_C2)) { + if (!SettingsInfo_C2[["ValueCol"]] %in% colnames(InputData_C2)) { + message <- paste0("The ", SettingsInfo_C2[["ValueCol"]], " column selected as ValueCol in SettingsInfo_C2 was not found in InputData_C2. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + ## StatCol + if ("StatCol" %in% names(SettingsInfo_C2)) { + if (!SettingsInfo_C2[["StatCol"]] %in% colnames(InputData_C2)) { + message <- paste0("The ", SettingsInfo_C2[["StatCol"]], " column selected as StatCol in SettingsInfo_C2 was not found in InputData_C2. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + } else { + ## Intra + ## ValueCol + if ("ValueCol" %in% names(SettingsInfo_Intra)) { + if (!SettingsInfo_Intra[["ValueCol"]] %in% colnames(InputData_Intra)) { + message <- paste0("The ", SettingsInfo_Intra[["ValueCol"]], " column selected as ValueCol in SettingsInfo_Intra was not found in InputData_Intra. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + ## StatCol + if ("StatCol" %in% names(SettingsInfo_Intra)) { + if (!SettingsInfo_Intra[["StatCol"]] %in% colnames(InputData_Intra)) { + message <- paste0("The ", SettingsInfo_Intra[["StatCol"]], " column selected as StatCol in SettingsInfo_Intra was not found in InputData_Intra. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } - #StatCol - if("DirectionCol" %in% names(SettingsInfo_CoRe)){ - if(SettingsInfo_CoRe[["DirectionCol"]] %in% colnames(InputData_CoRe)== FALSE){ - message <- paste0("The ", SettingsInfo_CoRe[["DirectionCol"]], " column selected as DirectionCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + ## CoRe + ## ValueCol + if ("ValueCol" %in% names(SettingsInfo_CoRe)) { + if (!SettingsInfo_CoRe[["ValueCol"]] %in% colnames(InputData_CoRe)) { + message <- paste0("The ", SettingsInfo_CoRe[["ValueCol"]], " column selected as ValueCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + ## StatCol + if ("StatCol" %in% names(SettingsInfo_CoRe)) { + if (!SettingsInfo_CoRe[["StatCol"]] %in% colnames(InputData_CoRe)) { + message <- paste0("The ", SettingsInfo_CoRe[["StatCol"]], " column selected as StatCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + ## StatCol + if ("DirectionCol" %in% names(SettingsInfo_CoRe)) { + if (!SettingsInfo_CoRe[["DirectionCol"]] %in% colnames(InputData_CoRe)) { + message <- paste0("The ", SettingsInfo_CoRe[["DirectionCol"]], " column selected as DirectionCol in SettingsInfo_CoRe was not found in InputData_CoRe. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } } - } + #------------- SettingsInfo Cutoffs: ## EDIT: this can be simplified, when you are checking for C1 and C2 for the same attributes, write a function and apply on C1 and C2 separately + if (!is.null(SettingsInfo_C1)) { + if (is.na(as.numeric(SettingsInfo_C1[["StatCutoff"]])) |as.numeric(SettingsInfo_C1[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_C1[["StatCutoff"]]) < 0) { + message <- paste0("Check input. The selected StatCutoff in SettingsInfo_C1 should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - #------------- SettingsInfo Cutoffs: - if(is.null(SettingsInfo_C1)==FALSE){ - if(is.na(as.numeric(SettingsInfo_C1[["StatCutoff"]])) == TRUE |as.numeric(SettingsInfo_C1[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_C1[["StatCutoff"]]) < 0){ - message <- paste0("Check input. The selected StatCutoff in SettingsInfo_C1 should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (is.na(as.numeric(SettingsInfo_C2[["StatCutoff"]])) |as.numeric(SettingsInfo_C2[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_C2[["StatCutoff"]]) < 0) { + message <- paste0("Check input. The selected StatCutoff in SettingsInfo_C2 should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(is.na(as.numeric(SettingsInfo_C2[["StatCutoff"]])) == TRUE |as.numeric(SettingsInfo_C2[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_C2[["StatCutoff"]]) < 0){ - message <- paste0("Check input. The selected StatCutoff in SettingsInfo_C2 should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (is.na(as.numeric(SettingsInfo_C1[["ValueCutoff"]]))) { + message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_C1 should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(is.na(as.numeric(SettingsInfo_C1[["ValueCutoff"]])) == TRUE){ - message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_C1 should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (is.na(as.numeric(SettingsInfo_C2[["ValueCutoff"]]))) { + message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_C2 should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(is.na(as.numeric(SettingsInfo_C2[["ValueCutoff"]])) == TRUE){ - message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_C2 should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + } else { + if (is.na(as.numeric(SettingsInfo_Intra[["StatCutoff"]])) | as.numeric(SettingsInfo_Intra[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_Intra[["StatCutoff"]]) < 0) { + message <- paste0("Check input. The selected StatCutoff in SettingsInfo_Intra should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - }else{ - if(is.na(as.numeric(SettingsInfo_Intra[["StatCutoff"]])) == TRUE |as.numeric(SettingsInfo_Intra[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_Intra[["StatCutoff"]]) < 0){ - message <- paste0("Check input. The selected StatCutoff in SettingsInfo_Intra should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (is.na(as.numeric(SettingsInfo_CoRe[["StatCutoff"]])) |as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) < 0) { + message <- paste0("Check input. The selected StatCutoff in SettingsInfo_CoRe should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(is.na(as.numeric(SettingsInfo_CoRe[["StatCutoff"]])) == TRUE |as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) > 1 | as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) < 0){ - message <- paste0("Check input. The selected StatCutoff in SettingsInfo_CoRe should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + if (is.na(as.numeric(SettingsInfo_Intra[["ValueCutoff"]]))) { + message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_Intra should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(is.na(as.numeric(SettingsInfo_Intra[["ValueCutoff"]])) == TRUE){ - message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_Intra should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + if (is.na(as.numeric(SettingsInfo_CoRe[["ValueCutoff"]]))) { + message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_CoRe should be numeric and between 0 and 1.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - if(is.na(as.numeric(SettingsInfo_CoRe[["ValueCutoff"]])) == TRUE){ - message <- paste0("Check input. The selected ValueCutoff in SettingsInfo_CoRe should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - #------------ NAs in data - if(is.null(InputData_C1)==FALSE){ - if(nrow(InputData_C1[complete.cases(InputData_C1[[SettingsInfo_C1[["ValueCol"]]]], InputData_C1[[SettingsInfo_C1[["StatCol"]]]]), ]) < nrow(InputData_C1)){ - message <- paste0("InputData_C1 includes NAs in ", SettingsInfo_C1[["ValueCol"]], " and/or in ", SettingsInfo_C1[["StatCol"]], ". ", nrow(InputData_C1)- nrow(InputData_C1[complete.cases(InputData_C1[[SettingsInfo_C1[["ValueCol"]]]], InputData_C1[[SettingsInfo_C1[["StatCol"]]]]), ]) ," metabolites containing NAs are removed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } + #------------ NAs in data + if (!is.null(InputData_C1)) { + if (nrow(InputData_C1[complete.cases(InputData_C1[[SettingsInfo_C1[["ValueCol"]]]], InputData_C1[[SettingsInfo_C1[["StatCol"]]]]), ]) < nrow(InputData_C1)) { + message <- paste0("InputData_C1 includes NAs in ", SettingsInfo_C1[["ValueCol"]], " and/or in ", SettingsInfo_C1[["StatCol"]], ". ", nrow(InputData_C1) - nrow(InputData_C1[complete.cases(InputData_C1[[SettingsInfo_C1[["ValueCol"]]]], InputData_C1[[SettingsInfo_C1[["StatCol"]]]]), ]), " metabolites containing NAs are removed.") + logger::log_trace(paste0("Warning ", messag)) + warning(message) + } - if(nrow(InputData_C2[complete.cases(InputData_C2[[SettingsInfo_C2[["ValueCol"]]]], InputData_C2[[SettingsInfo_C2[["StatCol"]]]]), ]) < nrow(InputData_C2)){ - message <- paste0("InputData_C2 includes NAs in ", SettingsInfo_C2[["ValueCol"]], " and/or in", SettingsInfo_C2[["StatCol"]], ". ", nrow(InputData_C2)- nrow(InputData_C2[complete.cases(InputData_C2[[SettingsInfo_C2[["ValueCol"]]]], InputData_C2[[SettingsInfo_C2[["StatCol"]]]]), ]) ," metabolites containing NAs are removed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } - }else{ - if(nrow(InputData_Intra[complete.cases(InputData_Intra[[SettingsInfo_Intra[["ValueCol"]]]], InputData_Intra[[SettingsInfo_Intra[["StatCol"]]]]), ]) < nrow(InputData_Intra)){ - message <- paste0("InputData_Intra includes NAs in ", SettingsInfo_Intra[["ValueCol"]], " and/or in ", SettingsInfo_Intra[["StatCol"]], ". ", nrow(InputData_Intra)- nrow(InputData_Intra[complete.cases(InputData_Intra[[SettingsInfo_Intra[["ValueCol"]]]], InputData_Intra[[SettingsInfo_Intra[["StatCol"]]]]), ]) ," metabolites containing NAs are removed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } + if (nrow(InputData_C2[complete.cases(InputData_C2[[SettingsInfo_C2[["ValueCol"]]]], InputData_C2[[SettingsInfo_C2[["StatCol"]]]]), ]) < nrow(InputData_C2)) { + message <- paste0("InputData_C2 includes NAs in ", SettingsInfo_C2[["ValueCol"]], " and/or in", SettingsInfo_C2[["StatCol"]], ". ", nrow(InputData_C2) - nrow(InputData_C2[complete.cases(InputData_C2[[SettingsInfo_C2[["ValueCol"]]]], InputData_C2[[SettingsInfo_C2[["StatCol"]]]]), ]), " metabolites containing NAs are removed.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + } + } else { + if (nrow(InputData_Intra[complete.cases(InputData_Intra[[SettingsInfo_Intra[["ValueCol"]]]], InputData_Intra[[SettingsInfo_Intra[["StatCol"]]]]), ]) < nrow(InputData_Intra)) { + message <- paste0("InputData_Intra includes NAs in ", SettingsInfo_Intra[["ValueCol"]], " and/or in ", SettingsInfo_Intra[["StatCol"]], ". ", nrow(InputData_Intra) - nrow(InputData_Intra[complete.cases(InputData_Intra[[SettingsInfo_Intra[["ValueCol"]]]], InputData_Intra[[SettingsInfo_Intra[["StatCol"]]]]), ]), " metabolites containing NAs are removed.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + } - if(nrow(InputData_CoRe[complete.cases(InputData_CoRe[[SettingsInfo_CoRe[["ValueCol"]]]], InputData_CoRe[[SettingsInfo_CoRe[["StatCol"]]]]), ]) < nrow(InputData_CoRe)){ - message <- paste0("InputData_CoRe includes NAs in ", SettingsInfo_CoRe[["ValueCol"]], " and/or in ", SettingsInfo_CoRe[["StatCol"]], ". ", nrow(InputData_CoRe)- nrow(InputData_CoRe[complete.cases(InputData_CoRe[[SettingsInfo_CoRe[["ValueCol"]]]], InputData_CoRe[[SettingsInfo_CoRe[["StatCol"]]]]), ]) ," metabolites containing NAs are removed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - } - } - - #------------- BackgroundMethod - if(is.null(SettingsInfo_C1)==FALSE){ - options <- c("C1|C2", "C1&C2", "C2", "C1" , "*") - if(any(options %in% BackgroundMethod) == FALSE){ - message <- paste0("Check input. The selected BackgroundMethod option is not valid. Please select one of the folowwing: ",paste(options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + if (nrow(InputData_CoRe[complete.cases(InputData_CoRe[[SettingsInfo_CoRe[["ValueCol"]]]], InputData_CoRe[[SettingsInfo_CoRe[["StatCol"]]]]), ]) < nrow(InputData_CoRe)) { + message <- paste0("InputData_CoRe includes NAs in ", SettingsInfo_CoRe[["ValueCol"]], " and/or in ", SettingsInfo_CoRe[["StatCol"]], ". ", nrow(InputData_CoRe) - nrow(InputData_CoRe[complete.cases(InputData_CoRe[[SettingsInfo_CoRe[["ValueCol"]]]], InputData_CoRe[[SettingsInfo_CoRe[["StatCol"]]]]), ]), " metabolites containing NAs are removed.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + } } - }else{ - options <- c("Intra|CoRe", "Intra&CoRe", "CoRe", "Intra" , "*") - if(any(options %in% BackgroundMethod) == FALSE){ - message <- paste0("Check input. The selected BackgroundMethod option is not valid. Please select one of the folowwing: ",paste(options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + #------------- BackgroundMethod + if (!is.null(SettingsInfo_C1)) { + options <- c("C1|C2", "C1&C2", "C2", "C1" , "*") + if (!any(options %in% BackgroundMethod)) { + message <- paste0("Check input. The selected BackgroundMethod option is not valid. Please select one of the folowwing: ", paste(options, collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } else { + options <- c("Intra|CoRe", "Intra&CoRe", "CoRe", "Intra" , "*") + if (!any(options %in% BackgroundMethod)) { + message <- paste0("Check input. The selected BackgroundMethod option is not valid. Please select one of the folowwing: ", paste(options, collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - - #------------- SaveAs - SaveAs_Table_options <- c("txt","csv", "xlsx") - if(is.null(SaveAs_Table)==FALSE){ - if((SaveAs_Table %in% SaveAs_Table_options == FALSE)| (is.null(SaveAs_Table)==TRUE)){ - message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the folowwing: ",paste(SaveAs_Table_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop( message) + + #------------- SaveAs + SaveAs_Table_options <- c("txt", "csv", "xlsx") + if (!is.null(SaveAs_Table)) { + if (!(SaveAs_Table %in% SaveAs_Table_options)| is.null(SaveAs_Table)) { + message <- paste0("Check input. The selected SaveAs_Table option is not valid. Please select one of the folowwing: ", paste(SaveAs_Table_options, collapse = ", "), "." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } } diff --git a/R/HelperLog.R b/R/HelperLog.R index dea86a18..b518f1a6 100644 --- a/R/HelperLog.R +++ b/R/HelperLog.R @@ -34,8 +34,8 @@ #' #' @seealso \code{\link{metaproviz_log}} MetaProViz_logfile <- function(){ - #Creates the path for the log file - OmnipathR::logfile('MetaProViz') + ## Creates the path for the log file + OmnipathR::logfile('MetaProViz') } @@ -56,8 +56,8 @@ MetaProViz_logfile <- function(){ #' @seealso \code{\link{metaproviz_logfile}} #' MetaProViz_log <- function(){ - #Opens log file for browsing - OmnipathR::read_log('MetaProViz') + ## opens log file for browsing + OmnipathR::read_log('MetaProViz') } @@ -82,34 +82,36 @@ MetaProViz_set_loglevel <- function(level, target = 'logfile'){ #' #' @noRd MPV_trace <- function() {#MPV=MetaProViz - # Useful for debugging - MetaProViz_set_loglevel('trace', target = 'console') + ## Useful for debugging + MetaProViz_set_loglevel("trace", target = "console") } #' Set the console log level to "trace" #' -#' @importFrom OmnipathR set_loglevel +#' @importFrom OmnipathR set_loglevel #' @importFrom logger log_info #' @importFrom utils packageVersion #' #' @noRd #' MetaProViz_Init <- function(){ - # Only run the first time a MetaProViz function is used in an environment --> Creates log file - if(is.null(metaproviz.env$init)){ - #Initial log - OmnipathR:::init_config(pkg = "MetaProViz") - OmnipathR:::init_log(pkg = "MetaProViz") - log_info('Welcome to MetaProViz!') - log_info('MetaProViz version: %s', packageVersion("MetaProViz")) + + ## only run the first time a MetaProViz function is used in an + ## environment --> Creates log file + if (is.null(metaproviz.env$init)) { + ## initial log + OmnipathR:::init_config(pkg = "MetaProViz") + OmnipathR:::init_log(pkg = "MetaProViz") + log_info("Welcome to MetaProViz!") + log_info("MetaProViz version: %s", packageVersion("MetaProViz")) - #Do we run in a build server like bioconductor? - buildserver <- OmnipathR:::.on_buildserver() + ## Do we run in a build server like bioconductor? + buildserver <- OmnipathR:::.on_buildserver() - if(buildserver){ - set_loglevel('trace', target = 'console', pkg = "MetaProViz") - } + if (buildserver) { + set_loglevel("trace", target = "console", pkg = "MetaProViz") + } - metaproviz.env$init <- TRUE - } + metaproviz.env$init <- TRUE + } } diff --git a/R/HelperOptions.R b/R/HelperOptions.R index 7525cfe5..c190eae8 100644 --- a/R/HelperOptions.R +++ b/R/HelperOptions.R @@ -1,7 +1,7 @@ .metaproviz_options_defaults <- list( - metaproviz.loglevel = 'trace', - metaproviz.console_loglevel = 'success' + metaproviz.loglevel = "trace", + metaproviz.console_loglevel = "success" ) @@ -28,13 +28,11 @@ #' @importFrom OmnipathR save_config #' @export metaproviz_save_config <- function( - path = NULL, - title = 'default', - local = FALSE - ){ - - save_config(path = path, title = title, local = local, pkg = 'MetaProViz') + path = NULL, + title = "default", + local = FALSE) { + save_config(path = path, title = title, local = local, pkg = "MetaProViz") } @@ -61,20 +59,18 @@ metaproviz_save_config <- function( #' @importFrom OmnipathR load_config #' @export metaproviz_load_config <- function( - path = NULL, - title = 'default', - user = FALSE, - ... - ){ + path = NULL, + title = "default", + user = FALSE, + ...) { load_config( path = path, title = title, user = user, - pkg = 'MetaProViz', + pkg = "MetaProViz", ... ) - } @@ -100,7 +96,7 @@ metaproviz_load_config <- function( #' @seealso \code{\link{metaproviz_load_config}, \link{metaproviz_save_config}} metaproviz_reset_config <- function(save = NULL, reset_all = FALSE) { - reset_config(save = save, reset_all = reset_all, pkg = 'MetaProViz') + reset_config(save = save, reset_all = reset_all, pkg = "MetaProViz") } @@ -117,8 +113,8 @@ metaproviz_reset_config <- function(save = NULL, reset_all = FALSE) { #' #' @importFrom OmnipathR config_path #' @export -metaproviz_config_path <- function(user = FALSE){ +metaproviz_config_path <- function(user = FALSE) { - config_path(user = user, pkg = 'MetaProViz') + config_path(user = user, pkg = "MetaProViz") } diff --git a/R/HelperPlots.R b/R/HelperPlots.R index 5f8dbe54..6880b739 100644 --- a/R/HelperPlots.R +++ b/R/HelperPlots.R @@ -84,16 +84,20 @@ set_size <- function( offset = 0L, ifempty = offset != 0L, callback = partial(switch, TRUE), - grow = FALSE - ) { + grow = FALSE) { + + ## EDIT: I think for all these function the in-function documentation should be + ## improved callback %<>% {`if`(is.character(.), get(.), .)} - size %<>% parse_unit - col <- dim %>% gtable_col - tdim <- dim %>% str_sub(end = -2L) - - idx <- - name %>% + size %<>% + parse_unit + col <- dim %>% + gtable_col + tdim <- dim %>% + str_sub(end = -2L) + + idx <- name %>% in_gtable(gtbl) %>% gtable_idx(gtbl, ., dim, offset = offset) @@ -103,27 +107,26 @@ set_size <- function( idx < min(gtbl$layout[[col]]) || idx > max(gtbl$layout[[col]]) - info <- - sprintf( - '[name=%s,offset=%i,empty=%s,original=%s]', - paste0(name, collapse = ','), - offset, - !(idx %in% gtbl$layout[[col]]), - `if`(name_miss || outof_range, 'NA', gtbl[[dim]][idx]) - ) + info <- sprintf( + '[name=%s,offset=%i,empty=%s,original=%s]', + paste0(name, collapse = ','), + offset, + !(idx %in% gtbl$layout[[col]]), + `if`(name_miss || outof_range, 'NA', gtbl[[dim]][idx]) + ) if (name_miss) { log_warn( - 'No such name in gtable: %s; names available: %s', - paste0(name, collapse = ', '), - paste0(gtbl$layout$name, collapse = ', ') + "No such name in gtable: %s; names available: %s", + paste0(name, collapse = "", ""), + paste0(gtbl$layout$name, collapse = ", ") ) } else if (outof_range) { log_warn( - 'Index %i is out of range for %s[%i-%i] %s', + "Index %i is out of range for %s[%i-%i] %s", idx, dim, min(gtbl$layout[[col]]), @@ -134,10 +137,12 @@ set_size <- function( } else if (!ifempty || !(idx %in% gtbl$layout[[col]])) { original <- gtbl[[dim]][idx] - size %<>% callback(original) + size %<>% + callback(original) if (grow && tdim %in% names(gtbl)) { - grow %<>% {`if`(is.numeric(.), ., size - original)} + grow %<>% + {`if`(is.numeric(.), ., size - original)} log_trace( paste0( 'Adding %s to the total %s of the gtable, ', @@ -183,7 +188,7 @@ set_width <- partial(set_size, dim = 'widths') adjust_layout <- function(gtbl, param) { c('widths', 'heights') %>% - reduce( + purrr::reduce( ~set_sizes(.x, .y, param[[.y]]), .init = gtbl ) @@ -308,22 +313,30 @@ adjust_title <- function(gtbl, titles) { log_trace('The plot has title, adjusting layout to accommodate it.') - gtbl %<>% set_height(c('title', 'main'), '0.5cm')#controls margins --> PlotName - gtbl %<>% set_height(c('subtitle', 'main'), '0.5cm')#controls margins --> PlotName + gtbl %<>% + set_height(c('title', 'main'), '0.5cm')#controls margins --> PlotName + gtbl %<>% + set_height(c('subtitle', 'main'), '0.5cm')#controls margins --> PlotName # Sum up total heights: - gtbl$height %<>% add(cm(1)) + gtbl$height %<>% + add(cm(1)) #------- Width: Check how much width is needed for the figure title/subtitle - title_width <- titles %>% char2cm %>% max %>% cm + title_width <- titles %>% + char2cm %>% + max %>% + cm - gtbl %<>% set_width( - c('guide-box-right', 'legend'), - sprintf('%.02fcm', title_width - gtbl$width), - callback = max + gtbl %<>% + set_width( + c('guide-box-right', 'legend'), + sprintf('%.02fcm', title_width - gtbl$width), + callback = max ) - gtbl$width %<>% max(title_width) + gtbl$width %<>% + max(title_width) } @@ -451,56 +464,57 @@ in_gtable <- function(name, gtbl) { #' @keywords Plot helper function #' @noRd #' - plotGrob_Processing <- function(InputPlot, PlotName, PlotType){ - if(PlotType == "Scree"){ - UNIT <- unit(12, "cm") - }else if(PlotType == "Hotellings"){ - UNIT <- unit(12, "cm")#0.25*Sample - }else{#CV and Hist - UNIT <- unit(8, "cm") - } - # Make plot into nice format: - SUPER_PARAM <- list(widths = list( - list("axis-b", UNIT), - list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), - list("axis-l", "1cm"), - list("ylab-l", "1cm"), - list("guide-box-left", "0cm"), - list("axis-r", "0cm"), - list("ylab-r", "0cm"), - list("ylab-l", "1cm", offset = -1L), - list("guide-box-right", "1cm") - ), - heights = list( - list("axis-l", "8cm"), - list("axis-b", "0.5cm"),#This is adjusted for the x-axis ticks! - list("xlab-b", "0.75cm"),#This gives us the distance of the caption to the x-axis label - list("title", "0cm", offset = -2L, ifempty = FALSE), - list("title", "0cm", offset = -1L), - list("title", "0.25cm"),# how much space is between title and y-axis label - list("subtitle", "0cm"), - list("caption", "0.5cm"), #plots statistics information, space to bottom - list("guide-box-top", "0cm"), - list("xlab-t", "0cm", offset = -1L) - ) - ) - - #Adjust the parameters: - suppressWarnings(suppressMessages( - Plot_Sized <- InputPlot %>% - ggplotGrob %>% - withCanvasSize(width = 12, height = 11) %>% - adjust_layout(SUPER_PARAM) %>% - adjust_title(c(PlotName)) + if (PlotType == "Scree") { + UNIT <- unit(12, "cm") + } else if(PlotType == "Hotellings") { + UNIT <- unit(12, "cm") ##0.25*Sample + } else { ## CV and Hist + UNIT <- unit(8, "cm") + } + + ## Make plot into nice format: + SUPER_PARAM <- list(widths = list( + list("axis-b", UNIT), + list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), + list("axis-l", "1cm"), + list("ylab-l", "1cm"), + list("guide-box-left", "0cm"), + list("axis-r", "0cm"), + list("ylab-r", "0cm"), + list("ylab-l", "1cm", offset = -1L), + list("guide-box-right", "1cm") + ), + heights = list( + list("axis-l", "8cm"), + list("axis-b", "0.5cm"),#This is adjusted for the x-axis ticks! + list("xlab-b", "0.75cm"),#This gives us the distance of the caption to the x-axis label + list("title", "0cm", offset = -2L, ifempty = FALSE), + list("title", "0cm", offset = -1L), + list("title", "0.25cm"),# how much space is between title and y-axis label + list("subtitle", "0cm"), + list("caption", "0.5cm"), #plots statistics information, space to bottom + list("guide-box-top", "0cm"), + list("xlab-t", "0cm", offset = -1L) + ) + ) + + ## adjust the parameters: + suppressWarnings(suppressMessages( + Plot_Sized <- InputPlot %>% + ggplotGrob %>% + withCanvasSize(width = 12, height = 11) %>% + adjust_layout(SUPER_PARAM) %>% + adjust_title(c(PlotName)) )) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) - return(Plot_Sized) + ## return + Plot_Sized } ############################################################## @@ -519,51 +533,51 @@ plotGrob_Processing <- function(InputPlot, PlotName, PlotType){ #' @noRd PlotGrob_PCA <- function(InputPlot, SettingsInfo, PlotName){ - PCA_PARAM <- list( - widths = list( - list("axis-b", "8cm"), - list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), - list("axis-l", "1cm"), - list("ylab-l", "1cm"), - list("guide-box-left", "0cm"), - list("axis-r", "0cm"), - list("ylab-r", "0cm"), - list("ylab-l", "1cm", offset = -1L), - list("guide-box-right", "1cm") - ), - heights = list( - list("axis-l", "8cm"), - list("axis-b", "1cm"), - list("xlab-b", ".5cm"), - list("xlab-b", "1cm", offset = 1L), - list("title", "0cm", offset = -2L, ifempty = FALSE), - list("title", "0cm", offset = -1L), - list("title", "0.25cm"),# how much space is between title and y-axis label - list("subtitle", "0cm"), - list("guide-box-top", "0cm"), - list("xlab-t", "0cm", offset = -1L) - ) - ) - - Plot_Sized <- InputPlot %>% - ggplotGrob %>% - withCanvasSize(width = 12, height = 11) %>% - adjust_layout(PCA_PARAM) %>% - adjust_title(PlotName) %>% - adjust_legend( - InputPlot, - sections = c("color", "shape"), - SettingsInfo = SettingsInfo + PCA_PARAM <- list( + widths = list( + list("axis-b", "8cm"), + list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), + list("axis-l", "1cm"), + list("ylab-l", "1cm"), + list("guide-box-left", "0cm"), + list("axis-r", "0cm"), + list("ylab-r", "0cm"), + list("ylab-l", "1cm", offset = -1L), + list("guide-box-right", "1cm") + ), + heights = list( + list("axis-l", "8cm"), + list("axis-b", "1cm"), + list("xlab-b", ".5cm"), + list("xlab-b", "1cm", offset = 1L), + list("title", "0cm", offset = -2L, ifempty = FALSE), + list("title", "0cm", offset = -1L), + list("title", "0.25cm"),# how much space is between title and y-axis label + list("subtitle", "0cm"), + list("guide-box-top", "0cm"), + list("xlab-t", "0cm", offset = -1L) + ) ) - log_trace( - 'Sum of heights: %.02f, sum of widths: %.02f', - grid::convertUnit(sum(Plot_Sized$height), 'cm', valueOnly = TRUE), - grid::convertUnit(sum(Plot_Sized$width), 'cm', valueOnly = TRUE) - ) + Plot_Sized <- InputPlot %>% + ggplotGrob %>% + withCanvasSize(width = 12, height = 11) %>% + adjust_layout(param = PCA_PARAM) %>% + adjust_title(titles = PlotName) %>% + adjust_legend( + InputPlot, + sections = c("color", "shape"), + SettingsInfo = SettingsInfo + ) + + log_trace( + 'Sum of heights: %.02f, sum of widths: %.02f', + grid::convertUnit(sum(Plot_Sized$height), 'cm', valueOnly = TRUE), + grid::convertUnit(sum(Plot_Sized$width), 'cm', valueOnly = TRUE) + ) - #Return - Output <- Plot_Sized + ## return + Plot_Sized } @@ -573,93 +587,103 @@ PlotGrob_PCA <- function(InputPlot, SettingsInfo, PlotName){ #' @param InputPlot This is the ggplot object generated within the VizHeatmap function. #' @param SettingsInfo Passed to VizHeatmap -#' @param SettingsFile_Sample Passed to VizHeatmap -#' @param SettingsFile_Metab Passed to VizHeatmap +#' @param se Passed to VizHeatmap #' @param PlotName Passed to VizHeatmap #' #' @keywords Heatmap helper function #' @noRd -PlotGrob_Heatmap <- function(InputPlot, SettingsInfo, SettingsFile_Sample, SettingsFile_Metab, PlotName){ - - # Set the parameters for the plot we would like to use as a basis, before we start adjusting it: - HEAT_PARAM <- list( - widths = list( - list("legend", "2cm") - ), - heights = list( - list("main", "1cm") +PlotGrob_Heatmap <- function(InputPlot, SettingsInfo, se, + PlotName) { + + ## set the parameters for the plot we would like to use as a basis, + ## before we start adjusting it: + HEAT_PARAM <- list( + widths = list( + list("legend", "2cm") + ), + heights = list( + list("main", "1cm") + ) ) - ) - - #If we plot feature names on the x-axis, we need to adjust the height of the plot: - #if(as.logical(show_rownames)==TRUE){ - # Rows <- nrow(t(data)) - #} - - #Adjust the parameters: - Input <- InputPlot$gtable - - Plot_Sized <- Input %>% - withCanvasSize(width = 12, height = 11) %>% - adjust_layout(HEAT_PARAM) %>% - adjust_title(c(PlotName)) - - #Extract legend information and adjust: - color_entries <- grep("^color", names(SettingsInfo), value = TRUE) - if(length(color_entries)>0){#We need to adapt the plot Hights and widths - if(sum(grepl("color_Sample", names(SettingsInfo)))>0){ - names <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] - colour_names <- NULL - legend_names <- NULL - for (x in 1:length(names)){ - names_sel <- names[[x]] - legend_names[x] <- names_sel - colour_names[x] <- SettingsFile_Sample[names[[x]]] - } - }else{ - colour_names <- NULL - legend_names <- NULL - } - if(sum(grepl("color_Metab", names(SettingsInfo)))>0){ - names <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] - colour_names_M <- NULL - legend_names_M <- NULL - for (x in 1:length(names)){ - names_sel <- names[[x]] - legend_names_M[x] <- names_sel - colour_names_M[x] <- SettingsFile_Metab[names[[x]]] - } - }else{ - colour_names_M <- NULL - legend_names_M <- NULL - } + #If we plot feature names on the x-axis, we need to adjust the height of the plot: + #if(as.logical(show_rownames)==TRUE){ + # Rows <- nrow(t(data)) + #} + + ## adjust the parameters: + Input <- InputPlot$gtable + + Plot_Sized <- Input %>% + withCanvasSize(width = 12, height = 11) %>% + adjust_layout(HEAT_PARAM) %>% + adjust_title(c(PlotName)) + + ## Extract legend information and adjust: + color_entries <- grep("^color", names(SettingsInfo), value = TRUE) + if (length(color_entries) > 0) { + ## we need to adapt the plot heights and widths + if (sum(grepl("color_Sample", names(SettingsInfo))) > 0) { + names <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] + colour_names <- NULL + legend_names <- NULL + for (x in seq_along(names)) { + names_sel <- names[[x]] + legend_names[x] <- names_sel + colour_names[x] <- colData(se)[names[[x]]] + } + } else { + colour_names <- NULL + legend_names <- NULL + } - legend_head <- c(legend_names, legend_names_M) - longest_name <- legend_head[which.max(nchar(legend_head[[1]]))] - character_count_head <- nchar(longest_name)+4#This is the length of the legend title name + if (sum(grepl("color_Metab", names(SettingsInfo))) > 0) { + names <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] + colour_names_M <- NULL + legend_names_M <- NULL + for (x in seq_along(names)) { + names_sel <- names[[x]] + legend_names_M[x] <- names_sel + colour_names_M[x] <- rowData(se)[names[[x]]] + } + } else { + colour_names_M <- NULL + legend_names_M <- NULL + } - legend_names <- c(unlist(colour_names), unlist(colour_names_M)) - longest_name <- legend_names[which.max(nchar(legend_names[[1]]))] - character_count <- nchar(longest_name)#This is the length of the legend colour names + legend_head <- c(legend_names, legend_names_M) + longest_name <- legend_head[which.max(nchar(legend_head[[1]]))] + ## this is the length of the legend title name + character_count_head <- nchar(longest_name) + 4 - legendWidth <- unit(((max(character_count_head, character_count))*0.3), "cm")#legend space + legend_names <- c(unlist(colour_names), unlist(colour_names_M)) + longest_name <- legend_names[which.max(nchar(legend_names[[1]]))] + ## this is the length of the legend colour names + character_count <- nchar(longest_name) - # Sum up total heights: - Plot_Sized$width %<>% add(legendWidth) + ## legend space + legendWidth <- unit( + max(character_count_head, character_count) * 0.3, "cm") - legendHeights <- unit((sum(length(unique(legend_names_M))+length(unique(colour_names_M))+length(unique(legend_names))+length(unique(colour_names)))), "cm") + ## Sum up total heights: + Plot_Sized$width %<>% + add(legendWidth) - Plot_Sized$width %<>% add(legendWidth) - if((grid::convertUnit(legendHeights, 'cm', valueOnly = TRUE))>(grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE))){ - Plot_Sized$height <- legendHeights - } + legendHeights <- unit(sum(length(unique(legend_names_M)) + + length(unique(colour_names_M)) + length(unique(legend_names)) + + length(unique(colour_names))), "cm") - } + Plot_Sized$width %<>% add(legendWidth) + if(grid::convertUnit(legendHeights, 'cm', valueOnly = TRUE) > + grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE)){ + Plot_Sized$height <- legendHeights + } - Output <- Plot_Sized + } + ## return + Plot_Sized } @@ -676,54 +700,59 @@ PlotGrob_Heatmap <- function(InputPlot, SettingsInfo, SettingsFile_Sample, Setti #' @noRd #' -plotGrob_Volcano <- function(InputPlot, SettingsInfo, PlotName, Subtitle){ - # Set the parameters for the plot we would like to use as a basis, before we start adjusting it: - VOL_PARAM <- list( - widths = list( - list("axis-b", "6cm"), - list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), - list("axis-l", "1cm"), - list("ylab-l", "1cm"), - list("guide-box-left", "0cm"), - list("axis-r", "0cm"), - list("ylab-r", "0cm"), - list("ylab-l", "1cm", offset = -1L), - list("guide-box-right", "1cm") - ), - heights = list( - list("axis-l", "8cm"), - list("axis-b", "0.75cm"),#This is the distance to x-axis! - list("xlab-b", "0.75cm"),#This gives us the distance of the caption to the x-axis label - #list("xlab-b", "1cm", offset = 1L), - list("title", "0cm", offset = -2L, ifempty = FALSE), - list("title", "0cm", offset = -1L),#Space above title - list("title", "0.25cm"),# how much space is between title and y-axis label - list("subtitle", "0cm"), - list("guide-box-top", "0cm"), - list("xlab-t", "0cm", offset = -1L) - ) - ) - - #Adjust the parameters: - Plot_Sized <- InputPlot %>% - ggplotGrob %>% - withCanvasSize(width = 12, height = 11) %>% - adjust_layout(VOL_PARAM) %>% - adjust_title(c(PlotName, Subtitle)) %>%#Fix this (if there is no Subtitle!) - adjust_legend( - InputPlot, - sections = c("color", "shape"), - SettingsInfo = SettingsInfo +plotGrob_Volcano <- function(InputPlot, SettingsInfo, PlotName, Subtitle) { + + # set the parameters for the plot we would like to use as a basis, before we start adjusting it: + VOL_PARAM <- list( + widths = list( + list("axis-b", "6cm"), + list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), + list("axis-l", "1cm"), + list("ylab-l", "1cm"), + list("guide-box-left", "0cm"), + list("axis-r", "0cm"), + list("ylab-r", "0cm"), + list("ylab-l", "1cm", offset = -1L), + list("guide-box-right", "1cm") + ), + heights = list( + list("axis-l", "8cm"), + ## this is the distance to x-axis! + list("axis-b", "0.75cm"), + ## this gives us the distance of the caption to the x-axis label + list("xlab-b", "0.75cm"), + #list("xlab-b", "1cm", offset = 1L), + list("title", "0cm", offset = -2L, ifempty = FALSE), + ## space above title + list("title", "0cm", offset = -1L), + ## how much space is between title and y-axis label + list("title", "0.25cm"), + list("subtitle", "0cm"), + list("guide-box-top", "0cm"), + list("xlab-t", "0cm", offset = -1L) + ) ) - log_trace( - 'Sum of heights: %.02f, sum of widths: %.02f', - grid::convertUnit(sum(Plot_Sized$height), 'cm', valueOnly = TRUE), - grid::convertUnit(sum(Plot_Sized$width), 'cm', valueOnly = TRUE) - ) + ## Adjust the parameters: + Plot_Sized <- InputPlot %>% + ggplotGrob %>% + withCanvasSize(width = 12, height = 11) %>% + adjust_layout(VOL_PARAM) %>% + adjust_title(c(PlotName, Subtitle)) %>%#Fix this (if there is no Subtitle!) + adjust_legend( + InputPlot, + sections = c("color", "shape"), + SettingsInfo = SettingsInfo + ) + + log_trace( + "Sum of heights: %.02f, sum of widths: %.02f", + grid::convertUnit(sum(Plot_Sized$height), "cm", valueOnly = TRUE), + grid::convertUnit(sum(Plot_Sized$width), "cm", valueOnly = TRUE) + ) - #Return - Output <- Plot_Sized + ## return + Plot_Sized } @@ -733,7 +762,7 @@ plotGrob_Volcano <- function(InputPlot, SettingsInfo, PlotName, Subtitle){ #' @param InputPlot This is the ggplot object generated within the VizSuperplots function. #' @param SettingsInfo Passed to VizSuperplots -#' @param SettingsFile_Sample Passed to VizSuperplots +#' @param se Passed to VizSuperplots #' @param Subtitle Passed to VizSuperplots #' @param PlotName Passed to VizSuperplots #' @param PlotType Passed to VizSuperplots @@ -742,64 +771,69 @@ plotGrob_Volcano <- function(InputPlot, SettingsInfo, PlotName, Subtitle){ #' @noRd plotGrob_Superplot <- function(InputPlot, - SettingsInfo, - SettingsFile_Sample, - Subtitle, - PlotName, - PlotType){ - # Set the parameters for the plot we would like to use as a basis, before we start adjusting it: - X_Con <- SettingsFile_Sample%>% - dplyr::distinct(Conditions) - - X_Tick <- unit(X_Con[[1]] %>% char2cm %>% max * 0.6, "cm") - - if(PlotType == "Bar"){ - UNIT <- unit(X_Con%>%nrow() * 0.5, "cm") - }else{ - UNIT <- unit(X_Con%>%nrow() * 1, "cm") - } - - SUPER_PARAM <- list( - widths = list( - list("axis-b", paste(UNIT)), - list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), - list("axis-l", "1cm"), - list("ylab-l", "1cm"), - list("guide-box-left", "0cm"), - list("axis-r", "0cm"), - list("ylab-r", "0cm"), - list("ylab-l", "1cm", offset = -1L), - list("guide-box-right", "1cm") - ), - heights = list( - list("axis-l", "8cm"), - list("axis-b", X_Tick),#This is adjusted for the x-axis ticks! - list("xlab-b", "0.75cm"),#This gives us the distance of the caption to the x-axis label - list("title", "0cm", offset = -2L, ifempty = FALSE), - list("title", "0cm", offset = -1L), - list("title", "0.25cm"),# how much space is between title and y-axis label - list("subtitle", "0cm"), - list("caption", "0.5cm"), #plots statistics information, space to bottom - list("guide-box-top", "0cm"), - list("xlab-t", "0cm", offset = -1L) - ) - ) - - #Adjust the parameters: - Plot_Sized <- InputPlot %>% - ggplotGrob %>% - withCanvasSize(width = 12, height = 11) %>% - adjust_layout(SUPER_PARAM) %>% - adjust_title(c(PlotName, Subtitle)) %>% - adjust_legend( - InputPlot, - sections = c("Superplot"),#here we do not have colour and shape, but other parameters - SettingsInfo = SettingsInfo - ) - - #Return - Output <- Plot_Sized -} + SettingsInfo, + se, + Subtitle, + PlotName, + PlotType) { + + ## set the parameters for the plot we would like to use as a basis, + ## before we start adjusting it: + X_Con <- colData(se) %>% + as.data.frame() |> + dplyr::distinct(Conditions) + + X_Tick <- unit(max(char2cm(X_Con[[1]])) * 0.6, "cm") + + if (PlotType == "Bar") { + UNIT <- unit(nrow(X_Con) * 0.5, "cm") + } else { + UNIT <- unit(nrow(X_Con) * 1, "cm") + } + SUPER_PARAM <- list( + widths = list( + list("axis-b", paste(UNIT)), + list("ylab-l", "0cm", offset = -4L, ifempty = FALSE), + list("axis-l", "1cm"), + list("ylab-l", "1cm"), + list("guide-box-left", "0cm"), + list("axis-r", "0cm"), + list("ylab-r", "0cm"), + list("ylab-l", "1cm", offset = -1L), + list("guide-box-right", "1cm") + ), + heights = list( + list("axis-l", "8cm"), + ## this is adjusted for the x-axis ticks! + list("axis-b", X_Tick), + list("xlab-b", "0.75cm"), + ## this gives us the distance of the caption to the x-axis label + list("title", "0cm", offset = -2L, ifempty = FALSE), + list("title", "0cm", offset = -1L), + ## how much space is between title and y-axis label + list("title", "0.25cm"), + list("subtitle", "0cm"), + ## plots statistics information, space to bottom + list("caption", "0.5cm"), + list("guide-box-top", "0cm"), + list("xlab-t", "0cm", offset = -1L) + ) + ) + ## adjust the parameters: + Plot_Sized <- InputPlot %>% + ggplotGrob %>% + withCanvasSize(width = 12, height = 11) %>% + adjust_layout(SUPER_PARAM) %>% + adjust_title(c(PlotName, Subtitle)) %>% + adjust_legend( + InputPlot, + ## here we do not have colour and shape, but other parameters + sections = c("Superplot"), + SettingsInfo = SettingsInfo + ) + ## return + Plot_Sized +} diff --git a/R/HelperSave.R b/R/HelperSave.R index 4cecb590..a78b777c 100644 --- a/R/HelperSave.R +++ b/R/HelperSave.R @@ -34,31 +34,37 @@ #' #' @noRd #' -SavePath<- function(FolderName, FolderPath){ - #Check if FolderName includes special characters that are not allowed - cleaned_FolderName <- gsub("[^a-zA-Z0-9 ]", "", FolderName) - if (FolderName != cleaned_FolderName){ - message("Special characters were removed from `FolderName`.") - } - - #Check if FolderPath exist - if(is.null(FolderPath)){ - FolderPath <- getwd() - FolderPath <- file.path(FolderPath, "MetaProViz_Results") - if(!dir.exists(FolderPath)){dir.create(FolderPath)} - }else{ - if(dir.exists(FolderPath)==FALSE){ - FolderPath <- getwd() - message("Provided `FolderPath` does not exist and hence results are saved here: ", FolderPath, sep="") +SavePath <- function(FolderName, FolderPath) { + + ## check if FolderName includes special characters that are not allowed + cleaned_FolderName <- gsub("[^a-zA-Z0-9 ]", "", FolderName) + if (FolderName != cleaned_FolderName){ + message("Special characters were removed from `FolderName`.") } - } - #Create the folder name - Results_folder <- file.path(FolderPath, cleaned_FolderName) - if(!dir.exists(Results_folder)){dir.create(Results_folder)} + ## check if FolderPath exist + if (is.null(FolderPath)) { + FolderPath <- getwd() + FolderPath <- file.path(FolderPath, "MetaProViz_Results") + if (!dir.exists(FolderPath)) { + dir.create(FolderPath) + } + } else { + if (!dir.exists(FolderPath)) { + FolderPath <- getwd() + message("Provided `FolderPath` does not exist and hence results are saved here: ", + FolderPath, sep = "") + } + } - #Return the folder path: - return(invisible(Results_folder)) + ## create the folder name + Results_folder <- file.path(FolderPath, cleaned_FolderName) + if (!dir.exists(Results_folder)) { + dir.create(Results_folder) + } + + ## return the folder path + invisible(Results_folder) } @@ -69,7 +75,7 @@ SavePath<- function(FolderName, FolderPath){ ResultsDir <- function(path = 'MetaProViz_Results') { # TODO: options? - path %>% {`if`(!dir.exists(.), {dir.create(.); .}, .) } + path %>% {`if`(!dir.exists(.), {dir.create(.); .}, .) } ## EDIT: is this easily understandable? Is the classical, non-"tidy" notation easier to read? } @@ -80,14 +86,14 @@ ResultsDir <- function(path = 'MetaProViz_Results') { #' SaveRes is the helper function to save the plots and tables #' -#' @param InputList_DF \emph{Optional: } Generated within the MetaProViz function. Contains named DFs. If not avalailable can be set to NULL.\strong{Default = NULL} -#' @param InputList_Plot \emph{Optional: } Generated within the MetaProViz function. Contains named Plots. If not avalailable can be set to NULL.\strong{Default = NULL} -#' @param SaveAs_Table \emph{Optional: } Passed to main function by the user. If not avalailable can be set to NULL.\strong{Default = NULL} -#' @param SaveAs_Plot \emph{Optional: } Passed to main function by the user. If not avalailable can be set to NULL. \strong{Default = NULL} +#' @param InputList_DF \emph{Optional: } Generated within the MetaProViz function. Contains named DFs. If not availalable can be set to NULL.\strong{Default = NULL} +#' @param InputList_Plot \emph{Optional: } Generated within the MetaProViz function. Contains named Plots. If not availalable can be set to NULL.\strong{Default = NULL} +#' @param SaveAs_Table \emph{Optional: } Passed to main function by the user. If not availalable can be set to NULL.\strong{Default = NULL} +#' @param SaveAs_Plot \emph{Optional: } Passed to main function by the user. If not availalable can be set to NULL. \strong{Default = NULL} #' @param FolderPath Passed to main function by the user. #' @param FileName Passed to main function by the user. -#' @param CoRe \emph{Optional: } Passed to main function by the user. If not avalailable can be set to NULL.\strong{Default = FALSE} -#' @param PrintPlot \emph{Optional: } Passed to main function by the user. If not avalailable can be set to NULL.\strong{Default = TRUE} +#' @param CoRe \emph{Optional: } Passed to main function by the user. If not availalable can be set to NULL.\strong{Default = FALSE} +#' @param PrintPlot \emph{Optional: } Passed to main function by the user. If not availalable can be set to NULL.\strong{Default = TRUE} #' @param PlotHeight \emph{Optional: } Parameter for ggsave.\strong{Default = NULL} #' @param PlotWidth \emph{Optional: } Parameter for ggsave. \strong{Default = NULL} #' @param PlotUnit \emph{Optional: } Parameter for ggsave. \strong{Default = NULL} @@ -96,85 +102,98 @@ ResultsDir <- function(path = 'MetaProViz_Results') { #' @noRd #' -SaveRes<- function(InputList_DF= NULL, - InputList_Plot= NULL, - SaveAs_Table = NULL, - SaveAs_Plot = NULL, - FolderPath, - FileName, - CoRe=FALSE, - PrintPlot=TRUE, - PlotHeight=NULL, - PlotWidth=NULL, - PlotUnit=NULL){ - - ################ Save Tables: - if(is.null(SaveAs_Table)==FALSE){ - # Excel File: One file with multiple sheets: - if(SaveAs_Table == "xlsx"){ - #Make FileName - if(CoRe==FALSE | is.null(CoRe)==TRUE){ - FileName <- paste0(FolderPath,"/" , FileName, "_",Sys.Date(), sep = "") - }else{ - FileName <- paste0(FolderPath,"/CoRe_" , FileName,"_",Sys.Date(), sep = "") - } - #Save Excel - writexl::write_xlsx(InputList_DF, paste0(FileName,".xlsx", sep = "") , col_names = TRUE) - }else{ - for(DF in names(InputList_DF)){ - #Make FileName - if(CoRe==FALSE | is.null(CoRe)==TRUE){ - FileName_Save <- paste0(FolderPath,"/" , FileName, "_", DF ,"_",Sys.Date(), sep = "") - }else{ - FileName_Save <- paste0(FolderPath,"/CoRe_" , FileName, "_", DF ,"_",Sys.Date(), sep = "") +SaveRes <- function(data = NULL, + plot = NULL, + SaveAs_Table = NULL, ## EDIT: name the options here and use match.arg ## EDIT: should have a different name, e.g. saveAsFormat ? ## EDIT: camel case and snake case notation should not be mixed + SaveAs_Plot = NULL, + FolderPath, + FileName, + CoRe = FALSE, + PrintPlot = TRUE, + PlotHeight = NULL, + PlotWidth = NULL, + PlotUnit = NULL) { + + ################ Save Tables: + if (!is.null(SaveAs_Table)) { + ## Excel File: One file with multiple sheets: + + for (data_i in names(data)) { ## EDIT: not every entry in list is a data.frame, check and adjust accordingly + ## make FileName + + ##FileName <- paste0(FileName, "_", data_i, "_", Sys.Date(), sep = "") EDIT: is this better? + if (!CoRe | is.null(CoRe)) { + FileName_Save <- paste0(FolderPath,"/" , FileName, "_", data_i,"_", Sys.Date(), sep = "") + ##FileName <- paste0(FolderPath, "/", FileName) + } else { + FileName_Save <- paste0(FolderPath,"/CoRe_" , FileName, "_", data_i,"_", Sys.Date(), sep = "") + ##FileName <- paste0(FolderPath, "/CoRe_", FileName) + } + + if (!is(data[[data_i]], "SummarizedExperiment")) { + + ## unlist data_i columns if needed + data[[data_i]] <- data[[data_i]] %>% + mutate( + across( + where(is.list), + ~map_chr(.x, ~ paste(sort(unique(.x)), collapse = "; ")) + ) + ) + ## Save table + ## save Excel + if (SaveAs_Table == "xlsx") { + writexl::write_xlsx(data[[data_i]], paste0(FileName_Save, ".xlsx"), + col_names = TRUE) + } + ## save csv + if (SaveAs_Table == "csv") { + data[[data_i]] %>% + readr::write_csv(paste0(FileName_Save, ".csv")) + } + if (SaveAs_Table == "txt") { + data[[data_i]] %>% + readr::write_delim(paste0(FileName_Save, ".csv")) + } + } else { + saveRDS(data[[data_i]], file = paste0(FileName_Save, ".RDS")) + } } + } - #unlist DF columns if needed - InputList_DF[[DF]] <- InputList_DF[[DF]]%>% - mutate( - across( - where(is.list), - ~map_chr(.x, ~ paste(sort(unique(.x)), collapse = "; ")) - ) - ) - #Save table - if (SaveAs_Table == "csv"){ - InputList_DF[[DF]]%>% - readr::write_csv(paste0(FileName_Save,".csv", sep = "")) - }else if (SaveAs_Table == "txt"){ - InputList_DF[[DF]]%>% - readr::write_delim(paste0(FileName_Save,".csv", sep = "")) + ################ Save Plots: + if(!is.null(SaveAs_Plot)){ + for (plot_i in names(plot)) { + ## make FileName + ##FileName <- paste0(FileName, "_", Sys.Date(), sep = "") EDIT: is this better? + + if (!CoRe | is.null(CoRe)) { + FileName_Save <- paste0(FolderPath,"/" , FileName,"_", plot_i, "_",Sys.Date(), sep = "") + ##FileName <- paste0(FolderPath, "/", FileName) + } else { + FileName_Save <- paste0(FolderPath,"/CoRe_" , FileName,"_", plot_i,"_",Sys.Date(), sep = "") + ##FileName <- paste0(FolderPath, "/CoRe_", FileName) + } + + ## save + if (is.null(PlotHeight)) { + PlotHeight <- 12 + } + if (is.null(PlotWidth)) { + PlotWidth <- 16 + } + if (is.null(PlotUnit)) { + PlotUnit <- "cm" + } + + ggplot2::ggsave(filename = paste0(FileName_Save, ".", SaveAs_Plot), + plot = plot[[plot_i]], width = PlotWidth, + height = PlotHeight, unit = PlotUnit) + + if (PrintPlot) { + suppressMessages(suppressWarnings( + plot(plot[[plot_i]]))) + } } - } - } - } - - ################ Save Plots: - if(is.null(SaveAs_Plot)==FALSE){ - for(Plot in names(InputList_Plot)){ - #Make FileName - if(CoRe==FALSE | is.null(CoRe)==TRUE){ - FileName_Save <- paste0(FolderPath,"/" , FileName,"_", Plot , "_",Sys.Date(), sep = "") - }else{ - FileName_Save <- paste0(FolderPath,"/CoRe_" , FileName,"_", Plot ,"_",Sys.Date(), sep = "") - } - - #Save - if(is.null(PlotHeight)){ - PlotHeight <- 12 - } - if(is.null(PlotWidth)){ - PlotWidth <- 16 - } - if(is.null(PlotUnit)){ - PlotUnit <- "cm" - } - - ggplot2::ggsave(filename = paste0(FileName_Save, ".",SaveAs_Plot, sep=""), plot = InputList_Plot[[Plot]], width = PlotWidth, height = PlotHeight, unit=PlotUnit) - - if(PrintPlot==TRUE){ - suppressMessages(suppressWarnings(plot(InputList_Plot[[Plot]]))) - } } - } } diff --git a/R/MetaDataAnalysis.R b/R/MetaDataAnalysis.R index e4045f39..ff9ad11b 100644 --- a/R/MetaDataAnalysis.R +++ b/R/MetaDataAnalysis.R @@ -39,8 +39,8 @@ #' @return List of DFs: prcomp results, loadings, Top-Bottom features, annova results, results summary #' #' @examples -#' Tissue_Norm <- MetaProViz::ToyData("Tissue_Norm") -#' Res <- MetaProViz::MetaAnalysis(InputData=Tissue_Norm[,-c(1:13)], +#' Tissue_Norm <- ToyData("Tissue_Norm") +#' Res <- MetaAnalysis(InputData=Tissue_Norm[,-c(1:13)], #' SettingsFile_Sample= Tissue_Norm[,c(2,4:5,12:13)]) #' #' @keywords PCA, annova, metadata @@ -55,251 +55,299 @@ #' #' @export #' -MetaAnalysis <- function(InputData, - SettingsFile_Sample, - Scaling = TRUE, - Percentage = 0.1, - StatCutoff= 0.05, - VarianceCutoff=1, - SaveAs_Table = "csv", - SaveAs_Plot = "svg", - PrintPlot= TRUE, - FolderPath = NULL - #SettingInfo= c(MainSeparator = "TISSUE_TYPE), # enable this parameter in the function --> main separator: Often a combination of demographics is is of paricular interest, e.g. comparing "Tumour versus Normal" for early stage patients and for late stage patients independently. If this is the case, we can use the parameter `SettingsInfo` and provide the column name of our main separator. - -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ################################################################################################################################################################################################ - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo=NULL, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=SaveAs_Table, - CoRe=FALSE, - PrintPlot= PrintPlot) - - # Specific checks: Check the column names of the demographics --> need to be R usable (no empty spaces, -, etc.) - if(is.null(SettingsFile_Sample)==FALSE){ - if(any(grepl('[^[:alnum:]]', colnames(SettingsFile_Sample)))==TRUE){ - #Remove special characters in colnames - colnames(SettingsFile_Sample) <- make.names(colnames(SettingsFile_Sample)) - #Message: - message <- paste("The column names of the 'SettingsFile_Sample' contain special character that where removed.") - logger::log_info(message) - message(message) +MetaAnalysis <- function(se, + Scaling = TRUE, + Percentage = 0.1, + StatCutoff = 0.05, + VarianceCutoff = 1, + SaveAs_Table = "csv", + SaveAs_Plot = "svg", + PrintPlot = TRUE, + FolderPath = NULL) { + #SettingInfo= c(MainSeparator = "TISSUE_TYPE), # enable this parameter in the function --> main separator: Often a combination of demographics is is of paricular interest, e.g. comparing "Tumour versus Normal" for early stage patients and for late stage patients independently. If this is the case, we can use the parameter `SettingsInfo` and provide the column name of our main separator. + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ############################################################################ + ## ------------ Check Input files ----------- ## + ## HelperFunction `CheckInput` + CheckInput(se, SettingsInfo = NULL, + SaveAs_Plot = SaveAs_Plot, SaveAs_Table = SaveAs_Table, + CoRe = FALSE, PrintPlot = PrintPlot) + + ## EDIT: the objects should also be adjusted downstream + InputData <- assay(se) |> + t() |> + as.data.frame() + SettingsFile_Sample <- colData(se) |> + as.data.frame() + + ## Specific checks: Check the column names of the demographics --> + ## need to be R usable (no empty spaces, -, etc.) + if (!is.null(SettingsFile_Sample)) { + if(any(grepl('[^[:alnum:]]', colnames(SettingsFile_Sample)))) { + + ## Remove special characters in colnames + colnames(SettingsFile_Sample) <- make.names(colnames(SettingsFile_Sample)) + + ## Message + message <- paste("The column names of the 'SettingsFile_Sample' contain special character that where removed.") + logger::log_info(message) + message(message) + } } - } - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Plot)==FALSE |is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "MetaAnalysis", - FolderPath=FolderPath) - } - - ############################################################################################################################################################################################################### - ## ---------- Run prcomp ------------## - #--- 1. prcomp - #Get PCs - PCA.res <- prcomp(InputData, center = TRUE, scale=Scaling) - PCA.res_Info <- as.data.frame(PCA.res$x) - - # Extract loadings for each PC - PCA.res_Loadings <- as.data.frame(PCA.res$rotation)%>% - tibble::rownames_to_column("FeatureID") - - #--- 2. Merge with demographics - PCA.res_Info <- merge(x=SettingsFile_Sample%>% tibble::rownames_to_column("UniqueID"), - y=PCA.res_Info%>% tibble::rownames_to_column("UniqueID"), - by="UniqueID", - all.y=TRUE)%>% - tibble::column_to_rownames("UniqueID") - - #--- 3. convert columns that are not numeric to factor: - ## Demographics are often non-numerical, categorical explanatory variables, which is often stored as characters, sometimes integers - PCA.res_Info[sapply(PCA.res_Info, is.character)] <- lapply(PCA.res_Info[sapply(PCA.res_Info, is.character)], as.factor) - PCA.res_Info[sapply(PCA.res_Info, is.integer)] <- lapply(PCA.res_Info[sapply(PCA.res_Info, is.integer)], as.factor) - - ############################################################################################################################################################################################################### - ## ---------- STATS ------------## - ## 1. Anova p.val - # Iterate through each combination of meta and PC columns - MetaData <- names(SettingsFile_Sample) - - Stat_results <- list() - - for (meta_col in MetaData) { - for (pc_col in colnames(PCA.res_Info)[grepl("^PC", colnames(PCA.res_Info))]) { - Formula <- stats::as.formula(paste(pc_col, "~", meta_col, sep=""))# Create a formula for ANOVA --> When constructing the ANOVA formula, it's important to ensure that the response variable (dependent variable) is numeric. - #pairwiseFormula <- as.formula(paste("pairwise ~" , meta_col, sep="")) - - anova_result <- stats::aov(Formula, data = PCA.res_Info)# Perform ANOVA - anova_result_tidy <- broom::tidy(anova_result)#broom::tidy --> convert statistics into table - anova_row <- dplyr::filter(anova_result_tidy, term != "Residuals") # Exclude Residuals row - - tukey_result <- stats::TukeyHSD(anova_result)# Perform Tukey test - tukey_result_tidy <- broom::tidy( tukey_result)#broom::tidy --> convert statistics into table - - #lm_result_p.val <- lsmeans::lsmeans((lm(Formula, data = PCA.res_Info)), pairwiseFormula , adjust=NULL)# adjust=NULL leads to the p-value! - #lm_result_p.adj <- lsmeans::lsmeans((lm(Formula, data = PCA.res_Info)), pairwiseFormula, adjust="FDR") - #lm_result <- as.data.frame(lm_result_p.val$contrasts) - #lm_result$p.adj <- as.data.frame(lm_result_p.adj$contrasts)[,"p.value"] - - # Combine results - combined_result <- data.frame( - tukeyHSD_Contrast = tukey_result_tidy$contrast, - PC = pc_col, - term = anova_row$term, - anova_sumsq = anova_row$sumsq, - anova_meansq = anova_row$meansq, - anova_statistic = anova_row$statistic, - anova_p.value = anova_row$p.value, - tukeyHSD_p.adjusted = tukey_result_tidy$adj.p.value - ) - - # Store ANOVA result - Stat_results[[paste(pc_col, meta_col, sep="_")]] <- combined_result + + ## ------------ Create Results output folder ----------- ## + if(!is.null(SaveAs_Plot) | !is.null(SaveAs_Table)){ + Folder <- SavePath(FolderName = "MetaAnalysis", + FolderPath = FolderPath) + } + + ############################################################################ + ## ---------- Run prcomp ------------## + ##--- 1. prcomp + ## Get PCs + PCA.res <- prcomp(InputData, center = TRUE, scale = Scaling) + PCA.res_Info <- as.data.frame(PCA.res$x) + + ## Extract loadings for each PC + PCA.res_Loadings <- as.data.frame(PCA.res$rotation) %>% + tibble::rownames_to_column("FeatureID") + + ##--- 2. Merge with demographics + PCA.res_Info <- merge( + x = tibble::rownames_to_column(SettingsFile_Sample, "UniqueID"), + y = tibble::rownames_to_column(PCA.res_Info, "UniqueID"), + by = "UniqueID", all.y = TRUE) %>% + tibble::column_to_rownames("UniqueID") + + ##--- 3. convert columns that are not numeric to factor: + ## Demographics are often non-numerical, categorical explanatory + ## variables, which is often stored as characters, sometimes integers + PCA.res_Info[sapply(PCA.res_Info, is.character)] <- lapply( + PCA.res_Info[sapply(PCA.res_Info, is.character)], as.factor) + PCA.res_Info[sapply(PCA.res_Info, is.integer)] <- lapply( + PCA.res_Info[sapply(PCA.res_Info, is.integer)], as.factor) + + ############################################################################ + ## ---------- STATS ------------## + ## 1. Anova p.val + ## Iterate through each combination of meta and PC columns + MetaData <- names(SettingsFile_Sample) + + Stat_results <- list() + + for (meta_col in MetaData) { + for (pc_col in colnames(PCA.res_Info)[grepl("^PC", colnames(PCA.res_Info))]) { + ## Create a formula for ANOVA --> When constructing the ANOVA + ## formula, it's important to ensure that the response variable + ## (dependent variable) is numeric. + Formula <- stats::as.formula(paste(pc_col, "~", meta_col, sep = "")) + #pairwiseFormula <- as.formula(paste("pairwise ~" , meta_col, sep="")) + + ## Perform ANOVA + anova_result <- stats::aov(Formula, data = PCA.res_Info) + ## broom::tidy --> convert statistics into table + anova_result_tidy <- broom::tidy(anova_result) + ## exclude Residuals row + anova_row <- dplyr::filter(anova_result_tidy, term != "Residuals") + + ## Perform Tukey test + tukey_result <- stats::TukeyHSD(anova_result) + ## #broom::tidy --> convert statistics into table + tukey_result_tidy <- broom::tidy(tukey_result) ## EDIT: what is this fct doign, checking ?broom::tidy it seems it is just a call to generics::tidy, could dependencies be reduced? + + #lm_result_p.val <- lsmeans::lsmeans((lm(Formula, data = PCA.res_Info)), pairwiseFormula , adjust=NULL)# adjust=NULL leads to the p-value! + #lm_result_p.adj <- lsmeans::lsmeans((lm(Formula, data = PCA.res_Info)), pairwiseFormula, adjust="FDR") + #lm_result <- as.data.frame(lm_result_p.val$contrasts) + #lm_result$p.adj <- as.data.frame(lm_result_p.adj$contrasts)[,"p.value"] + + ## combine results + combined_result <- data.frame( + tukeyHSD_Contrast = tukey_result_tidy$contrast, + PC = pc_col, + term = anova_row$term, + anova_sumsq = anova_row$sumsq, + anova_meansq = anova_row$meansq, + anova_statistic = anova_row$statistic, + anova_p.value = anova_row$p.value, + tukeyHSD_p.adjusted = tukey_result_tidy$adj.p.value + ) + + ## store ANOVA result + Stat_results[[paste(pc_col, meta_col, sep = "_")]] <- combined_result + } } - } - - # Add into one DF - Stat_results <- dplyr::bind_rows(Stat_results) - - #Add explained variance into the table: - prop_var_ex <- as.data.frame(((PCA.res[["sdev"]])^2/sum((PCA.res[["sdev"]])^2))*100)%>%#To compute the proportion of variance explained by each component in percent, we divide the variance by sum of total variance and multiply by 100(variance=standard deviation ^2) - tibble::rownames_to_column("PC")%>% - dplyr::mutate(PC = paste("PC", PC, sep=""))%>% - dplyr::rename("Explained_Variance"=2) - - Stat_results <- merge(Stat_results, prop_var_ex, by="PC",all.x=TRUE) - - ############################################################################################################################################################################################################### - ## ---------- Top/Bottom ------------## - #Add top/bottom related features to this - ## Create a data frame for top and bottom features for each PC - TopBottom_Features <- lapply(2:ncol(PCA.res_Loadings), function(i){ - #Make input - pc_loadings <- PCA.res_Loadings[, c("FeatureID", names(PCA.res_Loadings)[i])] - #get top and bottom features - n_features <- nrow(pc_loadings) - n_selected <- round(Percentage * n_features) - - top_features <- as.data.frame(head(arrange(pc_loadings, desc(!!sym(names(pc_loadings)[2]))), n_selected)$FeatureID)%>% - dplyr::rename(!!paste("Features_", "(Top", Percentage, "%)", sep=""):=1) - bottom_features <- as.data.frame(head(arrange(pc_loadings, !!sym(names(pc_loadings)[2])), n_selected)$FeatureID) %>% - dplyr::rename(!!paste("Features_", "(Bottom", Percentage, "%)", sep=""):=1) - - #Return - res <- cbind(data.frame(PC=paste("PC", i, sep = "")), top_features, bottom_features) - }) %>% - dplyr::bind_rows(.id = "PC")%>% - dplyr::mutate(PC = paste("PC", PC, sep="")) - - - ## ---------- Final DF 1------------## - ## Add to results DF - Stat_results <- merge(Stat_results, - TopBottom_Features%>% + + ## add into one DF + Stat_results <- dplyr::bind_rows(Stat_results) + + ## Add explained variance into the table: + prop_var_ex <- as.data.frame( + ## To compute the proportion of variance explained by each component in + ## percent, we divide the variance by sum of total variance and + ## multiply by 100(variance=standard deviation ^2) + ((PCA.res[["sdev"]]) ^ 2 / sum((PCA.res[["sdev"]]) ^ 2)) * 100) %>% + tibble::rownames_to_column("PC") %>% + dplyr::mutate(PC = paste("PC", PC, sep = "")) %>% + dplyr::rename("Explained_Variance" = 2) + + Stat_results <- merge(Stat_results, prop_var_ex, by = "PC", all.x = TRUE) + + ############################################################################ + ## ---------- Top/Bottom ------------## + ## add top/bottom related features to this + ## create a data frame for top and bottom features for each PC + TopBottom_Features <- lapply(seq_len(ncol(PCA.res_Loadings))[-1], function(i) { + ## Make input + pc_loadings <- PCA.res_Loadings[, c("FeatureID", + names(PCA.res_Loadings)[i])] + ## get top and bottom features + n_features <- nrow(pc_loadings) + n_selected <- round(Percentage * n_features) + + top_features <- as.data.frame(head( + arrange(pc_loadings, desc(!!sym(names(pc_loadings)[2]))), + n_selected)$FeatureID) %>% + dplyr::rename( + !!paste0("Features_", "(Top", Percentage, "%)") := 1) + bottom_features <- as.data.frame(head( + arrange(pc_loadings, !!sym(names(pc_loadings)[2])), + n_selected)$FeatureID) %>% ## EDIT: the calculation is done twice, should be simplified + dplyr::rename( + !!paste0("Features_", "(Bottom", Percentage, "%)") := 1) + + ## return + cbind(data.frame(PC = paste("PC", i, sep = "")), + top_features, bottom_features) + }) %>% + dplyr::bind_rows(.id = "PC") %>% + dplyr::mutate(PC = paste0("PC", PC)) + + + ## ---------- Final DF 1------------## + ## Add to results DF + Stat_results <- merge(Stat_results, + TopBottom_Features%>% ## EDIT: not sure if its really straitghtforward to understand what is done here, could it be simplified / rewritten? dplyr::group_by(PC) %>% dplyr::summarise(across(everything(), ~ paste(unique(gsub(", ", "_", .)), collapse = ", "))) %>% dplyr::ungroup(), - by="PC", - all.x=TRUE) - - ## ---------- DF 2: Metabolites as row names ------------## - Res_Top <- Stat_results%>% - dplyr::filter(tukeyHSD_p.adjusted < StatCutoff)%>% - tidyr::separate_rows(paste("Features_", "(Top", Percentage, "%)", sep=""), sep = ", ")%>% # Separate 'Features (Top 0.1%)' - dplyr::rename("FeatureID":= paste("Features_", "(Top", Percentage, "%)", sep=""))%>% - dplyr::select(- paste("Features_", "(Bottom", Percentage, "%)", sep="")) - - Res_Bottom <- Stat_results%>% - dplyr::filter(tukeyHSD_p.adjusted< StatCutoff)%>% - tidyr::separate_rows(paste("Features_", "(Bottom", Percentage, "%)", sep=""), sep = ", ")%>% # Separate 'Features (Bottom 0.1%)' - dplyr::rename("FeatureID":= paste("Features_", "(Bottom", Percentage, "%)", sep=""))%>% - dplyr::select(- paste("Features_", "(Top", Percentage, "%)", sep="")) - - Res <- rbind(Res_Top, Res_Bottom)%>% - dplyr::group_by(FeatureID, term) %>% # Group by FeatureID and term - dplyr::summarise( - PC = paste(unique(PC), collapse = ", "), # Concatenate unique PC entries with commas - `Sum(Explained_Variance)` = sum(Explained_Variance, na.rm = TRUE)) %>% # Sum Explained_Variance - dplyr::ungroup()%>% # Remove previous grouping - dplyr::group_by(FeatureID) %>% # Group by FeatureID for MainDriver calculation - dplyr::mutate(MainDriver = (`Sum(Explained_Variance)` == max(`Sum(Explained_Variance)`))) %>% # Mark TRUE for the highest value - dplyr::ungroup() # Remove grouping - - Res_summary <- Res%>% - dplyr::group_by(FeatureID) %>% - dplyr::summarise( - term = paste(term, collapse = ", "), # Concatenate all terms separated by commas - `Sum(Explained_Variance)` = paste(`Sum(Explained_Variance)`, collapse = ", "), # Concatenate all Sum(Explained_Variance) values - MainDriver = paste(MainDriver, collapse = ", ")) %>% # Extract the term where MainDriver is TRUE - dplyr::ungroup()%>% - dplyr::rowwise() %>% - dplyr::mutate( # Extract the term where MainDriver is TRUE - MainDriver_Term = ifelse("TRUE" %in% strsplit(MainDriver, ", ")[[1]], - strsplit(term, ", ")[[1]][which(strsplit(MainDriver, ", ")[[1]] == "TRUE")[1]], - NA), - # Extract the Sum(Explained_Variance) where MainDriver is TRUE - `MainDriver_Sum(VarianceExplained)` = ifelse("TRUE" %in% strsplit(MainDriver, ", ")[[1]], - as.numeric(strsplit(`Sum(Explained_Variance)`, ", ")[[1]][which(strsplit(MainDriver, ", ")[[1]] == "TRUE")[1]]), - NA)) %>% - dplyr::ungroup()%>% - dplyr::arrange(desc(`MainDriver_Sum(VarianceExplained)`)) - - ############################################################################################################################################################################################################### - ## ---------- Plot ------------## - # Plot DF - Data_Heat <- Stat_results %>% - dplyr::filter(tukeyHSD_p.adjusted < StatCutoff)%>%#Filter for significant results - dplyr::filter(Explained_Variance > VarianceCutoff)%>%#Exclude Residuals row - dplyr::distinct(term, PC, .keep_all = TRUE)%>%#only keep unique term~PC combinations AND STATS - dplyr::select(term, PC, Explained_Variance) - - Data_Heat <- reshape2::dcast( Data_Heat, term ~ PC, value.var = "Explained_Variance")%>% - tibble::column_to_rownames("term")%>% - dplyr::mutate_all(~replace(., is.na(.), 0)) - - if(nrow(Data_Heat) > 2){ - - #Plot - invisible(VizHeatmap(InputData = Data_Heat, - PlotName = paste0("ExplainedVariance-bigger-", VarianceCutoff , "Percent_AND_p.adj-smaller", StatCutoff, sep=""), - Scale = "none", - SaveAs_Plot = SaveAs_Plot, - PrintPlot = PrintPlot, - FolderPath = Folder)) - - }else{ - message <- paste0("StatCutoff of ", StatCutoff, " and VarianceCutoff of ", VarianceCutoff, " do only return <= 2 cases, hence no heatmap is plotted.") - logger::log_info("warning: ", message) - warning(message) - } - - - - ############################################################################################################################################################################################################### - ## ---------- Return ------------## - # Make list of Output DFs: 1. prcomp results, 2. Loadings result, 3. TopBottom Features, 4. AOV - ResList <- list(res_prcomp = PCA.res_Info, res_loadings = PCA.res_Loadings, res_TopBottomFeatures = TopBottom_Features, res_aov=Stat_results, res_summary=Res_summary) - - # Save the results - SaveRes(InputList_DF=ResList, - InputList_Plot = NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=FALSE, - FolderPath= Folder, - FileName= "MetaAnalysis", - CoRe=FALSE, - PrintPlot=FALSE) - - #Return - invisible(return(ResList)) + by = "PC", + all.x = TRUE) + + ## ---------- DF 2: Metabolites as row names ------------## + Res_Top <- Stat_results %>% + dplyr::filter(tukeyHSD_p.adjusted < StatCutoff) %>% + ## separate 'Features (Top 0.1%)' + tidyr::separate_rows(paste0("Features_", "(Top", Percentage, "%)"), sep = ", ") %>% + dplyr::rename("FeatureID":= paste0("Features_", "(Top", Percentage, "%)")) %>% + dplyr::select(- paste0("Features_", "(Bottom", Percentage, "%)")) + + Res_Bottom <- Stat_results%>% + dplyr::filter(tukeyHSD_p.adjusted < StatCutoff) %>% + ## separate 'Features (Bottom 0.1%)' + tidyr::separate_rows(paste0("Features_", "(Bottom", Percentage, "%)"), sep = ", ") %>% + dplyr::rename("FeatureID":= paste0("Features_", "(Bottom", Percentage, "%)")) %>% + dplyr::select(- paste0("Features_", "(Top", Percentage, "%)")) + + Res <- rbind(Res_Top, Res_Bottom) %>% + ## group by FeatureID and term + dplyr::group_by(FeatureID, term) %>% + dplyr::summarise( + ## concatenate unique PC entries with commas + PC = paste(unique(PC), collapse = ", "), + ## sum Explained_Variance + `Sum(Explained_Variance)` = sum(Explained_Variance, na.rm = TRUE)) %>% ## EDIT: I think colnames should be after applying make.names + ## remove previous grouping + dplyr::ungroup() %>% + ## group by FeatureID for MainDriver calculation + dplyr::group_by(FeatureID) %>% + ## mark TRUE for the highest value + dplyr::mutate(MainDriver = (`Sum(Explained_Variance)` == max(`Sum(Explained_Variance)`))) %>% + ## remove grouping + dplyr::ungroup() + + Res_summary <- Res%>% + dplyr::group_by(FeatureID) %>% + dplyr::summarise( + ## concatenate all terms separated by commas + term = paste(term, collapse = ", "), + ## concatenate all Sum(Explained_Variance) values + `Sum(Explained_Variance)` = paste(`Sum(Explained_Variance)`, collapse = ", "), + ## extract the term where MainDriver is TRUE + MainDriver = paste(MainDriver, collapse = ", ")) %>% + dplyr::ungroup()%>% + dplyr::rowwise() %>% + dplyr::mutate( + ## extract the term where MainDriver is TRUE + MainDriver_Term = ifelse("TRUE" %in% strsplit(MainDriver, ", ")[[1]], + strsplit(term, ", ")[[1]][which(strsplit(MainDriver, ", ")[[1]] == "TRUE")[1]], + NA), + ## extract the Sum(Explained_Variance) where MainDriver is TRUE + `MainDriver_Sum(VarianceExplained)` = ifelse("TRUE" %in% strsplit(MainDriver, ", ")[[1]], + as.numeric(strsplit(`Sum(Explained_Variance)`, ", ")[[1]][which(strsplit(MainDriver, ", ")[[1]] == "TRUE")[1]]), + NA)) %>% + dplyr::ungroup()%>% + dplyr::arrange(desc(`MainDriver_Sum(VarianceExplained)`)) + + ############################################################################# + ## ---------- Plot ------------## + ## plot DF + Data_Heat <- Stat_results %>% + ## filter for significant results + dplyr::filter(tukeyHSD_p.adjusted < StatCutoff) %>% + ## exclude Residuals row + dplyr::filter(Explained_Variance > VarianceCutoff) %>% + ## only keep unique term~PC combinations AND STATS + dplyr::distinct(term, PC, .keep_all = TRUE) %>% + dplyr::select(term, PC, Explained_Variance) + + Data_Heat <- reshape2::dcast(Data_Heat, term ~ PC, value.var = "Explained_Variance") %>% + tibble::column_to_rownames("term") %>% + dplyr::mutate_all(~replace(., is.na(.), 0)) + + if (nrow(Data_Heat) > 2) { + + ## Plot + invisible( + VizHeatmap(InputData = Data_Heat, + PlotName = paste0("ExplainedVariance-bigger-", + VarianceCutoff , "Percent_AND_p.adj-smaller", + StatCutoff), + Scale = "none", + SaveAs_Plot = SaveAs_Plot, + PrintPlot = PrintPlot, + FolderPath = Folder)) + } else { + message <- paste0("StatCutoff of ", StatCutoff, + " and VarianceCutoff of ", VarianceCutoff, + " do only return <= 2 cases, hence no heatmap is plotted.") + logger::log_info("warning: ", message) + warning(message) + } + + ############################################################################# + ## ---------- Return ------------## + ## make list of Output DFs: 1. prcomp results, 2. Loadings result, + ## 3. TopBottom Features, 4. AOV + ResList <- list(res_prcomp = PCA.res_Info, res_loadings = PCA.res_Loadings, + res_TopBottomFeatures = TopBottom_Features, res_aov = Stat_results, + res_summary = Res_summary) + + ## Save the results + SaveRes( + data = ResList, + plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = FALSE, + FolderPath = Folder, + FileName = "MetaAnalysis", + CoRe = FALSE, + PrintPlot = FALSE) + + ## return + invisible(ResList) } @@ -318,9 +366,9 @@ MetaAnalysis <- function(InputData, #' @return DF with prior knowledge based on patient metadata #' #' @examples -#' Tissue_Norm <- MetaProViz::ToyData("Tissue_Norm") -#' Res <- MetaProViz::MetaPK(InputData=Tissue_Norm[,-c(1:13)], -#' SettingsFile_Sample= Tissue_Norm[,c(2,4:5,12:13)]) +#' Tissue_Norm <- ToyData("Tissue_Norm") +#' Res <- MetaPK(se = se) #InputData=Tissue_Norm[,-c(1:13)], +#' # SettingsFile_Sample= Tissue_Norm[,c(2,4:5,12:13)]) #' #' @keywords prior knowledge, metadata #' @@ -330,74 +378,79 @@ MetaAnalysis <- function(InputData, #' #' @export #' -MetaPK <- function(InputData, - SettingsFile_Sample, - SettingsInfo=NULL, - SaveAs_Table = "csv", - FolderPath = NULL){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ### Enrichment analysis-based - #*we can make pathway file from metadata and use this to run enrichment analysis. - #*At the moment we can just make the pathways and we need to include a standard fishers exact test. - #*Merge with function above? - # *Advantage/disadvantage: Not specific - with annova PC we get granularity e.g. smoker-ExSmoker-PC5, whilst here we only get smoking in generall as parameter - - ################################################################################################################################################################################################ - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - - - - - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "MetaAnalysis", - FolderPath=FolderPath) - } +MetaPK <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo = NULL, + SaveAs_Table = "csv", + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ### Enrichment analysis-based + ## *we can make pathway file from metadata and use this to run enrichment + ## analysis. + ## *At the moment we can just make the pathways and we need to include a + ## standard fishers exact test. + ##*Merge with function above? + # *Advantage/disadvantage: Not specific - with annova PC we get granularity + ##e.g. smoker-ExSmoker-PC5, whilst here we only get smoking in generall + ## as parameter + + ############################################################################ + ## ------------ Check Input files ----------- ## + ## HelperFunction `CheckInput` + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "MetaAnalysis", FolderPath = FolderPath) + } - ############################################################################################################################################################################################################### - ## ---------- Create Prior Knowledge file format to perform enrichment analysis ------------## - # Use the Sample metadata for this: - if(is.null(SettingsInfo)==TRUE){ - MetaData <- names(SettingsFile_Sample) - SettingsFile_Sample_subset <- SettingsFile_Sample%>% - tibble::rownames_to_column("SampleID") - }else{ - MetaData <- SettingsInfo - SettingsFile_Sample_subset <- SettingsFile_Sample[, MetaData, drop = FALSE]%>% - tibble::rownames_to_column("SampleID") - } - - # Convert into a pathway DF - Metadata_df <- SettingsFile_Sample_subset %>% - tidyr::pivot_longer(cols = -SampleID, names_to = "ColumnName", values_to = "ColumnEntry")%>% - tidyr::unite("term", c("ColumnName", "ColumnEntry"), sep = "_") - Metadata_df$mor <- 1 - - #Run ULM using decoupleR (input=PCs from prcomp and pkn=Metadata_df) - #ULM_res <- decoupleR::run_ulm(mat=as.matrix(PCA.res$x), - # net=Metadata_df, - # .source='term', - # .target='SampleID', - # .mor='mor', - # minsize = 5) - - #Add explained variance into the table: - #prop_var_ex <- as.data.frame(((PCA.res[["sdev"]])^2/sum((PCA.res[["sdev"]])^2))*100)%>%#To compute the proportion of variance explained by each component in percent, we divide the variance by sum of total variance and multiply by 100(variance=standard deviation ^2) - # rownames_to_column("PC")%>% - # mutate(PC = paste("PC", PC, sep=""))%>% - # dplyr::rename("Explained_Variance"=2) - - #ULM_res <- merge(ULM_res, prop_var_ex, by.x="condition",by.y="PC",all.x=TRUE) - - ############################################################################################################################################################################################################### - ## ---------- Save ------------## - # Add to results DF - Res <- list(MetaData_PriorKnowledge = Metadata_df) + ############################################################################ + ## create Prior Knowledge file format to perform enrichment analysis ## + ## use the Sample metadata for this: + if (is.null(SettingsInfo)) { + MetaData <- colnames(colData(se)) + SettingsFile_Sample_subset <- colData(se) %>% + as.data.frame() + tibble::rownames_to_column("SampleID") + } else { + MetaData <- SettingsInfo + SettingsFile_Sample_subset <- coldata(se)[, MetaData, + drop = FALSE] %>% + as.data.frame() + tibble::rownames_to_column("SampleID") + } + ## convert into a pathway DF + Metadata_df <- SettingsFile_Sample_subset %>% + tidyr::pivot_longer(cols = -SampleID, + names_to = "ColumnName", values_to = "ColumnEntry") %>% + tidyr::unite("term", c("ColumnName", "ColumnEntry"), sep = "_") + Metadata_df$mor <- 1 + + ## run ULM using decoupleR (input=PCs from prcomp and pkn=Metadata_df) + #ULM_res <- decoupleR::run_ulm(mat=as.matrix(PCA.res$x), + # net=Metadata_df, + # .source='term', + # .target='SampleID', + # .mor='mor', + # minsize = 5) + + ## add explained variance into the table: + #prop_var_ex <- as.data.frame(((PCA.res[["sdev"]])^2/sum((PCA.res[["sdev"]])^2))*100)%>%#To compute the proportion of variance explained by each component in percent, we divide the variance by sum of total variance and multiply by 100(variance=standard deviation ^2) + # rownames_to_column("PC")%>% + # mutate(PC = paste("PC", PC, sep=""))%>% + # dplyr::rename("Explained_Variance"=2) + + #ULM_res <- merge(ULM_res, prop_var_ex, by.x="condition",by.y="PC",all.x=TRUE) + + ############################################################################ + ## ---------- save ------------## + ## add to results DF + Res <- list(MetaData_PriorKnowledge = Metadata_df) + + ## return + Res } diff --git a/R/MetaboliteClusteringAnalysis.R b/R/MetaboliteClusteringAnalysis.R index 50418f3c..ac6564f9 100644 --- a/R/MetaboliteClusteringAnalysis.R +++ b/R/MetaboliteClusteringAnalysis.R @@ -36,10 +36,12 @@ #' @return List of two DFs: 1. Summary of the cluster count and 2. the detailed information of each metabolites in the clusters. #' #' @examples -#' Intra <- MetaProViz::ToyData("IntraCells_Raw") -#' Input <- MetaProViz::DMA(InputData=Intra[-c(49:58) ,-c(1:3)], SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2")) +#' Intra <- ToyData("IntraCells_Raw") +#' +#' ## create +#' Input <- DMA(InputData = Intra[-c(49:58) ,-c(1:3)], SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2")) #' -#' Res <- MetaProViz::MCA_2Cond(InputData_C1 = Input[["DMA"]][["786-O_vs_HK2"]], +#' Res <- MCA_2Cond(InputData_C1 = Input[["DMA"]][["786-O_vs_HK2"]], #' InputData_C2 = Input[["DMA"]][["786-M1A_vs_HK2"]]) #' #' @keywords biological clustering @@ -52,361 +54,580 @@ #' @export #' MCA_2Cond <- function(InputData_C1, - InputData_C2, - SettingsInfo_C1=c(ValueCol="Log2FC",StatCol="p.adj", StatCutoff= 0.05, ValueCutoff=1), - SettingsInfo_C2=c(ValueCol="Log2FC",StatCol="p.adj", StatCutoff= 0.05, ValueCutoff=1), - FeatureID = "Metabolite", - SaveAs_Table = "csv", - BackgroundMethod="C1&C2", - FolderPath=NULL - ){ - - ################################################################################################################################################################################################ - ## ------------ Check Input files ----------- ## - CheckInput_MCA(InputData_C1=InputData_C1, - InputData_C2=InputData_C2, - InputData_CoRe=NULL, - InputData_Intra=NULL, - SettingsInfo_C1=SettingsInfo_C1, - SettingsInfo_C2=SettingsInfo_C2, - SettingsInfo_CoRe=NULL, - SettingsInfo_Intra=NULL, - BackgroundMethod=BackgroundMethod, - FeatureID=FeatureID, - SaveAs_Table=SaveAs_Table) - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "MCA2Cond", - FolderPath=FolderPath) - } - - ################################################################################################################################################################################################ - ## ------------ Prepare the Input -------- ## - #Import the data and check columns (here the user will get an error if the column can not be renamed as it does not exists.) - Cond1_DF <- as.data.frame(InputData_C1)%>% - dplyr::rename("MetaboliteID"=paste(FeatureID), - "ValueCol"=SettingsInfo_C1[["ValueCol"]], - "PadjCol"=SettingsInfo_C1[["StatCol"]]) - Cond1_DF <- Cond1_DF[complete.cases(Cond1_DF$ValueCol, Cond1_DF$PadjCol), ] - - Cond2_DF<- as.data.frame(InputData_C2)%>% - dplyr::rename("MetaboliteID"=paste(FeatureID), - "ValueCol"=SettingsInfo_C2[["ValueCol"]], - "PadjCol"=SettingsInfo_C2[["StatCol"]]) - Cond2_DF <- Cond2_DF[complete.cases(Cond2_DF$ValueCol, Cond2_DF$PadjCol), ] - - #Tag genes that are detected in each data layer - Cond1_DF$Detected <- "TRUE" - Cond2_DF$Detected <- "TRUE" - - ## ------------ Assign Groups -------- ## - #Assign to Group based on individual Cutoff ("UP", "DOWN", "No Change") - Cond1_DF <-Cond1_DF%>% - dplyr::mutate(Cutoff = dplyr::case_when(Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & Cond1_DF$ValueCol > as.numeric(SettingsInfo_C1[["ValueCutoff"]]) ~ 'UP', - Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & Cond1_DF$ValueCol < - as.numeric(SettingsInfo_C1[["ValueCutoff"]]) ~ 'DOWN', - TRUE ~ 'No Change'))%>% - dplyr::mutate(Cutoff_Specific = dplyr::case_when(Cutoff == "UP" ~ 'UP', - Cutoff == "DOWN" ~ 'DOWN', - Cutoff == "No Change" & Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & Cond1_DF$ValueCol > 0 ~ 'Significant Positive', - Cutoff == "No Change" & Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & Cond1_DF$ValueCol < 0 ~ 'Significant Negative', - Cutoff == "No Change" & Cond1_DF$PadjCol > as.numeric(SettingsInfo_C1[["StatCutoff"]]) ~ 'Not Significant', - TRUE ~ 'NA')) - - Cond2_DF <- Cond2_DF%>% - dplyr::mutate(Cutoff = dplyr::case_when(Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & Cond2_DF$ValueCol > as.numeric(SettingsInfo_C2[["ValueCutoff"]]) ~ 'UP', - Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & Cond2_DF$ValueCol < - as.numeric(SettingsInfo_C2[["ValueCutoff"]]) ~ 'DOWN', - TRUE ~ 'No Change')) %>% - dplyr::mutate(Cutoff_Specific = dplyr::case_when(Cutoff == "UP" ~ 'UP', - Cutoff == "DOWN" ~ 'DOWN', - Cutoff == "No Change" & Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & Cond2_DF$ValueCol > 0 ~ 'Significant Positive', - Cutoff == "No Change" & Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & Cond2_DF$ValueCol < 0 ~ 'Significant Negative', - Cutoff == "No Change" & Cond2_DF$PadjCol > as.numeric(SettingsInfo_C2[["StatCutoff"]]) ~ 'Not Significant', - TRUE ~ 'NA')) - - - - #Merge the dataframes together: Merge the supplied Cond1 and Cond2 dataframes together. - ##Add prefix to column names to distinguish the different data types after merge - colnames(Cond2_DF) <- paste0("Cond2_DF_", colnames(Cond2_DF)) - Cond2_DF <- Cond2_DF%>% - dplyr::rename("MetaboliteID" = "Cond2_DF_MetaboliteID") - - colnames(Cond1_DF) <- paste0("Cond1_DF_", colnames(Cond1_DF)) - Cond1_DF <-Cond1_DF%>% - dplyr::rename("MetaboliteID"="Cond1_DF_MetaboliteID") - - ##Merge - MergeDF <- merge(Cond1_DF, Cond2_DF, by="MetaboliteID", all=TRUE) - - ##Mark the undetected genes in each data layer - MergeDF<-MergeDF %>% - dplyr::mutate_at(c("Cond2_DF_Detected","Cond1_DF_Detected"), ~tidyr::replace_na(.,"FALSE"))%>% - dplyr::mutate_at(c("Cond2_DF_Cutoff","Cond1_DF_Cutoff"), ~tidyr::replace_na(.,"No Change"))%>% - dplyr::mutate_at(c("Cond2_DF_Cutoff_Specific", "Cond1_DF_Cutoff_Specific"), ~tidyr::replace_na(.,"Not Detected")) - - #Apply Background filter (label genes that will be removed based on choosen background) - if(BackgroundMethod == "C1|C2"){# C1|C2 = Cond2 OR Cond1 - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', #Cond1 & Cond2 - Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="FALSE" ~ 'TRUE', # JustCond1 - Cond1_DF_Detected=="FALSE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', # Just Cond2 - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "C1&C2"){ # Cond2 AND Cond1 - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', #Cond1 & Cond2 - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "C2"){ # Cond2 has to be there - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', #Cond1 & Cond2 - Cond1_DF_Detected=="FALSE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', # Just Cond2 - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "C1"){ #Cond1 has to be there - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="TRUE" ~ 'TRUE', #Cond1 & Cond2 - Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected=="FALSE" ~ 'TRUE', # JustCond1 - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "*"){ # Use all genes as the background - MergeDF$BG_Method <- "TRUE" - }else{ - stop("Please use one of the following BackgroundMethods: C1|C2, C1&C2, C2, C1, *")#error message - } - - #Assign SiRCle cluster names to the genes - MergeDF <- MergeDF%>% - dplyr::mutate(RG1_Specific_Cond2 = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 DOWN + Cond2 DOWN',#State 1 - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 DOWN + Cond2 Not Detected',#State 2 - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 DOWN + Cond2 Not Significant',#State 3 - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 DOWN + Cond2 Significant Negative',#State 4 - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 DOWN + Cond2 Significant Positive',#State 5 - Cond1_DF_Cutoff=="DOWN" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 DOWN + Cond2 UP',#State 6 - - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 No Change + Cond2 DOWN',#State 7 - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 No Change + Cond2 Not Detected',#State 8 - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 No Change + Cond2 Not Significant',#State 9 - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 No Change + Cond2 Significant Negative',#State 10 - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 No Change + Cond2 Significant Positive',#State 11 - Cond1_DF_Cutoff=="No Change" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 No Change + Cond2 UP',#State 6 - - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 UP + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 UP + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 UP + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 UP + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 UP + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff=="UP" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 UP + Cond2 UP',#State 17 - TRUE ~ 'NA'))%>% - dplyr::mutate(RG1_Specific_Cond1 = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="DOWN" ~ 'Cond2 DOWN + Cond1 DOWN',#State 1 - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="Not Detected" ~ 'Cond2 DOWN + Cond1 Not Detected',#State 2 - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="Not Significant" ~ 'Cond2 DOWN + Cond1 Not Significant',#State 3 - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond2 DOWN + Cond1 Significant Negative',#State 4 - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond2 DOWN + Cond1 Significant Positive',#State 5 - Cond2_DF_Cutoff=="DOWN" & Cond1_DF_Cutoff_Specific=="UP" ~ 'Cond2 DOWN + Cond1 UP',#State 6 - - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="DOWN" ~ 'Cond2 No Change + Cond1 DOWN',#State 7 - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="Not Detected" ~ 'Cond2 No Change + Cond1 Not Detected',#State 8 - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="Not Significant" ~ 'Cond2 No Change + Cond1 Not Significant',#State 9 - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond2 No Change + Cond1 Significant Negative',#State 10 - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond2 No Change + Cond1 Significant Positive',#State 11 - Cond2_DF_Cutoff=="No Change" & Cond1_DF_Cutoff_Specific=="UP" ~ 'Cond2 No Change + Cond1 UP',#State 6 - - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="DOWN" ~ 'Cond2 UP + Cond1 DOWN',#State 12 - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="Not Detected" ~ 'Cond2 UP + Cond1 Not Detected',#State 13 - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="Not Significant" ~ 'Cond2 UP + Cond1 Not Significant',#State 14 - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond2 UP + Cond1 Significant Negative',#State 15 - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond2 UP + Cond1 Significant Positive',#State 16 - Cond2_DF_Cutoff=="UP" & Cond1_DF_Cutoff_Specific=="UP" ~ 'Cond2 UP + Cond1 UP',#State 17 - TRUE ~ 'NA'))%>% - dplyr::mutate(RG1_All = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 DOWN + Cond2 DOWN',#State 1 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 DOWN + Cond2 Not Detected',#State 2 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 DOWN + Cond2 Not Significant',#State 3 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 DOWN + Cond2 Significant Negative',#State 4 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 DOWN + Cond2 Significant Positive',#State 5 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 DOWN + Cond2 UP',#State 6 - - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 UP + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 UP + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 UP + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 UP + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 UP + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 UP + Cond2 UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 Not Detected + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 Not Detected + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 Not Detected + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 Not Detected + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 Not Detected + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 Not Detected + Cond2 UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 Significant Negative + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 Significant Negative + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 Significant Negative + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 Significant Negative + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 Significant Negative + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 Significant Negative + Cond2 UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 Significant Positive + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 Significant Positive + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 Significant Positive + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 Significant Positive + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 Significant Positive + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 Significant Positive + Cond2 UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond1 Not Significant + Cond2 DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1 Not Significant + Cond2 Not Detected',#State 13 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1 Not Significant + Cond2 Not Significant',#State 14 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1 Not Significant + Cond2 Significant Negative',#State 15 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1 Not Significant + Cond2 Significant Positive',#State 16 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond1 Not Significant + Cond2 UP',#State 1 - TRUE ~ 'NA'))%>% - dplyr::mutate(RG2_Significant = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Core_DOWN',#State 1 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1_DOWN',#State 2 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1_DOWN',#State 3 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Core_DOWN',#State 4 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Opposite',#State 5 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Opposite',#State 6 - - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Opposite',#State 12 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1_UP',#State 13 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1_UP',#State 14 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Opposite',#State 15 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Core_UP',#State 16 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Core_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Core_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Opposite',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Opposite',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Core_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 1 - TRUE ~ 'NA'))%>% - dplyr::mutate(RG3_SignificantChange = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Core_DOWN',#State 1 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1_DOWN',#State 2 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1_DOWN',#State 3 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1_DOWN',#State 4 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1_DOWN',#State 5 - Cond1_DF_Cutoff_Specific=="DOWN" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Opposite',#State 6 - - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Opposite',#State 12 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'Cond1_UP',#State 13 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'Cond1_UP',#State 14 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'Cond1_UP',#State 15 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'Cond1_UP',#State 16 - Cond1_DF_Cutoff_Specific=="UP" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Core_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Not Detected" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Negative" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Significant Positive" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 17 - - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="DOWN" ~ 'Cond2_DOWN',#State 12 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Detected" ~ 'None',#State 13 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Not Significant" ~ 'None',#State 14 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Negative" ~ 'None',#State 15 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="Significant Positive" ~ 'None',#State 16 - Cond1_DF_Cutoff_Specific=="Not Significant" & Cond2_DF_Cutoff_Specific=="UP" ~ 'Cond2_UP',#State 1 - TRUE ~ 'NA')) - - #Safe the DF and return the groupings - ##MCA DF (Merged InputDF filtered for background with assigned MCA cluster names) - MergeDF_Select1 <- MergeDF[, c("MetaboliteID", "Cond1_DF_Detected","Cond1_DF_ValueCol","Cond1_DF_PadjCol","Cond1_DF_Cutoff", "Cond1_DF_Cutoff_Specific", "Cond2_DF_Detected", "Cond2_DF_ValueCol","Cond2_DF_PadjCol","Cond2_DF_Cutoff", "Cond2_DF_Cutoff_Specific", "BG_Method", "RG1_All", "RG2_Significant", "RG3_SignificantChange")] - - Cond2ValueCol_Unique<-paste("Cond2_DF_",SettingsInfo_C2[["ValueCol"]]) - Cond2PadjCol_Unique <-paste("Cond2_DF_",SettingsInfo_C2[["StatCol"]]) - Cond1ValueCol_Unique<-paste("Cond1_DF_",SettingsInfo_C1[["ValueCol"]]) - Cond1PadjCol_Unique <-paste("Cond1_DF_",SettingsInfo_C1[["StatCol"]]) - - MergeDF_Select2<- subset(MergeDF, select=-c(Cond1_DF_Detected,Cond1_DF_Cutoff, Cond2_DF_Detected,Cond2_DF_Cutoff, Cond2_DF_Cutoff_Specific, BG_Method, RG1_All, RG2_Significant, RG3_SignificantChange))%>% - dplyr::rename(!!Cond2ValueCol_Unique :="Cond2_DF_ValueCol",#This syntax is needed since paste(MetaboliteID)="MetaboliteID" is not working in dyplr - !!Cond2PadjCol_Unique :="Cond2_DF_PadjCol", - !!Cond1ValueCol_Unique :="Cond1_DF_ValueCol", - !!Cond1PadjCol_Unique :="Cond1_DF_PadjCol") - - MergeDF_Rearrange <- merge(MergeDF_Select1, MergeDF_Select2, by="MetaboliteID") - MergeDF_Rearrange <-MergeDF_Rearrange%>% - dplyr::rename("Metabolite"="MetaboliteID") - - ##Summary SiRCle clusters (number of genes assigned to each SiRCle cluster in each grouping) - ClusterSummary_RG1 <- MergeDF_Rearrange[,c("Metabolite", "RG1_All")]%>% - dplyr::count(RG1_All, name="Number of Features")%>% - dplyr::rename("SiRCle cluster Name"= "RG1_All") - ClusterSummary_RG1$`Regulation Grouping` <- "RG1_All" - - ClusterSummary_RG2 <- MergeDF_Rearrange[,c("Metabolite", "RG2_Significant")]%>% - dplyr::count(RG2_Significant, name="Number of Features")%>% - dplyr::rename("SiRCle cluster Name"= "RG2_Significant") - ClusterSummary_RG2$`Regulation Grouping` <- "RG2_Significant" - - ClusterSummary_RG3 <- MergeDF_Rearrange[,c("Metabolite", "RG3_SignificantChange")]%>% - dplyr::count(RG3_SignificantChange, name="Number of Features")%>% - dplyr::rename("SiRCle cluster Name"= "RG3_SignificantChange") - ClusterSummary_RG3$`Regulation Grouping` <- "RG3_SignificantChange" - - ClusterSummary <- rbind(ClusterSummary_RG1, ClusterSummary_RG2,ClusterSummary_RG3) - ClusterSummary <- ClusterSummary[,c(3,1,2)] - - ## Rename FeatureID - MergeDF_Rearrange <-MergeDF_Rearrange%>% - dplyr::rename(!!FeatureID := "Metabolite") - - ###################################################################################################################################################################### - ##----- Save and Return - #Here we make a list in which we will save the outputs: - DF_List <- list("MCA_2Cond_Summary"=ClusterSummary, "MCA_2Cond_Results"=MergeDF_Rearrange) - - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=DF_List, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= Folder, - FileName= "MCA_2Cond", - CoRe=FALSE, - PrintPlot=FALSE))) - - #Return: - invisible(return(DF_List)) + InputData_C2, + SettingsInfo_C1 = c( + ValueCol = "Log2FC", StatCol = "p.adj", StatCutoff = 0.05, + ValueCutoff = 1), + SettingsInfo_C2 = c( + ValueCol = "Log2FC", StatCol = "p.adj", StatCutoff = 0.05, + ValueCutoff = 1), + FeatureID = "Metabolite", + SaveAs_Table = "csv", ## EDIT: see helperSave + BackgroundMethod = "C1&C2", + FolderPath=NULL) { + + ############################################################################## + ## ------------ Check Input files ----------- ## + CheckInput_MCA(InputData_C1 = InputData_C1, + InputData_C2 = InputData_C2, + InputData_CoRe = NULL, + InputData_Intra = NULL, + SettingsInfo_C1 = SettingsInfo_C1, + SettingsInfo_C2 = SettingsInfo_C2, + SettingsInfo_CoRe = NULL, + SettingsInfo_Intra = NULL, + BackgroundMethod = BackgroundMethod, + FeatureID = FeatureID, + SaveAs_Table = SaveAs_Table) + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "MCA2Cond", FolderPath = FolderPath) + } + + ############################################################################ + ## ------------ Prepare the Input -------- ## + ## import the data and check columns (here the user will get an error if + ## the column can not be renamed as it does not exists.) + Cond1_DF <- as.data.frame(InputData_C1) %>% + dplyr::rename( + "MetaboliteID" = paste(FeatureID), + "ValueCol" = SettingsInfo_C1[["ValueCol"]], + "PadjCol" = SettingsInfo_C1[["StatCol"]]) + Cond1_DF <- Cond1_DF[complete.cases(Cond1_DF$ValueCol, Cond1_DF$PadjCol), ] + + Cond2_DF<- as.data.frame(InputData_C2) %>% + dplyr::rename( + "MetaboliteID" = paste(FeatureID), + "ValueCol" = SettingsInfo_C2[["ValueCol"]], + "PadjCol" = SettingsInfo_C2[["StatCol"]]) + Cond2_DF <- Cond2_DF[complete.cases(Cond2_DF$ValueCol, Cond2_DF$PadjCol), ] + + ## Tag genes that are detected in each data layer + Cond1_DF$Detected <- "TRUE" ## EDIT: is there a specific reason that this is a character and no logical? + Cond2_DF$Detected <- "TRUE" + + ## ------------ Assign Groups -------- ## + ## assign to Group based on individual Cutoff ("UP", "DOWN", "No Change") + Cond1_DF <-Cond1_DF %>% + dplyr::mutate( + Cutoff = dplyr::case_when( + Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & + Cond1_DF$ValueCol > as.numeric(SettingsInfo_C1[["ValueCutoff"]]) ~ 'UP', + Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & + Cond1_DF$ValueCol < - as.numeric(SettingsInfo_C1[["ValueCutoff"]]) ~ 'DOWN', + TRUE ~ 'No Change')) %>% + dplyr::mutate( + Cutoff_Specific = dplyr::case_when( + Cutoff == "UP" ~ 'UP', + Cutoff == "DOWN" ~ 'DOWN', + Cutoff == "No Change" & + Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & + Cond1_DF$ValueCol > 0 ~ 'Significant Positive', + Cutoff == "No Change" & + Cond1_DF$PadjCol <= as.numeric(SettingsInfo_C1[["StatCutoff"]]) & + Cond1_DF$ValueCol < 0 ~ 'Significant Negative', + Cutoff == "No Change" & + Cond1_DF$PadjCol > as.numeric(SettingsInfo_C1[["StatCutoff"]]) ~ 'Not Significant', + TRUE ~ 'NA')) + + Cond2_DF <- Cond2_DF %>% + dplyr::mutate( + Cutoff = dplyr::case_when( + Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & + Cond2_DF$ValueCol > as.numeric(SettingsInfo_C2[["ValueCutoff"]]) ~ 'UP', + Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & + Cond2_DF$ValueCol < - as.numeric(SettingsInfo_C2[["ValueCutoff"]]) ~ 'DOWN', + TRUE ~ 'No Change')) %>% + dplyr::mutate( + Cutoff_Specific = dplyr::case_when( + Cutoff == "UP" ~ 'UP', + Cutoff == "DOWN" ~ 'DOWN', + Cutoff == "No Change" & + Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & + Cond2_DF$ValueCol > 0 ~ 'Significant Positive', + Cutoff == "No Change" & + Cond2_DF$PadjCol <= as.numeric(SettingsInfo_C2[["StatCutoff"]]) & + Cond2_DF$ValueCol < 0 ~ 'Significant Negative', + Cutoff == "No Change" & + Cond2_DF$PadjCol > as.numeric(SettingsInfo_C2[["StatCutoff"]]) ~ 'Not Significant', + TRUE ~ 'NA')) + + ## merge the supplied Cond1 and Cond2 dataframes + ## add prefix to column names to distinguish the different data types + ## after merge + colnames(Cond2_DF) <- paste0("Cond2_DF_", colnames(Cond2_DF)) + Cond2_DF <- Cond2_DF %>% + dplyr::rename("MetaboliteID" = "Cond2_DF_MetaboliteID") + colnames(Cond1_DF) <- paste0("Cond1_DF_", colnames(Cond1_DF)) + Cond1_DF <- Cond1_DF %>% + dplyr::rename("MetaboliteID" = "Cond1_DF_MetaboliteID") + MergeDF <- merge(Cond1_DF, Cond2_DF, by = "MetaboliteID", all = TRUE) + + ## mark the undetected genes in each data layer + MergeDF <- MergeDF %>% + dplyr::mutate_at(c("Cond2_DF_Detected", "Cond1_DF_Detected"), + ~ tidyr::replace_na(., "FALSE")) %>% + dplyr::mutate_at(c("Cond2_DF_Cutoff", "Cond1_DF_Cutoff"), + ~ tidyr::replace_na(., "No Change")) %>% + dplyr::mutate_at(c("Cond2_DF_Cutoff_Specific", "Cond1_DF_Cutoff_Specific"), + ~ tidyr::replace_na(., "Not Detected")) + + ## apply Background filter (label genes that will be removed based on + ## chosen background) + if (BackgroundMethod == "C1|C2") { ## C1|C2 = Cond2 OR Cond1 + MergeDF <- MergeDF %>% + dplyr::mutate( + BG_Method = dplyr::case_when( + Cond1_DF_Detected == "TRUE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Cond1 & Cond2 + Cond1_DF_Detected == "TRUE" & Cond2_DF_Detected == "FALSE" ~ 'TRUE', ## JustCond1 + Cond1_DF_Detected == "FALSE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Just Cond2 + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "C1&C2") { ## Cond2 AND Cond1 + MergeDF <- MergeDF %>% + dplyr::mutate( + BG_Method = dplyr::case_when( + Cond1_DF_Detected == "TRUE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Cond1 & Cond2 + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "C2") { ## Cond2 has to be there + MergeDF <- MergeDF %>% + dplyr::mutate( + BG_Method = dplyr::case_when( + Cond1_DF_Detected == "TRUE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Cond1 & Cond2 + Cond1_DF_Detected == "FALSE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Just Cond2 + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "C1") { ## Cond1 has to be there + MergeDF <- MergeDF %>% + dplyr::mutate( + BG_Method = dplyr::case_when( + Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected == "TRUE" ~ 'TRUE', ## Cond1 & Cond2 + Cond1_DF_Detected=="TRUE" & Cond2_DF_Detected == "FALSE" ~ 'TRUE', ## JustCond1 + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "*") { # Use all genes as the background + MergeDF$BG_Method <- "TRUE" + } else { + stop("Please use one of the following BackgroundMethods: C1|C2, C1&C2, C2, C1, *") ##error message + } + + ## Assign SiRCle cluster names to the genes + MergeDF <- MergeDF %>% + dplyr::mutate( + RG1_Specific_Cond2 = dplyr::case_when( + BG_Method =="FALSE"~ 'Background = FALSE', + ## Cond1 DOWN + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 DOWN + Cond2 DOWN', ## State 1 + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 DOWN + Cond2 Not Detected', ## State 2 + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 DOWN + Cond2 Not Significant', ## State 3 + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 DOWN + Cond2 Significant Negative', ## State 4 + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 DOWN + Cond2 Significant Positive', ## State 5 + Cond1_DF_Cutoff=="DOWN" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 DOWN + Cond2 UP', ## State 6 + + ## Cond1 No Change + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 No Change + Cond2 DOWN', ## State 7 + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 No Change + Cond2 Not Detected', ## State 8 + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 No Change + Cond2 Not Significant', ## State 9 + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 No Change + Cond2 Significant Negative', ## State 10 + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 No Change + Cond2 Significant Positive', ## State 11 + Cond1_DF_Cutoff=="No Change" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 No Change + Cond2 UP', ## State 6 + + ## Cond1 UP + Cond1_DF_Cutoff == "UP" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 UP + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff == "UP" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 UP + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff == "UP" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 UP + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 UP + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 UP + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff == "UP" & Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 UP + Cond2 UP', ## State 17 + TRUE ~ 'NA')) %>% + dplyr::mutate( + RG1_Specific_Cond1 = dplyr::case_when( + BG_Method =="FALSE"~ 'Background = FALSE', + ## Cond2 DOWN + Cond2_DF_Cutoff == "DOWN" & + Cond1_DF_Cutoff_Specific == "DOWN" ~ 'Cond2 DOWN + Cond1 DOWN', ## State 1 + Cond2_DF_Cutoff == "DOWN" & + Cond1_DF_Cutoff_Specific == "Not Detected" ~ 'Cond2 DOWN + Cond1 Not Detected', ## State 2 + Cond2_DF_Cutoff == "DOWN" & + Cond1_DF_Cutoff_Specific == "Not Significant" ~ 'Cond2 DOWN + Cond1 Not Significant', ## State 3 + Cond2_DF_Cutoff == "DOWN" & + Cond1_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond2 DOWN + Cond1 Significant Negative', ## State 4 + Cond2_DF_Cutoff == "DOWN" & + Cond1_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond2 DOWN + Cond1 Significant Positive', ## State 5 + Cond2_DF_Cutoff == "DOWN" & Cond1_DF_Cutoff_Specific == "UP" ~ 'Cond2 DOWN + Cond1 UP', ## State 6 + + ## Cond2 No Change + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "DOWN" ~ 'Cond2 No Change + Cond1 DOWN', ## State 7 + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "Not Detected" ~ 'Cond2 No Change + Cond1 Not Detected', ## State 8 + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "Not Significant" ~ 'Cond2 No Change + Cond1 Not Significant', ## State 9 + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond2 No Change + Cond1 Significant Negative', ## State 10 + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond2 No Change + Cond1 Significant Positive', ## State 11 + Cond2_DF_Cutoff == "No Change" & + Cond1_DF_Cutoff_Specific == "UP" ~ 'Cond2 No Change + Cond1 UP', ## State 6 + + ## Cond2 UP + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "DOWN" ~ 'Cond2 UP + Cond1 DOWN', ## State 12 + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "Not Detected" ~ 'Cond2 UP + Cond1 Not Detected', ## State 13 + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "Not Significant" ~ 'Cond2 UP + Cond1 Not Significant', ## State 14 + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond2 UP + Cond1 Significant Negative', ## State 15 + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond2 UP + Cond1 Significant Positive', ## State 16 + Cond2_DF_Cutoff == "UP" & Cond1_DF_Cutoff_Specific == "UP" ~ 'Cond2 UP + Cond1 UP', ## State 17 + TRUE ~ 'NA')) %>% + dplyr::mutate( + RG1_All = dplyr::case_when( + BG_Method == "FALSE"~ 'Background = FALSE', + ## Cond1 DOWN + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 DOWN + Cond2 DOWN', ## State 1 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 DOWN + Cond2 Not Detected', ## State 2 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 DOWN + Cond2 Not Significant', ## State 3 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 DOWN + Cond2 Significant Negative', ## State 4 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 DOWN + Cond2 Significant Positive', ## State 5 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 DOWN + Cond2 UP', ## State 6 + + ## Cond1 UP + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 UP + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 UP + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 UP + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 UP + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 UP + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 UP + Cond2 UP', ## State 17 + + ## Cond1 Not Detected + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 Not Detected + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 Not Detected + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 Not Detected + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 Not Detected + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 Not Detected + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 Not Detected + Cond2 UP', ## State 17 + + ## Cond1 Significant Negative + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 Significant Negative + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 Significant Negative + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 Significant Negative + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 Significant Negative + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 Significant Negative + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 Significant Negative + Cond2 UP', ## State 17 + + ## Cond1 Significant Positive + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 Significant Positive + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 Significant Positive + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 Significant Positive + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 Significant Positive + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 Significant Positive + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 Significant Positive + Cond2 UP', ## State 17 + + ## Cond1 Not Significant + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond1 Not Significant + Cond2 DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1 Not Significant + Cond2 Not Detected', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1 Not Significant + Cond2 Not Significant', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1 Not Significant + Cond2 Significant Negative', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1 Not Significant + Cond2 Significant Positive', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond1 Not Significant + Cond2 UP', ## State 1 + TRUE ~ 'NA')) %>% + dplyr::mutate( + RG2_Significant = dplyr::case_when( + BG_Method == "FALSE"~ 'Background = FALSE', + ## Cond1 DOWN + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Core_DOWN', ## State 1 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1_DOWN', ## State 2 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1_DOWN', ## State 3 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Core_DOWN', ## State 4 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Opposite', ## State 5 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Opposite', ## State 6 + + ## Cond1 UP + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Opposite', ## State 12 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1_UP', ## State 13 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1_UP', ## State 14 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Opposite', ## State 15 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Core_UP', ## State 16 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Core_UP', ## State 17 + + ## Cond1 Not Detected + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 17 + + ## Cond1 Significant Negative + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Core_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Opposite', ## State 17 + + ## Cond1 Significant Positive + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Opposite', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Core_UP', ## State 17 + + ## Cond1 Not Significant + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 1 + TRUE ~ 'NA')) %>% + dplyr::mutate( + RG3_SignificantChange = dplyr::case_when( + BG_Method == "FALSE"~ 'Background = FALSE', + ## Cond1 DOWN + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Core_DOWN', ## State 1 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1_DOWN', ## State 2 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1_DOWN', ## State 3 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1_DOWN', ## State 4 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1_DOWN', ## State 5 + Cond1_DF_Cutoff_Specific == "DOWN" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Opposite', ## State 6 + + ## Cond1 UP + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Opposite', ## State 12 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'Cond1_UP', ## State 13 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'Cond1_UP', ## State 14 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'Cond1_UP', ## State 15 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'Cond1_UP', ## State 16 + Cond1_DF_Cutoff_Specific == "UP" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Core_UP', ## State 17 + + ## Cond1 Not Detected + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Detected" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 17 + + ## Cond1 Significant Negative + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Negative" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 17 + + ## Cond1 Significant Positive + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Significant Positive" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 17 + + ## Cond1 Not Significant + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "DOWN" ~ 'Cond2_DOWN', ## State 12 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Detected" ~ 'None', ## State 13 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Not Significant" ~ 'None', ## State 14 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Negative" ~ 'None', ## State 15 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "Significant Positive" ~ 'None', ## State 16 + Cond1_DF_Cutoff_Specific == "Not Significant" & + Cond2_DF_Cutoff_Specific == "UP" ~ 'Cond2_UP', ## State 1 + TRUE ~ 'NA')) + + ## Safe the DF and return the groupings + ## MCA DF (Merged InputDF filtered for background with assigned MCA cluster names) + MergeDF_Select1 <- MergeDF[, c("MetaboliteID", "Cond1_DF_Detected", + "Cond1_DF_ValueCol", "Cond1_DF_PadjCol", "Cond1_DF_Cutoff", + "Cond1_DF_Cutoff_Specific", "Cond2_DF_Detected", "Cond2_DF_ValueCol", + "Cond2_DF_PadjCol", "Cond2_DF_Cutoff", "Cond2_DF_Cutoff_Specific", + "BG_Method", "RG1_All", "RG2_Significant", "RG3_SignificantChange")] + + Cond2ValueCol_Unique <- paste("Cond2_DF_", SettingsInfo_C2[["ValueCol"]]) + Cond2PadjCol_Unique <- paste("Cond2_DF_", SettingsInfo_C2[["StatCol"]]) + Cond1ValueCol_Unique <- paste("Cond1_DF_", SettingsInfo_C1[["ValueCol"]]) + Cond1PadjCol_Unique <- paste("Cond1_DF_", SettingsInfo_C1[["StatCol"]]) + + MergeDF_Select2 <- subset(MergeDF, + select = -c(Cond1_DF_Detected, Cond1_DF_Cutoff, + Cond2_DF_Detected, Cond2_DF_Cutoff, Cond2_DF_Cutoff_Specific, + BG_Method, RG1_All, RG2_Significant, RG3_SignificantChange)) %>% + dplyr::rename( + ## This syntax is needed since paste(MetaboliteID) = "MetaboliteID" + ## is not working in dplyr + !!Cond2ValueCol_Unique := "Cond2_DF_ValueCol", + !!Cond2PadjCol_Unique := "Cond2_DF_PadjCol", + !!Cond1ValueCol_Unique := "Cond1_DF_ValueCol", + !!Cond1PadjCol_Unique := "Cond1_DF_PadjCol") + + MergeDF_Rearrange <- merge(MergeDF_Select1, MergeDF_Select2, + by = "MetaboliteID") %>% + dplyr::rename("Metabolite" = "MetaboliteID") + + ## Summary SiRCle clusters (number of genes assigned to each SiRCle + ## cluster in each grouping) + ClusterSummary_RG1 <- MergeDF_Rearrange[, c("Metabolite", "RG1_All")] %>% + dplyr::count(RG1_All, name = "Number of Features") %>% + dplyr::rename("SiRCle cluster Name" = "RG1_All") + ClusterSummary_RG1$`Regulation Grouping` <- "RG1_All" + + ClusterSummary_RG2 <- MergeDF_Rearrange[, c("Metabolite", "RG2_Significant")] %>% + dplyr::count(RG2_Significant, name = "Number of Features") %>% + dplyr::rename("SiRCle cluster Name"= "RG2_Significant") + ClusterSummary_RG2$`Regulation Grouping` <- "RG2_Significant" + + ClusterSummary_RG3 <- MergeDF_Rearrange[, c("Metabolite", "RG3_SignificantChange")] %>% + dplyr::count(RG3_SignificantChange, name = "Number of Features") %>% + dplyr::rename("SiRCle cluster Name"= "RG3_SignificantChange") + ClusterSummary_RG3$`Regulation Grouping` <- "RG3_SignificantChange" + + ClusterSummary <- rbind(ClusterSummary_RG1, ClusterSummary_RG2, + ClusterSummary_RG3) + ClusterSummary <- ClusterSummary[, c(3, 1, 2)] + + ## Rename FeatureID + MergeDF_Rearrange <- MergeDF_Rearrange %>% + dplyr::rename(!!FeatureID := "Metabolite") + + ############################################################################ + ##----- Save and Return + ## Here we make a list in which we will save the outputs: + DF_List <- list("MCA_2Cond_Summary" = ClusterSummary, + "MCA_2Cond_Results" = MergeDF_Rearrange) + + suppressMessages(suppressWarnings( + SaveRes( + InputList_DF = DF_List, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = Folder, + FileName = "MCA_2Cond", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(DF_List) } @@ -429,21 +650,21 @@ MCA_2Cond <- function(InputData_C1, #' #' @examples #' -#' Media <- MetaProViz::ToyData("CultureMedia_Raw") -#' ResM <- MetaProViz::PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], +#' Media <- ToyData("CultureMedia_Raw") +#' ResM <- PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], #' SettingsFile_Sample = Media[-c(40:45) ,c(1:3)] , #' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates", CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), #' CoRe=TRUE) #' -#' MediaDMA <- MetaProViz::DMA(InputData=ResM[["DF"]][["Preprocessing_output"]][ ,-c(1:4)], +#' MediaDMA <- DMA(InputData=ResM[["DF"]][["Preprocessing_output"]][ ,-c(1:4)], #' SettingsFile_Sample=ResM[["DF"]][["Preprocessing_output"]][ , c(1:4)], #' SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2"), #' StatPval ="aov", #' CoRe=TRUE) #' -#' IntraDMA <- MetaProViz::ToyData(Data="IntraCells_DMA") +#' IntraDMA <- ToyData(Data="IntraCells_DMA") #' -#' Res <- MetaProViz::MCA_CoRe(InputData_Intra = IntraDMA%>%tibble::rownames_to_column("Metabolite"), +#' Res <- MCA_CoRe(InputData_Intra = IntraDMA%>%tibble::rownames_to_column("Metabolite"), #' InputData_CoRe = MediaDMA[["DMA"]][["786-M1A_vs_HK2"]]) #' #' @keywords biological clustering @@ -456,588 +677,1293 @@ MCA_2Cond <- function(InputData_C1, #' @export #' MCA_CoRe <- function(InputData_Intra, - InputData_CoRe, - SettingsInfo_Intra=c(ValueCol="Log2FC",StatCol="p.adj", StatCutoff= 0.05, ValueCutoff=1), - SettingsInfo_CoRe=c(DirectionCol="CoRe", ValueCol="Log2(Distance)",StatCol="p.adj", StatCutoff= 0.05, ValueCutoff=1), - FeatureID= "Metabolite", - SaveAs_Table = "csv", - BackgroundMethod="Intra&CoRe", - FolderPath=NULL - ){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ################################################################################################################################################################################################ - ## ------------ Check Input files ----------- ## - CheckInput_MCA(InputData_C1=NULL, - InputData_C2=NULL, - InputData_CoRe= InputData_CoRe, - InputData_Intra=InputData_Intra, - SettingsInfo_C1=NULL, - SettingsInfo_C2=NULL, - SettingsInfo_CoRe=SettingsInfo_CoRe, - SettingsInfo_Intra=SettingsInfo_Intra, - BackgroundMethod=BackgroundMethod, - FeatureID=FeatureID, - SaveAs_Table=SaveAs_Table) - - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "MCACoRe", - FolderPath=FolderPath) - } - - - ################################################################################################################################################################################################ - ## ------------ Prepare the Input -------- ## - #Import the data and check columns (here the user will get an error if the column can not be renamed as it does not exists.) - CoRe_DF <- as.data.frame(InputData_CoRe)%>% - dplyr::rename("MetaboliteID"=paste(FeatureID), - "ValueCol"=SettingsInfo_CoRe[["ValueCol"]], - "PadjCol"=SettingsInfo_CoRe[["StatCol"]], - "CoRe_Direction"=SettingsInfo_CoRe[["DirectionCol"]]) - CoRe_DF <- CoRe_DF[complete.cases(CoRe_DF$ValueCol, CoRe_DF$PadjCol), ] - - Intra_DF<- as.data.frame(InputData_Intra)%>% - dplyr::rename("MetaboliteID"=paste(FeatureID), - "ValueCol"=SettingsInfo_Intra[["ValueCol"]], - "PadjCol"=SettingsInfo_Intra[["StatCol"]]) - Intra_DF <- Intra_DF[complete.cases(Intra_DF$ValueCol, Intra_DF$PadjCol), ] - - #Tag genes that are detected in each data layer - CoRe_DF$Detected <- "TRUE" - Intra_DF$Detected <- "TRUE" - - #Assign to Group based on individual Cutoff ("UP", "DOWN", "No Change") - CoRe_DF <- CoRe_DF%>% - dplyr::mutate(Cutoff = dplyr::case_when(CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & CoRe_DF$ValueCol > as.numeric(SettingsInfo_CoRe[["ValueCutoff"]]) ~ 'UP', - CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & CoRe_DF$ValueCol < - as.numeric(SettingsInfo_CoRe[["ValueCutoff"]]) ~ 'DOWN', - TRUE ~ 'No Change')) %>% - dplyr::mutate(Cutoff_Specific = dplyr::case_when(Cutoff == "UP" ~ 'UP', - Cutoff == "DOWN" ~ 'DOWN', - Cutoff == "No Change" & CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & CoRe_DF$ValueCol > 0 ~ 'Significant Positive', - Cutoff == "No Change" & CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & CoRe_DF$ValueCol < 0 ~ 'Significant Negative', - Cutoff == "No Change" & CoRe_DF$PadjCol > as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) ~ 'Not Significant', - TRUE ~ 'NA')) - - Intra_DF <-Intra_DF%>% - dplyr::mutate(Cutoff = dplyr::case_when(Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & Intra_DF$ValueCol > as.numeric(SettingsInfo_Intra[["ValueCutoff"]]) ~ 'UP', - Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & Intra_DF$ValueCol < - as.numeric(SettingsInfo_Intra[["ValueCutoff"]]) ~ 'DOWN', - TRUE ~ 'No Change'))%>% - dplyr::mutate(Cutoff_Specific = dplyr::case_when(Cutoff == "UP" ~ 'UP', - Cutoff == "DOWN" ~ 'DOWN', - Cutoff == "No Change" & Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & Intra_DF$ValueCol > 0 ~ 'Significant Positive', - Cutoff == "No Change" & Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & Intra_DF$ValueCol < 0 ~ 'Significant Negative', - Cutoff == "No Change" & Intra_DF$PadjCol > as.numeric(SettingsInfo_Intra[["StatCutoff"]]) ~ 'Not Significant', - TRUE ~ 'NA')) - - #Merge the dataframes together: Merge the supplied Intra and CoRe dataframes together. - ##Add prefix to column names to distinguish the different data types after merge - colnames(CoRe_DF) <- paste0("CoRe_DF_", colnames(CoRe_DF)) - CoRe_DF <- CoRe_DF%>% - dplyr::rename("MetaboliteID" = "CoRe_DF_MetaboliteID") - - colnames(Intra_DF) <- paste0("Intra_DF_", colnames(Intra_DF)) - Intra_DF <-Intra_DF%>% - dplyr::rename("MetaboliteID"="Intra_DF_MetaboliteID") - - ##Merge - MergeDF <- merge(Intra_DF, CoRe_DF, by="MetaboliteID", all=TRUE) - - ##Mark the undetected genes in each data layer - MergeDF<-MergeDF %>% - dplyr::mutate_at(c("CoRe_DF_Detected","Intra_DF_Detected"), ~tidyr::replace_na(.,"FALSE"))%>% - dplyr::mutate_at(c("CoRe_DF_Cutoff","Intra_DF_Cutoff"), ~tidyr::replace_na(.,"No Change"))%>% - dplyr::mutate_at(c("CoRe_DF_Cutoff_Specific", "Intra_DF_Cutoff_Specific"), ~tidyr::replace_na(.,"Not Detected"))%>% - dplyr::mutate_at(c("CoRe_DF_CoRe_Direction"), ~tidyr::replace_na(.,"Not Detected")) - - #Apply Background filter (label metabolites that will be removed based on chosen background) - if(BackgroundMethod == "Intra|CoRe"){# C1|C2 = CoRe OR Intra - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', #Intra & CoRe - Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="FALSE" ~ 'TRUE', # JustIntra - Intra_DF_Detected=="FALSE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', # Just CoRe - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "Intra&CoRe"){ # CoRe AND Intra - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', #Intra & CoRe - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "CoRe"){ # CoRe has to be there - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', #Intra & CoRe - Intra_DF_Detected=="FALSE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', # Just CoRe - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "Intra"){ #Intra has to be there - MergeDF <- MergeDF%>% - dplyr::mutate(BG_Method = dplyr::case_when(Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="TRUE" ~ 'TRUE', #Intra & CoRe - Intra_DF_Detected=="TRUE" & CoRe_DF_Detected=="FALSE" ~ 'TRUE', # JustIntra - TRUE ~ 'FALSE')) - }else if(BackgroundMethod == "*"){ # Use all metabolites as the background - MergeDF$BG_Method <- "TRUE" - }else{ - stop("Please use one of the following BackgroundMethods: Intra|CoRe, Intra&CoRe, CoRe, Intra, *")#error message - } - - #Assign Metabolite cluster names to the metabolites - MergeDF <- MergeDF%>% - dplyr::mutate(RG1_All = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra DOWN + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra DOWN + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra DOWN + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra DOWN + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra DOWN + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra DOWN + CoRe UP_Released', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra UP + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra UP + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra UP + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra UP + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra UP + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra UP + CoRe UP_Released', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra Not Detected + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra Not Detected + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra Not Detected + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra Not Detected + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Intra Not Detected + CoRe UP_Released', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Negative + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Negative + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Negative + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Negative + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Negative + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Negative + CoRe UP_Released', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Positive + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Positive + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Positive + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Positive + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Positive + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Significant Positive + CoRe UP_Released', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Not Significant + CoRe DOWN_Released', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Not Significant + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Not Significant + CoRe Not Significant_Released', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Not Significant + CoRe Significant Negative_Released', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Not Significant + CoRe Significant Positive_Released', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'Intra Not Significant + CoRe UP_Released', - - #Consumed: - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra DOWN + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra DOWN + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra DOWN + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra DOWN + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra DOWN + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra DOWN + CoRe UP_Consumed', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra UP + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra UP + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra UP + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra UP + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra UP + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra UP + CoRe UP_Consumed', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra Not Detected + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra Not Detected + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra Not Detected + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra Not Detected + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Intra Not Detected + CoRe UP_Consumed', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Negative + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Negative + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Negative + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Negative + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Negative + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Negative + CoRe UP_Consumed', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Positive + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Positive + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Positive + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Positive + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Positive + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Significant Positive + CoRe UP_Consumed', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Not Significant + CoRe DOWN_Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Not Significant + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Not Significant + CoRe Not Significant_Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Not Significant + CoRe Significant Negative_Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Not Significant + CoRe Significant Positive_Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Intra Not Significant + CoRe UP_Consumed', - - #Released/Consumed (Consumed in one, released in the other) - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra DOWN + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra DOWN + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra DOWN + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra DOWN + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra DOWN + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra DOWN + CoRe UP_Released/Consumed', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra UP + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra UP + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra UP + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra UP + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra UP + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra UP + CoRe UP_Released/Consumed', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Detected + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Detected + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Detected + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Detected + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Detected + CoRe UP_Released/Consumed', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Negative + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Negative + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Negative + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Negative + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Negative + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Negative + CoRe UP_Released/Consumed', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Positive + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Significant Positive + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Positive + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Positive + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Positive + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Significant Positive + CoRe UP_Released/Consumed', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Significant + CoRe DOWN_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'Intra Not Significant + CoRe Not Detected', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Significant + CoRe Not Significant_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Significant + CoRe Significant Negative_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Significant + CoRe Significant Positive_Released/Consumed', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Intra Not Significant + CoRe UP_Released/Consumed', - TRUE ~ 'NA'))%>% - dplyr::mutate(RG2_Significant = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Both_DOWN (Released)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'Both_DOWN (Released)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'Opposite (Released UP)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Opposite (Released UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Opposite (Released DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'Opposite (Released UP)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'Both_UP (Released)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Both_UP (Released)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'CoRe_UP (Released)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'Both_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'Opposite (Released UP)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'Opposite (Released DOWN)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'Both_UP (Released)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_UP (Released)', - - #Consumed: - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Both_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Both_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Opposite (Consumed UP)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Opposite (Consumed UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Opposite (Consumed DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Opposite (Consumed UP)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Both_UP (Consumed)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Both_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'CoRe_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Both_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Opposite (Consumed UP)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Opposite (Consumed DOWN)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'Both_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_UP (Consumed)', - - #Consumed/Released (Consumed in one, released in the other) - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Both_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Both_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Opposite (Released/Consumed UP)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Opposite (Released/Consumed UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Opposite (Released/Consumed DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Opposite (Released/Consumed UP)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Both_UP (Released/Consumed)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Both_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'CoRe_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Both_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Opposite (Released/Consumed UP)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Opposite (Released/Consumed DOWN)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'Both_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_UP (Released/Consumed)', - TRUE ~ 'NA'))%>% - dplyr::mutate(RG3_Change = dplyr::case_when(BG_Method =="FALSE"~ 'Background = FALSE', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Both_DOWN (Released)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Opposite (Released UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'Opposite (Released DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'Both_UP (Released)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released" ~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released" ~ 'CoRe_UP (Released)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_UP (Released)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_UP (Released)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_DOWN (Released)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released"~ 'CoRe_UP (Released)', - - #Consumed: - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Both_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Opposite (Consumed UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Opposite (Consumed DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'Both_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed" ~ 'CoRe_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_UP (Consumed)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_DOWN (Consumed)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Consumed"~ 'CoRe_UP (Consumed)', - - #Consumed/Released (Consumed in one, released in the other) - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Both_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="DOWN" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Opposite (Released/Consumed UP)', - - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Opposite (Released/Consumed DOWN)', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="UP" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'Both_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'None', - Intra_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed" ~ 'CoRe_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_UP (Released/Consumed)', - - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="DOWN" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Detected" & CoRe_DF_CoRe_Direction=="Not Detected"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Negative" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="Significant Positive" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'None', - Intra_DF_Cutoff_Specific=="Not Significant" & CoRe_DF_Cutoff_Specific=="UP" & CoRe_DF_CoRe_Direction=="Released/Consumed"~ 'CoRe_UP (Released/Consumed)', - TRUE ~ 'NA')) - - #Safe the DF and return the groupings - ##MCA DF (Merged InputDF filtered for background with assigned MCA cluster names) - MergeDF_Select1 <- MergeDF[, c("MetaboliteID", "Intra_DF_Detected","Intra_DF_ValueCol","Intra_DF_PadjCol","Intra_DF_Cutoff", "Intra_DF_Cutoff_Specific", "CoRe_DF_Detected", "CoRe_DF_ValueCol","CoRe_DF_PadjCol","CoRe_DF_Cutoff", "CoRe_DF_Cutoff_Specific", "BG_Method", "RG1_All", "RG2_Significant", "RG3_Change")] - - CoReValueCol_Unique<-paste("Cond2_DF_",SettingsInfo_CoRe[["ValueCol"]]) - CoRePadjCol_Unique <-paste("Cond2_DF_",SettingsInfo_CoRe[["StatCol"]]) - IntraValueCol_Unique<-paste("Cond1_DF_",SettingsInfo_Intra[["ValueCol"]]) - IntraPadjCol_Unique <-paste("Cond1_DF_",SettingsInfo_Intra[["StatCol"]]) - - MergeDF_Select2<- subset(MergeDF, select=-c(Intra_DF_Detected,Intra_DF_Cutoff, CoRe_DF_Detected,CoRe_DF_Cutoff, CoRe_DF_Cutoff_Specific, BG_Method, RG1_All, RG2_Significant, RG3_Change))%>% - dplyr::rename(!!CoReValueCol_Unique :="CoRe_DF_ValueCol",#This syntax is needed since paste(MetaboliteID)="MetaboliteID" is not working in dyplr - !!CoRePadjCol_Unique :="CoRe_DF_PadjCol", - !!IntraValueCol_Unique :="Intra_DF_ValueCol", - !!IntraPadjCol_Unique :="Intra_DF_PadjCol") - - MergeDF_Rearrange <- merge(MergeDF_Select1, MergeDF_Select2, by="MetaboliteID") - MergeDF_Rearrange <-MergeDF_Rearrange%>% - dplyr::rename("Metabolite"="MetaboliteID") - - - ##Summary SiRCle clusters (number of genes assigned to each SiRCle cluster in each grouping) - ClusterSummary_RG1 <- MergeDF_Rearrange[,c("Metabolite", "RG1_All")]%>% - dplyr::group_by(RG1_All) %>% - dplyr::mutate("Number of Features" = n()) %>% - dplyr::distinct(RG1_All, .keep_all = TRUE) %>% - dplyr::rename("SiRCle cluster Name" = "RG1_All") - ClusterSummary_RG1$`Regulation Grouping` <- "RG1_All" - ClusterSummary_RG1 <- ClusterSummary_RG1[-c(1)] - - ClusterSummary_RG2 <- MergeDF_Rearrange[,c("Metabolite", "RG2_Significant")]%>% - dplyr::group_by(RG2_Significant) %>% - dplyr::mutate("Number of Features" = n()) %>% - dplyr::distinct(RG2_Significant, .keep_all = TRUE) %>% - dplyr::rename("SiRCle cluster Name"= "RG2_Significant") - ClusterSummary_RG2$`Regulation Grouping` <- "RG2_Significant" - ClusterSummary_RG2 <- ClusterSummary_RG2[-c(1)] - - ClusterSummary_RG3 <- MergeDF_Rearrange[,c("Metabolite", "RG3_Change")]%>% - dplyr::group_by(RG3_Change) %>% - dplyr::mutate("Number of Features" = n()) %>% - dplyr::distinct(RG3_Change, .keep_all = TRUE) %>% - dplyr::rename("SiRCle cluster Name"= "RG3_Change") - ClusterSummary_RG3$`Regulation Grouping` <- "RG3_Change" - ClusterSummary_RG3 <- ClusterSummary_RG3[-c(1)] - - ClusterSummary <- rbind(ClusterSummary_RG1, ClusterSummary_RG2,ClusterSummary_RG3) - ClusterSummary <- ClusterSummary[,c(3,1,2)] - - ## Rename FeatureID - MergeDF_Rearrange <-MergeDF_Rearrange%>% - dplyr::rename(!!FeatureID := "Metabolite") - - ###################################################################################################################################################################### - ##----- Save and Return - #Here we make a list in which we will save the outputs: - DF_List <- list("MCA_CoRe_Summary"=ClusterSummary, "MCA_CoRe_Results"=MergeDF_Rearrange) - - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=DF_List, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= Folder, - FileName= "MCA_2Cond", - CoRe=FALSE, - PrintPlot=FALSE))) - - invisible(return(DF_List)) + InputData_CoRe, + SettingsInfo_Intra = c(ValueCol = "Log2FC",StatCol = "p.adj", + StatCutoff = 0.05, ValueCutoff = 1), + SettingsInfo_CoRe = c(DirectionCol = "CoRe", ValueCol = "Log2(Distance)", + StatCol = "p.adj", StatCutoff = 0.05, ValueCutoff = 1), + FeatureID = "Metabolite", + SaveAs_Table = "csv", + BackgroundMethod = "Intra&CoRe", + FolderPath = NULL){ + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ############################################################################ + ## ------------ Check Input files ----------- ## + CheckInput_MCA( + InputData_C1 = NULL, + InputData_C2 = NULL, + InputData_CoRe = InputData_CoRe, + InputData_Intra = InputData_Intra, + SettingsInfo_C1 = NULL, + SettingsInfo_C2 = NULL, + SettingsInfo_CoRe = SettingsInfo_CoRe, + SettingsInfo_Intra = SettingsInfo_Intra, + BackgroundMethod = BackgroundMethod, + FeatureID = FeatureID, + SaveAs_Table = SaveAs_Table) + + + ## ------------ Create Results output folder ----------- ## + if(!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "MCACoRe", FolderPath = FolderPath) + } + + ############################################################################ + ## ------------ Prepare the Input -------- ## + ## import the data and check columns (here the user will get an error if + ## the column can not be renamed as it does not exists.) + CoRe_DF <- as.data.frame(InputData_CoRe) %>% + dplyr::rename( + "MetaboliteID" = paste(FeatureID), + "ValueCol" = SettingsInfo_CoRe[["ValueCol"]], + "PadjCol" = SettingsInfo_CoRe[["StatCol"]], + "CoRe_Direction" = SettingsInfo_CoRe[["DirectionCol"]]) + CoRe_DF <- CoRe_DF[complete.cases(CoRe_DF$ValueCol, CoRe_DF$PadjCol), ] + + Intra_DF <- as.data.frame(InputData_Intra) %>% + dplyr::rename( + "MetaboliteID" = paste(FeatureID), + "ValueCol" = SettingsInfo_Intra[["ValueCol"]], + "PadjCol" = SettingsInfo_Intra[["StatCol"]]) + Intra_DF <- Intra_DF[complete.cases(Intra_DF$ValueCol, Intra_DF$PadjCol), ] + + ## tag genes that are detected in each data layer + CoRe_DF$Detected <- "TRUE" + Intra_DF$Detected <- "TRUE" + + ## Assign to Group based on individual Cutoff ("UP", "DOWN", "No Change") + CoRe_DF <- CoRe_DF %>% + dplyr::mutate(Cutoff = dplyr::case_when( + CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & + CoRe_DF$ValueCol > as.numeric(SettingsInfo_CoRe[["ValueCutoff"]]) ~ 'UP', + CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & + CoRe_DF$ValueCol < - as.numeric(SettingsInfo_CoRe[["ValueCutoff"]]) ~ 'DOWN', + TRUE ~ 'No Change')) %>% + dplyr::mutate(Cutoff_Specific = dplyr::case_when( + Cutoff == "UP" ~ 'UP', + Cutoff == "DOWN" ~ 'DOWN', + Cutoff == "No Change" & + CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & + CoRe_DF$ValueCol > 0 ~ 'Significant Positive', + Cutoff == "No Change" & + CoRe_DF$PadjCol <= as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) & + CoRe_DF$ValueCol < 0 ~ 'Significant Negative', + Cutoff == "No Change" & + CoRe_DF$PadjCol > as.numeric(SettingsInfo_CoRe[["StatCutoff"]]) ~ 'Not Significant', + TRUE ~ 'NA')) + + Intra_DF <-Intra_DF %>% + dplyr::mutate(Cutoff = dplyr::case_when( + Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & + Intra_DF$ValueCol > as.numeric(SettingsInfo_Intra[["ValueCutoff"]]) ~ 'UP', + Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & + Intra_DF$ValueCol < - as.numeric(SettingsInfo_Intra[["ValueCutoff"]]) ~ 'DOWN', + TRUE ~ 'No Change')) %>% + dplyr::mutate(Cutoff_Specific = dplyr::case_when( + Cutoff == "UP" ~ 'UP', + Cutoff == "DOWN" ~ 'DOWN', + Cutoff == "No Change" & + Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & + Intra_DF$ValueCol > 0 ~ 'Significant Positive', + Cutoff == "No Change" & + Intra_DF$PadjCol <= as.numeric(SettingsInfo_Intra[["StatCutoff"]]) & + Intra_DF$ValueCol < 0 ~ 'Significant Negative', + Cutoff == "No Change" & + Intra_DF$PadjCol > as.numeric(SettingsInfo_Intra[["StatCutoff"]]) ~ 'Not Significant', + TRUE ~ 'NA')) + + ## merge the dataframes together: Merge the supplied Intra and CoRe + ## dataframes together. + ## add prefix to column names to distinguish the different data types + ## after merge + colnames(CoRe_DF) <- paste0("CoRe_DF_", colnames(CoRe_DF)) + CoRe_DF <- CoRe_DF %>% + dplyr::rename("MetaboliteID" = "CoRe_DF_MetaboliteID") + + colnames(Intra_DF) <- paste0("Intra_DF_", colnames(Intra_DF)) + Intra_DF <-Intra_DF %>% + dplyr::rename("MetaboliteID" = "Intra_DF_MetaboliteID") + + ## merge + MergeDF <- merge(Intra_DF, CoRe_DF, by = "MetaboliteID", all = TRUE) + + ## mark the undetected genes in each data layer + MergeDF<-MergeDF %>% + dplyr::mutate_at(c("CoRe_DF_Detected", "Intra_DF_Detected"), + ~ tidyr::replace_na(., "FALSE")) %>% + dplyr::mutate_at(c("CoRe_DF_Cutoff", "Intra_DF_Cutoff"), + ~ tidyr::replace_na(., "No Change")) %>% + dplyr::mutate_at(c("CoRe_DF_Cutoff_Specific", "Intra_DF_Cutoff_Specific"), + ~ tidyr::replace_na(., "Not Detected")) %>% + dplyr::mutate_at(c("CoRe_DF_CoRe_Direction"), + ~ tidyr::replace_na(., "Not Detected")) + + ## apply Background filter (label metabolites that will be removed based + ## on chosen background) + if(BackgroundMethod == "Intra|CoRe") { ## C1|C2 = CoRe OR Intra + MergeDF <- MergeDF %>% + dplyr::mutate(BG_Method = dplyr::case_when( + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## intra & CoRe + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "FALSE" ~ 'TRUE', ## just intra + Intra_DF_Detected == "FALSE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## just CoRe + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "Intra&CoRe") { ## CoRe AND Intra + MergeDF <- MergeDF %>% + dplyr::mutate(BG_Method = dplyr::case_when( + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## intra & CoRe + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "CoRe") { ## CoRe has to be there + MergeDF <- MergeDF %>% + dplyr::mutate(BG_Method = dplyr::case_when( + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## Intra & CoRe + Intra_DF_Detected == "FALSE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## just CoRe + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "Intra") { ## intra has to be there + MergeDF <- MergeDF %>% + dplyr::mutate(BG_Method = dplyr::case_when( + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "TRUE" ~ 'TRUE', ## intra & CoRe + Intra_DF_Detected == "TRUE" & + CoRe_DF_Detected == "FALSE" ~ 'TRUE', # just intra + TRUE ~ 'FALSE')) + } else if (BackgroundMethod == "*") { # Use all metabolites as the background + MergeDF$BG_Method <- "TRUE" + } else { + stop("Please use one of the following BackgroundMethods: Intra|CoRe, Intra&CoRe, CoRe, Intra, *") ## error message + } + + ## assign Metabolite cluster names to the metabolites + MergeDF <- MergeDF %>% + dplyr::mutate(RG1_All = dplyr::case_when( + BG_Method =="FALSE"~ 'Background = FALSE', + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra DOWN + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra DOWN + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra DOWN + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra DOWN + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra DOWN + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra DOWN + CoRe UP_Released', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra UP + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra UP + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra UP + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra UP + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra UP + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra UP + CoRe UP_Released', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra Not Detected + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra Not Detected + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra Not Detected + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra Not Detected + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Intra Not Detected + CoRe UP_Released', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Negative + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra Significant Negative + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Negative + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Negative + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Negative + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Negative + CoRe UP_Released', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Positive + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra Significant Positive + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Positive + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Positive + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Positive + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Significant Positive + CoRe UP_Released', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Not Significant + CoRe DOWN_Released', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra Not Significant + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Not Significant + CoRe Not Significant_Released', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Not Significant + CoRe Significant Negative_Released', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Not Significant + CoRe Significant Positive_Released', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'Intra Not Significant + CoRe UP_Released', + + ## Consumed: + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra DOWN + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra DOWN + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra DOWN + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra DOWN + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra DOWN + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra DOWN + CoRe UP_Consumed', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra UP + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra UP + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra UP + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra UP + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra UP + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra UP + CoRe UP_Consumed', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Detected + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Detected + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Detected + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Detected + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Detected + CoRe UP_Consumed', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Significant Negative + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'Intra Significant Negative + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Significant Negative + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Significant Negative + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Significant Negative + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Significant Negative + CoRe UP_Consumed', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Significant Positive + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Significant Positive + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Significant Positive + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Significant Positive + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Significant Positive + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Significant Positive + CoRe UP_Consumed', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Significant + CoRe DOWN_Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Not Significant + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Significant + CoRe Not Significant_Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Significant + CoRe Significant Negative_Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Intra Not Significant + CoRe Significant Positive_Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Intra Not Significant + CoRe UP_Consumed', + + #Released/Consumed (Consumed in one, released in the other) + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra DOWN + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra DOWN + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Intra DOWN + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra DOWN + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra DOWN + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra DOWN + CoRe UP_Released/Consumed', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra UP + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra UP + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra UP + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra UP + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra UP + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra UP + CoRe UP_Released/Consumed', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Detected + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Not Detected + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Detected + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Detected + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Detected + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Detected + CoRe UP_Released/Consumed', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Negative + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Significant Negative + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Negative + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Negative + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Negative + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Negative + CoRe UP_Released/Consumed', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Positive + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Significant Positive + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Positive + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Positive + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Positive + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Significant Positive + CoRe UP_Released/Consumed', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Significant + CoRe DOWN_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'Intra Not Significant + CoRe Not Detected', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Significant + CoRe Not Significant_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Significant + CoRe Significant Negative_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Significant + CoRe Significant Positive_Released/Consumed', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Intra Not Significant + CoRe UP_Released/Consumed', + TRUE ~ 'NA')) %>% + dplyr::mutate(RG2_Significant = dplyr::case_when( + BG_Method == "FALSE"~ 'Background = FALSE', + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Both_DOWN (Released)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'Both_DOWN (Released)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'Opposite (Released UP)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Opposite (Released UP)', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Opposite (Released DOWN)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Opposite (Released UP)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Both_UP (Released)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Both_UP (Released)', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'CoRe_UP (Released)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'Both_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'Opposite (Released UP)', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'Opposite (Released DOWN)', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'Both_UP (Released)', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_UP (Released)', + + ## Consumed + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "DOWN" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Both_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "Not Detected" & CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "Not Significant" & CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_CoRe_Direction == "Consumed"~ 'Both_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_CoRe_Direction == "Consumed"~ 'Opposite (Consumed UP)', + Intra_DF_Cutoff_Specific == "DOWN" & CoRe_DF_Cutoff_Specific == "UP" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Opposite (Consumed UP)', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "DOWN" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Opposite (Consumed DOWN)', + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "Not Detected" & CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "Not Significant" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Opposite (Consumed UP)', + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Both_UP (Consumed)', + Intra_DF_Cutoff_Specific == "UP" & CoRe_DF_Cutoff_Specific == "UP" & CoRe_DF_CoRe_Direction == "Consumed" ~ 'Both_UP (Consumed)', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'CoRe_UP (Consumed)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Both_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Opposite (Consumed UP)', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Opposite (Consumed DOWN)', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'Both_UP (Consumed)', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_UP (Consumed)', + + ## Consumed/Released (Consumed in one, released in the other) + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Both_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Both_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Opposite (Released/Consumed UP)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Opposite (Released/Consumed UP)', + + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Opposite (Released/Consumed DOWN)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Opposite (Released/Consumed UP)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Both_UP (Released/Consumed)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Both_UP (Released/Consumed)', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'CoRe_UP (Released/Consumed)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Both_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Opposite (Released/Consumed UP)', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Opposite (Released/Consumed DOWN)', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'Both_UP (Released/Consumed)', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_UP (Released/Consumed)', + TRUE ~ 'NA')) %>% + dplyr::mutate(RG3_Change = dplyr::case_when( + BG_Method == "FALSE"~ 'Background = FALSE', + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Both_DOWN (Released)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Opposite (Released UP)', + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Opposite (Released DOWN)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released" ~ 'Both_UP (Released)', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released" ~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & CoRe_DF_CoRe_Direction == "Released" ~ 'CoRe_UP (Released)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "DOWN" & CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "Not Detected" & CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "Not Significant" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_Cutoff_Specific == "UP" & CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_UP (Released)', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "DOWN" & CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "Not Detected" & CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "Not Significant" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "Significant Negative" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & CoRe_DF_Cutoff_Specific == "UP" & CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_UP (Released)', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_DOWN (Released)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released"~ 'CoRe_UP (Released)', + + ## Consumed + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Both_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Opposite (Consumed UP)', + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Opposite (Consumed DOWN)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'Both_UP (Consumed)', + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed" ~ 'CoRe_UP (Consumed)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_UP (Consumed)', + + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_UP (Consumed)', + + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_DOWN (Consumed)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Consumed"~ 'CoRe_UP (Consumed)', + + + ## Consumed/Released (Consumed in one, released in the other) + ## Intra DOWN + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Both_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Opposite (Released/Consumed UP)', + ## Intra UP + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Opposite (Released/Consumed DOWN)', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "UP" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'Both_UP (Released/Consumed)', + + ## Intra Not Detected + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'None', + Intra_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed" ~ 'CoRe_UP (Released/Consumed)', + + ## Intra Significant Negative + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_UP (Released/Consumed)', + ## Intra Significant Positive + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_UP (Released/Consumed)', + ## Intra Not Significant + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "DOWN" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_DOWN (Released/Consumed)', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Detected" & + CoRe_DF_CoRe_Direction == "Not Detected"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Negative" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "Significant Positive" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'None', + Intra_DF_Cutoff_Specific == "Not Significant" & + CoRe_DF_Cutoff_Specific == "UP" & + CoRe_DF_CoRe_Direction == "Released/Consumed"~ 'CoRe_UP (Released/Consumed)', + TRUE ~ 'NA')) + + ## safe the DF and return the groupings + ## MCA DF (Merged InputDF filtered for background with assigned MCA cluster names) + MergeDF_Select1 <- MergeDF[, c("MetaboliteID", "Intra_DF_Detected", + "Intra_DF_ValueCol", "Intra_DF_PadjCol", "Intra_DF_Cutoff", + "Intra_DF_Cutoff_Specific", "CoRe_DF_Detected", "CoRe_DF_ValueCol", + "CoRe_DF_PadjCol", "CoRe_DF_Cutoff", "CoRe_DF_Cutoff_Specific", + "BG_Method", "RG1_All", "RG2_Significant", "RG3_Change")] + + CoReValueCol_Unique <- paste("Cond2_DF_", SettingsInfo_CoRe[["ValueCol"]]) + CoRePadjCol_Unique <- paste("Cond2_DF_", SettingsInfo_CoRe[["StatCol"]]) + IntraValueCol_Unique <- paste("Cond1_DF_", SettingsInfo_Intra[["ValueCol"]]) + IntraPadjCol_Unique <- paste("Cond1_DF_", SettingsInfo_Intra[["StatCol"]]) + + MergeDF_Select2<- subset(MergeDF, + select = -c(Intra_DF_Detected, Intra_DF_Cutoff, CoRe_DF_Detected, + CoRe_DF_Cutoff, CoRe_DF_Cutoff_Specific, BG_Method, + RG1_All, RG2_Significant, RG3_Change)) %>% + dplyr::rename( + ## this syntax is needed since paste(MetaboliteID)="MetaboliteID" + ## is not working in dyplr + !!CoReValueCol_Unique :="CoRe_DF_ValueCol", + !!CoRePadjCol_Unique :="CoRe_DF_PadjCol", + !!IntraValueCol_Unique :="Intra_DF_ValueCol", + !!IntraPadjCol_Unique :="Intra_DF_PadjCol") + + MergeDF_Rearrange <- merge(MergeDF_Select1, MergeDF_Select2, + by = "MetaboliteID") + MergeDF_Rearrange <-MergeDF_Rearrange %>% + dplyr::rename("Metabolite"="MetaboliteID") + + ## summary SiRCle clusters (number of genes assigned to each SiRCle + ## cluster in each grouping) + ClusterSummary_RG1 <- MergeDF_Rearrange[, c("Metabolite", "RG1_All")] %>% + dplyr::group_by(RG1_All) %>% + dplyr::mutate("Number of Features" = n()) %>% + dplyr::distinct(RG1_All, .keep_all = TRUE) %>% + dplyr::rename("SiRCle cluster Name" = "RG1_All") + ClusterSummary_RG1$`Regulation Grouping` <- "RG1_All" + ClusterSummary_RG1 <- ClusterSummary_RG1[-c(1)] + + ClusterSummary_RG2 <- MergeDF_Rearrange[, c("Metabolite", "RG2_Significant")] %>% + dplyr::group_by(RG2_Significant) %>% + dplyr::mutate("Number of Features" = n()) %>% + dplyr::distinct(RG2_Significant, .keep_all = TRUE) %>% + dplyr::rename("SiRCle cluster Name"= "RG2_Significant") + ClusterSummary_RG2$`Regulation Grouping` <- "RG2_Significant" + ClusterSummary_RG2 <- ClusterSummary_RG2[-c(1)] + + ClusterSummary_RG3 <- MergeDF_Rearrange[, c("Metabolite", "RG3_Change")] %>% + dplyr::group_by(RG3_Change) %>% + dplyr::mutate("Number of Features" = n()) %>% + dplyr::distinct(RG3_Change, .keep_all = TRUE) %>% + dplyr::rename("SiRCle cluster Name"= "RG3_Change") + ClusterSummary_RG3$`Regulation Grouping` <- "RG3_Change" + ClusterSummary_RG3 <- ClusterSummary_RG3[-c(1)] + + ClusterSummary <- rbind(ClusterSummary_RG1, ClusterSummary_RG2, + ClusterSummary_RG3) + ClusterSummary <- ClusterSummary[, c(3, 1, 2)] + + ## Rename FeatureID + MergeDF_Rearrange <- MergeDF_Rearrange %>% + dplyr::rename(!!FeatureID := "Metabolite") + + ############################################################################ + ##----- Save and Return + ## make a list in which we will save the outputs: + DF_List <- list("MCA_CoRe_Summary" = ClusterSummary, + "MCA_CoRe_Results" = MergeDF_Rearrange) + + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = DF_List, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = Folder, + FileName = "MCA_2Cond", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(DF_List) } ######################################## @@ -1053,23 +1979,24 @@ MCA_CoRe <- function(InputData_Intra, #' @return A data frame containing the toy data. #' @export #' -MCA_rules<- function(Method){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - # Read the .csv files - Cond <- system.file("data", "MCA_2Cond.csv", package = "MetaProViz") - Cond<- read.csv( Cond, check.names=FALSE) - - CoRe <- system.file("data", "MCA_CoRe.csv", package = "MetaProViz") - CoRe<- read.csv(CoRe, check.names=FALSE) - - # Return the toy data into environment - if(Method=="2Cond"){ - assign("MCA_2Cond", Cond, envir=.GlobalEnv) - } else if(Method=="CoRe"){ - assign("MCA_CoRe", CoRe, envir=.GlobalEnv) - } else{ - warning("Please choose the MCA regulatory rules you would like to load: 2Cond, CoRe") - } +MCA_rules <- function(Method = c("2Cond", "CoRe")) { + + Method <- match.arg(Method) + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## Read the .csv files + Cond <- system.file("data", "MCA_2Cond.csv", package = "MetaProViz") + Cond<- read.csv( Cond, check.names = FALSE) + + CoRe <- system.file("data", "MCA_CoRe.csv", package = "MetaProViz") + CoRe<- read.csv(CoRe, check.names = FALSE) + + ## Return the toy data into environment + if(Method == "2Cond") { ## EDIT: assigning to environment should be discouraged, why not export the object? + assign("MCA_2Cond", Cond, envir = .GlobalEnv) + } else if (Method == "CoRe") { + assign("MCA_CoRe", CoRe, envir = .GlobalEnv) + } } diff --git a/R/OverRepresentationAnalysis.R b/R/OverRepresentationAnalysis.R index 82290c5e..9bde0e93 100644 --- a/R/OverRepresentationAnalysis.R +++ b/R/OverRepresentationAnalysis.R @@ -41,116 +41,133 @@ #' @return Saves results as individual .csv files. #' @export -ClusterORA <- function(InputData, - SettingsInfo=c(ClusterColumn="RG2_Significant", BackgroundColumn="BG_Method", PathwayTerm= "term", PathwayFeature= "Metabolite"), - RemoveBackground=TRUE, - PathwayFile, - PathwayName="", - minGSSize=10, - maxGSSize=1000 , - SaveAs_Table= "csv", - FolderPath = NULL){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - - ## ------------ Check Input files ----------- ## - Pathways <- CheckInput_ORA(InputData=InputData, - SettingsInfo=SettingsInfo, - RemoveBackground=RemoveBackground, - PathwayFile=PathwayFile, - PathwayName=PathwayName, - minGSSize=minGSSize, - maxGSSize=maxGSSize, - SaveAs_Table=SaveAs_Table, - pCutoff=NULL, - PercentageCutoff=NULL) - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "ClusterORA", - FolderPath=FolderPath) +ClusterORA <- function(se, #InputData, + SettingsInfo = c(ClusterColumn = "RG2_Significant", + BackgroundColumn = "BG_Method", PathwayTerm = "term", + PathwayFeature = "Metabolite"), + RemoveBackground = TRUE, + PathwayFile, + PathwayName = "", + minGSSize = 10, + maxGSSize = 1000 , + SaveAs_Table = "csv", + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Check Input files ----------- ## + Pathways <- CheckInput_ORA(se = se, ##InputData = InputData, + SettingsInfo = SettingsInfo, RemoveBackground = RemoveBackground, + PathwayFile = PathwayFile, PathwayName = PathwayName, + minGSSize = minGSSize, maxGSSize = maxGSSize, + SaveAs_Table = SaveAs_Table, pCutoff = NULL, PercentageCutoff = NULL) + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "ClusterORA", FolderPath = FolderPath) } - ############################################################################################################ - ## ------------ Prepare Data ----------- ## - # open the data - if(RemoveBackground==TRUE){ - df <- subset(InputData, !InputData[[SettingsInfo[["BackgroundColumn"]]]] == "FALSE")%>% - rownames_to_column("Metabolite") - } else{ - df <- InputData%>% - rownames_to_column("Metabolite") - } - - #Select universe - allMetabolites <- as.character(df$Metabolite) - - #Select clusters - grps_labels <- unlist(unique(df[[SettingsInfo[["ClusterColumn"]]]])) - - #Load Pathways - Pathway <- Pathways - Term2gene <- Pathway[,c("term", "gene")]# term and MetaboliteID (MetaboliteID= gene as syntax required for enricher) - term2name <- Pathway[,c("term", "Description")]# term and description - - #Add the number of genes present in each pathway - Pathway$Count <- 1 - Pathway_Mean <- aggregate(Pathway$Count, by=list(term=Pathway$term), FUN=sum) - names(Pathway_Mean)[names(Pathway_Mean) == "x"] <- "Metabolites_in_Pathway" - Pathway <- merge(x= Pathway, y=Pathway_Mean,by="term", all.x=TRUE) - Pathway$Count <- NULL - - ## ------------ Run ----------- ## - df_list = list()# Make an empty list to store the created DFs - clusterGo_list = list() - #Run ORA - for(g in grps_labels){ - grpMetabolites <- subset(df, df[[SettingsInfo[["ClusterColumn"]]]] == g) - message("Number of metabolites in cluster `",g, "`: ", nrow(grpMetabolites), sep="") - - clusterGo <- clusterProfiler::enricher(gene=as.character(grpMetabolites$Metabolite), - pvalueCutoff = 1, - pAdjustMethod = "BH", - universe = allMetabolites, - minGSSize=minGSSize, - maxGSSize=maxGSSize, - qvalueCutoff = 1, - TERM2GENE=Term2gene , - TERM2NAME = term2name) - clusterGoSummary <- data.frame(clusterGo) - clusterGo_list[[g]]<- clusterGo - if(!(dim(clusterGoSummary)[1] == 0)){ - #Add pathway information (% of genes in pathway detected) - clusterGoSummary <- merge(x= clusterGoSummary%>% select(-Description), y=Pathway%>% select(term, Metabolites_in_Pathway), by.x="ID",by.y="term", all=TRUE) - clusterGoSummary$Count[is.na(clusterGoSummary$Count)] <- 0 - clusterGoSummary$Percentage_of_Pathway_detected <-round(((clusterGoSummary$Count/clusterGoSummary$Metabolites_in_Pathway)*100),digits=2) - clusterGoSummary <- clusterGoSummary[!duplicated(clusterGoSummary$ID),] - clusterGoSummary <- clusterGoSummary[order(clusterGoSummary$p.adjust),] - clusterGoSummary <- clusterGoSummary%>% - dplyr::rename("Metabolites_in_pathway"="geneID") - - g_save <- gsub("/", "-", g) - df_list[[g_save]] <- clusterGoSummary - }else{ - message("None of the Input_data Metabolites of the cluster ", g ," were present in any terms of the PathwayFile. Hence the ClusterGoSummary ouput will be empty for this cluster. Please check that the metabolite IDs match the pathway IDs.") + ############################################################################ + ## ------------ Prepare Data ----------- ## + InputData <- assay(se) + ## open the data + if (RemoveBackground) { + df <- subset(InputData, + !InputData[[SettingsInfo[["BackgroundColumn"]]]] == "FALSE") %>% + rownames_to_column("Metabolite") + } else{ + df <- InputData %>% + rownames_to_column("Metabolite") + } + + ## select universe + allMetabolites <- as.character(df$Metabolite) + + ## select clusters + grps_labels <- unlist(unique(df[[SettingsInfo[["ClusterColumn"]]]])) + + ## load Pathways + Pathway <- Pathways + ## term and MetaboliteID (MetaboliteID= gene as syntax required for enricher) + Term2gene <- Pathway[, c("term", "gene")] + ## term and description + term2name <- Pathway[, c("term", "Description")] + + ## add the number of genes present in each pathway + Pathway$Count <- 1 + Pathway_Mean <- aggregate(Pathway$Count, + by = list(term = Pathway$term), FUN = sum) + names(Pathway_Mean)[names(Pathway_Mean) == "x"] <- "Metabolites_in_Pathway" + Pathway <- merge(x = Pathway, y = Pathway_Mean, by = "term", all.x = TRUE) + Pathway$Count <- NULL + + ## ------------ Run ----------- ## + ## make an empty list to store the created DFs + df_list = list() + clusterGo_list = list() + + ## run ORA + for (g in grps_labels) { + grpMetabolites <- subset(df, df[[SettingsInfo[["ClusterColumn"]]]] == g) + message("Number of metabolites in cluster `", g, "`: ", + nrow(grpMetabolites), sep = "") + + clusterGo <- clusterProfiler::enricher( + gene = as.character(grpMetabolites$Metabolite), + pvalueCutoff = 1, + pAdjustMethod = "BH", + universe = allMetabolites, + minGSSize = minGSSize, + maxGSSize = maxGSSize, + qvalueCutoff = 1, + TERM2GENE = Term2gene , + TERM2NAME = term2name) + clusterGoSummary <- data.frame(clusterGo) + clusterGo_list[[g]]<- clusterGo + if (!(nrow(clusterGoSummary) == 0)) { + ## add pathway information (% of genes in pathway detected) + clusterGoSummary <- merge( + x = select(clusterGoSummary, -Description), + y = select(Pathway, term, Metabolites_in_Pathway), + by.x = "ID", by.y = "term", all = TRUE) + clusterGoSummary$Count[is.na(clusterGoSummary$Count)] <- 0 + clusterGoSummary$Percentage_of_Pathway_detected <-round( + clusterGoSummary$Count / clusterGoSummary$Metabolites_in_Pathway * 100, + digits = 2) + clusterGoSummary <- clusterGoSummary[!duplicated(clusterGoSummary$ID), ] + clusterGoSummary <- clusterGoSummary[order(clusterGoSummary$p.adjust), ] + clusterGoSummary <- clusterGoSummary %>% + dplyr::rename("Metabolites_in_pathway"="geneID") + + g_save <- gsub("/", "-", g) + df_list[[g_save]] <- clusterGoSummary + } else { + message("None of the Input_data Metabolites of the cluster ", g, + " were present in any terms of the PathwayFile. Hence the ClusterGoSummary ouput will be empty for this cluster. Please check that the metabolite IDs match the pathway IDs.") + } } - } - #Save files - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=df_list, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= Folder, - FileName= paste("ClusterGoSummary",PathwayName, sep="_"), - CoRe=FALSE, - PrintPlot=FALSE))) - - #return <- clusterGoSummary - ORA_Output <- list("DF"= df_list, "ClusterGo"=clusterGo_list) - - invisible(return(ORA_Output)) + + ## save files + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = df_list, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = Folder, + FileName = paste("ClusterGoSummary", PathwayName, sep = "_"), + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return <- clusterGoSummary + ORA_Output <- list( + "data" = list( + "DF" = df_list, + "ClusterGo" = clusterGo_list) + ) + + ## return + invisible(ORA_Output) } @@ -175,127 +192,154 @@ ClusterORA <- function(InputData, #' #' @export #' -StandardORA <- function(InputData, - SettingsInfo=c(pvalColumn="p.adj", PercentageColumn="t.val", PathwayTerm= "term", PathwayFeature= "Metabolite"), - pCutoff=0.05, - PercentageCutoff=10, - PathwayFile, - PathwayName="", - minGSSize=10, - maxGSSize=1000 , - SaveAs_Table="csv", - FolderPath = NULL - -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Check Input files ----------- ## - Pathways <- CheckInput_ORA(InputData=InputData, - SettingsInfo=SettingsInfo, - RemoveBackground=FALSE, - PathwayFile=PathwayFile, - PathwayName=PathwayName, - minGSSize=minGSSize, - maxGSSize=maxGSSize, - SaveAs_Table=SaveAs_Table, - pCutoff=pCutoff, - PercentageCutoff=PercentageCutoff) - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "ORA", - FolderPath=FolderPath) - } - - ############################################################################################################ - ## ------------ Load the data and check ----------- ## - InputData<- InputData %>% - rownames_to_column("Metabolite") - - #Select universe - allMetabolites <- as.character(InputData$Metabolite) - - #select top changed metabolites (Up and down together) - #check if the metabolites are significantly changed. - value <- PercentageCutoff/100 - - allMetabolites_DF <- InputData[order(InputData[[SettingsInfo[["PercentageColumn"]]]]),]# rank by t.val - selectMetabolites_DF <- allMetabolites_DF[c(1:(ceiling(value * nrow(allMetabolites_DF))),(nrow(allMetabolites_DF)-(ceiling(value * nrow(allMetabolites_DF)))):(nrow(allMetabolites_DF))),] - selectMetabolites_DF$`Top/Bottom`<- "TRUE" - selectMetabolites_DF <-merge(allMetabolites_DF,selectMetabolites_DF[,c("Metabolite", "Top/Bottom")], by="Metabolite", all.x=TRUE) - - InputSelection <- selectMetabolites_DF%>% - mutate(`Top/Bottom_Percentage` = case_when(`Top/Bottom`==TRUE ~ 'TRUE', - TRUE ~ 'FALSE'))%>% - mutate(Significant = case_when(get(SettingsInfo[["pvalColumn"]]) <= pCutoff ~ 'TRUE', - TRUE ~ 'FALSE'))%>% - mutate(Cluster_ChangedMetabolites = case_when(Significant==TRUE & `Top/Bottom_Percentage`==TRUE ~ 'TRUE', - TRUE ~ 'FALSE')) - InputSelection$`Top/Bottom` <- NULL #remove column as its not needed for output - - selectMetabolites <- InputSelection%>% - subset(Cluster_ChangedMetabolites==TRUE) - selectMetabolites <-as.character(selectMetabolites$Metabolite) - - #Load Pathways - Pathway <- Pathways - Term2gene <- Pathway[,c("term", "gene")]# term and MetaboliteID (MetaboliteID= gene as syntax required for enricher) - term2name <- Pathway[,c("term", "Description")]# term and description - - #Add the number of genes present in each pathway - Pathway$Count <- 1 - Pathway_Mean <- aggregate(Pathway$Count, by=list(term=Pathway$term), FUN=sum) - names(Pathway_Mean)[names(Pathway_Mean) == "x"] <- "Metabolites_in_Pathway" - Pathway <- merge(x= Pathway, y=Pathway_Mean,by="term", all.x=TRUE) - Pathway$Count <- NULL - - ## ------------ Run ----------- ## - #Run ORA - clusterGo <- clusterProfiler::enricher(gene=selectMetabolites, - pvalueCutoff = 1, - pAdjustMethod = "BH", - universe = allMetabolites, - minGSSize=minGSSize, - maxGSSize=maxGSSize, - qvalueCutoff = 1, - TERM2GENE=Term2gene , - TERM2NAME = term2name) - clusterGoSummary <- data.frame(clusterGo) - - #Make DF: - if(!(dim(clusterGoSummary)[1] == 0)){ - #Add pathway information % of genes in pathway detected) - clusterGoSummary <- merge(x= clusterGoSummary%>% select(-Description), y=Pathway%>% select(term, Metabolites_in_Pathway),by.x="ID",by.y="term", all=TRUE) - clusterGoSummary$Count[is.na(clusterGoSummary$Count)] <- 0 - clusterGoSummary$Percentage_of_Pathway_detected <-round(((clusterGoSummary$Count/clusterGoSummary$Metabolites_in_Pathway)*100),digits=2) - clusterGoSummary <- clusterGoSummary[!duplicated(clusterGoSummary$ID),] - clusterGoSummary <- clusterGoSummary[order(clusterGoSummary$p.adjust),] - clusterGoSummary <- clusterGoSummary%>% - dplyr::rename("Metabolites_in_pathway"="geneID") - }else{ - stop("None of the Input_data Metabolites were present in any terms of the PathwayFile. Hence the ClusterGoSummary ouput will be empty. Please check that the metabolite IDs match the pathway IDs.") +StandardORA <- function(se, + SettingsInfo = c(pvalColumn = "p.adj", PercentageColumn = "t.val", + PathwayTerm = "term", PathwayFeature = "Metabolite"), + pCutoff = 0.05, + PercentageCutoff = 10, + PathwayFile, + PathwayName = "", + minGSSize = 10, + maxGSSize = 1000 , + SaveAs_Table = "csv", + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Check Input files ----------- ## + Pathways <- CheckInput_ORA(se = se, + SettingsInfo = SettingsInfo, + RemoveBackground = FALSE, + PathwayFile = PathwayFile, + PathwayName = PathwayName, + minGSSize = minGSSize, + maxGSSize = maxGSSize, + SaveAs_Table = SaveAs_Table, + pCutoff = pCutoff, + PercentageCutoff = PercentageCutoff) + + ## ------------ Create Results output folder ----------- ## + if(!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName= "ORA", FolderPath = FolderPath) } - #Return and save list of DFs - ORA_output_list <- list("InputSelection" = InputSelection , "ClusterGoSummary" = clusterGoSummary) - - #save: - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=ORA_output_list, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= Folder, - FileName= paste(PathwayName), - CoRe=FALSE, - PrintPlot=FALSE))) - - #Return - ORA_output_list <- c( ORA_output_list, list("ClusterGo"=clusterGo)) - - invisible(return(ORA_output_list)) - } + ############################################################################ + ## ------------ Load the data and check ----------- ## + #InputData <- se |> + # assay() |> + # rownames_to_column("Metabolite") + + ## select universe + allMetabolites <- assay(se)$KEGGCompound + + ## select top changed metabolites (Up and down together) + ## check if the metabolites are significantly changed. + value <- PercentageCutoff / 100 + + ## rank by t.val + allMetabolites_DF <- assay(se)[ + order(assay(se)[, SettingsInfo[["PercentageColumn"]]]), ] + selectMetabolites_DF <- allMetabolites_DF[ + c(seq_len(ceiling(value * nrow(se))), + (nrow(se) - (ceiling(value * nrow(se)))):(nrow(se))), ] + selectMetabolites_DF$`Top/Bottom` <- TRUE + selectMetabolites_DF <- merge(allMetabolites_DF, + selectMetabolites_DF[, c("Top/Bottom"), drop = FALSE], + by = "row.names", all.x = TRUE) + + InputSelection <- selectMetabolites_DF %>% + mutate(`Top/Bottom_Percentage` = case_when( + `Top/Bottom` ~ TRUE, + TRUE ~ FALSE)) %>% + mutate(Significant = case_when( + get(SettingsInfo[["pvalColumn"]]) <= pCutoff ~ TRUE, + TRUE ~ FALSE)) %>% + mutate(Cluster_ChangedMetabolites = case_when( + Significant & `Top/Bottom_Percentage` ~ TRUE, + TRUE ~ FALSE)) + ## remove column as its not needed for output + InputSelection$`Top/Bottom` <- NULL + + selectMetabolites <- InputSelection %>% + subset(Cluster_ChangedMetabolites) + selectMetabolites <- as.character(selectMetabolites$KEGGCompound) + + ## load Pathways + Pathway <- Pathways + ## term and MetaboliteID (MetaboliteID= gene as syntax required for enricher) + Term2gene <- Pathway[, c("term", "gene")] + ## term and description + term2name <- Pathway[, c("term", "Description")] + + ## add the number of genes present in each pathway + Pathway$Count <- 1 + Pathway_Mean <- aggregate(Pathway$Count, + by = list(term = Pathway$term), FUN = sum) + names(Pathway_Mean)[names(Pathway_Mean) == "x"] <- "Metabolites_in_Pathway" + Pathway <- merge(x = Pathway, y = Pathway_Mean, by = "term", all.x = TRUE) + Pathway$Count <- NULL + + ## ------------ Run ----------- ## + ## run ORA + clusterGo <- clusterProfiler::enricher(gene = selectMetabolites, + pvalueCutoff = 1, + pAdjustMethod = "BH", + universe = allMetabolites, + minGSSize = minGSSize, + maxGSSize = maxGSSize, + qvalueCutoff = 1, + TERM2GENE = Term2gene , + TERM2NAME = term2name) + clusterGoSummary <- data.frame(clusterGo) + + ## make DF: + if(!nrow(clusterGoSummary) == 0){ + ## add pathway information % of genes in pathway detected) + clusterGoSummary <- merge(x = select(clusterGoSummary, -Description), + y = select(Pathway, term, Metabolites_in_Pathway), + by.x = "ID", by.y = "term", all = TRUE) + clusterGoSummary$Count[is.na(clusterGoSummary$Count)] <- 0 + clusterGoSummary$Percentage_of_Pathway_detected <- round( + clusterGoSummary$Count / clusterGoSummary$Metabolites_in_Pathway * 100, + digits = 2) + clusterGoSummary <- clusterGoSummary[!duplicated(clusterGoSummary$ID), ] + clusterGoSummary <- clusterGoSummary[order(clusterGoSummary$p.adjust), ] + clusterGoSummary <- clusterGoSummary %>% + dplyr::rename("Metabolites_in_pathway" = "geneID") + } else { + stop("None of the Input_data Metabolites were present in any terms of the PathwayFile. Hence the ClusterGoSummary ouput will be empty. Please check that the metabolite IDs match the pathway IDs.") + } + + ## create SummarizedExperiment output + cols_a <- c("RichFactor", "FoldEnrichment", "zScore", "pvalue", "p.adjust", "qvalue", "Count", "Metabolites_in_Pathway", "Percentage_of_Pathway_detected") + a <- as.matrix(clusterGoSummary[, cols_a]) + cD <- DataFrame(feature = cols_a) + rownames(cD) <- cols_a + rD <- DataFrame(clusterGoSummary[, !colnames(clusterGoSummary) %in% cols_a]) + rownames(rD) <- rownames(a) + se_go <- SummarizedExperiment(assays = a, rowData = rD, colData = cD) + + ## return and save list of DFs + ORA_output_list <- list( + "data" = list( + "se" = se_go, + "InputSelection" = InputSelection , + "ClusterGoSummary" = clusterGoSummary) + ) + + ## save + suppressMessages(suppressWarnings( + SaveRes(data = ORA_output_list, + plot = NULL, SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, FolderPath = Folder, + FileName = paste(PathwayName), CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + ORA_output_list[["data"]][["ClusterGo"]] <- clusterGo + invisible(ORA_output_list) +} ################################# diff --git a/R/Processing.R b/R/Processing.R index 9935a10e..2b6eddf7 100644 --- a/R/Processing.R +++ b/R/Processing.R @@ -44,16 +44,46 @@ #' @return List with two elements: DF (including all output tables generated) and Plot (including all plots generated) #' #' @examples -#' Intra <- MetaProViz::ToyData("IntraCells_Raw") -#' ResI <- MetaProViz::PreProcessing(InputData=Intra[-c(49:58) ,-c(1:3)], -#' SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates")) -#' -#' Media <- MetaProViz::ToyData("CultureMedia_Raw") -#' ResM <- MetaProViz::PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], -#' SettingsFile_Sample = Media[-c(40:45) ,c(1:3)] , -#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates", CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), -#' CoRe=TRUE) +#' ## load the data and mapping Info +#' Intra <- ToyData("IntraCells_Raw") +#' MappingInfo <- ToyData(Data = "Cells_MetaData") +#' Media <- ToyData("CultureMedia_Raw") +#' +#' ## create SummarizedExperiment objects +#' ## se_intra +#' rD <- MappingInfo +#' cD <- Intra[-c(49:58), c(1:3)] +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' +#' ## obtain overlapping metabolites +#' metabolites <- intersect(rownames(a), rownames(rD)) +#' rD <- rD[metabolites, ] +#' a <- a[metabolites, ] +#' se_intra <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) +#' +#' ## se_media +#' rD <- MappingInfo +#' cD <- Media[, 1:3] +#' a <- t(Media[, 4:ncol(Media)]) +#' +#' ## obtain overlapping metabolites +#' metabolites <- intersect(rownames(a), rownames(rD)) +#' rD <- rD[metabolites, ] +#' a <- a[metabolites, ] +#' se_media <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) +#' +#' ## apply the functions +#' ResI <- PreProcessing( +#' se = se_intra, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates")) +#' +#' ResM <- PreProcessing( +#' se = se_media, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates", +#' CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), +#' CoRe = TRUE) #' #' @keywords 80 percent filtering rule, Missing Value Imputation, Total Ion Count normalization, PCA, HotellingT2, multivariate quality control charts #' @@ -63,198 +93,218 @@ #' #' @export #' -PreProcessing <- function(InputData, - SettingsFile_Sample, - SettingsInfo, - FeatureFilt = "Modified", - FeatureFilt_Value = 0.8, - TIC = TRUE, - MVI= TRUE, - MVI_Percentage=50, - HotellinsConfidence = 0.99, - CoRe = FALSE, - SaveAs_Plot = "svg", - SaveAs_Table = "csv", - PrintPlot = TRUE, - FolderPath = NULL -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo= SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=SaveAs_Table, - CoRe=CoRe, - PrintPlot= PrintPlot) - - # HelperFunction `CheckInput` Specific - CheckInput_PreProcessing(SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - CoRe=CoRe, - FeatureFilt=FeatureFilt, - FeatureFilt_Value=FeatureFilt_Value, - TIC=TIC, - MVI=MVI, - MVI_Percentage=MVI_Percentage, - HotellinsConfidence=HotellinsConfidence) - - ## ------------------ Create output folders and path ------------------- ## - if(is.null(SaveAs_Plot)==FALSE |is.null(SaveAs_Table)==FALSE ){ - Folder <- SavePath(FolderName= "Processing", - FolderPath=FolderPath) - - SubFolder_P <- file.path(Folder, "PreProcessing") - if (!dir.exists(SubFolder_P)) {dir.create(SubFolder_P)} - } - - ## ------------------ Prepare the data ------------------- ## - #InputData files: - InputData <-as.data.frame(InputData)%>% - dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .))#Make sure all 0 are changed to NAs - - InputData <- as.data.frame(dplyr::mutate_all(as.data.frame(InputData), function(x) as.numeric(as.character(x)))) - - ################################################################################################################################### - ## ------------------ 1. Feature filtering ------------------- ## - if(is.null(FeatureFilt)==FALSE){ - InputData_Filtered <- FeatureFiltering(InputData=InputData, - FeatureFilt=FeatureFilt, - FeatureFilt_Value=FeatureFilt_Value, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - CoRe=CoRe) - - InputData_Filt <- InputData_Filtered[["DF"]] - }else{ - InputData_Filt <- InputData - } - - ## ------------------ 2. Missing value Imputation ------------------- ## - if(MVI==TRUE){ - MVIRes<- MVImputation(InputData=InputData_Filt, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - CoRe=CoRe, - MVI_Percentage=MVI_Percentage) - }else{ - MVIRes<- InputData_Filt - } - - ## ------------------ 3. Total Ion Current Normalization ------------------- ## - if(TIC==TRUE){ - #Perform TIC - TICRes_List <- TICNorm(InputData=MVIRes, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - TIC=TIC) - TICRes <- TICRes_List[["DF"]][["Data_TIC"]] - - #Add plots to PlotList - PlotList <- list() - PlotList[["RLAPlot"]] <- TICRes_List[["Plot"]][["RLA_BeforeTICNorm"]] - PlotList[["RLAPlot_TICnorm"]] <- TICRes_List[["Plot"]][["RLA_AfterTICNorm"]] - PlotList[["RLAPlot_BeforeAfter_TICnorm"]] <- TICRes_List[["Plot"]][["norm_plots"]] - }else{ - TICRes <- MVIRes - - #Add plots to PlotList - RLAPlot_List <- TICNorm(InputData=MVIRes, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - TIC=TIC) - PlotList <- list() - PlotList[["RLAPlot"]] <- RLAPlot_List[["Plot"]][["RLA_BeforeTICNorm"]] - } - - ## ------------------ 4. CoRe media QC (blank) and normalization ------------------- ## - if(CoRe ==TRUE){ - data_CoReNorm <- CoReNorm(InputData= TICRes, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo) - - TICRes <- data_CoReNorm[["DF"]][["Core_Norm"]] - } - - # ------------------ Final Output: - data_norm <- TICRes %>% as.data.frame() - - ################################################################################################################################### - ## ------------------ Sample outlier identification ------------------- ## - OutlierRes <- OutlierDetection(InputData= data_norm, - SettingsFile_Sample=SettingsFile_Sample, - SettingsInfo=SettingsInfo, - CoRe=CoRe, - HotellinsConfidence=HotellinsConfidence) - - ################################################################################################################################### - ## ------------------ Return ------------------- ## - ## ---- DFs - if(is.null(FeatureFilt)==FALSE){#Add metabolites that where removed as part of the feature filtering - if(length(InputData_Filtered[["RemovedMetabolites"]])==0){ - DFList <- list("InputData_RawData"= merge(as.data.frame(SettingsFile_Sample), as.data.frame(InputData), by="row.names")%>% tibble::column_to_rownames("Row.names"), - "Filtered_metabolites"= as.data.frame(list(FeatureFiltering = c(FeatureFilt), - FeatureFilt_Value = c(FeatureFilt_Value), - RemovedMetabolites = c("None"))), - "Preprocessing_output"=OutlierRes[["DF"]][["data_outliers"]]) - }else{ - DFList <- list("InputData_RawData"= merge(as.data.frame(SettingsFile_Sample), as.data.frame(InputData), by="row.names")%>% tibble::column_to_rownames("Row.names"), - "Filtered_metabolites"= as.data.frame(list(FeatureFiltering = rep(FeatureFilt, length(InputData_Filtered[["RemovedMetabolites"]])), - FeatureFilt_Value = rep(FeatureFilt_Value, length(InputData_Filtered[["RemovedMetabolites"]])), - RemovedMetabolites = InputData_Filtered[["RemovedMetabolites"]])), - "Preprocessing_output"=OutlierRes[["DF"]][["data_outliers"]]) +PreProcessing <- function( + se, + #InputData, + #SettingsFile_Sample, + SettingsInfo, + FeatureFilt = "Modified", + FeatureFilt_Value = 0.8, + TIC = TRUE, + MVI = TRUE, + MVI_Percentage = 50, + HotellinsConfidence = 0.99, + CoRe = FALSE, + SaveAs_Plot = "svg", + SaveAs_Table = "csv", + PrintPlot = TRUE, + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------------ Check Input ------------------- ## + ## HelperFunction `CheckInput` + CheckInput( + se = se, + ##InputData = InputData, SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = NULL, + SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, SaveAs_Table = SaveAs_Table, + CoRe = CoRe, PrintPlot = PrintPlot) + + ## HelperFunction `CheckInput` Specific + CheckInput_PreProcessing( + se = se, + #SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo, CoRe = CoRe, FeatureFilt = FeatureFilt, + FeatureFilt_Value = FeatureFilt_Value, TIC = TIC, MVI = MVI, + MVI_Percentage = MVI_Percentage, + HotellinsConfidence = HotellinsConfidence) + + ## ------------------ Create output folders and path ------------------- ## + if (!is.null(SaveAs_Plot) |!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "Processing", FolderPath = FolderPath) + + SubFolder_P <- file.path(Folder, "PreProcessing") + if (!dir.exists(SubFolder_P)) { + dir.create(SubFolder_P) + } + } + + ## ------------------ Prepare the data ------------------- ## + ## InputData files: + ## make sure all 0 are changed to NAs + #InputData <- as.data.frame(InputData) %>% + # dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)) ## EDIT: why not: + assay(se)[assay(se) == 0] <- NA + + #InputData <- as.data.frame( + # dplyr::mutate_all(as.data.frame(InputData), function(x) + # as.numeric(as.character(x)))) + + ############################################################################ + ## ------------------ 1. Feature filtering ------------------- ## + if (!is.null(FeatureFilt)) { + l_filtered <- FeatureFiltering( + se = se,## InputData = InputData, + FeatureFilt = FeatureFilt, + FeatureFilt_Value = FeatureFilt_Value, + #SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo, + CoRe = CoRe) + + se_Filt <- l_filtered[["data"]][["se"]] + } else { + se_Filt <- se } - }else{ - DFList <- list("InputData_RawData"= merge(as.data.frame(SettingsFile_Sample), as.data.frame(InputData), by="row.names")%>% tibble::column_to_rownames("Row.names"), "Preprocessing_output"=OutlierRes[["DF"]][["data_outliers"]]) - } - - if(CoRe ==TRUE){ - if(is.null(data_CoReNorm[["DF"]][["Contigency_table_CoRe_blank"]])){ - DFList_CoRe <- list( "CV_CoRe_blank"= data_CoReNorm[["DF"]][["CV_CoRe_blank"]]) - }else{ - DFList_CoRe <- list( "CV_CoRe_blank"= data_CoReNorm[["DF"]][["CV_CoRe_blank"]],"Variation_ContigencyTable_CoRe_blank"=data_CoReNorm[["DF"]][["Contigency_table_CoRe_blank"]]) + + ## ------------------ 2. Missing value Imputation ------------------- ## + if (MVI) { + l_imputed <- MVImputation(se = se_Filt, ##InputData = InputData_Filt, + ##SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo, + CoRe = CoRe, + MVI_Percentage = MVI_Percentage) + se_MVI <- l_imputed[["data"]][["se"]] + } else { + se_MVI <- se_Filt } - DFList <- c(DFList, DFList_CoRe) - } - ## ---- Plots - if(TIC==TRUE){ - PlotList <- c(TICRes_List[["Plot"]], OutlierRes[["Plot"]]) - }else{ - PlotList <- c(RLAPlot_List[["Plot"]], OutlierRes[["Plot"]]) - } + ## ---------------- 3. Total Ion Current Normalization ----------------- ## + if (TIC) { + + ## perform TIC normalization + l_tic <- TICNorm(se = se_MVI, + SettingsInfo = SettingsInfo, + TIC = TIC) + se_tic <- l_tic[["data"]][["se"]] + + ## add plots to PlotList + PlotList <- list() + PlotList[["RLAPlot"]] <- l_tic[["plot"]][["beforeTicNormalization"]] + PlotList[["RLAPlot_TICnorm"]] <- l_tic[["plot"]][["afterTicNormalization"]] + PlotList[["RLAPlot_BeforeAfter_TICnorm"]] <- l_tic[["plot"]][["combined"]] + + } else { + ##se_tic <- se_MVI ## EDIT: could also use the SE object returned from TICNorm? + + ## perform TIC normalization (TIC = FALSE) + l_tic <- TICNorm(se = se_tic, ## EDIT: could it have the same name l_tic? + SettingsInfo = SettingsInfo, + TIC = TIC) + se_tic <- l_tic[["data"]][["se"]] + + ## add plots to PlotList + PlotList <- list() + PlotList[["RLAPlot"]] <- l_tic[["plot"]][["beforeTicNormalization"]] + } - if(CoRe ==TRUE){ - PlotList <- c(PlotList , data_CoReNorm[["Plot"]]) - } + ## ------------- 4. CoRe media QC (blank) and normalization ------------- ## + if (CoRe) { + l_CoReNorm <- CoReNorm(se = se_tic, ##InputData = TICRes, + ##SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo) + + se_tic <- l_CoReNorm[["data"]][["se"]] + } - Res_List <- list("DF"= DFList ,"Plot" =PlotList) + ## ------------------ Final Output: + + ############################################################################ + ## ------------------ Sample outlier identification ------------------- ## + l_outlier <- OutlierDetection(se = se_tic, ##InputData = data_norm, + ##SettingsFile_Sample = SettingsFile_Sample, + SettingsInfo = SettingsInfo, + CoRe = CoRe, + HotellinsConfidence = HotellinsConfidence) + + ## continue from here ... + ############################################################################ + ## ------------------ Return ------------------- ## + ## ---- DFs + if (!is.null(FeatureFilt)) { + + ## add metabolites that where removed as part of the feature filtering + if (length(l_filtered[["RemovedMetabolites"]]) == 0) { + + l <- list( + "se_raw"= se, + "Filtered_metabolites"= as.data.frame( + list(FeatureFiltering = c(FeatureFilt), ## EDIT: are the c() needed? + FeatureFilt_Value = c(FeatureFilt_Value), + RemovedMetabolites = c("None"))), ## EDIT: for simplicity why not only return here l_filtered[["RemovedMetabolites"]]? / have only one return not dependong on length(l_filtered[["RemovedMetabolites"]])? + "se_processed" = l_outlier[["data"]][["se"]]) + } else { + l <- list( + "se_raw"= se, + "Filtered_metabolites"= as.data.frame( + list( + FeatureFiltering = rep(FeatureFilt, length(l_filtered[["RemovedMetabolites"]])), + FeatureFilt_Value = rep(FeatureFilt_Value, length(l_filtered[["RemovedMetabolites"]])), + RemovedMetabolites = l_filtered[["RemovedMetabolites"]])), + "se_processed" = l_outlier[["data"]][["se"]]) + } + } else { + l <- list( + "se_raw"= se, + "se_processed" = l_outlier[["data"]][["se"]]) ## EDIT: it seems to me that only Filtered_metabolites is different here, better to put this in the if/else and assemble everything outside of it + } - # Save Plots and DFs - #As row names are not saved we need to make row.names to column for the DFs that needs this: - DFList[["InputData_RawData"]] <- DFList[["InputData_RawData"]]%>%tibble::rownames_to_column("Code") - DFList[["Preprocessing_output"]] <- DFList[["Preprocessing_output"]]%>%tibble::rownames_to_column("Code") + if (CoRe) { + if (is.null(l_CoReNorm[["Contigency_table_CoRe_blank"]])) { + l_CoRe <- list( + "CV_CoRe_blank"= l_CoReNorm[["CV_CoRe_blank"]]) + } else { + l_CoRe <- list( + "CV_CoRe_blank" = l_CoReNorm[["CV_CoRe_blank"]], + "Variation_ContigencyTable_CoRe_blank" = l_CoReNorm[["Contigency_table_CoRe_blank"]]) + } + l <- c(l, l_CoRe) + } - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=DFList, - InputList_Plot= PlotList, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= SubFolder_P, - FileName= "PreProcessing", - CoRe=CoRe, - PrintPlot=PrintPlot))) - - - #Return - invisible(return(Res_List)) -} + ## ---- Plots + if (TIC) { + l_plot <- c(l_tic[["plot"]], l_outlier[["plot"]]) + } else { + l_plot <- c(l_notic[["plot"]], l_outlier[["plot"]]) + } + if (CoRe) { + l_plot <- c(l_plot , l_CoReNorm[["plot"]]) + } + ## save Plots and DFs + ## as row names are not saved we need to make row.names to column for + ## the DFs that needs this: + ##DFList[["InputData_RawData"]] <- DFList[["InputData_RawData"]] %>% + ## tibble::rownames_to_column("Code") + ##DFList[["Preprocessing_output"]] <- DFList[["Preprocessing_output"]] %>% + ## tibble::rownames_to_column("Code") ## EDIT: not needed since we return SummarizedExperiment object + + suppressMessages(suppressWarnings( + SaveRes(data = l, + plot = l_plot, + SaveAs_Table =SaveAs_Table, + SaveAs_Plot = SaveAs_Plot, + FolderPath = SubFolder_P, + FileName = "PreProcessing", + CoRe = CoRe, + PrintPlot = PrintPlot))) + + ## return + invisible(list("data" = l, "plot" = l_plot)) +} ############################################################ @@ -272,10 +322,20 @@ PreProcessing <- function(InputData, #' @return DF with the merged analytical replicates #' #' @examples +#' ## load the data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- ReplicateSum(InputData=Intra[-c(49:58) ,-c(1:3)], -#' SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], -#' SettingsInfo = c(Conditions="Conditions", Biological_Replicates="Biological_Replicates", Analytical_Replicates="Analytical_Replicates")) +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58), c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' ReplicateSum(se = se, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates", +#' Analytical_Replicates = "Analytical_Replicates")) #' #' @keywords Analytical Replicate Merge #' @@ -287,91 +347,125 @@ PreProcessing <- function(InputData, #' #' @export #' -ReplicateSum <- function(InputData, - SettingsFile_Sample, - SettingsInfo = c(Conditions="Conditions", Biological_Replicates="Biological_Replicates", Analytical_Replicates="Analytical_Replicates"), - SaveAs_Table = "csv", - FolderPath = NULL){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo = SettingsInfo, - SaveAs_Plot=NULL, - SaveAs_Table=SaveAs_Table, - CoRe=FALSE, - PrintPlot=FALSE) - - # `CheckInput` Specific - if(SettingsInfo[["Conditions"]] %in% colnames(SettingsFile_Sample)){ - # Conditions <- InputData[[SettingsInfo[["Conditions"]] ]] - }else{ - stop("Column `Conditions` is required.") - } - if(SettingsInfo[["Biological_Replicates"]] %in% colnames(SettingsFile_Sample)){ - #Biological_Replicates <- InputData[[SettingsInfo[["Biological_Replicates"]]]] - }else{ - stop("Column `Biological_Replicates` is required.") - } - if(SettingsInfo[["Analytical_Replicates"]] %in% colnames(SettingsFile_Sample)){ - #Analytical_Replicates <- InputData[[SettingsInfo[["Analytical_Replicates"]]]] - }else{ - stop("Column `Analytical_Replicates` is required.") - } - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE ){ - Folder <- SavePath(FolderName= "Processing", - FolderPath=FolderPath) - SubFolder <- file.path(Folder, "ReplicateSum") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - ## ------------ Load data and process ----------- ## - Input <- merge(x= SettingsFile_Sample%>% dplyr::select(!!SettingsInfo[["Conditions"]], !!SettingsInfo[["Biological_Replicates"]], !!SettingsInfo[["Analytical_Replicates"]]), - y= InputData, - by="row.names")%>% - tibble::column_to_rownames("Row.names")%>% - dplyr::rename("Conditions"=SettingsInfo[["Conditions"]], - "Biological_Replicates"=SettingsInfo[["Biological_Replicates"]], - "Analytical_Replicates"=SettingsInfo[["Analytical_Replicates"]]) - - # Make the replicate Sums - Input_data_numeric_summed <- as.data.frame(Input %>% - dplyr::group_by(Biological_Replicates, Conditions) %>% - dplyr::summarise_all("mean") %>% dplyr::select(-Analytical_Replicates)) - - # Make a number of merged replicates column - nReplicates <- Input %>% - dplyr::group_by(Biological_Replicates, Conditions) %>% - dplyr::summarise_all("max") %>% - dplyr::ungroup() %>% - dplyr::select(Analytical_Replicates, Biological_Replicates, Conditions) %>% - dplyr::rename("n_AnalyticalReplicates_Summed "= "Analytical_Replicates") - - Input_data_numeric_summed <- merge(nReplicates,Input_data_numeric_summed, by = c("Conditions","Biological_Replicates"))%>% - tidyr::unite(UniqueID, c("Conditions","Biological_Replicates"), sep="_", remove=FALSE)%>% # Create a uniqueID - tibble::column_to_rownames("UniqueID")# set UniqueID to rownames - - #--------------- return ------------------## - SaveRes(InputList_DF=list("Sum_AnalyticalReplicates"=Input_data_numeric_summed%>%tibble::rownames_to_column("Code")), - InputList_Plot = NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "Sum_AnalyticalReplicates", - CoRe=FALSE, - PrintPlot=FALSE) - - #Return - invisible(return(Input_data_numeric_summed)) -} - +ReplicateSum <- function(se, ##InputData, ## EDIT: the name of this function is not informative? summarizeAnalyticalReplicates? + ##SettingsFile_Sample, + SettingsInfo = c(Conditions = "Conditions", + Biological_Replicates = "Biological_Replicates", + Analytical_Replicates = "Analytical_Replicates"), + SaveAs_Table = "csv", ## EDIT: list here the options + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------------ Check Input ------------------- ## + ## HelperFunction `CheckInput` + CheckInput(se, ##InputData = InputData, + ##SettingsFile_Sample = SettingsFile_Sample, + SettingsFile_Metab = NULL, + SettingsInfo = SettingsInfo, + SaveAs_Plot = NULL, + SaveAs_Table = SaveAs_Table, + CoRe = FALSE, + PrintPlot = FALSE) + + ## create object that will simplify the calculations + cD <- colData(se) |> + as.data.frame() + + ## `CheckInput` Specific + if (SettingsInfo[["Conditions"]] %in% colnames(cD)) { + ## Conditions <- InputData[[SettingsInfo[["Conditions"]] ]] ## EDIT: simplify + } else { + stop("Column `Conditions` is required.") + } + if (SettingsInfo[["Biological_Replicates"]] %in% colnames(cD)) { + ## Biological_Replicates <- InputData[[SettingsInfo[["Biological_Replicates"]]]] + } else { + stop("Column `Biological_Replicates` is required.") + } + if (SettingsInfo[["Analytical_Replicates"]] %in% colnames(cD)) { + #Analytical_Replicates <- InputData[[SettingsInfo[["Analytical_Replicates"]]]] + } else { + stop("Column `Analytical_Replicates` is required.") + } ## EDIT: why have the if/else here, if for "if" nothing is done? + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "Processing", FolderPath = FolderPath) + SubFolder <- file.path(Folder, "ReplicateSum") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } + ## ------------ Load data and process ----------- ## + ##se_merged <- merge( + ### x = dplyr::select(as.data.frame(colData(se)), !!SettingsInfo[["Conditions"]], + ## !!SettingsInfo[["Biological_Replicates"]], + ## !!SettingsInfo[["Analytical_Replicates"]]), + ## y = t(assay(se)), + ## by = "row.names") %>% + ## tibble::column_to_rownames("Row.names") %>% + ## dplyr::rename("Conditions" = SettingsInfo[["Conditions"]], + ## "Biological_Replicates" = SettingsInfo[["Biological_Replicates"]], + ## "Analytical_Replicates" = SettingsInfo[["Analytical_Replicates"]]) ## EDIT: not needed with SE + + ## Make the replicate Sums + assay_summed <- t(assay(se)) |> + as.data.frame() |> + dplyr::group_by( + Biological_Replicates = cD[[SettingsInfo[["Biological_Replicates"]]]], + Conditions = cD[[SettingsInfo[["Conditions"]]]]) %>% + dplyr::summarise_all("mean") %>% + #dplyr::select(-Analytical_Replicates) %>% + as.data.frame() + + ## make a number of merged replicates column + n_replicates <- cD |> + dplyr::group_by(Biological_Replicates, Conditions) %>% + dplyr::summarise_all("max") %>% + dplyr::ungroup() %>% + dplyr::select(Analytical_Replicates, Biological_Replicates, Conditions) %>% + dplyr::rename("n_AnalyticalReplicates_Summed "= "Analytical_Replicates") |> + dplyr::mutate(sample_ID = paste(n_replicates[["Conditions"]], + n_replicates[["Biological_Replicates"]], sep = "_")) |> + tibble::column_to_rownames(var = "sample_ID") + + ## create SummarizedExperiment + a_colnames <- paste(assay_summed[["Conditions"]], assay_summed[["Biological_Replicates"]], sep = "_") + a <- assay_summed[, rownames(se)] |> + t() + colnames(a) <- a_colnames + + ## make sure that a has same column order than row order of n_replicates and + ## same row order than row order of rowData(se) + a <- a[, rownames(n_replicates)] + a <- a[rownames(rowData(se)), ] + se <- SummarizedExperiment(assay = a, rowData = rowData(se), colData = n_replicates) + + ##assay_summed <- merge(n_replicates, assay_summed, + ## by = c("Conditions", "Biological_Replicates")) %>% + ## ## create a uniqueID + ## tidyr::unite(UniqueID, c("Conditions", "Biological_Replicates"), + ## sep = "_", remove = FALSE) %>% + ## ## set UniqueID to rownames + ## tibble::column_to_rownames("UniqueID") + + ##--------------- return ------------------## + l <- list("se" = se) + SaveRes(data = list("se" = se), + plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "Sum_AnalyticalReplicates", + CoRe = FALSE, + PrintPlot = FALSE) + + ## return + invisible(list("data" = l)) +} ########################################################################## @@ -382,7 +476,7 @@ ReplicateSum <- function(InputData, #' #' @param InputData DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. Can be either a full dataset or a dataset with only the pool samples. #' @param SettingsFile_Sample \emph{Optional: } DF which contains information about the samples when a full dataset is inserted as Input_data. Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), has to exist.\strong{Default = NULL} -#' @param SettingsInfo \emph{Optional: } NULL or Named vector including the Conditions and PoolSample information (Name of the Conditions column and Name of the pooled samples in the Conditions in the Input_SettingsFile) : c(Conditions="ColumnNameConditions, PoolSamples=NamePoolCondition. If no Conditions is added in the Input_SettingsInfo, it is assumed that the conditions column is named 'Conditions' in the Input_SettingsFile. ). \strong{Default = NULL} +#' @param SettingsInfo \emph{Optional: } NULL or Named vector including the Conditions and PoolSample information (Name of the Conditions column and Name of the pooled samples in the Conditions in the Input_SettingsFile) : c(Conditions="ColumnNameConditions, PoolSamples=NamePoolCondition. If no Conditions is added in the Input_SettingsInfo, it is assumed that the conditions column is named 'Conditions' in the Input_SettingsFile.). \strong{Default = NULL} #' @param CutoffCV \emph{Optional: } Filtering cutoff for high variance metabolites using the Coefficient of Variation. \strong{Default = 30} #' @param SaveAs_Plot \emph{Optional: } Select the file type of output plots. Options are svg, png, pdf or NULL. \strong{Default = svg} #' @param SaveAs_Table \emph{Optional: } File types for the analysis results are: "csv", "xlsx", "txt", ot NULL \strong{default: "csv"} @@ -392,10 +486,18 @@ ReplicateSum <- function(InputData, #' @return List with two elements: DF (including input and output table) and Plot (including all plots generated) #' #' @examples +#' ## load the data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- PoolEstimation(InputData=Intra[ ,-c(1:3)], -#' SettingsFile_Sample=Intra[ , c(1:3)], -#' SettingsInfo = c(PoolSamples = "Pool", Conditions="Conditions")) +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[, -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[, c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' PoolEstimation(se = se, +#' SettingsInfo = c(Conditions = "Conditions", PoolSamples = "Pool")) #' #' @keywords Coefficient of Variation, high variance metabolites #' @@ -406,200 +508,245 @@ ReplicateSum <- function(InputData, #' #' @export #' -PoolEstimation <- function(InputData, - SettingsFile_Sample = NULL, - SettingsInfo = NULL, - CutoffCV = 30, - SaveAs_Plot = "svg", - SaveAs_Table = "csv", - PrintPlot=TRUE, - FolderPath = NULL){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - logger::log_info('Starting pool estimation.') - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo=SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=SaveAs_Table, - CoRe=FALSE, - PrintPlot = PrintPlot) - - # `CheckInput` Specific - if(is.null(SettingsFile_Sample)==FALSE){ - if("Conditions" %in% names(SettingsInfo)==TRUE){ - if(SettingsInfo[["Conditions"]] %in% colnames(SettingsFile_Sample)== FALSE ){ - stop("You have chosen Conditions = ",paste(SettingsInfo[["Conditions"]]), ", ", paste(SettingsInfo[["Conditions"]])," was not found in SettingsFile_Sample as column. Please insert the name of the experimental conditions as stated in the SettingsFile_Sample." ) - } +PoolEstimation <- function(se, InputData, + ##SettingsFile_Sample = NULL, + SettingsInfo = NULL, + CutoffCV = 30, + SaveAs_Plot = "svg", ## EDIT: name the option here and use match.arg + SaveAs_Table = "csv", ## EDIT: name the option here and use match.arg + PrintPlot = TRUE, + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + #InputData <- assay(se) + #SettingsFile_Sample <- colData() + + logger::log_info('Starting pool estimation.') + + ## ------------------ Check Input ------------------- ## + # HelperFunction `CheckInput` + CheckInput(se = se, + SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, + SaveAs_Table = SaveAs_Table, + CoRe = FALSE, + PrintPlot = PrintPlot) + + ## `CheckInput` Specific + if ("Conditions" %in% names(SettingsInfo)) { + if (!SettingsInfo[["Conditions"]] %in% colnames(colData(se))) { + stop("You have chosen Conditions = ", + SettingsInfo[["Conditions"]], ", ", SettingsInfo[["Conditions"]], + " was not found in SettingsFile_Sample as column. Please insert the name of the experimental conditions as stated in the SettingsFile_Sample." ) + } } - if("PoolSamples" %in% names(SettingsInfo)==TRUE){ - if(SettingsInfo[["PoolSamples"]] %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == FALSE ){ - stop("You have chosen PoolSamples = ",paste(SettingsInfo[["PoolSamples"]] ), ", ", paste(SettingsInfo[["PoolSamples"]] )," was not found in SettingsFile_Sample as sample condition. Please insert the name of the pool samples as stated in the Conditions column of the SettingsFile_Sample." ) - } + if ("PoolSamples" %in% names(SettingsInfo)) { + if (!SettingsInfo[["PoolSamples"]] %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + stop("You have chosen PoolSamples = ", + SettingsInfo[["PoolSamples"]], ", ", + SettingsInfo[["PoolSamples"]], + " was not found in SettingsFile_Sample as sample condition. Please insert the name of the pool samples as stated in the Conditions column of the SettingsFile_Sample." ) + } } - } - - if(is.numeric(CutoffCV)== FALSE | CutoffCV < 0){ - stop("Check input. The selected CutoffCV value should be a positive numeric value.") - } - - ## ------------------ Create output folders and path ------------------- ## - if(is.null(SaveAs_Plot)==FALSE |is.null(SaveAs_Table)==FALSE ){ - Folder <- SavePath(FolderName= "Processing", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "PoolEstimation") - logger::log_info('Selected output directory: `%s`.', SubFolder) - if (!dir.exists(SubFolder)) { - logger::log_trace('Creating directory: `%s`.', SubFolder) - dir.create(SubFolder) + + if (!is.numeric(CutoffCV) | CutoffCV < 0) { + stop("Check input. The selected CutoffCV value should be a positive numeric value.") } - } - - ## ------------------ Prepare the data ------------------- ## - #InputData files: - if(is.null(SettingsFile_Sample)==TRUE){ - PoolData <- InputData%>% - dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .))#Make sure all 0 are changed to NAs - }else{ - PoolData <- InputData[SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["PoolSamples"]],]%>% - dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .))#Make sure all 0 are changed to NAs - } - - ################################################################################################################################### - ## ------------------ Coefficient of Variation ------------------- ## - logger::log_trace('Calculating coefficient of variation.') - result_df <- apply(PoolData, 2, function(x) { (sd(x, na.rm =T)/ mean(x, na.rm =T))*100 } ) %>% t()%>% as.data.frame() - rownames(result_df)[1] <- "CV" - - NAvector <- apply(PoolData, 2, function(x) {(sum(is.na(x))/length(x))*100 })# Calculate the NAs - - # Create Output DF - result_df_final <- result_df %>% - t()%>% as.data.frame() %>% dplyr::rowwise() %>% - dplyr::mutate(HighVar = CV > CutoffCV) %>% as.data.frame() - - result_df_final$MissingValuePercentage <- NAvector - - rownames(result_df_final)<- colnames(InputData) - result_df_final_out <- tibble::rownames_to_column(result_df_final,"Metabolite" ) - - # Remove Metabolites from InputData based on CutoffCV - logger::log_trace('Applying CV cut-off.') - if(is.null(SettingsFile_Sample)==FALSE){ - unstable_metabs <- rownames(result_df_final)[result_df_final[["HighVar_Metabs"]]] - if(length(unstable_metabs)>0){ - filtered_Input_data <- InputData %>% dplyr::select(!unstable_metabs) - }else{ - filtered_Input_data <- NULL - } - }else{ - filtered_Input_data <- NULL - } - - ## ------------------ QC plots ------------------- ## - # Start QC plot list - logger::log_info('Plotting QC plots.') - PlotList <- list() - - # 1. Pool Sample PCA - logger::log_trace('Pool sample PCA.') - dev.new() - if(is.null(SettingsFile_Sample)==TRUE){ - pca_data <- PoolData - pca_QC_pool <-invisible(VizPCA(InputData=pca_data, - PlotName = "QC Pool samples", - SaveAs_Plot = NULL)) - }else{ - pca_data <- merge(SettingsFile_Sample %>% dplyr::select(SettingsInfo[["Conditions"]]), InputData, by=0) %>% - tibble::column_to_rownames("Row.names") %>% - dplyr::mutate(Sample_type = dplyr::case_when(.data[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["PoolSamples"]] ~ "Pool", - TRUE ~ "Sample")) - - pca_QC_pool <-invisible(VizPCA(InputData=pca_data %>%dplyr::select(-all_of(SettingsInfo[["Conditions"]]), -Sample_type), - SettingsInfo= c(color="Sample_type"), - SettingsFile_Sample= pca_data, - PlotName = "QC Pool samples", - SaveAs_Plot = NULL)) - } - dev.off() - PlotList [["PCAPlot_PoolSamples"]] <- pca_QC_pool[["Plot_Sized"]][["Plot_Sized"]] - - - # 2. Histogram of CVs - logger::log_trace('CV histogram.') - HistCV <-suppressWarnings(invisible(ggplot(result_df_final_out, aes(CV)) + - geom_histogram(aes(y=after_stat(density)), color="black", fill="white")+ - geom_vline(aes(xintercept=CutoffCV), - color="darkred", linetype="dashed", size=1)+ - geom_density(alpha=.2, fill="#FF6666") + - labs(title="CV for metabolites of Pool samples",x="Coefficient of variation (CV%)", y = "Frequency")+ - theme_classic())) - - HistCV_Sized <- plotGrob_Processing(InputPlot = HistCV, PlotName= "CV for metabolites of Pool samples", PlotType= "Hist") - PlotList [["Histogram_CV-PoolSamples"]] <- HistCV_Sized - - # 2. ViolinPlot of CVs - logger::log_trace('CV violin plot.') - #Make Violin of CVs - Plot_cv_result_df <- result_df_final_out %>% - dplyr::mutate(HighVar = ifelse((CV > CutoffCV)==TRUE, paste("> CV", CutoffCV, sep=""), paste("< CV", CutoffCV, sep=""))) - - ViolinCV <- invisible(ggplot( Plot_cv_result_df, aes(y=CV, x=HighVar, label=Plot_cv_result_df$Metabolite))+ - geom_violin(alpha = 0.5 , fill="#FF6666")+ - geom_dotplot(binaxis = "y", stackdir = "center", dotsize = 0.5) + - ggrepel::geom_text_repel(aes(label = ifelse(Plot_cv_result_df$CV > CutoffCV, - as.character(Plot_cv_result_df$Metabolite), '')), - hjust = 0, vjust = 0, - box.padding = 0.5, # space between text and point - point.padding = 0.5, # space around points - max.overlaps = Inf) + # allow for many labels - labs(title="CV for metabolites of Pool samples",x="Metabolites", y = "Coefficient of variation (CV%)")+ - theme_classic()) - - ViolinCV_Sized <- plotGrob_Processing(InputPlot = ViolinCV, PlotName= "CV for metabolites of Pool samples", PlotType= "Violin") - - PlotList [["ViolinPlot_CV-PoolSamples"]] <- ViolinCV_Sized - - ################################################################################################################################### - ## ------------------ Return and Save ------------------- ## - #Save - logger::log_info('Preparing saved and returned data.') - if(is.null(filtered_Input_data)==FALSE){ - DF_list <- list("InputData" = InputData, "Filtered_InputData" = filtered_Input_data, "CV" = result_df_final_out ) - }else{ - DF_list <- list("InputData" = InputData, "CV" = result_df_final_out) - } - ResList <- list("DF"= DF_list,"Plot"=PlotList) - - #Save - DF_list[["InputData"]]<- DF_list[["InputData"]]%>%tibble::rownames_to_column("Code") - - logger::log_info( - 'Saving results: [SaveAs_Table=%s, SaveAs_Plot=%s, FolderPath=%s].', - SaveAs_Table, - SaveAs_Plot, - SubFolder - ) - SaveRes(InputList_DF=DF_list, - InputList_Plot = PlotList, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=SaveAs_Plot, - FolderPath= SubFolder, - FileName= "PoolEstimation", - CoRe=FALSE, - PrintPlot=PrintPlot) - - #Return - logger::log_info('Finished pool estimation.') - invisible(return(ResList)) -} + ## ----------------- create output folders and path ------------------- ## + if (!is.null(SaveAs_Plot) | !is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "Processing", FolderPath = FolderPath) + + SubFolder <- file.path(Folder, "PoolEstimation") + logger::log_info("Selected output directory: `%s`.", SubFolder) + if (!dir.exists(SubFolder)) { + logger::log_trace("Creating directory: `%s`.", SubFolder) + dir.create(SubFolder) + } + } + + ## ------------------ Prepare the data ------------------- ## + ## InputData files: + ##if (is.null(SettingsFile_Sample)) { + ## PoolData <- assay(se) %>% + ## ## make sure all 0 are changed to NAs + ## dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)) ## EDIT: this mutate_all should be simplified + ##} else { + PoolData <- assay(se)[, colData(se)[[ SettingsInfo[["Conditions"]]]] == SettingsInfo[["PoolSamples"]]]## %>% + PoolData[PoolData == 0] <- NA + ## Make sure all 0 are changed to NAs + ##dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)) + ## } + + ############################################################################ + ## ------------------ Coefficient of Variation ------------------- ## + logger::log_trace("Calculating coefficient of variation.") + result_df <- apply(PoolData, 1, + function(x) sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE) * 100) %>% ## EDIT: use an external function to calculate CVs + t() %>% + as.data.frame() + rownames(result_df)[1] <- "CV" + + ## calculate the NAs + NAvector <- apply(PoolData, 1, function(x) sum(is.na(x)) / length(x) * 100) + + ## create Output DF + result_df_final <- result_df %>% + t() %>% + as.data.frame() %>% + dplyr::rowwise() %>% + dplyr::mutate(HighVar = CV > CutoffCV) %>% + as.data.frame() + result_df_final$MissingValuePercentage <- NAvector + + rownames(result_df_final) <- rownames(se) + result_df_final_out <- tibble::rownames_to_column(result_df_final, "Metabolite") + + ## remove Metabolites from se based on CutoffCV and assign to se_filtered + logger::log_trace('Applying CV cut-off.') + #if (!is.null(SettingsFile_Sample)) { + unstable_metabs <- rownames(result_df_final)[result_df_final[["HighVar"]]] + if (length(unstable_metabs) > 0) { + se_filtered <- se[!rownames(se) %in% unstable_metabs, ] + ##} else { + ## filtered_Input_data <- NULL + ##} + #} else { + # filtered_Input_data <- NULL ## EDIT: preset filtered_Input_data <- NULL and delete the else statements + #} + + ## ------------------ QC plots ------------------- ## + ## start QC plot list + logger::log_info('Plotting QC plots.') + l_plot <- list() + + ## 1. Pool Sample PCA + logger::log_trace('Pool sample PCA.') + #dev.new() ## EDIT: not sure if this is needed + #if (is.null(SettingsFile_Sample)) { + # pca_data <- PoolData + # pca_QC_pool <-invisible(VizPCA( + # InputData = pca_data, + # PlotName = "QC Pool samples", + # SaveAs_Plot = NULL)) + #} else { + #pca_data <- merge( + # dplyr::select(SettingsFile_Sample, SettingsInfo[["Conditions"]]), + # InputData, by = 0) %>% + # tibble::column_to_rownames("Row.names") %>% + # dplyr::mutate(Sample_type = dplyr::case_when( + # .data[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["PoolSamples"]] ~ "Pool", + # TRUE ~ "Sample")) + + ## add column Sample_type to se object + se[["Sample_type"]] <- ifelse( + colData(se)[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["PoolSamples"]], + "Pool", "Sample") + + ## run PCA + pca_QC_pool <- invisible( + VizPCA( + se = se, + #InputData = dplyr::select(pca_data, -all_of(SettingsInfo[["Conditions"]]), -Sample_type), + SettingsInfo = c(color = "Sample_type"), + ##SettingsFile_Sample = pca_data, + PlotName = "QC Pool samples", + SaveAs_Plot = NULL)) + } + dev.off() ## EDIT: not sure if this is needed + l_plot [["PCAPlot_PoolSamples"]] <- pca_QC_pool[["Plot_Sized"]][["Plot_Sized"]] + + + ## 2. Histogram of CVs + logger::log_trace('CV histogram.') + HistCV <- suppressWarnings(invisible( + ggplot(result_df_final_out, aes(CV)) + + geom_histogram(aes(y = after_stat(density)), color = "black", + fill = "white") + + geom_vline(aes(xintercept = CutoffCV), + color = "darkred", linetype = "dashed", size = 1) + + geom_density(alpha = .2, fill = "#FF6666") + + labs(title = "CV for metabolites of Pool samples", + x = "Coefficient of variation (CV%)", y = "Frequency") + + theme_classic())) + + HistCV_Sized <- plotGrob_Processing(InputPlot = HistCV, + PlotName = "CV for metabolites of Pool samples", PlotType = "Hist") + l_plot[["Histogram_CV-PoolSamples"]] <- HistCV_Sized + + ## 2. ViolinPlot of CVs + logger::log_trace('CV violin plot.') + ## Make Violin of CVs + Plot_cv_result_df <- result_df_final_out %>% + dplyr::mutate( + HighVar = ifelse(CV > CutoffCV, + paste("> CV", CutoffCV, sep = ""), + paste("< CV", CutoffCV, sep=""))) + + ViolinCV <- invisible( + ggplot(Plot_cv_result_df, + aes(y = CV, x = HighVar, label = Plot_cv_result_df$Metabolite)) + + geom_violin(alpha = 0.5 , fill = "#FF6666") + + geom_dotplot(binaxis = "y", stackdir = "center", dotsize = 0.5) + + ggrepel::geom_text_repel( + aes(label = ifelse(Plot_cv_result_df$CV > CutoffCV, + as.character(Plot_cv_result_df$Metabolite), '')), + hjust = 0, vjust = 0, + ## space between text and point + box.padding = 0.5, + ## space around points + point.padding = 0.5, + ## allow for many labels + max.overlaps = Inf) + + labs(title = "CV for metabolites of Pool samples", + x = "Metabolites", y = "Coefficient of variation (CV%)") + + theme_classic()) + + ViolinCV_Sized <- plotGrob_Processing(InputPlot = ViolinCV, + PlotName = "CV for metabolites of Pool samples", PlotType = "Violin") + l_plot[["ViolinPlot_CV-PoolSamples"]] <- ViolinCV_Sized + + ############################################################################ + ## ------------------ return and save ------------------- ## + ## save + logger::log_info('Preparing saved and returned data.') + if (length(unstable_metabs) > 0) { + l_pool <- list( + "se" = se, + "se_filtered" = se_filtered, + "CV" = result_df_final_out) + } else { + l_pool <- list( + "se" = se, + "CV" = result_df_final_out) ## EDIT: could be simplified, define DF_list and add Filtered_InputData IF + } + + ## save + ##DF_list[["InputData"]] <- DF_list[["InputData"]] %>% + ## tibble::rownames_to_column("Code") + logger::log_info( + "Saving results: [SaveAs_Table=%s, SaveAs_Plot=%s, FolderPath=%s].", + SaveAs_Table, + SaveAs_Plot, + SubFolder + ) + SaveRes( + data = l_pool, + plot = l_plot, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = SaveAs_Plot, + FolderPath = SubFolder, + FileName = "PoolEstimation", + CoRe = FALSE, + PrintPlot = PrintPlot) + + ## return + l_res <- list("data" = l_pool, "plot" = l_plot) + logger::log_info('Finished pool estimation.') + invisible(l_res) +} ################################################################################################ ### ### ### PreProcessing helper function: FeatureFiltering ### ### ### @@ -617,10 +764,18 @@ PoolEstimation <- function(InputData, #' @return List with two elements: filtered matrix and features filtered #' #' @examples +#' ## load the data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- FeatureFiltering(InputData=Intra[-c(49:58), -c(1:3)]%>% dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)), -#' SettingsFile_Sample=Intra[-c(49:58), c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates")) +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58), c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' FeatureFiltering(se = se, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates")) #' #' @keywords feature filtering or modified feature filtering #' @@ -630,104 +785,141 @@ PoolEstimation <- function(InputData, #' #' @noRd #' -FeatureFiltering <-function(InputData, - SettingsFile_Sample, - SettingsInfo, - CoRe=FALSE, - FeatureFilt="Modified", - FeatureFilt_Value=0.8){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------------ Prepare the data ------------------- ## - feat_filt_data <- as.data.frame(InputData)%>% - dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .))#Make sure all 0 are changed to NAs - - if(CoRe== TRUE){ # remove CoRe_media samples for feature filtering - feat_filt_data <- feat_filt_data %>% dplyr::filter(!SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] ==SettingsInfo[["CoRe_media"]]) - Feature_Filtering <- paste0(FeatureFilt, "_CoRe") - } - - ## ------------------ Perform filtering ------------------ ## - if(FeatureFilt == "Modified"){ - message <- paste0("FeatureFiltering: Here we apply the modified 80%-filtering rule that takes the class information (Column `Conditions`) into account, which additionally reduces the effect of missing values (REF: Yang et. al., (2015), doi: 10.3389/fmolb.2015.00004). ", "Filtering value selected: ", FeatureFilt_Value, sep="") - logger::log_info(message) - message(message) - if(CoRe== TRUE){ - feat_filt_Conditions <- SettingsFile_Sample[[SettingsInfo[["Conditions"]]]][!SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] - }else{ - feat_filt_Conditions <- SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] +FeatureFiltering <- function(se, ##InputData, + #SettingsFile_Sample, + SettingsInfo, + CoRe = FALSE, + FeatureFilt = "Modified", ## EDIT: name options here and use match.arg + FeatureFilt_Value = 0.8) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------------ Prepare the data ------------------- ## + + #feat_filt_data <- as.data.frame(InputData) %>% + # ## make sure all 0 are changed to NAs + # dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)) ## EDIT: this term is applied several times, make a function? + se_feat_filt_data <- se + assay(se_feat_filt_data)[assay(se_feat_filt_data) == 0] <- NA + #assay(se)[assay(se) == 0] <- NA + + if (CoRe) { + ## remove CoRe_media samples for feature filtering + se_feat_filt_data <- se_feat_filt_data[, + !colData(se_feat_filt_data)[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] + Feature_Filtering <- paste0(FeatureFilt, "_CoRe") } - if(is.null(unique(feat_filt_Conditions)) == TRUE){ - message("Conditions information is missing.") - logger::log_trace(message) - stop(message) - } - if(length(unique(feat_filt_Conditions)) == 1){ - message("To perform the Modified feature filtering there have to be at least 2 different Conditions in the `Condition` column in the Experimental design. Consider using the Standard feature filtering option.") - logger::log_trace(message) - stop(message) - } + ## ------------------ Perform filtering ------------------ ## + if (FeatureFilt == "Modified") { + message <- paste0("FeatureFiltering: Here we apply the modified 80%-filtering rule that takes the class information (Column `Conditions`) into account, which additionally reduces the effect of missing values (REF: Yang et. al., (2015), doi: 10.3389/fmolb.2015.00004). ", + "Filtering value selected: ", FeatureFilt_Value) + logger::log_info(message) + message(message) + + ## obtain the updated Conditions after filtering + feat_filt_Conditions <- colData(se_feat_filt_data)[[SettingsInfo[["Conditions"]]]] + # if (CoRe) { + # feat_filt_Conditions <- colData(se_feat_filt_data)[[SettingsInfo[["Conditions"]]]][!colData(se)[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] + # } else { + # feat_filt_Conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + # } + + if (is.null(unique(feat_filt_Conditions))) { + message("Conditions information is missing.") + logger::log_trace(message) + stop(message) + } + if (length(unique(feat_filt_Conditions)) == 1) { + message("To perform the Modified feature filtering there have to be at least 2 different Conditions in the `Condition` column in the Experimental design. Consider using the Standard feature filtering option.") + logger::log_trace(message) + stop(message) + } - miss <- c() - split_Input <- split(feat_filt_data, feat_filt_Conditions) # split data frame into a list of dataframes by condition + miss <- c() + ## split data frame into a list of dataframes by condition + + split_Input <- assay(se_feat_filt_data) |> + t() |> + as.data.frame() |> + split(f = feat_filt_Conditions, drop = FALSE) + + for (m in split_Input) { + ## select metabolites to be filtered for different conditions + for (i in seq_len(ncol(m))) { + if (length(which(is.na(m[, i]))) > (1 - FeatureFilt_Value) * nrow(m)) + miss <- append(miss, i) + } + } - for (m in split_Input){ # Select metabolites to be filtered for different conditions - for(i in 1:ncol(m)) { - if(length(which(is.na(m[,i]))) > (1-FeatureFilt_Value)*nrow(m)) - miss <- append(miss,i) - } - } + if (length(miss) == 0) { + ## remove metabolites if any are found + message("There where no metabolites exluded") + filtered_matrix <- assay(se) + feat_file_res <- "There where no metabolites exluded" + } else { + names_filt <- unique(rownames(se)[miss]) + message( + length(unique(miss)), " metabolites where removed: ", + paste0(names_filt, collapse = ", ")) + filtered_matrix <- assay(se)[-miss, ] + } + } else if (FeatureFilt == "Standard") { + message <- paste0("FeatureFiltering: Here we apply the so-called 80%-filtering rule, which removes metabolites with missing values in more than 80% of samples (REF: Smilde et. al. (2005), Anal. Chem. 77, 6729–6736., doi:10.1021/ac051080y). ", + "Filtering value selected:", FeatureFilt_Value) + logger::log_info(message) + message(message) - if(length(miss) == 0){ #remove metabolites if any are found - message("There where no metabolites exluded") - filtered_matrix <- InputData - feat_file_res <- "There where no metabolites exluded" - }else{ - names<-unique(colnames(InputData)[miss]) - message(length(unique(miss)) ," metabolites where removed: ", paste0(names, collapse = ", ")) - filtered_matrix <- InputData[,-miss] - } - }else if(FeatureFilt == "Standard"){ - message <- paste0 ("FeatureFiltering: Here we apply the so-called 80%-filtering rule, which removes metabolites with missing values in more than 80% of samples (REF: Smilde et. al. (2005), Anal. Chem. 77, 6729–6736., doi:10.1021/ac051080y). ","Filtering value selected:", FeatureFilt_Value) - logger::log_info(message) - message(message) + split_Input <- assay(se_feat_filt_data) |> + t() - split_Input <- feat_filt_data + miss <- c() + for (i in seq_len(ncol(split_Input))) { + ## select metabolites to be filtered for one condition + if (length(which(is.na(split_Input[, i]))) > (1 - FeatureFilt_Value) * nrow(split_Input)) + miss <- append(miss, i) + } - miss <- c() - for(i in 1:ncol(split_Input)) { # Select metabolites to be filtered for one condition - if(length(which(is.na(split_Input[,i]))) > (1-FeatureFilt_Value)*nrow(split_Input)) - miss <- append(miss,i) - } + if (length(miss) == 0) { + ## remove metabolites if any are found + message <- paste0("FeatureFiltering: There where no metabolites exluded") + logger::log_info(message) + message(message) - if(length(miss) == 0){ #remove metabolites if any are found - message <- paste0("FeatureFiltering: There where no metabolites exluded") - logger::log_info(message) - message(message) - - filtered_matrix <- InputData - feat_file_res <- "There where no metabolites exluded" - }else{ - names<-unique(colnames(InputData)[miss]) - message <- paste0(length(unique(miss)) ," metabolites where removed: ", paste0(names, collapse = ", ")) - logger::log_info(message) - message(message) - filtered_matrix <- InputData[,-miss] + filtered_matrix <- assay(se) + feat_file_res <- "There where no metabolites exluded" + } else { + names_filt <- unique(rownames(se)[miss]) + message <- paste0(length(unique(miss)), + " metabolites where removed: ", paste0(names_filt, collapse = ", ")) + logger::log_info(message) + message(message) + filtered_matrix <- assay(se)[, -miss] + } } - } - ## ------------------ Return ------------------ ## - features_filtered <- unique(colnames(InputData)[miss]) %>% as.vector() - filtered_matrix <- as.data.frame(dplyr::mutate_all(as.data.frame(filtered_matrix), function(x) as.numeric(as.character(x)))) - - Filtered_results <- list("DF"= filtered_matrix , "RemovedMetabolites" = features_filtered) - invisible(return(Filtered_results)) + ## ------------------ Return ------------------ ## + features_filtered <- unique(rownames(se)[miss]) %>% + as.vector() + #filtered_matrix <- dplyr::mutate_all( ## EDIT: why is this needed? + # as.data.frame(filtered_matrix), function(x) as.numeric(as.character(x))) |> + # as.matrix() + + ## update the SummarizedObject + se <- se[rownames(filtered_matrix), ] + assay(se) <- filtered_matrix + + ## assemble the object to return + l <- list( + "se" = se, + "assay" = filtered_matrix, + "RemovedMetabolites" = features_filtered) + + ## return + invisible(list("data" = l)) } - - ################################################################################################ ### ### ### PreProcessing helper function: Missing Value imputation ### ### ### ################################################################################################ @@ -743,106 +935,143 @@ FeatureFiltering <-function(InputData, #' @return DF with imputed values #' #' @examples +#' ## load the data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- MVImputation(InputData=Intra[-c(49:58), -c(1:3)]%>% dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)), -#' SettingsFile_Sample=Intra[-c(49:58), c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates")) +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58), c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' MVImputation(se = se, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates")) #' #' @keywords Half minimum missing value imputation #' -#' @importFrom dplyr select mutate group_by filter -#' @importFrom magrittr %>% %<>% -#' @importFrom tibble column_to_rownames -#' @importFrom logger log_info log_trace +#' @importFrom dplyr mutate group_by +#' @importFrom MatrixGenerics rowMins +#' @importFrom logger log_info #' #' @noRd #' -MVImputation <-function(InputData, - SettingsFile_Sample, - SettingsInfo, - CoRe=FALSE, - MVI_Percentage=50){ - ## ------------------ Prepare the data ------------------- ## - filtered_matrix <- InputData%>% - dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .))#Make sure all 0 are changed to NAs - - ## ------------------ Perform MVI ------------------ ## - # Do MVI for the samples - message <- paste0("Missing Value Imputation: Missing value imputation is performed, as a complementary approach to address the missing value problem, where the missing values are imputing using the `half minimum value`. REF: Wei et. al., (2018), Reports, 8, 663, doi:https://doi.org/10.1038/s41598-017-19120-0") - logger::log_info(message) - message(message) - - if(CoRe==TRUE){#remove blank samples - NA_removed_matrix <- filtered_matrix%>% dplyr::filter(!SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]) - - }else{ - NA_removed_matrix <- filtered_matrix %>% as.data.frame() - } - - for (feature in colnames(NA_removed_matrix)){ - feature_data <- merge(NA_removed_matrix[feature] , SettingsFile_Sample %>% dplyr::select(Conditions), by= 0) - feature_data <- tibble::column_to_rownames(feature_data, "Row.names") - - imputed_feature_data <- feature_data %>% - dplyr::group_by(Conditions) %>% - dplyr::mutate(across(all_of(feature), ~{ - if(all(is.na(.))) { - message <- paste0("For some conditions all measured samples are NA for " , feature, ". Hence we can not perform half-minimum value imputation per condition for this metabolite and will assume it is a true biological 0 in those cases.") - logger::log_info(message) - message(message) - return(0) # Return NA if all values are missing - } else { - return(replace(., is.na(.), min(., na.rm = TRUE)*(MVI_Percentage/100))) - } - })) - - NA_removed_matrix[[feature]] <- imputed_feature_data[[feature]] - } - - if(CoRe==TRUE){ - replaceNAdf <- filtered_matrix%>% dplyr::filter(SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]) - - # find metabolites with NA - na_percentage <- colMeans(is.na(replaceNAdf)) * 100 - highNA_metabs <- na_percentage[na_percentage>20 & na_percentage<100] - OnlyNA_metabs <- na_percentage[na_percentage==100] - - # report metabolites with NA - if(sum(na_percentage)>0){ - message <- paste0("NA values were found in Control_media samples for metabolites. For metabolites including NAs MVI is performed unless all samples of a metabolite are NA.") - logger::log_info(message) - message(message) - if(sum(na_percentage>20 & na_percentage<100)>0){ - message <- paste0("Metabolites with high NA load (>20%) in Control_media samples are: ",paste(names(highNA_metabs), collapse = ", "), ".") - logger::log_info(message) - message(message) - } - if(sum(na_percentage==100)>0){ - message <- paste0("Metabolites with only NAs (=100%) in Control_media samples are: ",paste(names(OnlyNA_metabs), collapse = ", "), ". Those NAs are set zero as we consider them true zeros") - logger::log_info(message) - message(message) - } +MVImputation <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo, + CoRe = FALSE, + MVI_Percentage = 50) { + + ## ------------------ Prepare the data ------------------- ## + if (CoRe) { + ## remove blank samples + se <- se[, + !colData(se)[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] } + + #se_NA_removed <- se + filtered_matrix <- assay(se) + filtered_matrix[filtered_matrix == 0] <- NA + + ## ------------------ Perform MVI ------------------ ## + ## do MVI for the samples + message <- paste0("Missing Value Imputation: Missing value imputation is performed, as a complementary approach to address the missing value problem, where the missing values are imputing using the `half minimum value`. REF: Wei et. al., (2018), Reports, 8, 663, doi:https://doi.org/10.1038/s41598-017-19120-0") + logger::log_info(message) + message(message) - # if all values are NA set to 0 - replaceNAdf_zero <- as.data.frame(lapply(replaceNAdf, function(x) if(all(is.na(x))) replace(x, is.na(x), 0) else x)) - colnames(replaceNAdf_zero) <- colnames(replaceNAdf) - rownames(replaceNAdf_zero) <- rownames(replaceNAdf) - - # If there is at least 1 value use the half minimum per feature - replaceNAdf_Zero_MVI <- apply( replaceNAdf_zero, 2, function(x) {x[is.na(x)] <- min(x, na.rm = TRUE)/2 - return(x) - }) %>% as.data.frame() - rownames(replaceNAdf_Zero_MVI) <- rownames(replaceNAdf) - - # add the samples in the original dataframe - filtered_matrix_res <- rbind(NA_removed_matrix, replaceNAdf_Zero_MVI) - }else{ - filtered_matrix_res <- NA_removed_matrix - } - - ## ------------------ Return ------------------ ## - invisible(return(filtered_matrix_res)) + ## impute features + for (feature in rownames(se)) { + ##feature_data <- merge(t(assay(se_NA_removed[feature, ])), as.data.frame(colData(se_NA_removed)) %>% dplyr::select(Conditions), by = 0) + + feature_data <- cbind( + t(assay(se)[feature, , drop = FALSE]), + colData(se)) + feature_compatible <- make.names(feature) + + imputed_feature_data <- feature_data %>% + as.data.frame() |> + dplyr::group_by(Conditions) %>% + dplyr::mutate(across(all_of(feature_compatible), + ~ { + if (all(is.na(.))) { + message <- paste0( + "For some conditions all measured samples are NA for " , + feature, + ". Hence we can not perform half-minimum value imputation ", + "per condition for this metabolite and will assume it ", + "is a true biological 0 in those cases.") + logger::log_info(message) + message(message) + ## Return NA if all values are missing + return(0) ## EDIT: this returns 0 instead of NA? + } else { + return(replace(., is.na(.), min(., na.rm = TRUE) * (MVI_Percentage / 100))) + } + })) + + assay(se)[feature, ] <- imputed_feature_data[[feature_compatible]] + } + + ## for CoRe + if (CoRe) { + replaceNA <- filtered_matrix[, colnames(se)] + + ## find metabolites with NA + na_percentage <- rowMeans(is.na(replaceNA)) * 100 + highNA_metabs <- na_percentage[na_percentage > 20 & na_percentage < 100] ## EDIT: I would describe in @description or @details that the value is hardcoded + OnlyNA_metabs <- na_percentage[na_percentage == 100] + + ## report metabolites with NA + if (sum(na_percentage) > 0) { + message <- paste0("NA values were found in Control_media samples for metabolites. For metabolites including NAs MVI is performed unless all samples of a metabolite are NA.") + logger::log_info(message) + message(message) + if (sum(na_percentage > 20 & na_percentage < 100) > 0) { + message <- paste0( + "Metabolites with high NA load (>20%) in Control_media samples are: ", + paste(names(highNA_metabs), collapse = ", "), ".") + logger::log_info(message) + message(message) + } + if (sum(na_percentage == 100) > 0) { + message <- paste0("Metabolites with only NAs (=100%) in Control_media samples are: ", + paste(names(OnlyNA_metabs), collapse = ", "), + ". Those NAs are set zero as we consider them true zeros") + logger::log_info(message) + message(message) + } + } + + ## if all values are NA set to 0 + replaceNA_zero <- replaceNA + replaceNA_zero[apply(replaceNA_zero, 1, + function(row) all(is.na(row))), ] <- 0 + + ## if there is at least 1 value use the half minimum per feature + replaceNA_zero_MVI <- replaceNA_zero + half_min <- rowMins(replaceNA_zero_MVI, na.rm = TRUE) / 2 + replaceNA_zero_MVI <- replace(replaceNA_zero_MVI, + is.na(replaceNA_zero_MVI), + half_min[row(replaceNA_zero_MVI)[is.na(replaceNA_zero_MVI)]]) + + ## add the samples in the original dataframe + filtered_matrix <- replaceNA_zero_MVI + } else { ## EDIT: why is this only done for CoRe = TRUE? + filtered_matrix <- assay(se) + } + + ## update the SummarizedObject + se <- se[rownames(filtered_matrix), ] + assay(se) <- filtered_matrix + + ## assemble the object to return + l_imputed <- list( + "se" = se, + "assay" = filtered_matrix) + + ## return + invisible(list("data" = l_imputed)) } @@ -860,111 +1089,171 @@ MVImputation <-function(InputData, #' @return List with two elements: DF (including output table) and Plot (including all plots generated) #' #' @examples +#' ## load data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- TICNorm(InputData=Intra[-c(49:58), -c(1:3)]%>% dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)), -#' SettingsFile_Sample=Intra[-c(49:58), c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions")) +#' +#' ## create SummarizedExperiment +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58), c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' TICNorm(se = se, SettingsInfo = c(Conditions = "Conditions")) #' #' @keywords total ion count normalisation #' -#' @importFrom magrittr %>% %<>% #' @importFrom tidyr pivot_longer #' @importFrom gridExtra grid.arrange -#' @importFrom ggplot2 ggplot geom_boxplot geom_hline labs theme_classic theme_minimal theme annotation_custom aes_string +#' @importFrom ggplot2 ggplot sym geom_boxplot geom_hline labs theme_classic theme_minimal theme annotation_custom aes_string #' @importFrom logger log_info log_trace #' #' @noRd #' -TICNorm <-function(InputData, - SettingsFile_Sample, - SettingsInfo, - TIC=TRUE){ - ## ------------------ Prepare the data ------------------- ## - NA_removed_matrix <- InputData - NA_removed_matrix[is.na(NA_removed_matrix)] <- 0#replace NA with 0 - - ## ------------------ QC plot ------------------- ## - ### Before TIC Normalization - #### Log() transformation: - log_NA_removed_matrix <- suppressWarnings(log(NA_removed_matrix) %>% t() %>% as.data.frame()) # log tranforms the data - nan_count <- sum(is.nan(as.matrix(log_NA_removed_matrix)))# Count NaN values (produced by log(0)) - if (nan_count > 0) {# Issue a custom warning if NaNs are present - message <- paste("For the RLA plot before/after TIC normalisation we have to perform log() transformation. This resulted in", nan_count, "NaN values due to 0s in the data.") - logger::log_trace("Warning: ", message, sep="") - warning(message) - } - - medians <- apply(log_NA_removed_matrix, 2, median) # get median - RLA_data_raw <- log_NA_removed_matrix - medians # Subtract the medians from each column - RLA_data_long <- tidyr::pivot_longer(RLA_data_raw, cols = everything(), names_to = "Group") - names(RLA_data_long)<- c("Samples", "Intensity") - RLA_data_long <- as.data.frame(RLA_data_long) - for (row in 1:nrow(RLA_data_long)){ # add conditions - RLA_data_long[row, SettingsInfo[["Conditions"]]] <- SettingsFile_Sample[rownames(SettingsFile_Sample) %in%RLA_data_long[row,1],SettingsInfo[["Conditions"]]] - } - - # Create the ggplot boxplot - RLA_data_raw <- ggplot2::ggplot(RLA_data_long, ggplot2::aes_string(x = "Samples", y = "Intensity", color = SettingsInfo[["Conditions"]])) + - ggplot2::geom_boxplot() + - ggplot2::geom_hline(yintercept = 0, color = "red", linetype = "solid") + - ggplot2::labs(title = "Before TIC Normalization")+ - ggplot2::theme_classic()+ - ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1))+ - ggplot2::theme(legend.position = "none") - - #RLA_data_raw_Sized <- plotGrob_Processing(InputPlot = RLA_data_raw, PlotName= "Before TIC Normalization", PlotType= "RLA") - - if(TIC==TRUE){ - ## ------------------ Perform TIC ------------------- ## - message <- paste0("Total Ion Count (TIC) normalization: Total Ion Count (TIC) normalization is used to reduce the variation from non-biological sources, while maintaining the biological variation. REF: Wulff et. al., (2018), Advances in Bioscience and Biotechnology, 9, 339-351, doi:https://doi.org/10.4236/abb.2018.98022") - logger::log_info(message) - message(message) - - RowSums <- rowSums(NA_removed_matrix) - Median_RowSums <- median(RowSums) #This will built the median - Data_TIC_Pre <- apply(NA_removed_matrix, 2, function(i) i/RowSums) #This is dividing the ion intensity by the total ion count - Data_TIC <- Data_TIC_Pre*Median_RowSums #Multiplies with the median metabolite intensity - Data_TIC <- as.data.frame(Data_TIC) +TICNorm <- function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo, + TIC = TRUE) { + + ## ------------------ Prepare the data ------------------- ## + NA_removed <- assay(se) + + ## replace NA with 0 + NA_removed[is.na(NA_removed)] <- 0 ## ------------------ QC plot ------------------- ## - ### After TIC normalization - log_Data_TIC <- suppressWarnings(log(Data_TIC) %>% t() %>% as.data.frame()) # log tranforms the data - medians <- apply(log_Data_TIC, 2, median) - RLA_data_norm <- log_Data_TIC - medians # Subtract the medians from each column - RLA_data_long <- tidyr::pivot_longer(RLA_data_norm, cols = everything(), names_to = "Group") - names(RLA_data_long)<- c("Samples", "Intensity") - for (row in 1:nrow(RLA_data_long)){ # add conditions - RLA_data_long[row, SettingsInfo[["Conditions"]]] <- SettingsFile_Sample[rownames(SettingsFile_Sample) %in%RLA_data_long[row,1],SettingsInfo[["Conditions"]]] + ## before TIC Normalization + ## log() transformation: + log_NA_removed <- suppressWarnings( + ## log tranform the data + log(NA_removed)) + + ## count NaN values (produced by log(0)) + nan_count <- sum(is.nan(as.matrix(log_NA_removed))) + if (nan_count > 0) { + ## issue a custom warning if NaNs are present + message <- paste("For the RLA plot before/after TIC normalisation we have to perform log() transformation. This resulted in", + nan_count, + "NaN values due to 0s in the data.") + logger::log_trace("Warning: ", message, sep="") + warning(message) } - # Create the ggplot boxplot - RLA_data_norm <- ggplot2::ggplot(RLA_data_long, ggplot2::aes_string(x = "Samples", y = "Intensity", color = SettingsInfo[["Conditions"]])) + - ggplot2::geom_boxplot() + - ggplot2::geom_hline(yintercept = 0, color = "red", linetype = "solid") + - ggplot2::labs(title = "After TIC Normalization")+ - ggplot2::theme_classic() + - ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1))+ - ggplot2::theme(legend.position = "none") - - #RLA_data_norm_Sized <- plotGrob_Processing(InputPlot = RLA_data_norm, PlotName= "After TIC Normalization", PlotType= "RLA") - - #Combine Plots - dev.new() - norm_plots <- suppressWarnings(gridExtra::grid.arrange(RLA_data_raw+ ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1))+ ggplot2::theme(legend.position = "none"), - RLA_data_norm+ ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1))+ ggplot2::theme(legend.position = "none"), - ncol = 2)) - dev.off() - norm_plots <- ggplot2::ggplot() +ggplot2::theme_minimal()+ ggplot2::annotation_custom(norm_plots) - + ## get median + median_tic <- apply(log_NA_removed, 2, median) + + ## Subtract the medians from each column + data_raw <- log_NA_removed - median_tic + data_long <- tidyr::pivot_longer(as.data.frame(data_raw), + cols = everything(), names_to = "Samples", values_to = "Intensity") + + ## add Conditions from colData + data_long <- merge(data_long, colData(se), + by.x = "Samples", by.y = "row.names") + + ## create the ggplot boxplot + gg_data_raw <- ggplot2::ggplot(data_long, + ggplot2::aes(x = !!sym("Samples"), y = !!sym("Intensity"), + color = !!sym(SettingsInfo[["Conditions"]]))) + + ggplot2::geom_boxplot() + + ggplot2::geom_hline(yintercept = 0, color = "red", linetype = "solid") + + ggplot2::labs(title = "Before TIC Normalization") + + ggplot2::theme_classic() + + ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1)) + + ggplot2::theme(legend.position = "none") + + if (TIC) { + + ## ------------------ Perform TIC normalization ------------------- ## + message <- paste0("Total Ion Count (TIC) normalization: Total Ion ", + "Count (TIC) normalization is used to reduce the variation from ", + "non-biological sources, while maintaining the biological ", + "variation. REF: Wulff et. al., (2018), Advances in Bioscience ", + "and Biotechnology, 9, 339-351, ", + "doi:https://doi.org/10.4236/abb.2018.98022") + logger::log_info(message) + message(message) - ## ------------------ Return ------------------ ## - Output_list <- list("DF" = list("Data_TIC"=as.data.frame(Data_TIC)),"Plot"=list( "norm_plots"=norm_plots, "RLA_AfterTICNorm"=RLA_data_norm, "RLA_BeforeTICNorm" = RLA_data_raw )) - invisible(return(Output_list)) - }else{ - ## ------------------ Return ------------------ ## - Output_list <- list("Plot"=list("RLA_BeforeTICNorm" = RLA_data_raw)) - invisible(return(Output_list)) - } + tic <- colSums(NA_removed) + + ## built the median + median_tic <- median(tic) + + ## divide the ion intensity by the total ion count and multiply with + ## the median intensity + tic_norm <- sweep(NA_removed, 2, STATS = tic, FUN = "/") * median_tic ## EDIT: is this what should be done? + + ## ------------------ QC plot ------------------- ## + ### After TIC normalization + log_tic_norm <- suppressWarnings( + ## log tranforms the data + log(tic_norm)) + median_tic_norm <- apply(log_tic_norm, 2, median) + + ## Subtract the medians from each column + data_norm <- sweep(log_tic_norm, 2, STATS = median_tic_norm, FUN = "-") + data_long <- tidyr::pivot_longer(as.data.frame(data_norm), + cols = everything(), names_to = "Samples", values_to = "Intensity") + + ## add Conditons from colData + data_long <- merge(data_long, + colData(se), by.x = "Samples", by.y = "row.names") + + ## Create the ggplot boxplot + gg_data_norm <- ggplot2::ggplot(data_long, + ggplot2::aes(x = !!sym("Samples"), y = !!sym("Intensity"), + color = !!sym(SettingsInfo[["Conditions"]]))) + + ggplot2::geom_boxplot() + + ggplot2::geom_hline(yintercept = 0, color = "red", linetype = "solid") + + ggplot2::labs(title = "After TIC Normalization") + + ggplot2::theme_classic() + + ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1)) + + ggplot2::theme(legend.position = "none") + + ## RLA_data_norm_Sized <- plotGrob_Processing(InputPlot = RLA_data_norm, PlotName= "After TIC Normalization", PlotType= "RLA") + + ## combine Plots + dev.new() ## EDIT: is this needed? + plots_combined <- suppressWarnings(gridExtra::grid.arrange( + gg_data_raw + + ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1)) + + ggplot2::theme(legend.position = "none"), + gg_data_norm + + ggplot2::theme(axis.text.x = element_text(angle = 90, hjust = 1)) + + ggplot2::theme(legend.position = "none"), ncol = 2)) + dev.off() + plots_combined <- ggplot2::ggplot() + + ggplot2::theme_minimal() + + ggplot2::annotation_custom(plots_combined) + + ## update the SummarizedExperiment object + assay(se) <- tic_norm + + ## create the object to return + l_normalized <- list( + "data" = list( + "se" = se, + "assay" = assay(se) + ), + "plot" = list( + "beforeTicNormalization" = gg_data_raw, + "afterTicNormalization" = gg_data_norm, + "combined" = plots_combined + )) + + } else { + ## create the object to return + l_normalized <- list( + "data" = list( + "se" = se, + "assay" = assay(se) ## EDIT: correct? this is just a pass through + ), + "plot" = list( + "beforeTicNormalization" = gg_data_raw)) + } + + ## return + invisible(l_normalized) } ################################################################################################ @@ -980,10 +1269,20 @@ TICNorm <-function(InputData, #' @return List with two elements: DF (including output table) and Plot (including all plots generated) #' #' @examples -#' Media <- ToyData("CultureMedia_Raw")%>% subset(!Conditions=="Pool")%>% dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)) -#' Res <- CoReNorm(InputData= Media[, -c(1:3)], -#' SettingsFile_Sample= Media[, c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank")) +#' ## load the data +#' Media <- ToyData("CultureMedia_Raw") %>% +#' subset(!Conditions=="Pool") +#' +#' ## create the SummarizedExperiment +#' a <- t(Media[, -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Media[, c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' Res <- CoReNorm(se = se, +#' SettingsInfo = c(Conditions = "Conditions", +#' CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank")) #' #' @keywords Consumption Release Metaqbolomics, Normalisation, Exometabolomics #' @@ -998,242 +1297,338 @@ TICNorm <-function(InputData, #' @noRd #' #' -CoReNorm <-function(InputData, - SettingsFile_Sample, - SettingsInfo){ - ## ------------------ Prepare the data ------------------- ## - Data_TIC <- InputData - Data_TIC[is.na(Data_TIC)] <- 0 - - ## ------------------ Perform QC ------------------- ## - Conditions <- SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - CoRe_medias <- Data_TIC[grep(SettingsInfo[["CoRe_media"]], Conditions),] - - if(dim(CoRe_medias)[1]==1){ - message <- paste0("Only 1 CoRe_media sample was found. Thus, the consistency of the CoRe_media samples cannot be checked. It is assumed that the CoRe_media samples are already summed.") - logger::log_trace(paste("Warning: ", message, sep="")) - warning(message) - - CoRe_media_df <- CoRe_medias %>% t() %>% as.data.frame() - colnames(CoRe_medias) <- "CoRe_mediaMeans" - }else{ - ###################################################################################### - ## ------------------ QC Plots - PlotList <- list() - ##-- 1. PCA Media_control - media_pca_data <- merge(x= SettingsFile_Sample %>% dplyr::select(SettingsInfo[["Conditions"]]), y= Data_TIC, by=0) %>% - tibble::column_to_rownames("Row.names") %>% - dplyr::mutate(Sample_type = dplyr::case_when(Conditions == SettingsInfo[["CoRe_media"]] ~ "CoRe_media", - TRUE ~ "Sample")) - - media_pca_data[is.na( media_pca_data)] <- 0 - - dev.new() - pca_QC_media <-invisible(VizPCA(InputData=media_pca_data %>%dplyr::select(-SettingsInfo[["Conditions"]], -Sample_type), - SettingsInfo= c(color="Sample_type"), - SettingsFile_Sample= media_pca_data, - PlotName = "QC Media_samples", - SaveAs_Plot = NULL)) - dev.off() - - PlotList[["PCA_CoReMediaSamples"]] <- pca_QC_media[["Plot_Sized"]][["QC Media_samples"]] - - ##-- 2. Metabolite Variance Histogram - # Coefficient of Variation - result_df <- apply(CoRe_medias, 2, function(x) { (sd(x, na.rm =T)/ mean(x, na.rm =T))*100 } ) %>% t()%>% as.data.frame() - result_df[1, is.na(result_df[1,])]<- 0 - rownames(result_df)[1] <- "CV" - - CutoffCV <- 30 - result_df <- result_df %>% t()%>%as.data.frame() %>% dplyr::rowwise() %>% - dplyr::mutate(HighVar = CV > CutoffCV) %>% as.data.frame() - rownames(result_df)<- colnames(CoRe_medias) - - # calculate the NAs - NAvector <- apply(CoRe_medias, 2, function(x) { (sum(is.na(x))/length(x))*100 }) - result_df$MissingValuePercentage <- NAvector - - cv_result_df <- result_df +CoReNorm <-function( + se, + #InputData, + #SettingsFile_Sample, + SettingsInfo) { + + ## ------------------ Prepare the data ------------------- ## + Data_TIC <- assay(se) + Data_TIC[is.na(Data_TIC)] <- 0 + + ## ------------------ Perform QC ------------------- ## + Conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] + CoRe_medias <- Data_TIC[, grep(SettingsInfo[["CoRe_media"]], Conditions)] + + if (ncol(CoRe_medias) == 1) { + message <- paste0("Only 1 CoRe_media sample was found. Thus, the ", + "consistency of the CoRe_media samples cannot be checked. It is ", + "assumed that the CoRe_media samples are already summed.") + logger::log_trace(paste0("Warning: ", message)) + warning(message) - HighVar_metabs <- sum(result_df$HighVar == TRUE) - if(HighVar_metabs>0){ - message <- paste0(HighVar_metabs, " of variables have high variability (CV > 30) in the CoRe_media control samples. Consider checking the pooled samples to decide whether to remove these metabolites or not.") - logger::log_info(message) - message(message) - } + CoRe_media_df <- CoRe_medias + colnames(CoRe_medias) <- "CoRe_mediaMeans" + + } else { + ######################################################################## + ## ------------------ QC Plots + PlotList <- list() + + ##-- 1. PCA Media_control + media_pca_data <- merge( + x = colData(se)[, SettingsInfo[["Conditions"]], drop = FALSE], + y = t(Data_TIC), by = "row.names") %>% + tibble::column_to_rownames("Row.names") %>% + dplyr::mutate(Sample_type = dplyr::case_when( + Conditions == SettingsInfo[["CoRe_media"]] ~ "CoRe_media", + TRUE ~ "Sample")) + + ##media_pca_data[is.na(media_pca_data)] <- 0 ## EDIT: this is not needed when we have done it above + se_tmp <- se + assay(se_tmp) <- media_pca_data[, rownames(se)] |> + t() + se_tmp@colData <- media_pca_data[, !colnames(media_pca_data) %in% rownames(se)] |> + DataFrame() + + dev.new() + pca_QC_media <- invisible( + VizPCA(se = se_tmp, #InputData = dplyr::select(media_pca_data, -SettingsInfo[["Conditions"]], -Sample_type), ## EDIT: why not just use t(Data_TIC)? + SettingsInfo = c(color = "Sample_type"), + #SettingsFile_Sample = media_pca_data, + PlotName = "QC Media_samples", + SaveAs_Plot = NULL)) + dev.off() + + PlotList[["PCA_CoReMediaSamples"]] <- pca_QC_media[["Plot_Sized"]][["QC Media_samples"]] + + ##-- 2. Metabolite Variance Histogram + ## Coefficient of Variation + result_df <- apply(CoRe_medias, MARGIN = 1, ## EDIT: should this be on samples (MARGIN = 2) or metabolites (MARGIN = 1) + function(x) sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE) * 100) %>% ## EDIT: I would write here a function to calculate CVs + test it + t() %>% + as.data.frame() + result_df[1, is.na(result_df[1, ])] <- 0 + rownames(result_df)[1] <- "CV" - #Make histogram of CVs - HistCV <- invisible(ggplot2::ggplot(cv_result_df, aes(CV)) + - ggplot2::geom_histogram(aes(y=after_stat(density)), color="black", fill="white")+ - ggplot2::geom_vline(aes(xintercept=CutoffCV), - color="darkred", linetype="dashed", linewidth=1)+ - ggplot2::geom_density(alpha=.2, fill="#FF6666") + - ggplot2::labs(title="CV for metabolites of control media samples (no cells)",x="Coefficient of variation (CV)", y = "Frequency")+ - ggplot2::theme_classic()) - - HistCV_Sized <- plotGrob_Processing(InputPlot = HistCV, PlotName= "CV for metabolites of control media samples (no cells)", PlotType= "Hist") - - PlotList[["Histogram_CoReMediaCV"]] <- HistCV_Sized - - #Make Violin of CVs - Plot_cv_result_df <- cv_result_df %>% - dplyr::mutate(HighVar = ifelse(HighVar == TRUE, "> CV 30", "< CV 30")) - - ViolinCV <- invisible(ggplot2::ggplot(Plot_cv_result_df, aes(y=CV, x=HighVar, label=row.names(cv_result_df)))+ - ggplot2::geom_violin(alpha = 0.5 , fill="#FF6666")+ - ggplot2::geom_dotplot(binaxis = "y", stackdir = "center", dotsize = 0.5) + - ggrepel::geom_text_repel(aes(label = ifelse(Plot_cv_result_df$CV > CutoffCV, - as.character(row.names(Plot_cv_result_df)), '')), - hjust = 0, vjust = 0, - box.padding = 0.5, # space between text and point - point.padding = 0.5, # space around points - max.overlaps = Inf) + # allow for many labels - ggplot2::labs(title="CV for metabolites of control media samples (no cells)",x="Metabolites", y = "Coefficient of variation (CV)")+ - ggplot2::theme_classic()) - - ViolinCV_Sized <- plotGrob_Processing(InputPlot = ViolinCV, PlotName= "CV for metabolites of control media samples (no cells)", PlotType= "Violin") - PlotList[["CoRe_Media_CV_Violin"]] <- ViolinCV_Sized - - ###################################################################################### - ## ------------------ Outlier testing - if(dim(CoRe_medias)[1]>=3){ - Outlier_data <- CoRe_medias - Outlier_data <- Outlier_data %>% dplyr::mutate_all(.funs = ~ FALSE) - - while(HighVar_metabs>0){ - #remove the furthest value from the mean - if(HighVar_metabs>1){ - max_var_pos <- CoRe_medias[,result_df$HighVar == TRUE] %>% - as.data.frame() %>% - dplyr::mutate_all(.funs = ~ . - mean(., na.rm = TRUE)) %>% - dplyr::summarise_all(.funs = ~ which.max(abs(.))) - }else{ - max_var_pos <- CoRe_medias[,result_df$HighVar == TRUE] %>% - as.data.frame() %>% - dplyr::mutate_all(.funs = ~ . - mean(., na.rm = TRUE)) %>% - dplyr::summarise_all(.funs = ~ which.max(abs(.))) - colnames(max_var_pos)<- colnames(CoRe_medias)[result_df$HighVar == TRUE] + CutoffCV <- 30 + result_df <- result_df %>% + t() %>% + as.data.frame() %>% + dplyr::rowwise() %>% + dplyr::mutate(HighVar = CV > CutoffCV) %>% + as.data.frame() + rownames(result_df)<- rownames(CoRe_medias) ## adjust to colnames if for samples + + ## calculate the NAs + NAvector <- apply(CoRe_medias, 1, + function(x) sum(is.na(x)) / length(x) * 100) ## EDIT: I would write here a function to calculate #NAs + test it + result_df$MissingValuePercentage <- NAvector + + cv_result_df <- result_df + + HighVar_metabs <- sum(result_df$HighVar) + if (HighVar_metabs > 0) { + message <- paste0(HighVar_metabs, + " of variables have high variability (CV > 30) in the CoRe_media control samples. Consider checking the pooled samples to decide whether to remove these metabolites or not.") + logger::log_info(message) + message(message) } - # Remove rows based on positions - for(i in 1:length(max_var_pos)){ - CoRe_medias[max_var_pos[[i]],names(max_var_pos)[i]] <- NA - Outlier_data[max_var_pos[[i]],names(max_var_pos)[i]] <- TRUE + ## Make histogram of CVs + HistCV <- invisible( + ggplot2::ggplot(cv_result_df, aes(CV)) + + ggplot2::geom_histogram(aes(y = after_stat(density)), + color = "black", fill = "white") + + ggplot2::geom_vline(aes(xintercept = CutoffCV), + color = "darkred", linetype = "dashed", linewidth = 1) + + ggplot2::geom_density(alpha = .2, fill = "#FF6666") + + ggplot2::labs( + title = "CV for metabolites of control media samples (no cells)", + x = "Coefficient of variation (CV)", y = "Frequency") + + ggplot2::theme_classic()) + + HistCV_Sized <- plotGrob_Processing( + InputPlot = HistCV, + PlotName = "CV for metabolites of control media samples (no cells)", + PlotType = "Hist") + + PlotList[["Histogram_CoReMediaCV"]] <- HistCV_Sized + + ## Make Violin of CVs + Plot_cv_result_df <- cv_result_df %>% + dplyr::mutate(HighVar = ifelse(HighVar, "> CV 30", "< CV 30")) + + ViolinCV <- invisible( + ggplot2::ggplot(Plot_cv_result_df, + aes(y=CV, x = HighVar, label = row.names(cv_result_df))) + + ggplot2::geom_violin(alpha = 0.5 , fill = "#FF6666")+ + ggplot2::geom_dotplot(binaxis = "y", stackdir = "center", + dotsize = 0.5) + + ggrepel::geom_text_repel( + aes(label = ifelse(Plot_cv_result_df$CV > CutoffCV, + as.character(row.names(Plot_cv_result_df)), "")), + hjust = 0, vjust = 0, + ## space between text and point + box.padding = 0.5, + ## space around points + point.padding = 0.5, + ## allow for many labels + max.overlaps = Inf) + + ggplot2::labs( + title = "CV for metabolites of control media samples (no cells)", + x = "Metabolites", y = "Coefficient of variation (CV)") + + ggplot2::theme_classic()) + + ViolinCV_Sized <- plotGrob_Processing( + InputPlot = ViolinCV, + PlotName = "CV for metabolites of control media samples (no cells)", + PlotType = "Violin") + PlotList[["CoRe_Media_CV_Violin"]] <- ViolinCV_Sized + + ######################################################################## + ## ------------------ Outlier testing + if (ncol(CoRe_medias) >= 3) { + Outlier_data <- CoRe_medias + Outlier_data <- Outlier_data %>% + as.data.frame() |> + dplyr::mutate_all(.funs = ~ FALSE) + + while(HighVar_metabs > 0) { + ## remove the furthest value from the mean + if (HighVar_metabs > 1) { + max_var_pos <- CoRe_medias[result_df$HighVar, ] %>% + t() |> + as.data.frame() %>% + dplyr::mutate_all(.funs = ~ . - mean(., na.rm = TRUE)) %>% + dplyr::summarise_all(.funs = ~ which.max(abs(.))) + } else { + max_var_pos <- CoRe_medias[result_df$HighVar] %>% + t() |> + as.data.frame() %>% + dplyr::mutate_all(.funs = ~ . - mean(., na.rm = TRUE)) %>% + dplyr::summarise_all(.funs = ~ which.max(abs(.))) + colnames(max_var_pos)<- rownames(CoRe_medias)[result_df$HighVar] ## EDIT: is this the only difference? Then you can wrap "colnames(max_var_pos) <- ..." in the if/else and everything before the if/else + } + + ## Remove rows based on positions + for (i in seq_along(max_var_pos)) { + CoRe_medias[names(max_var_pos)[i], max_var_pos[[i]]] <- NA + Outlier_data[names(max_var_pos)[i], max_var_pos[[i]]] <- TRUE + } + + ## recalculate coefficient of variation for each column in the + ## filtered data + result_df <- apply(CoRe_medias, MARGIN = 1, + function(x) sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)) %>% ## EDIT: use here a function instead (see above) + t() %>% + as.data.frame() + result_df[1, is.na(result_df[1, ])] <- 0 + rownames(result_df)[1] <- "CV" + + result_df <- result_df %>% + t() %>% + as.data.frame() %>% + dplyr::rowwise() %>% + dplyr::mutate(HighVar = CV > CutoffCV) %>% + as.data.frame() + rownames(result_df)<- rownames(CoRe_medias) + + HighVar_metabs <- sum(result_df$HighVar) + } + + data_cont <- Outlier_data %>% + #t() %>% + as.data.frame() + + ## list to store results + fisher_test_results <- list() + large_contingency_table <- matrix(0, nrow = 2, + ncol = ncol(data_cont)) + + for (i in seq_along(colnames(data_cont))) { + sample <- colnames(data_cont)[i] + current_sample <- data_cont[, sample] + + contingency_table <- matrix(0, nrow = 2, ncol = 2) + contingency_table[1, 1] <- sum(current_sample) + contingency_table[2, 1] <- sum(!current_sample) + contingency_table[1, 2] <- sum(rowSums(data_cont) - current_sample) + contingency_table[2, 2] <- nrow(dplyr::select(data_cont, !all_of(sample))) * + ncol(dplyr::select(data_cont, !all_of(sample))) - + sum(rowSums(data_cont) - current_sample) + + ## Fisher's exact test + fisher_test_result <- fisher.test(contingency_table) + fisher_test_results[[sample]] <- fisher_test_result + + ## calculate the sum of "TRUE" and "FALSE" for the current sample + ## sum of "TRUE" + large_contingency_table[1, i] <- sum(current_sample) + ## Sum of "FALSE" + large_contingency_table[2, i] <- sum(!current_sample) + } + + ## convert the matrix into a data_contframe for better readability + contingency_data_contframe <- as.data.frame(large_contingency_table) + colnames(contingency_data_contframe) <- colnames(data_cont) + rownames(contingency_data_contframe) <- c("HighVar", "Low_var") + + contingency_data_contframe <- contingency_data_contframe %>% + dplyr::mutate(Total = rowSums(contingency_data_contframe)) + contingency_data_contframe <- rbind(contingency_data_contframe, + Total = colSums(contingency_data_contframe)) + + different_samples <- c() + for (sample in colnames(data_cont)) { + p_value <- fisher_test_results[[sample]]$p.value + if (p_value < 0.05) { + ## adjust the significance level as needed + different_samples <- c(different_samples, sample) ## EDIT: where is the adjustment taking place? + } + } + + if (!is.null(different_samples)) { + message <- paste("The CoRe_media samples ", + paste(different_samples, collapse = ", "), + " were found to be different from the rest. They will not be included in the sum of the CoRe_media samples.") + logger::log_trace("Warning: " , message, sep = "") + warning(message) + } + + ## filter the CoRe_media samples + CoRe_medias <- CoRe_medias %>% + as.data.frame() |> + dplyr::select(-all_of(different_samples)) + } else { + message <- paste0( + "Only >=2 blank samples available. Thus,we can not perform outlier testing for the blank samples.") + logger::log_trace(message) + message(message) } + CoRe_media_df <- as.data.frame( ## EDIT: why convert a data.frame to a data.frame? Can the as.data.frame be removed? + data.frame("CoRe_mediaMeans" = rowMeans(CoRe_medias, na.rm = TRUE))) + } - # ReCalculate coefficient of variation for each column in the filtered data - result_df <- apply(CoRe_medias, 2, function(x) { sd(x, na.rm =T)/ mean(x, na.rm =T) } ) %>% t()%>% as.data.frame() - result_df[1, is.na(result_df[1,])]<- 0 - rownames(result_df)[1] <- "CV" - - result_df <- result_df %>% t()%>%as.data.frame() %>% dplyr::rowwise() %>% - dplyr::mutate(HighVar = CV > CutoffCV) %>% as.data.frame() - rownames(result_df)<- colnames(CoRe_medias) - - HighVar_metabs <- sum(result_df$HighVar == TRUE) - } - - data_cont <- Outlier_data %>% t() %>% as.data.frame() - - # List to store results - fisher_test_results <- list() - large_contingency_table <- matrix(0, nrow = 2, ncol = ncol(data_cont)) - - for (i in 1:length(colnames(data_cont))) { - sample = colnames(data_cont)[i] - current_sample <- data_cont[, sample] - - contingency_table <- matrix(0, nrow = 2, ncol = 2) - contingency_table[1, 1] <- sum(current_sample) - contingency_table[2, 1] <- sum(!current_sample) - contingency_table[1, 2] <- sum(rowSums(data_cont) - current_sample) - contingency_table[2, 2] <- dim(data_cont %>% dplyr::select(!all_of(sample)))[1]*dim(data_cont %>% dplyr::select(!all_of(sample)))[2] -sum( rowSums(data_cont) - current_sample) - - # Fisher's exact test - fisher_test_result <- fisher.test(contingency_table) - fisher_test_results[[sample]] <- fisher_test_result - - # Calculate the sum of "TRUE" and "FALSE" for the current sample - large_contingency_table[1, i] <- sum(current_sample) # Sum of "TRUE" - large_contingency_table[2, i] <- sum(!current_sample) # Sum of "FALSE" - } - - # Convert the matrix into a data_contframe for better readability - contingency_data_contframe <- as.data.frame(large_contingency_table) - colnames(contingency_data_contframe) <- colnames(data_cont) - rownames(contingency_data_contframe) <- c("HighVar", "Low_var") - - contingency_data_contframe <- contingency_data_contframe %>% dplyr::mutate(Total = rowSums(contingency_data_contframe)) - contingency_data_contframe <- rbind(contingency_data_contframe, Total= colSums(contingency_data_contframe)) - - different_samples <- c() - for (sample in colnames(data_cont)) { - p_value <- fisher_test_results[[sample]]$p.value - if (p_value < 0.05) { # Adjust the significance level as needed - different_samples <- c(different_samples, sample) - } - } + cv_result_df <- tibble::rownames_to_column(cv_result_df, "Metabolite") - if(is.null(different_samples)==FALSE){ - message <- paste("The CoRe_media samples ", paste(different_samples, collapse = ", "), " were found to be different from the rest. They will not be included in the sum of the CoRe_media samples.") - logger::log_trace("Warning: " , message, sep="") - warning(message) - } - # Filter the CoRe_media samples - CoRe_medias <- CoRe_medias %>% dplyr::filter(!rownames(CoRe_medias) %in% different_samples) - }else{ - message <- paste0("Only >=2 blank samples available. Thus,we can not perform outlier testing for the blank samples.") - logger::log_trace(message) - message(message) + ############################################################################ + ##------------------------ Substract mean (media control) from samples + message <- paste0("CoRe data are normalised by substracting mean ", + "(blank) from each sample and multiplying with the CoRe_norm_factor") + logger::log_info(message) + message(message) + ##-- Check CoRe_norm_factor + if ("CoRe_norm_factor" %in% names(SettingsInfo)) { + CoRe_norm_factor <- colData(se) %>% + as.data.frame() |> + dplyr::filter(!!as.name(SettingsInfo[["Conditions"]]) != SettingsInfo[["CoRe_media"]]) %>% + dplyr::select(SettingsInfo[["CoRe_norm_factor"]]) %>% + dplyr::pull() + + if (var(CoRe_norm_factor) == 0) { + message <- paste("The growth rate or growth factor for normalising the CoRe result, is the same for all samples") + logger::log_trace("Warning: " , message) + warning(message) + } + } else { + CoRe_norm_factor <- rep(1, + sum(colData(se)[, SettingsInfo[["Conditions"]]] != SettingsInfo[["CoRe_media"]])) } - CoRe_media_df <- as.data.frame(data.frame("CoRe_mediaMeans"= colMeans(CoRe_medias, na.rm = TRUE))) - } - - cv_result_df <- tibble::rownames_to_column(cv_result_df, "Metabolite") - - ###################################################################################### - ##------------------------ Substract mean (media control) from samples - message <- paste("CoRe data are normalised by substracting mean (blank) from each sample and multiplying with the CoRe_norm_factor") - logger::log_info(message) - message(message) - - ##-- Check CoRe_norm_factor - if(("CoRe_norm_factor" %in% names(SettingsInfo))){ - CoRe_norm_factor <- SettingsFile_Sample %>% dplyr::filter(!!as.name(SettingsInfo[["Conditions"]])!=SettingsInfo[["CoRe_media"]]) %>% dplyr::select(SettingsInfo[["CoRe_norm_factor"]]) %>%dplyr::pull() - if(var(CoRe_norm_factor) == 0){ - message <- paste("The growth rate or growth factor for normalising the CoRe result, is the same for all samples") - logger::log_trace("Warning: " , message, sep="") - warning(message) + + ## remove CoRe_media samples from the data + Data_TIC <- merge(colData(se), t(Data_TIC), by = "row.names") %>% + dplyr::filter(!!as.name(SettingsInfo[["Conditions"]]) != SettingsInfo[["CoRe_media"]]) %>% + tibble::column_to_rownames("Row.names") %>% + dplyr::select(-c(seq_len(ncol(colData(se))))) + + ## subtract from each sample the CoRe_media mean + Data_TIC_CoReNorm_Media <- t( + apply(t(Data_TIC), 2, function(i) i - CoRe_media_df$CoRe_mediaMeans)) ## EDIT: is this correct? + Data_TIC_CoReNorm <- t( + apply(Data_TIC_CoReNorm_Media, 2, function(i) i * CoRe_norm_factor)) ## EDIT: is this correct? + + ## remove CoRe_media samples from the data + # Input_SettingsFile <- Input_SettingsFile[Input_SettingsFile$Conditions!="CoRe_media",] + # Conditions <- Conditions[!Conditions=="CoRe_media"] + + ## update the SummarizedExperiment object + se <- se[, colnames(Data_TIC_CoReNorm)] + assay(se) <- Data_TIC_CoReNorm + + ############################################################################ + ##------------------------ Return Plots and Data + if (nrow(CoRe_medias) >= 3) { + l_corenorm <- list( + "data" = list( + "CV_CoRe_blank" = cv_result_df, + "Contigency_table_CoRe_blank" = contingency_data_contframe, + "se" = se + ), + "plot" = PlotList) + } else { + l_corenorm <- list( + "data" = list( + "CV_CoRe_blank" = cv_result_df, + "se" = se + ), + "plot" = PlotList) ## EDIT: define this list before and update with "Contigency_table_CoRe_blank" if TRUE } - }else{ - CoRe_norm_factor <- as.numeric(rep(1,dim(SettingsFile_Sample %>% dplyr::filter(!!as.name(SettingsInfo[["Conditions"]])!=SettingsInfo[["CoRe_media"]]))[1])) - } - - # Remove CoRe_media samples from the data - Data_TIC <- merge(SettingsFile_Sample, Data_TIC, by="row.names")%>% - dplyr::filter(!!as.name(SettingsInfo[["Conditions"]])!=SettingsInfo[["CoRe_media"]])%>% - tibble::column_to_rownames("Row.names")%>% - dplyr::select(-1:-ncol(SettingsFile_Sample)) - - Data_TIC_CoReNorm_Media <- as.data.frame(t( apply(t(Data_TIC),2, function(i) i-CoRe_media_df$CoRe_mediaMeans))) #Subtract from each sample the CoRe_media mean - Data_TIC_CoReNorm <- as.data.frame(apply(Data_TIC_CoReNorm_Media, 2, function(i) i*CoRe_norm_factor)) - - #Remove CoRe_media samples from the data - #Input_SettingsFile <- Input_SettingsFile[Input_SettingsFile$Conditions!="CoRe_media",] - #Conditions <- Conditions[!Conditions=="CoRe_media"] - - ###################################################################################### - ##------------------------ Return Plots and Data - if(dim(CoRe_medias)[1]>=3){ - DF_list <- list("CV_CoRe_blank" = cv_result_df, "Contigency_table_CoRe_blank" = contingency_data_contframe, "Core_Norm" = Data_TIC_CoReNorm) - } else{ - DF_list <- list("CV_CoRe_blank" = cv_result_df, "Core_Norm" = Data_TIC_CoReNorm) - } - - #Return - Output_list <- list("DF"= DF_list,"Plot"=PlotList) - invisible(return(Output_list)) + + ## return + invisible(l_corenorm) } @@ -1241,7 +1636,7 @@ CoReNorm <-function(InputData, ### ### ### PreProcessing helper function: Outlier detection ### ### ### ################################################################################################ -#' OutlierDetection +#' @name OutlierDetection #' #' @param InputData DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected and consider converting any zeros to NA unless they are true zeros. #' @param SettingsFile_Sample DF which contains information about the samples, which will be combined with the input data based on the unique sample identifiers used as rownames. @@ -1252,10 +1647,19 @@ CoReNorm <-function(InputData, #' @return List with two elements: : DF (including output tables) and Plot (including all plots generated) #' #' @examples +#' ## load the data #' Intra <- ToyData("IntraCells_Raw") -#' Res <- OutlierDetection(InputData=Intra[-c(49:58), -c(1:3)]%>% dplyr::mutate_all(~ ifelse(grepl("^0*(\\.0*)?$", as.character(.)), NA, .)), -#' SettingsFile_Sample=Intra[-c(49:58), c(1:3)], -#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates")) +#' +#' ## create SummarizedExperiment object +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' rD <- DataFrame(feature = rownames(a)) +#' cD <- Intra[-c(49:58), c(1:3)] +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' ## apply the function +#' Res <- OutlierDetection(se = se, +#' SettingsInfo = c(Conditions = "Conditions", +#' Biological_Replicates = "Biological_Replicates")) #' #' @keywords Hotellins T2 outlier detection #' @@ -1271,282 +1675,368 @@ CoReNorm <-function(InputData, #' #' @noRd #' -OutlierDetection <-function(InputData, - SettingsFile_Sample, - SettingsInfo, - CoRe=FALSE, - HotellinsConfidence=0.99){ - # Message: - message <- paste("Outlier detection: Identification of outlier samples is performed using Hotellin's T2 test to define sample outliers in a mathematical way (Confidence = 0.99 ~ p.val < 0.01) (REF: Hotelling, H. (1931), Annals of Mathematical Statistics. 2 (3), 360–378, doi:https://doi.org/10.1214/aoms/1177732979). ", - "HotellinsConfidence value selected: ", HotellinsConfidence, sep= "") - logger::log_info(message) - message(message) - - # Load the data: - data_norm <- InputData%>% - dplyr::mutate_all(~ replace(., is.nan(.), 0)) - data_norm[is.na(data_norm)] <- 0 #replace NA with 0 - - if(CoRe==TRUE){ - Conditions <- SettingsFile_Sample[[SettingsInfo[["Conditions"]]]][!SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] - }else{ - Conditions <- SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] - } - - - # Prepare the lists to store the results: - Outlier_filtering_loop = 10 #Here we do 10 rounds of hotelling filtering - sample_outliers <- list() - scree_plot_list <- list() - outlier_plot_list <- list() - metabolite_zero_var_total_list <- list() - zero_var_metab_warning = FALSE - - - ################################################# - ##--------- Perform Outlier testing: - for(loop in 1:Outlier_filtering_loop){ - ##--- Zero variance metabolites - metabolite_var <- as.data.frame(apply(data_norm, 2, var) %>% t()) # calculate each metabolites variance - metabolite_zero_var_list <- list(colnames(metabolite_var)[which(metabolite_var[1,]==0)]) # takes the names of metabolites with zero variance and puts them in list - - if(sum(metabolite_var[1,]==0)==0){ - metabolite_zero_var_total_list[loop] <- 0 - }else if(sum(metabolite_var[1,]==0)>0){ - metabolite_zero_var_total_list[loop] <- metabolite_zero_var_list - zero_var_metab_warning = TRUE # This is used later to print and save the zero variance metabolites if any are found. - } +OutlierDetection <-function(se, ##InputData, + ##SettingsFile_Sample, + SettingsInfo, + CoRe = FALSE, + HotellinsConfidence = 0.99) { + + ## create and log message + message <- paste( + "Outlier detection: Identification of outlier samples is performed ", + "using Hotellin's T2 test to define sample outliers in a mathematical ", + "way (Confidence = 0.99 ~ p.val < 0.01) (REF: Hotelling, H. (1931), ", + "Annals of Mathematical Statistics. 2 (3), 360–378, ", + "doi:https://doi.org/10.1214/aoms/1177732979). ", + "HotellinsConfidence value selected: ", HotellinsConfidence, sep = "") + logger::log_info(message) + message(message) - for(metab in metabolite_zero_var_list){ # Remove the metabolites with zero variance from the data to do PCA - data_norm <- data_norm %>% dplyr::select(-all_of(metab)) + ## load the data + data_norm <- assay(se)# %>% + #dplyr::mutate_all(~ replace(., is.nan(.), 0)) ## EDIT: this is repeated and should be done via a function + + ## replace NA with 0 + data_norm[is.na(data_norm)] <- 0 ## EDIT: what is the difference to the call before? + + if (CoRe) { + Conditions <- colData(se)[[SettingsInfo[["Conditions"]]]][!colData(se)[[SettingsInfo[["Conditions"]]]] == SettingsInfo[["CoRe_media"]]] + } else { + Conditions <- colData(se)[[SettingsInfo[["Conditions"]]]] ## EDIT: define Conditions as here outside the if/else and truncate if TRUE as above } - ##--- PCA - PCA.res <- prcomp(data_norm, center = TRUE, scale. = TRUE) - outlier_PCA_data <- data_norm - outlier_PCA_data$Conditions <- Conditions + ## prepare the lists to store the results + ## do 10 rounds of hotelling filtering + Outlier_filtering_loop <- 10 + sample_outliers <- list() + scree_plot_list <- list() + outlier_plot_list <- list() + metabolite_zero_var_total_list <- list() + zero_var_metab_warning = FALSE + + ################################################# + ##--------- Perform Outlier testing: + for (loop in seq_len(Outlier_filtering_loop)) { + ##--- Zero variance metabolites + # calculate each metabolites variance + metabolite_var <- apply(data_norm, 1, var) %>% + t() %>% + as.data.frame() + # take the names of metabolites with zero variance and puts them in list + metabolite_zero_var_list <- list( + colnames(metabolite_var)[which(metabolite_var[1, ] == 0)]) + + if (sum(metabolite_var[1, ] == 0) == 0) { + metabolite_zero_var_total_list[loop] <- 0 + } else if (sum(metabolite_var[1, ] == 0) > 0) { + metabolite_zero_var_total_list[loop] <- metabolite_zero_var_list + ## this is used later to print and save the zero variance + ## metabolites if any are found + zero_var_metab_warning <- TRUE + } - dev.new() - pca_outlier <-invisible(VizPCA(InputData=data_norm, - SettingsInfo= c(color=SettingsInfo[["Conditions"]]), - SettingsFile_Sample= outlier_PCA_data, - PlotName = paste("PCA outlier test filtering round ",loop), - SaveAs_Plot = NULL)) + #for (metab in metabolite_zero_var_list) { + ## remove the metabolites with zero variance from the data to do PCA + data_norm <- data_norm[!rownames(data_norm) %in% unlist(metabolite_zero_var_list), ] + #} + + ##--- PCA + ## remove features with zero variance + #sds <- apply(data_norm, 2, sd, na.rm = TRUE) + #data_norm_pca <- data_norm[, sds != 0] + PCA.res <- prcomp(t(data_norm), center = TRUE, scale. = TRUE) + se_tmp <- se[rownames(data_norm), colnames(data_norm)] + assay(se_tmp) <- data_norm + #outlier_PCA_data <- data_norm + #outlier_PCA_data$Conditions <- Conditions + + dev.new() + pca_outlier <- invisible( + VizPCA(se = se_tmp, + SettingsInfo = c(color = SettingsInfo[["Conditions"]]), + ##SettingsFile_Sample = outlier_PCA_data, + PlotName = paste("PCA outlier test filtering round ", loop), + SaveAs_Plot = NULL)) + + if (loop == 1) { + pca_outlierloop1 <- pca_outlier[["Plot_Sized"]][[1]] + } + outlier_plot_list[[paste0("PCA_round", loop)]] <- pca_outlier[["Plot_Sized"]][[1]] + dev.off() + + ##--- Scree plot + ## get Scree plot values for inflection point calculation + inflect_df <- as.data.frame(seq_along(PCA.res$sdev)) + colnames(inflect_df) <- "x" + inflect_df$y <- summary(PCA.res)$importance[2, ] + inflect_df$Cumulative <- summary(PCA.res)$importance[3, ] + + ## make cumulative variation labels for plot + screeplot_cumul <- format(round( + inflect_df$Cumulative[seq_len(20)] * 100, 1), nsmall = 1) + + ## Calculate the knee and select optimal number of components + knee <- inflection::uik(inflect_df$x, inflect_df$y) + ## subtract 1 components from the knee cause the root of the knee is + ## the PC that does not add something. npcs = 30 + npcs <- knee -1 + + ## make a scree plot with the selected component cut-off for + ## HotellingT2 test + screeplot <- factoextra::fviz_screeplot(PCA.res, + main = paste0("PCA Explained variance plot filtering round ", loop), + addlabels = TRUE, ncp = 20, geom = c("bar", "line"), + barfill = "grey", barcolor = "grey", linecolor = "black", + linetype = 1) + + ggplot2::theme_classic()+ + ggplot2::geom_vline(xintercept = npcs + 0.5, linetype = 2, + color = "red") + + ggplot2::annotate("text", x = c(1:20), y = -0.8, + label = screeplot_cumul, col = "black", size = 1.75) + + #screeplot_Sized <- plotGrob_Processing(InputPlot = screeplot, PlotName= paste("PCA Explained variance plot filtering round ",loop, sep = ""), PlotType= "Scree") + + if (loop == 1) { + scree_outlierloop1 <- screeplot + } + dev.new() + ## save plot + outlier_plot_list[[paste("ScreePlot_round",loop,sep="")]] <- screeplot + dev.off() + + ##--- HotellingT2 test for outliers + data_hot <- as.matrix(PCA.res$x[, seq_len(npcs)]) + hotelling_qcc <- qcc::mqcc(data_hot, type = "T2.single", + labels = rownames(data_hot), + confidence.level = HotellinsConfidence, + title = paste0( + "Outlier filtering via HotellingT2 test filtering round ", + loop, ", with ", HotellinsConfidence, "% Confidence"), + plot = FALSE) + HotellingT2plot_data <- as.data.frame(hotelling_qcc$statistics) |> + tibble::rownames_to_column("Samples") + colnames(HotellingT2plot_data) <- c("Samples", "Group summary statistics") + outlier <- HotellingT2plot_data %>% + dplyr::filter(HotellingT2plot_data$`Group summary statistics` > hotelling_qcc$limits[2]) ## EDIT: choose a name that does not need ticks + limits <- as.data.frame(hotelling_qcc$limits) + legend <- colnames(HotellingT2plot_data[2]) + LegendTitle <- "Limits" + + HotellingT2plot <- ggplot2::ggplot(HotellingT2plot_data, + aes(x = Samples, y = `Group summary statistics`, + group = 1, fill =)) + ## EDIT: fill is missing + ggplot2::geom_point(aes(x = Samples, y = `Group summary statistics`), + color = 'blue', size = 2) + + ggplot2::geom_point(data = outlier, + aes(x = Samples, y = `Group summary statistics`), + color = 'red', size = 3) + + ggplot2::geom_line(linetype = 2) + + ## draw the horizontal lines corresponding to the LCL, UCL + HotellingT2plot <- HotellingT2plot + + ggplot2::geom_hline(aes(yintercept = limits[, 1]), + color = "black", data = limits, show.legend = FALSE) + + ggplot2::geom_hline(aes(yintercept = limits[, 2], linetype = "UCL"), + color = "red", data = limits, show.legend = TRUE) + + ggplot2::scale_y_continuous(breaks = sort( + c(ggplot_build(HotellingT2plot)$layout$panel_ranges[[1]]$y.major_source, + c(limits[, 1],limits[, 2])))) + + HotellingT2plot <- HotellingT2plot + + ggplot2::theme_classic() + + ggplot2::theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1)) + + ggplot2::ggtitle( + paste("Hotelling ", hotelling_qcc$type , + " test filtering round ", loop, ", with ", + 100 * hotelling_qcc$confidence.level, "% Confidence")) + + ggplot2::scale_linetype_discrete(name = LegendTitle,) + + ggplot2::theme(plot.title = element_text(size = 13)) + #, face = "bold")) + + ggplot2::theme(axis.text = element_text(size = 7)) + #HotellingT2plot_Sized <- plotGrob_Processing(InputPlot = HotellingT2plot, PlotName= paste("Hotelling ", hotelling_qcc$type ," test filtering round ",loop,", with ", 100 * hotelling_qcc$confidence.level,"% Confidence"), PlotType= "Hotellings") + + if (loop == 1) { + hotel_outlierloop1 <- HotellingT2plot + } + dev.new() + #plot(HotellingT2plot) + outlier_plot_list[[paste0("HotellingsPlot_round", loop)]] <- HotellingT2plot + dev.off() + + a <- loop + if (CoRe) { + a <- paste0(a, "_CoRe") + } - if(loop==1){ - pca_outlierloop1 <- pca_outlier[["Plot_Sized"]][[1]] - } - outlier_plot_list[[paste("PCA_round",loop,sep="")]] <- pca_outlier[["Plot_Sized"]][[1]] - dev.off() - - ##--- Scree plot - inflect_df <- as.data.frame(c(1:length(PCA.res$sdev))) # get Scree plot values for inflection point calculation - colnames(inflect_df) <- "x" - inflect_df$y <- summary(PCA.res)$importance[2,] - inflect_df$Cumulative <- summary(PCA.res)$importance[3,] - screeplot_cumul <- format(round(inflect_df$Cumulative[1:20]*100, 1), nsmall = 1) #make cumulative variation labels for plot - knee = inflection::uik(inflect_df$x,inflect_df$y) # Calculate the knee and select optimal number of components - npcs = knee -1 #Note: we subtract 1 components from the knee cause the root of the knee is the PC that does not add something. npcs = 30 - - # Make a scree plot with the selected component cut-off for HotellingT2 test - screeplot <- factoextra::fviz_screeplot(PCA.res, main = paste("PCA Explained variance plot filtering round ",loop, sep = ""), - addlabels = TRUE, - ncp = 20, - geom = c("bar", "line"), - barfill = "grey", - barcolor = "grey", - linecolor = "black",linetype = 1) + - ggplot2::theme_classic()+ - ggplot2::geom_vline(xintercept = npcs+0.5, linetype = 2, color = "red") + - ggplot2::annotate("text", x = c(1:20),y = -0.8,label = screeplot_cumul,col = "black", size = 1.75) - - #screeplot_Sized <- plotGrob_Processing(InputPlot = screeplot, PlotName= paste("PCA Explained variance plot filtering round ",loop, sep = ""), PlotType= "Scree") - - if(loop==1){ - scree_outlierloop1 <-screeplot - } - dev.new() - - outlier_plot_list[[paste("ScreePlot_round",loop,sep="")]] <- screeplot # save plot - dev.off() - - ##--- HotellingT2 test for outliers - data_hot <- as.matrix(PCA.res$x[,1:npcs]) - hotelling_qcc <- qcc::mqcc(data_hot, type = "T2.single",labels = rownames(data_hot),confidence.level = HotellinsConfidence, title = paste("Outlier filtering via HotellingT2 test filtering round ",loop,", with ",HotellinsConfidence, "% Confidence", sep = ""), plot = FALSE) - HotellingT2plot_data <- as.data.frame(hotelling_qcc$statistics) - HotellingT2plot_data <- tibble::rownames_to_column(HotellingT2plot_data, "Samples") - colnames(HotellingT2plot_data) <- c("Samples", "Group summary statisctics") - outlier <- HotellingT2plot_data %>% dplyr::filter(HotellingT2plot_data$`Group summary statisctics`>hotelling_qcc$limits[2]) - limits <- as.data.frame(hotelling_qcc$limits) - legend <- colnames(HotellingT2plot_data[2]) - LegendTitle = "Limits" - - HotellingT2plot <- ggplot2::ggplot(HotellingT2plot_data, aes(x = Samples, y = `Group summary statisctics`, group = 1, fill = )) - HotellingT2plot <- HotellingT2plot + - ggplot2::geom_point(aes(x = Samples,y = `Group summary statisctics`), color = 'blue', size = 2) + - ggplot2::geom_point(data = outlier, aes(x = Samples,y = `Group summary statisctics`), color = 'red',size = 3) + - ggplot2::geom_line(linetype = 2) - - #draw the horizontal lines corresponding to the LCL,UCL - HotellingT2plot <- HotellingT2plot + - ggplot2::geom_hline(aes(yintercept = limits[,1]), color = "black", data = limits, show.legend = F) + - ggplot2::geom_hline(aes(yintercept = limits[,2], linetype = "UCL"), color = "red", data = limits, show.legend = T) + - ggplot2::scale_y_continuous(breaks = sort(c(ggplot_build(HotellingT2plot)$layout$panel_ranges[[1]]$y.major_source, c(limits[,1],limits[,2])))) - - HotellingT2plot <- HotellingT2plot + - ggplot2::theme_classic()+ - ggplot2::theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1))+ - ggplot2::ggtitle(paste("Hotelling ", hotelling_qcc$type ," test filtering round ",loop,", with ", 100 * hotelling_qcc$confidence.level,"% Confidence"))+ - ggplot2::scale_linetype_discrete(name = LegendTitle,)+ - ggplot2::theme(plot.title = element_text(size = 13))+#, face = "bold")) + - ggplot2::theme(axis.text = element_text(size = 7)) - #HotellingT2plot_Sized <- plotGrob_Processing(InputPlot = HotellingT2plot, PlotName= paste("Hotelling ", hotelling_qcc$type ," test filtering round ",loop,", with ", 100 * hotelling_qcc$confidence.level,"% Confidence"), PlotType= "Hotellings") - - if(loop==1){ - hotel_outlierloop1 <- HotellingT2plot - } - dev.new() - #plot(HotellingT2plot) - outlier_plot_list[[paste("HotellingsPlot_round",loop,sep="")]] <- HotellingT2plot - dev.off() - - a<- loop - if(CoRe==TRUE){ - a<- paste0(a,"_CoRe") + ## loop for outliers until no outlier is detected + if (length(hotelling_qcc[["violations"]][["beyond.limits"]]) == 0) { + data_norm <- data_norm + break ## EDIT: why is break needed here? + } else if (length(hotelling_qcc[["violations"]][["beyond.limits"]]) == 1) { + ## filter the selected outliers from the data + data_norm <- data_norm[, -hotelling_qcc[["violations"]][["beyond.limits"]] ] + Conditions <- Conditions[-hotelling_qcc[["violations"]][["beyond.limits"]]] + + ## Change the names of outliers in mqcc, instead of saving the + ## order number it saves the name + hotelling_qcc[["violations"]][["beyond.limits"]][1] <- rownames(data_hot)[hotelling_qcc[["violations"]][["beyond.limits"]][1]] + sample_outliers[loop] <- list(hotelling_qcc[["violations"]][["beyond.limits"]]) + } else { + data_norm <- data_norm[, -hotelling_qcc[["violations"]][["beyond.limits"]]] + Conditions <- Conditions[-hotelling_qcc[["violations"]][["beyond.limits"]]] + + ## change the names of outliers in mqcc, instead of saving the + ## order number it saves the name + sm_out <- c() # list of outliers samples + for (i in seq_along(hotelling_qcc[["violations"]][["beyond.limits"]])) { + sm_out <- append(sm_out, + rownames(data_hot)[hotelling_qcc[["violations"]][["beyond.limits"]][i]]) + } + sample_outliers[loop] <- list(sm_out) + } } - if(length(hotelling_qcc[["violations"]][["beyond.limits"]]) == 0){ # loop for outliers until no outlier is detected - data_norm <- data_norm - break - }else if(length(hotelling_qcc[["violations"]][["beyond.limits"]]) == 1){ - data_norm <- data_norm[-hotelling_qcc[["violations"]][["beyond.limits"]],]# filter the selected outliers from the data - Conditions <- Conditions[-hotelling_qcc[["violations"]][["beyond.limits"]]] - - # Change the names of outliers in mqcc . Instead of saving the order number it saves the name - hotelling_qcc[["violations"]][["beyond.limits"]][1] <- rownames(data_hot)[hotelling_qcc[["violations"]][["beyond.limits"]][1]] - sample_outliers[loop] <- list(hotelling_qcc[["violations"]][["beyond.limits"]]) - }else{ - data_norm <- data_norm[-hotelling_qcc[["violations"]][["beyond.limits"]],] - Conditions <- Conditions[-hotelling_qcc[["violations"]][["beyond.limits"]]] - - # Change the names of outliers in mqcc . Instead of saving the order number it saves the name - sm_out <- c() # list of outliers samples - for (i in 1:length(hotelling_qcc[["violations"]][["beyond.limits"]])){ - sm_out <- append(sm_out, rownames(data_hot)[hotelling_qcc[["violations"]][["beyond.limits"]][i]]) - } - sample_outliers[loop] <- list(sm_out ) + ################################################# + ##-- Print Outlier detection results about samples and metabolites + if (length(sample_outliers) > 0) { + ## print outlier samples + message <- "There are possible outlier samples in the data." + logger::log_info(message) + message(message) #This was a warning + for (i in seq_along(sample_outliers)) { + message <- paste("Filtering round ", i, " Outlier Samples: ", + paste(head(sample_outliers[[i]]), " ")) + logger::log_info(message) + message(message) + } + } else { + message <- "No sample outliers were found." + logger::log_info(message) + message(message) } - } - ################################################# - ##-- Print Outlier detection results about samples and metabolites - if(length(sample_outliers) > 0){ # Print outlier samples - message <- paste("There are possible outlier samples in the data") - logger::log_info(message) - message(message) #This was a warning - for (i in 1:length(sample_outliers) ){ - message <- paste("Filtering round ",i ," Outlier Samples: ", paste( head(sample_outliers[[i]]) ," ")) - logger::log_info(message) - message(message) + ##-- Print Zero variance metabolites + zero_var_metab_export_df <- data.frame(1, 2) + names(zero_var_metab_export_df) <- c("Filtering round", "Metabolite") + + if (zero_var_metab_warning) { + message <- paste("Metabolites with zero variance have been identified in the data. As scaling in PCA cannot be applied when features have zero variace, these metabolites are not taken into account for the outlier detection and the PCA plots.") + logger::log_trace("Warning: " , message, sep = "") + warning(message) } - }else{ - message <- paste("No sample outliers were found") - logger::log_info(message) - message(message) + + count <- 1 + for (i in seq_along(metabolite_zero_var_total_list)) { + if (metabolite_zero_var_total_list[[i]] != 0) { + message <- paste("Filtering round ", i, + ". Zero variance metabolites identified: ", + paste(metabolite_zero_var_total_list[[i]], " ")) + logger::log_info(message) + message(message) + + zero_var_metab_export_df[count, "Filtering round"] <- paste(i) + zero_var_metab_export_df[count, "Metabolite"] <- paste(metabolite_zero_var_total_list[[i]]) + count <- count +1 + } } - ##-- Print Zero variance metabolites - zero_var_metab_export_df <- data.frame(1,2) - names(zero_var_metab_export_df) <- c("Filtering round","Metabolite") - - if(zero_var_metab_warning==TRUE){ - message <- paste("Metabolites with zero variance have been identified in the data. As scaling in PCA cannot be applied when features have zero variace, these metabolites are not taken into account for the outlier detection and the PCA plots.") - logger::log_trace("Warning: " , message, sep="") - warning(message) - } - - count = 1 - for (i in 1:length(metabolite_zero_var_total_list)){ - if (metabolite_zero_var_total_list[[i]] != 0){ - message <- paste("Filtering round ",i ,". Zero variance metabolites identified: ", paste( metabolite_zero_var_total_list[[i]] ," ")) - logger::log_info(message) - message(message) - - zero_var_metab_export_df[count,"Filtering round"] <- paste(i) - zero_var_metab_export_df[count,"Metabolite"] <- paste(metabolite_zero_var_total_list[[i]]) - count = count +1 + ############################################# + ##---- 1. Make Output DF + ## make a dictionary + total_outliers <- hash::hash() + if (length(sample_outliers) > 0) { + ## create columns with outliers to merge to output dataframe + for (i in seq_along(sample_outliers) ) { ## EDIT: with seq_along probably you do not need the outer if + total_outliers[[paste0("Outlier_filtering_round_", i)]] <- sample_outliers[i] + } } - } - - ############################################# - ##---- 1. Make Output DF - total_outliers <- hash::hash() # make a dictionary - if(length(sample_outliers) > 0){ # Create columns with outliers to merge to output dataframe - for (i in 1:length(sample_outliers) ){ - total_outliers[[paste("Outlier_filtering_round_",i, sep = "")]] <- sample_outliers[i] + + data_norm_filtered_full <- assay(se) |> + t() |> + as.data.frame() + data_norm_filtered_full[data_norm_filtered_full == 0] <- NA + data_norm_filtered_full$Outliers <- "no" + + ## add outlier information to the full output dataframe + for (i in seq_along(total_outliers)) { ## EDIT: with seq_along probably you do not need the outer if + for (k in seq_along(hash::values(total_outliers)[i])) { + data_norm_filtered_full[as.character(hash::values(total_outliers)[[i]]), "Outliers"] <- hash::keys(total_outliers)[i] + } } - } - data_norm_filtered_full <- as.data.frame(replace(InputData, InputData==0, NA)) + ## put Outlier columns in the front + data_norm_filtered_full <- data_norm_filtered_full %>% + dplyr::relocate(Outliers) + + ## add the design in the output df (merge by rownames/sample names) + data_norm_filtered_full <- merge(as.data.frame(colData(se)), + data_norm_filtered_full, by = "row.names") + data_norm_filtered_full <- tibble::column_to_rownames(data_norm_filtered_full, "Row.names") + + ##-- 2. Quality Control (QC) PCA + MetaData_Sample <- data_norm_filtered_full %>% + dplyr::mutate(Outliers = dplyr::case_when( + Outliers == "no" ~ 'no', + Outliers == "Outlier_filtering_round_1" ~ ' Outlier_filtering_round = 1', + Outliers == "Outlier_filtering_round_2" ~ ' Outlier_filtering_round = 2', + Outliers == "Outlier_filtering_round_3" ~ ' Outlier_filtering_round = 3', + Outliers == "Outlier_filtering_round_4" ~ ' Outlier_filtering_round = 4', + TRUE ~ 'Outlier_filtering_round = or > 5')) + MetaData_Sample$Outliers <- relevel( + as.factor(MetaData_Sample$Outliers), ref = "no") + + ## define updated SummarizedExperiment for plotting + se_tmp <- se[-zero_var_metab_export_df$Metabolite, ] + se_tmp@colData <- MetaData_Sample[, !colnames(MetaData_Sample) %in% rownames(se)] |> + #as.data.frame() |> + #tibble::column_to_rownames(var = "Row.names") |> + DataFrame() + + ## 1. Shape Outliers + if (length(sample_outliers) > 0) { + dev.new() + pca_QC <- invisible( + VizPCA( + se = se_tmp, + ##InputData = dplyr::select(as.data.frame(InputData), -zero_var_metab_export_df$Metabolite), + SettingsInfo = c(color = SettingsInfo[["Conditions"]], shape = "Outliers"), + ##SettingsFile_Sample = MetaData_Sample , + PlotName = "Quality Control PCA Condition clustering and outlier check", + SaveAs_Plot = NULL)) + dev.off() + outlier_plot_list[["QC_PCA_and_Outliers"]] <- pca_QC[["Plot_Sized"]][[1]] + } - if(length(total_outliers) > 0){ # add outlier information to the full output dataframe - data_norm_filtered_full$Outliers <- "no" - for (i in 1:length(total_outliers)){ - for (k in 1:length( hash::values(total_outliers)[i] ) ){ - data_norm_filtered_full[as.character(hash::values(total_outliers)[[i]]) , "Outliers"] <- hash::keys(total_outliers)[i] - } + ## 2. Shape Biological replicates + if ("Biological_Replicates" %in% names(SettingsInfo)) { + dev.new() + pca_QC_repl <- invisible( + VizPCA( + se = se_tmp, + #InputData = dplyr::select(as.data.frame(InputData), -zero_var_metab_export_df$Metabolite), + SettingsInfo = c(color = SettingsInfo[["Conditions"]], shape = SettingsInfo[["Biological_Replicates"]]), + #SettingsFile_Sample = MetaData_Sample, + PlotName = "Quality Control PCA replicate spread check", + SaveAs_Plot = NULL)) + dev.off() + outlier_plot_list[["QC_PCA_Replicates"]] <- pca_QC_repl[["Plot_Sized"]][[1]] } - }else{ - data_norm_filtered_full$Outliers <- "no" - } - - data_norm_filtered_full <- data_norm_filtered_full %>% dplyr::relocate(Outliers) #Put Outlier columns in the front - data_norm_filtered_full <- merge(SettingsFile_Sample, data_norm_filtered_full, by = 0) # add the design in the output df (merge by rownames/sample names) - rownames(data_norm_filtered_full) <- data_norm_filtered_full$Row.names - data_norm_filtered_full$Row.names <- c() - - ##-- 2. Quality Control (QC) PCA - MetaData_Sample <- data_norm_filtered_full %>% - dplyr::mutate(Outliers = dplyr::case_when(Outliers == "no" ~ 'no', - Outliers == "Outlier_filtering_round_1" ~ ' Outlier_filtering_round = 1', - Outliers == "Outlier_filtering_round_2" ~ ' Outlier_filtering_round = 2', - Outliers == "Outlier_filtering_round_3" ~ ' Outlier_filtering_round = 3', - Outliers == "Outlier_filtering_round_4" ~ ' Outlier_filtering_round = 4', - TRUE ~ 'Outlier_filtering_round = or > 5')) - MetaData_Sample$Outliers <- relevel(as.factor(MetaData_Sample$Outliers), ref="no") - - # 1. Shape Outliers - if(length(sample_outliers)>0){ - dev.new() - pca_QC <-invisible(VizPCA(InputData=as.data.frame(InputData)%>%dplyr::select(-zero_var_metab_export_df$Metabolite), - SettingsInfo= c(color=SettingsInfo[["Conditions"]], shape = "Outliers"), - SettingsFile_Sample= MetaData_Sample , - PlotName = "Quality Control PCA Condition clustering and outlier check", - SaveAs_Plot = NULL)) - dev.off() - outlier_plot_list[["QC_PCA_and_Outliers"]] <- pca_QC[["Plot_Sized"]][[1]] - } - - # 2. Shape Biological replicates - if("Biological_Replicates" %in% names(SettingsInfo)){ - dev.new() - pca_QC_repl <-invisible(VizPCA(InputData=as.data.frame(InputData)%>%dplyr::select(-zero_var_metab_export_df$Metabolite), - SettingsInfo= c(color=SettingsInfo[["Conditions"]], shape = SettingsInfo[["Biological_Replicates"]]), - SettingsFile_Sample= MetaData_Sample, - PlotName = "Quality Control PCA replicate spread check", - SaveAs_Plot = NULL)) - dev.off() - - outlier_plot_list[["QC_PCA_Replicates"]] <- pca_QC_repl[["Plot_Sized"]][[1]] - } - - - - ############################################# - ##--- Save and Return plots and DFs - DF_list <- list("Zero_variance_metabolites_CoRe" = zero_var_metab_export_df, "data_outliers" = data_norm_filtered_full) - - #Return - Output_list <- list("DF"= DF_list,"Plot"=outlier_plot_list) - invisible(return(Output_list)) + + ## add data_norm_filtered_full to assay + tmp <- data_norm_filtered_full# |> + #tibble::column_to_rownames(var = "Row.names") + assay(se_tmp) <- tmp[, rownames(se_tmp)] |> + t() + + ############################################# + ##--- Save and Return plots and DFs + l_outlier <- list( + "data" = list( + "se" = se_tmp, + "Zero_variance_metabolites_CoRe" = zero_var_metab_export_df + ), + "plot" = outlier_plot_list)#, + #"data_outliers" = data_norm_filtered_full) ## EDIT: correct? For PCA InputData is used? + + ## return + invisible(l_outlier) } diff --git a/R/RefactorPriorKnoweldge.R b/R/RefactorPriorKnoweldge.R index f220bf67..3265413f 100644 --- a/R/RefactorPriorKnoweldge.R +++ b/R/RefactorPriorKnoweldge.R @@ -35,8 +35,10 @@ #' @return List with at least three DFs: 1) Original data and the new column of translated ids spearated by comma. 2) Mapping information between Original ID to Translated ID. 3) Mapping summary between Original ID to Translated ID. #' #' @examples -#' KEGG_Pathways <- MetaProViz::LoadKEGG() -#' Res <- MetaProViz::TranslateID(InputData= KEGG_Pathways, SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), From = c("kegg"), To = c("pubchem", "hmdb")) +#' KEGG_Pathways <- LoadKEGG() +#' Res <- TranslateID(InputData = KEGG_Pathways, +#' SettingsInfo = c(InputID = "MetaboliteID", GroupingVariable = "term"), +#' From = c("kegg"), To = c("pubchem", "hmdb")) #' #' @keywords Translate metabolite IDs #' @@ -50,148 +52,167 @@ #' @export #' TranslateID <- function(InputData, - SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), - From = "kegg", - To = c("pubchem","chebi","hmdb"), - Summary=FALSE, - SaveAs_Table= "csv", - FolderPath=NULL - ){# Add ability to also get metabolite names that are human readable from an ID type! - - MetaProViz_Init() - - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - MetaProViz:::CheckInput(InputData=InputData, - InputData_Num=FALSE, - SaveAs_Table=SaveAs_Table) - - # Specific checks: - if("InputID" %in% names(SettingsInfo)){ - if(SettingsInfo[["InputID"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["InputID"]], " column selected as InputID in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + SettingsInfo = c(InputID = "MetaboliteID", GroupingVariable = "term"), + From = "kegg", ## EDIT: name the options here and use match.arg + To = c("pubchem", "chebi", "hmdb"), ## EDIT: are here multiple allowed?, should be checked with match.arg + Summary = FALSE, + SaveAs_Table = "csv", ## EDIT: name the options here and use match.arg + FolderPath = NULL) { + + ## check arguments + From <- match.arg(From) + To <- match.arg(To, several.ok = TRUE) + + ## add ability to also get metabolite names that are human readable from an ID type! + #MetaProViz_Init() + + ## ------------------ Check Input ------------------- ## + # HelperFunction `CheckInput` + CheckInput(InputData = InputData, InputData_Num = FALSE, + SaveAs_Table = SaveAs_Table) + + ## Specific checks: + if ("InputID" %in% names(SettingsInfo)) { + if (!SettingsInfo[["InputID"]] %in% colnames(InputData)) { + message <- paste0("The ", SettingsInfo[["InputID"]], + " column selected as InputID in SettingsInfo was not found in ", + "InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - if("GroupingVariable" %in% names(SettingsInfo)){ - if(SettingsInfo[["GroupingVariable"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["GroupingVariable"]], " column selected as GroupingVariable in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + if ("GroupingVariable" %in% names(SettingsInfo)) { + if (!SettingsInfo[["GroupingVariable"]] %in% colnames(InputData)) { + message <- paste0("The ", SettingsInfo[["GroupingVariable"]], + " column selected as GroupingVariable in SettingsInfo was not ", + "found in InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } } - } - - if(is.logical(Summary) == FALSE){ - message <- paste0("Check input. The Summary parameter should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - unknown_types <- OmnipathR::id_types() %>% - dplyr::select(tidyselect::starts_with('in_')) %>% - unlist %>% - unique %>% - str_to_lower %>% - setdiff(union(From, To), .) - - if (length(unknown_types) > 0L) { - msg <- sprintf('The following ID types are not recognized: %s', paste(unknown_types, collapse = ', ')) - logger::log_warn(msg) - warning(msg) - } - - # Check that SettingsInfo[['InputID']] has no duplications within one group --> should not be the case --> remove duplications and inform the user/ ask if they forget to set groupings column - doublons <- InputData %>% - dplyr::group_by(!!sym(SettingsInfo[['InputID']]), !!sym(SettingsInfo[['GroupingVariable']]))%>% - dplyr::filter(dplyr::n() > 1) %>% - dplyr::ungroup() - - if(nrow(doublons) > 0){ - message <- sprintf('The following ID types are duplicated within one group: %s',paste(doublons, collapse = ', ')) - logger::log_warn(message) - warning(message) - } - - ## ------------------ Create output folders and path ------------------- ## - if(is.null(SaveAs_Table)==FALSE ){ - Folder <- MetaProViz:::SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "ID_Translation") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - ######################################################################################################################################################## - ## ------------------ Translate To-From for each pair ------------------- ## - TranslatedDF <- OmnipathR::translate_ids( - InputData, - !!sym(SettingsInfo[['InputID']]) := !!sym(From), - !!!syms(To),#list of symbols, hence three !!! - ramp = TRUE, - expand = FALSE, - quantify_ambiguity = TRUE, - qualify_ambiguity = TRUE, - ambiguity_groups = SettingsInfo[['GroupingVariable']],#Checks within the groups, without it checks across groups - ambiguity_summary = TRUE + + if (!is.logical(Summary)) { + message <- paste0("Check input. The Summary parameter should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + unknown_types <- OmnipathR::id_types() %>% + dplyr::select(tidyselect::starts_with('in_')) %>% + unlist() %>% + unique() %>% + str_to_lower() %>% + setdiff(union(From, To), .) + + if (length(unknown_types) > 0L) { + msg <- sprintf('The following ID types are not recognized: %s', + paste(unknown_types, collapse = ', ')) + logger::log_warn(msg) + warning(msg) + } + + ## check that SettingsInfo[['InputID']] has no duplications within + ## one group --> should not be the case --> remove duplications and + ## inform the user/ ask if they forget to set groupings column + doublons <- InputData %>% + dplyr::group_by(!!sym(SettingsInfo[['InputID']]), + !!sym(SettingsInfo[['GroupingVariable']]))%>% + dplyr::filter(dplyr::n() > 1) %>% + dplyr::ungroup() + + if (nrow(doublons) > 0) { + message <- sprintf( + "The following ID types are duplicated within one group: %s", + paste(doublons, collapse = ', ')) + logger::log_warn(message) + warning(message) + } + + ## ------------------ Create output folders and path ------------------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", + FolderPath = FolderPath) + + SubFolder <- file.path(Folder, "ID_Translation") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } + + ############################################################################ + ## ------------------ Translate To-From for each pair ------------------- ## + TranslatedDF <- OmnipathR::translate_ids( + d = InputData, + !!sym(SettingsInfo[['InputID']]) := !!sym(From), + !!!syms(To), ## list of symbols, hence three !!! + ramp = TRUE, + expand = FALSE, + quantify_ambiguity = TRUE, + qualify_ambiguity = TRUE, + ## checks within the groups, without it checks across groups + ambiguity_groups = SettingsInfo[['GroupingVariable']], + ambiguity_summary = TRUE ) - #TranslatedDF %>% attributes %>% names - #TranslatedDF%>% attr('ambiguity_MetaboliteID_hmdb') - - ## --------------- Create output DF -------------------- ## - ResList <- list() - - ## Create DF for TranslatedIDs only with the original data and the translatedID columns - DF_subset <- TranslatedDF %>% - dplyr::select(tidyselect::all_of(intersect(names(.), names(InputData))), tidyselect::all_of(To)) %>% - dplyr::mutate(across(all_of(To), ~ map_chr(., ~ paste(unique(.), collapse = ", ")))) %>% - dplyr::group_by(!!sym(SettingsInfo[['InputID']]), !!sym(SettingsInfo[['GroupingVariable']])) %>% - dplyr::mutate(across(tidyselect::all_of(To), ~ paste(unique(.), collapse = ", "), .names = "{.col}")) %>% - dplyr::ungroup() %>% - dplyr::distinct() %>% - dplyr::mutate(dplyr::across(tidyselect::all_of(To), ~ ifelse(. == "0", NA, .))) - - ResList[["TranslatedDF"]] <- DF_subset - - ## Add DF with mapping information - ResList[["TranslatedDF_MappingInfo"]] <- TranslatedDF - - ## Also save the different mapping summaries! - for(item in To){ - SummaryDF <- TranslatedDF%>% attr(paste0("ambiguity_", SettingsInfo[['InputID']], "_", item, sep="")) - ResList[[paste0("MappingSummary_", item, sep="")]] <- SummaryDF - } - - ## Create the long DF summary if Summary =TRUE - if(Summary==TRUE){ - for(item in To){ - Summary <- MetaProViz::MappingAmbiguity(InputData= TranslatedDF, - From = SettingsInfo[['InputID']], - To = item, - GroupingVariable = SettingsInfo[['GroupingVariable']], - Summary=TRUE)[["Summary"]] - ResList[[paste0("MappingSummary_Long_", From, "-to-", item, sep="")]] <- Summary + #TranslatedDF %>% attributes %>% names + #TranslatedDF%>% attr('ambiguity_MetaboliteID_hmdb') + + ## --------------- Create output DF -------------------- ## + ResList <- list() + + ## Create DF for TranslatedIDs only with the original data and the translatedID columns + DF_subset <- TranslatedDF %>% + dplyr::select(tidyselect::all_of(intersect(names(.), names(InputData))), + tidyselect::all_of(To)) %>% + dplyr::mutate(across(all_of(To), ~ map_chr(., ~ paste(unique(.), + collapse = ", ")))) %>% + dplyr::group_by(!!sym(SettingsInfo[['InputID']]), + !!sym(SettingsInfo[['GroupingVariable']])) %>% + dplyr::mutate(across( + tidyselect::all_of(To), ~ paste(unique(.), collapse = ", "), + .names = "{.col}")) %>% + dplyr::ungroup() %>% + dplyr::distinct() %>% + dplyr::mutate(dplyr::across(tidyselect::all_of(To), ~ ifelse(. == "0", NA, .))) ## EDIT: this seems quite complicated and takes some time to understand, is it possible to simplify or add comments? + + ResList[["TranslatedDF"]] <- DF_subset + + ## add DF with mapping information + ResList[["TranslatedDF_MappingInfo"]] <- TranslatedDF + + ## also save the different mapping summaries! + for (item in To) { + SummaryDF <- TranslatedDF %>% + attr(paste0("ambiguity_", SettingsInfo[['InputID']], "_", item)) + ResList[[paste0("MappingSummary_", item, sep)]] <- SummaryDF } - } - - - ## ------------------ Save the results ------------------- ## - suppressMessages(suppressWarnings( - MetaProViz:::SaveRes(InputList_DF=ResList, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "TranslateID", - CoRe=FALSE, - PrintPlot=FALSE))) - - #Return - invisible(return(ResList)) -} + ## create the long DF summary if Summary =TRUE + if (Summary) { + for (item in To) { + Summary <- MappingAmbiguity(InputData = TranslatedDF, + From = SettingsInfo[['InputID']], + To = item, + GroupingVariable = SettingsInfo[['GroupingVariable']], + Summary = TRUE)[["Summary"]] + ResList[[paste0("MappingSummary_Long_", From, "-to-", item)]] <- Summary + } + } + ## ------------------ Save the results ------------------- ## + suppressMessages(suppressWarnings( + SaveRes( + InputList_DF = ResList, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "TranslateID", + CoRe = FALSE, + PrintPlot = FALSE))) + #Return + invisible(ResList) +} ########################################################################################## ### ### ### Find additional potential IDs ### ### ### @@ -208,8 +229,11 @@ TranslateID <- function(InputData, #' @return Input DF with additional column including potential additional IDs. #' #' @examples -#' DetectedIDs <- MetaProViz::ToyData(Data="Cells_MetaData")%>% tibble::rownames_to_column("TrivialName")%>%tidyr::drop_na() -#' Res <- MetaProViz::EquivalentIDs(InputData= DetectedIDs, SettingsInfo = c(InputID="HMDB"), From = "hmdb") +#' DetectedIDs <- ToyData(Data="Cells_MetaData") %>% +#' tibble::rownames_to_column("TrivialName") %>% +#' tidyr::drop_na() +#' Res <- EquivalentIDs(InputData = DetectedIDs, +#' SettingsInfo = c(InputID = "HMDB"), From = "hmdb") #' #' @keywords Find potential additional IDs for one metabolite identifier #' @@ -225,194 +249,231 @@ TranslateID <- function(InputData, #' @export #' EquivalentIDs <- function(InputData, - SettingsInfo = c(InputID="MetaboliteID"), - From = "hmdb", - SaveAs_Table= "csv", - FolderPath=NULL){ - # FUTURE: Once we have the structural similarity tool available in OmniPath, we can start creating this function! + SettingsInfo = c(InputID = "MetaboliteID"), + From = "hmdb", + SaveAs_Table= "csv", + FolderPath = NULL) { + + # FUTURE: Once we have the structural similarity tool available in OmniPath, we can start creating this function! + + ### 1) + ## check Measured ID's in prior knowledge + + ### 2) + ## A user has one HMDB IDs for their measured metabolites + ## (one ID per measured peak) --> this is often the case as the user + ## either gets a trivial name and they have searched for the ID + ## themselves or because the facility only provides one ID at random + # We have mapped the HMDB IDs with the pathways and 20 do not map + # We want to check if it is because the pathways don't include them, + ## or because the user just gave the wrong ID by chance (i.e. They + ## picked D-Alanine, but the prior knowledge includes L-Alanine) + + ## Do this by using structural information via accessing the + ## structural DB in OmniPath! + ## Output is DF with the original ID column and a new column with + ## additional possible IDs based on structure + + ## Is it possible to do this at the moment without structures, + ## but by using other pior knowledge? + + MetaProViz_Init() + + ## ------------------ Check Input ------------------- ## + ## HelperFunction `CheckInput` + CheckInput(InputData = InputData, InputData_Num = FALSE, + SaveAs_Table = SaveAs_Table) + + ## specific checks: + if ("InputID" %in% names(SettingsInfo)) { + if (!SettingsInfo[["InputID"]] %in% colnames(InputData)) { + message <- paste0("The ", SettingsInfo[["InputID"]], + " column selected as InputID in SettingsInfo was not found ", + "in InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + unknown_types <- OmnipathR::id_types() %>% + dplyr::select(tidyselect::starts_with('in_')) %>% + unlist() %>% + unique() %>% + str_to_lower() %>% + setdiff(From, .) ## EDIT: every term that is replicated should be written as a function and tested + + if (length(unknown_types) > 0L) { + msg <- sprintf('The following ID types are not recognized: %s', + paste(unknown_types, collapse = ', ')) + logger::log_warn(msg) + warning(msg) + } - ### 1) - #Check Measured ID's in prior knowledge + ## check that SettingsInfo[['InputID']] has no duplications within + ## one group --> should not be the case --> remove duplications and inform + ## the user/ ask if they forget to set groupings column + doublons <- InputData[duplicated(InputData[[SettingsInfo[['InputID']]]]), ] + if (nrow(doublons) > 0) { + InputData <- InputData %>% + dplyr::distinct(!!sym(SettingsInfo[['InputID']]), .keep_all = TRUE) - ### 2) - # A user has one HMDB IDs for their measured metabolites (one ID per measured peak) --> this is often the case as the user either gets a trivial name and they have searched for the ID themselves or because the facility only provides one ID at random - # We have mapped the HMDB IDs with the pathways and 20 do not map - # We want to check if it is because the pathways don't include them, or because the user just gave the wrong ID by chance (i.e. They picked D-Alanine, but the prior knowledge includes L-Alanine) + message <- sprintf("The following IDs are duplicated and removed: %s", + paste(doublons[[SettingsInfo[['InputID']]]], collapse = ', ')) + logger::log_warn(message) + warning(message) + } + + ## ------------------ Create output folders and path ------------------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", FolderPath = FolderPath) - # Do this by using structural information via accessing the structural DB in OmniPath! - # Output is DF with the original ID column and a new column with additional possible IDs based on structure + SubFolder <- file.path(Folder, "EquivalentIDs") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } - #Is it possible to do this at the moment without structures, but by using other pior knowledge? + ## ------------------ Set the ID type for To ----------------- ## + To <- case_when( + ## if To is "pubchem", choose "chebi" + From == "chebi" ~ "pubchem", + ## for other cases, don't use a secondary column + TRUE ~ "chebi" + ) - MetaProViz_Init() + message <- paste0(To, " is used to find additional potential IDs for ", + From, ".") + logger::log_trace(message) + message(message) - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - MetaProViz:::CheckInput(InputData=InputData, - InputData_Num=FALSE, - SaveAs_Table=SaveAs_Table) + ## ------------------ Load manual table ----------------- ## + if (From != "kegg") { + EquivalentFeatures <- ToyData("EquivalentFeatures") %>% + dplyr::select(From) + } - # Specific checks: - if("InputID" %in% names(SettingsInfo)){ - if(SettingsInfo[["InputID"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["InputID"]], " column selected as InputID in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + ## ------------------ Translate From-to-To ------------------- ## + TranslatedDF <- OmnipathR::translate_ids( + InputData, + !!sym(SettingsInfo[['InputID']]) := !!sym(From), + !!!syms(To), ## list of symbols, hence three !!! + ramp = TRUE, + expand = FALSE, + quantify_ambiguity = FALSE, + ## Can not be set to FALSE! + qualify_ambiguity = TRUE, + ## Checks within the groups, without it checks across groups + ambiguity_groups = NULL, + ambiguity_summary = FALSE) %>% + dplyr::select( + tidyselect::all_of(intersect(names(.), names(InputData))), + tidyselect::all_of(To)) %>% + dplyr::mutate( + across(all_of(To), ~ purrr::map_chr(., ~ paste(unique(.), collapse = ", ")))) %>% + dplyr::group_by(!!sym(SettingsInfo[['InputID']])) %>% + dplyr::mutate( + across(tidyselect::all_of(To), ~ paste(unique(.), collapse = ", "), + .names = "{.col}")) %>% + dplyr::ungroup() %>% + dplyr::distinct() %>% + dplyr::mutate(dplyr::across(tidyselect::all_of(To), ~ ifelse(. == "0", NA, .))) ## EDIT: looks quite complicated, could it be simplified or comments be added? + + + ## ------------------ Translate To-to-From ------------------- ## + TranslatedDF_Long <- TranslatedDF %>% + dplyr::select(!!sym(SettingsInfo[['InputID']]), !!sym(To)) %>% + dplyr::rename("InputID" = !!sym(SettingsInfo[['InputID']])) %>% + tidyr::separate_rows(!!sym(To), sep = ", ") %>% + ## remove extra spaces + dplyr::mutate(across(all_of(To), ~ trimws(.))) %>% + ## remove empty entries + dplyr::filter(!!sym(To) != "") + + OtherIDs <- OmnipathR::translate_ids( + TranslatedDF_Long , + !!sym(To), + !!sym(From),#list of symbols, hence three !!! + ramp = TRUE, + expand = FALSE, + quantify_ambiguity =FALSE, + ## can not be set to FALSE! + qualify_ambiguity = TRUE, + ## checks within the groups, without it checks across groups + ambiguity_groups = NULL, + ambiguity_summary = FALSE) %>% + dplyr::select("InputID", !!sym(To), !!sym(From)) %>% + ## remove duplicates based on InputID and From + dplyr::distinct(InputID, !!sym(From), .keep_all = TRUE) %>% + dplyr::mutate(AdditionalID = dplyr::if_else(InputID == !!sym(From), FALSE, TRUE)) %>% + dplyr::select("InputID",!!sym(From), "AdditionalID") %>% + dplyr::filter(AdditionalID == TRUE) %>% + dplyr::mutate(across(all_of(From), ~ purrr::map_chr(., ~ paste(unique(.), collapse = ", ")))) %>% + dplyr::rowwise() %>% + dplyr::mutate( + ## wrap in list + FromList = list(stringr::str_split(!!sym(From), ",\\s*")[[1]]), + ## match InputID + SameAsInput = ifelse(any(FromList == InputID), InputID, NA_character_), + ## combine other IDs + PotentialAdditionalIDs = paste(FromList[FromList != InputID], collapse = ", ") + ) %>% + dplyr::ungroup() %>% + ## final selection + dplyr::select(InputID, PotentialAdditionalIDs, hmdb) %>% + dplyr::rename("AllIDs" = "hmdb") ## EDIT: looks quite complicated, could it be simplified or comments be added? + + ## ------------------ Merge to Input ------------------- ## + OtherIDs <- merge(InputData, OtherIDs, by.x = SettingsInfo[['InputID']], + by.y = "InputID", all.x = TRUE) + + ##------------------- Add additional IDs -------------- ## + if (exists("EquivalentFeatures")) { + EquivalentFeatures$AllIDs <- EquivalentFeatures[[From]] + EquivalentFeatures_Long <- EquivalentFeatures %>% + separate_rows(!!sym(From), sep = ",") + + OtherIDs <- merge(OtherIDs, EquivalentFeatures_Long, + by.x = SettingsInfo[['InputID']] , by.y = "hmdb", + all.x = TRUE) %>% + rowwise() %>% + mutate(AllIDs = paste(unique( + na.omit(unlist(str_split(paste(na.omit(c(AllIDs.x, AllIDs.y)), collapse = ","), ",\\s*")))), + collapse = ",")) %>% + ungroup()%>% + rowwise() %>% + mutate( + PotentialAdditionalIDs = paste( + setdiff( + ## split merged_column into individual IDs + unlist(str_split(AllIDs, ",\\s*")), + ## split hmdb into individual IDs + as.character(!!sym(SettingsInfo[['InputID']])) + ), + ## Combine the remaining IDs back into a comma-separated string + collapse = ", ")) %>% + ungroup() %>% + select(-AllIDs.x, -AllIDs.y) ## EDIT: looks quite complicated, could it be simplified or comments be added? } - } - - unknown_types <- OmnipathR::id_types() %>% - dplyr::select(tidyselect::starts_with('in_')) %>% - unlist %>% - unique %>% - str_to_lower %>% - setdiff(From, .) - - if (length(unknown_types) > 0L) { - msg <- sprintf('The following ID types are not recognized: %s', paste(unknown_types, collapse = ', ')) - logger::log_warn(msg) - warning(msg) - } - - # Check that SettingsInfo[['InputID']] has no duplications within one group --> should not be the case --> remove duplications and inform the user/ ask if they forget to set groupings column - doublons <- InputData[duplicated(InputData[[SettingsInfo[['InputID']]]]), ] - - if(nrow(doublons) > 0){ - InputData <- InputData %>% - dplyr::distinct(!!sym(SettingsInfo[['InputID']]), .keep_all = TRUE) - - message <- sprintf('The following IDs are duplicated and removed: %s',paste(doublons[[SettingsInfo[['InputID']]]], collapse = ', ')) - logger::log_warn(message) - warning(message) - } - - ## ------------------ Create output folders and path ------------------- ## - if(is.null(SaveAs_Table)==FALSE ){ - Folder <- MetaProViz:::SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "EquivalentIDs") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - ## ------------------ Set the ID type for To ----------------- ## - To <- case_when( - From == "chebi" ~ "pubchem", # If To is "pubchem", choose "chebi" - TRUE ~ "chebi" # For other cases, don't use a secondary column - ) - - message <- paste0(To, " is used to find additional potential IDs for ", From, ".", sep="") - logger::log_trace(message) - message(message) - - ## ------------------ Load manual table ----------------- ## - if((From == "kegg") == FALSE){ - EquivalentFeatures <- MetaProViz:: ToyData("EquivalentFeatures")%>% - dplyr::select(From) - } - - ## ------------------ Translate From-to-To ------------------- ## - TranslatedDF <- OmnipathR::translate_ids( - InputData, - !!sym(SettingsInfo[['InputID']]) := !!sym(From), - !!!syms(To),#list of symbols, hence three !!! - ramp = TRUE, - expand = FALSE, - quantify_ambiguity =FALSE, - qualify_ambiguity = TRUE, # Can not be set to FALSE! - ambiguity_groups = NULL,#Checks within the groups, without it checks across groups - ambiguity_summary = FALSE - )%>% - dplyr::select(tidyselect::all_of(intersect(names(.), names(InputData))), tidyselect::all_of(To)) %>% - dplyr::mutate(across(all_of(To), ~ purrr::map_chr(., ~ paste(unique(.), collapse = ", ")))) %>% - dplyr::group_by(!!sym(SettingsInfo[['InputID']])) %>% - dplyr::mutate(across(tidyselect::all_of(To), ~ paste(unique(.), collapse = ", "), .names = "{.col}")) %>% - dplyr::ungroup() %>% - dplyr::distinct() %>% - dplyr::mutate(dplyr::across(tidyselect::all_of(To), ~ ifelse(. == "0", NA, .))) - - - ## ------------------ Translate To-to-From ------------------- ## - TranslatedDF_Long <- TranslatedDF%>% - dplyr::select(!!sym(SettingsInfo[['InputID']]), !!sym(To))%>% - dplyr::rename("InputID" = !!sym(SettingsInfo[['InputID']]))%>% - tidyr::separate_rows(!!sym(To), sep = ", ") %>% - dplyr::mutate(across(all_of(To), ~trimws(.))) %>% # Remove extra spaces - dplyr::filter(!!sym(To) != "") # Remove empty entries - - OtherIDs <- OmnipathR::translate_ids( - TranslatedDF_Long , - !!sym(To), - !!sym(From),#list of symbols, hence three !!! - ramp = TRUE, - expand = FALSE, - quantify_ambiguity =FALSE, - qualify_ambiguity = TRUE, # Can not be set to FALSE! - ambiguity_groups = NULL,#Checks within the groups, without it checks across groups - ambiguity_summary = FALSE - )%>% - dplyr::select("InputID", !!sym(To), !!sym(From))%>% - dplyr::distinct(InputID, !!sym(From), .keep_all = TRUE) %>% # Remove duplicates based on InputID and From - dplyr::mutate(AdditionalID = dplyr::if_else(InputID == !!sym(From), FALSE, TRUE)) %>% - dplyr::select("InputID",!!sym(From), "AdditionalID")%>% - dplyr::filter(AdditionalID == TRUE) %>% - dplyr::mutate(across(all_of(From), ~ purrr::map_chr(., ~ paste(unique(.), collapse = ", "))))%>% - dplyr::rowwise() %>% - dplyr::mutate( - FromList = list(stringr::str_split(!!sym(From), ",\\s*")[[1]]), # Wrap in list - SameAsInput = ifelse(any(FromList == InputID), InputID, NA_character_), # Match InputID - PotentialAdditionalIDs = paste(FromList[FromList != InputID], collapse = ", ") # Combine other IDs - ) %>% - dplyr::ungroup() %>% - dplyr::select(InputID, PotentialAdditionalIDs, hmdb)%>% # Final selection - dplyr::rename("AllIDs"= "hmdb") - - ## ------------------ Merge to Input ------------------- ## - OtherIDs <- merge(InputData, OtherIDs, by.x= SettingsInfo[['InputID']] , by.y= "InputID", all.x=TRUE) - - ##------------------- Add additional IDs -------------- ## - - if (exists("EquivalentFeatures")) { - EquivalentFeatures$AllIDs <- EquivalentFeatures[[From]] - EquivalentFeatures_Long <- EquivalentFeatures %>% - separate_rows(!!sym(From), sep = ",") - - OtherIDs <- merge(OtherIDs, EquivalentFeatures_Long, by.x= SettingsInfo[['InputID']] , by.y= "hmdb", all.x=TRUE)%>% - rowwise() %>% - mutate(AllIDs = paste(unique(na.omit(unlist(str_split(paste(na.omit(c(AllIDs.x, AllIDs.y)), collapse = ","), ",\\s*")))), collapse = ",")) %>% - ungroup()%>% - rowwise() %>% - mutate( - PotentialAdditionalIDs = paste( - setdiff( - unlist(str_split(AllIDs, ",\\s*")), # Split merged_column into individual IDs - as.character(!!sym(SettingsInfo[['InputID']])) # Split hmdb into individual IDs - ), - collapse = ", " # Combine the remaining IDs back into a comma-separated string - ) - ) %>% - ungroup()%>% - select(-AllIDs.x, -AllIDs.y) - } - - ## ------------------ Create Output ------------------- ## - OutputDF <- OtherIDs - - ## ------------------ Save the results ------------------- ## - ResList <- list("EquivalentIDs" = OutputDF) - - suppressMessages(suppressWarnings( - MetaProViz:::SaveRes(InputList_DF=ResList, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "EquivalentIDs", - CoRe=FALSE, - PrintPlot=FALSE))) - - return(invisible(OutputDF)) + + ## ------------------ Create Output ------------------- ## + OutputDF <- OtherIDs + + ## ------------------ Save the results ------------------- ## + ResList <- list("EquivalentIDs" = OutputDF) + + suppressMessages(suppressWarnings( + SaveRes( + InputList_DF = ResList, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "EquivalentIDs", + CoRe = FALSE, + PrintPlot = FALSE))) + + invisible(OutputDF) } ########################################################################################## @@ -432,9 +493,12 @@ EquivalentIDs <- function(InputData, #' @return List with at least 4 DFs: 1-3) From-to-To: 1. MappingIssues, 2. MappingIssues Summary, 3. Long summary (If Summary=TRUE) & 4-6) To-to-From: 4. MappingIssues, 5. MappingIssues Summary, 6. Long summary (If Summary=TRUE) & 7) Combined summary table (If Summary=TRUE) #' #' @examples -#' KEGG_Pathways <- MetaProViz::LoadKEGG() -#' InputDF <- MetaProViz::TranslateID(InputData= KEGG_Pathways, SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), From = c("kegg"), To = c("pubchem"))[["TranslatedDF"]] -#' Res <- MetaProViz::MappingAmbiguity(InputData= InputDF, From = "MetaboliteID", To = "pubchem", GroupingVariable = "term", Summary=TRUE) +#' KEGG_Pathways <- LoadKEGG() +#' InputDF <- TranslateID(InputData= KEGG_Pathways, +#' SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), +#' From = c("kegg"), To = c("pubchem"))[["TranslatedDF"]] +#' Res <- MappingAmbiguity(InputData = InputDF, From = "MetaboliteID", +#' To = "pubchem", GroupingVariable = "term", Summary = TRUE) #' #' @keywords Mapping ambiguity #' @@ -445,196 +509,217 @@ EquivalentIDs <- function(InputData, #' @export #' MappingAmbiguity <- function(InputData, - From, - To, - GroupingVariable = NULL, - Summary=FALSE, - SaveAs_Table= "csv", - FolderPath=NULL -) { - - MetaProViz_Init() - ## ------------------ Check Input ------------------- ## - # HelperFunction `CheckInput` - MetaProViz:::CheckInput(InputData=InputData, - InputData_Num=FALSE, - SaveAs_Table=SaveAs_Table) - - # Specific checks: - if(From %in% colnames(InputData)== FALSE){ - message <- paste0(From, " column was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(To %in% colnames(InputData)== FALSE){ - message <- paste0(To, " column was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(GroupingVariable)==FALSE){ - if(GroupingVariable %in% colnames(InputData)== FALSE){ - message <- paste0(GroupingVariable, " column was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + From, + To, + GroupingVariable = NULL, + Summary = FALSE, + SaveAs_Table = "csv", + FolderPath = NULL) { + + MetaProViz_Init() + + ## ------------------ Check Input ------------------- ## + ## HelperFunction `CheckInput` + CheckInput(InputData = InputData, InputData_Num = FALSE, + SaveAs_Table = SaveAs_Table) + + # Specific checks: + if (!From %in% colnames(InputData)) { + message <- paste0(From, " column was not found in InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - } - - if(is.logical(Summary) == FALSE){ - message <- paste0("Check input. The Summary parameter should be either =TRUE or =FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - ## ------------------ General checks of wrong occurences ------------------- ## - # Task 1: Check that From has no duplications within one group --> should not be the case --> remove duplications and inform the user/ ask if they forget to set groupings column - # Task 2: Check that From has the same items in to across the different entries (would be in different Groupings, otherwise there should not be any duplications) --> List of Miss-Mappings across terms - - # FYI: The above can not happen if our translateID function was used, but may be the case when the user has done something manually before - - - ## ------------------ Create output folders and path ------------------- ## - if(is.null(SaveAs_Table)==FALSE ){ - Folder <- MetaProViz:::SavePath(FolderName= "PriorKnowledge", - FolderPath=FolderPath) - - SubFolder <- file.path(Folder, "MappingAmbiguities") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - ##################################################################################################################################################################################### - ## ------------------ Prepare Input data ------------------- ## - #If the user provides a DF where the To column is a list of IDs, then we can use it right away - #If the To column is not a list of IDs, but a character column, we need to convert it into a list of IDs - if(is.character(InputData[[To]])==TRUE){ - InputData[[To]] <- InputData[[To]]%>% - strsplit(", ")%>% - lapply(as.character) - } - - ## ------------------ Perform ambiguity mapping ------------------- ## - #1. From-to-To: OriginalID-to-TranslatedID - #2. From-to-To: TranslatedID-to-OriginalID - Comp <- list( - list(From = From, To = To), - list(From = To, To = From) - ) - - ResList <- list() - for(comp in seq_along(Comp)){ - #Run Omnipath ambiguity - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]] <- InputData %>% - tidyr::unnest(cols = all_of(Comp[[comp]]$From))%>% # unlist the columns in case they are not expaned - filter(!is.na(!!sym(Comp[[comp]]$From)))%>%#Remove NA values, otherwise they are counted as column is character - OmnipathR::ambiguity( - from_col = !!sym(Comp[[comp]]$From), - to_col = !!sym(Comp[[comp]]$To), - groups = GroupingVariable, - quantify = TRUE, - qualify = TRUE, - global = TRUE,#across groups will be done additionally --> suffix _AcrossGroup - summary=TRUE, #summary of the mapping column - expand=TRUE) - - #Extract summary table: - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Summary", sep="")]] <- - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]]%>% - attr(paste0("ambiguity_", Comp[[comp]]$From , "_",Comp[[comp]]$To, sep="")) - - ############################################################################################################ - if(Summary==TRUE){ - if(is.null(GroupingVariable)==FALSE){ - # Add further information we need to summarise the table and combine Original-to-Translated and Translated-to-Original - # If we have a GroupingVariable we need to combine it with the MetaboliteID before merging - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Long", sep="")]] <- ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]]%>% - tidyr::unnest(cols = all_of(Comp[[comp]]$From))%>% - mutate(!!sym(paste0("AcrossGroupMappingIssue(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")", sep="")) := case_when( - !!sym(paste0(Comp[[comp]]$From, "_", Comp[[comp]]$To, "_ambiguity_bygroup", sep="")) != !!sym(paste0(Comp[[comp]]$From, "_", Comp[[comp]]$To, "_ambiguity", sep="")) ~ "TRUE", - TRUE ~ "FALSE" ))%>% - group_by(!!sym(Comp[[comp]]$From), !!sym(GroupingVariable))%>% - mutate(!!sym(Comp[[comp]]$To) := ifelse(!!sym(Comp[[comp]]$From) == 0, NA, # Or another placeholder - paste(unique(!!sym(Comp[[comp]]$To)), collapse = ", ") - )) %>% - mutate( !!sym(paste0("Count(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")")) := ifelse(all(!!sym(Comp[[comp]]$To) == 0), 0, n()))%>% - ungroup()%>% - distinct() %>% - unite(!!sym(paste0(Comp[[comp]]$From, "_to_", Comp[[comp]]$To)), c(Comp[[comp]]$From, Comp[[comp]]$To), sep=" --> ", remove=FALSE)%>% - separate_rows(!!sym(Comp[[comp]]$To), sep = ", ") %>% - unite(UniqueID, c(From, To, GroupingVariable), sep="_", remove=FALSE)%>% - distinct() - }else{ - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Long", sep="")]] <- ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]]%>% - tidyr::unnest(cols = all_of(Comp[[comp]]$From))%>% - group_by(!!sym(Comp[[comp]]$From))%>% - mutate(!!sym(Comp[[comp]]$To) := ifelse(!!sym(Comp[[comp]]$From) == 0, NA, # Or another placeholder - paste(unique(!!sym(Comp[[comp]]$To)), collapse = ", ") - )) %>% - mutate( !!sym(paste0("Count(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")")) := ifelse(all(!!sym(Comp[[comp]]$To) == 0), 0, n()))%>% - ungroup()%>% - distinct() %>% - unite(!!sym(paste0(Comp[[comp]]$From, "_to_", Comp[[comp]]$To)), c(Comp[[comp]]$From, Comp[[comp]]$To), sep=" --> ", remove=FALSE)%>% - separate_rows(!!sym(Comp[[comp]]$To), sep = ", ") %>% - unite(UniqueID, c(From, To), sep="_", remove=FALSE)%>% - distinct()%>% - mutate(!!sym(paste0("AcrossGroupMappingIssue(", From, "_to_", To, ")", sep="")) := NA) + + if (!To %in% colnames(InputData)) { + message <- paste0(To, + " column was not found in InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + if (!is.null(GroupingVariable)) { + if (!GroupingVariable %in% colnames(InputData)) { + message <- paste0(GroupingVariable, + " column was not found in InputData. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } + + if (!is.logical(Summary)) { + message <- paste0( + "Check input. The Summary parameter should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + ## ------------------ General checks of wrong occurences ------------------- ## + ## Task 1: Check that From has no duplications within one group --> should + ## not be the case --> remove duplications and inform the user/ ask if + ## they forget to set groupings column + ## Task 2: Check that From has the same items in to across the different + ## entries (would be in different Groupings, otherwise there should not be + ## any duplications) --> List of Miss-Mappings across terms + + ## FYI: The above can not happen if our translateID function was used, + ## but may be the case when the user has done something manually before + + + ## ------------------ Create output folders and path ------------------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledge", + FolderPath = FolderPath) + + SubFolder <- file.path(Folder, "MappingAmbiguities") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) } } - # Add NA metabolite maps back if they do exist: - Removed <- InputData %>% - tidyr::unnest(cols = all_of(Comp[[comp]]$From))%>% # unlist the columns in case they are not expaned - filter(is.na(!!sym(Comp[[comp]]$From))) - if(nrow(Removed)>0){ - ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]] <- bind_rows(ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]], - test<- Removed%>% - bind_cols(setNames(as.list(rep(NA, length(setdiff(names(ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]]), names(Removed))))), - setdiff(names(ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To , sep="")]]), names(Removed)))) - ) + ############################################################################ + ## ------------------ Prepare Input data ------------------- ## + ## if the user provides a DF where the To column is a list of IDs, then we + ## can use it right away + ## if the To column is not a list of IDs, but a character column, we need + ## to convert it into a list of IDs + if (is.character(InputData[[To]])) { + InputData[[To]] <- InputData[[To]] %>% + strsplit(", ") %>% + lapply(as.character) + } + + ## ------------------ Perform ambiguity mapping ------------------- ## + ## 1. From-to-To: OriginalID-to-TranslatedID + ## 2. From-to-To: TranslatedID-to-OriginalID + Comp <- list( + list(From = From, To = To), + list(From = To, To = From) + ) + + ResList <- list() + for (comp in seq_along(Comp)) { + + ## run Omnipath ambiguity + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]] <- InputData %>% + ## unlist the columns in case they are not expaned + tidyr::unnest(cols = all_of(Comp[[comp]]$From)) %>% + ## Remove NA values, otherwise they are counted as column is character + filter(!is.na(!!sym(Comp[[comp]]$From))) %>% + OmnipathR::ambiguity( + from_col = !!sym(Comp[[comp]]$From), + to_col = !!sym(Comp[[comp]]$To), + groups = GroupingVariable, + quantify = TRUE, + qualify = TRUE, + ## across groups will be done additionally --> suffix _AcrossGroup + global = TRUE, + ## summary of the mapping column + summary = TRUE, + expand = TRUE) + + ## extract summary table: + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Summary")]] <- + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]] %>% ## EDIT: the index could be assigned to an object since it is used several times and then be reused + attr(paste0("ambiguity_", Comp[[comp]]$From , "_", Comp[[comp]]$To)) + + ######################################################################## + if (Summary) { + if (!is.null(GroupingVariable)) { + ## add further information we need to summarise the table and + ## combine Original-to-Translated and Translated-to-Original + ## If we have a GroupingVariable we need to combine it + ## with the MetaboliteID before merging + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Long")]] <- ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]] %>% + tidyr::unnest(cols = all_of(Comp[[comp]]$From)) %>% + mutate(!!sym(paste0("AcrossGroupMappingIssue(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")")) := case_when( + !!sym(paste0(Comp[[comp]]$From, "_", Comp[[comp]]$To, "_ambiguity_bygroup")) != !!sym(paste0(Comp[[comp]]$From, "_", Comp[[comp]]$To, "_ambiguity")) ~ "TRUE", + TRUE ~ "FALSE" )) %>% + group_by(!!sym(Comp[[comp]]$From), !!sym(GroupingVariable)) %>% + mutate(!!sym(Comp[[comp]]$To) := ifelse( + !!sym(Comp[[comp]]$From) == 0, NA, ## Or another placeholder + paste(unique(!!sym(Comp[[comp]]$To)), collapse = ", "))) %>% + mutate(!!sym(paste0("Count(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")")) := ifelse(all(!!sym(Comp[[comp]]$To) == 0), 0, n())) %>% + ungroup()%>% + distinct() %>% + unite(!!sym(paste0(Comp[[comp]]$From, "_to_", Comp[[comp]]$To)), c(Comp[[comp]]$From, Comp[[comp]]$To), sep = " --> ", remove = FALSE) %>% + separate_rows(!!sym(Comp[[comp]]$To), sep = ", ") %>% + unite(UniqueID, c(From, To, GroupingVariable), sep = "_", remove = FALSE)%>% + distinct() ## EDIT: looks quite complicated, could it be simplified or comments be added? + } else{ + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To, "_Long")]] <- ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]] %>% + tidyr::unnest(cols = all_of(Comp[[comp]]$From))%>% + group_by(!!sym(Comp[[comp]]$From))%>% + mutate(!!sym(Comp[[comp]]$To) := ifelse(!!sym(Comp[[comp]]$From) == 0, NA, # Or another placeholder + paste(unique(!!sym(Comp[[comp]]$To)), collapse = ", "))) %>% + mutate(!!sym(paste0("Count(", Comp[[comp]]$From, "_to_", Comp[[comp]]$To, ")")) := ifelse(all(!!sym(Comp[[comp]]$To) == 0), 0, n())) %>% + ungroup()%>% + distinct() %>% + unite(!!sym(paste0(Comp[[comp]]$From, "_to_", Comp[[comp]]$To)), c(Comp[[comp]]$From, Comp[[comp]]$To), sep=" --> ", remove = FALSE) %>% + separate_rows(!!sym(Comp[[comp]]$To), sep = ", ") %>% + unite(UniqueID, c(From, To), sep="_", remove = FALSE) %>% + distinct() %>% + mutate(!!sym(paste0("AcrossGroupMappingIssue(", From, "_to_", To, ")")) := NA) ## EDIT: looks quite complicated, could it be simplified or comments be added? + } + } + + ## add NA metabolite maps back if they do exist: + Removed <- InputData %>% + ## unlist the columns in case they are not expaned + tidyr::unnest(cols = all_of(Comp[[comp]]$From)) %>% + filter(is.na(!!sym(Comp[[comp]]$From))) + + if (nrow(Removed)>0) { + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]] <- bind_rows( + ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]], + test <- Removed %>% + bind_cols(setNames(as.list(rep(NA, length(setdiff(names(ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]]), names(Removed))))), + setdiff(names(ResList[[paste0(Comp[[comp]]$From, "-to-", Comp[[comp]]$To)]]), names(Removed)))) ## EDIT: looks quite complicated, could it be simplified or comments be added? + ) + } + } + + ## ------------------ Create SummaryTable ------------------- ## + if (Summary) { + ## combine the two tables + Summary <- merge( + x = ResList[[paste0(From, "-to-", To, "_Long")]][, c("UniqueID", paste0(From, "_to_", To), paste0("Count(", From, "_to_", To, ")"), paste0("AcrossGroupMappingIssue(", From, "_to_", To, ")"))], + y= ResList[[paste0(To, "-to-", From, "_Long")]][, c("UniqueID", paste0(To, "_to_", From), paste0("Count(", To, "_to_", From, ")"), paste0("AcrossGroupMappingIssue(", To, "_to_", From, ")"))], ## EDIT: looks quite complicated, could it be simplified or comments be added? + by = "UniqueID", + all = TRUE) %>% + separate(UniqueID, into = c(From, To, GroupingVariable), sep = "_", remove = FALSE) %>% + distinct() + + ## Add relevant mapping information + Summary <- Summary %>% + mutate(Mapping = case_when( + !!sym(paste0("Count(", From, "_to_", To, ")")) == 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == 1 ~ "one-to-one", + !!sym(paste0("Count(", From, "_to_", To, ")")) > 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == 1 ~ "one-to-many", + !!sym(paste0("Count(", From, "_to_", To, ")")) > 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) > 1 ~ "many-to-many", + !!sym(paste0("Count(", From, "_to_", To, ")")) == 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) > 1 ~ "many-to-one", + !!sym(paste0("Count(", From, "_to_", To, ")")) >= 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == NA ~ "one-to-none", + !!sym(paste0("Count(", From, "_to_", To, ")")) >= 1 & is.na(!!sym(paste0("Count(", To, "_to_", From, ")"))) ~ "one-to-none", + !!sym(paste0("Count(", From, "_to_", To, ")")) == NA & !!sym(paste0("Count(", To, "_to_", From, ")")) >= 1 ~ "none-to-one", + is.na(!!sym(paste0("Count(", From, "_to_", To, ")"))) & !!sym(paste0("Count(", To, "_to_", From, ")")) >= 1 ~ "none-to-one", + TRUE ~ NA )) %>% + mutate(!!sym(paste0("Count(", From, "_to_", To, ")")) := replace_na(!!sym(paste0("Count(", From, "_to_", To, ")")), 0)) %>% + mutate(!!sym(paste0("Count(", To, "_to_", From, ")")) := replace_na(!!sym(paste0("Count(", To, "_to_", From, ")")), 0)) + + ResList[["Summary"]] <- Summary } - } - - ## ------------------ Create SummaryTable ------------------- ## - if(Summary==TRUE){ - # Combine the two tables - Summary <- merge(x= ResList[[paste0(From, "-to-", To, "_Long", sep="")]][,c("UniqueID", paste0(From, "_to_", To), paste0("Count(", From, "_to_", To, ")"), paste0("AcrossGroupMappingIssue(", From, "_to_", To, ")", sep=""))], - y= ResList[[paste0(To, "-to-", From, "_Long", sep="")]][,c("UniqueID", paste0(To, "_to_", From), paste0("Count(", To, "_to_", From, ")"), paste0("AcrossGroupMappingIssue(", To, "_to_", From, ")", sep=""))], - by = "UniqueID", - all = TRUE)%>% - separate(UniqueID, into = c(From, To, GroupingVariable), sep="_", remove=FALSE)%>% - distinct() - - # Add relevant mapping information - Summary <- Summary %>% - mutate(Mapping = case_when( - !!sym(paste0("Count(", From, "_to_", To, ")")) == 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == 1 ~ "one-to-one", - !!sym(paste0("Count(", From, "_to_", To, ")")) > 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == 1 ~ "one-to-many", - !!sym(paste0("Count(", From, "_to_", To, ")")) > 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) > 1 ~ "many-to-many", - !!sym(paste0("Count(", From, "_to_", To, ")")) == 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) > 1 ~ "many-to-one", - !!sym(paste0("Count(", From, "_to_", To, ")")) >= 1 & !!sym(paste0("Count(", To, "_to_", From, ")")) == NA ~ "one-to-none", - !!sym(paste0("Count(", From, "_to_", To, ")")) >= 1 & is.na(!!sym(paste0("Count(", To, "_to_", From, ")"))) ~ "one-to-none", - !!sym(paste0("Count(", From, "_to_", To, ")")) == NA & !!sym(paste0("Count(", To, "_to_", From, ")")) >= 1 ~ "none-to-one", - is.na(!!sym(paste0("Count(", From, "_to_", To, ")"))) & !!sym(paste0("Count(", To, "_to_", From, ")")) >= 1 ~ "none-to-one", - TRUE ~ NA )) %>% - mutate( !!sym(paste0("Count(", From, "_to_", To, ")")) := replace_na( !!sym(paste0("Count(", From, "_to_", To, ")")), 0)) %>% - mutate( !!sym(paste0("Count(", To, "_to_", From, ")")) := replace_na( !!sym(paste0("Count(", To, "_to_", From, ")")), 0)) - - ResList[["Summary"]] <- Summary - } - - ## ------------------ Save the results ------------------- ## - suppressMessages(suppressWarnings( - MetaProViz:::SaveRes(InputList_DF=ResList, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "MappingAmbiguity", - CoRe=FALSE, - PrintPlot=FALSE))) - - #Return - invisible(return(ResList)) + + ## ------------------ Save the results ------------------- ## + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = ResList, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "MappingAmbiguity", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(ResList) } ########################################################################################## @@ -651,213 +736,237 @@ MappingAmbiguity <- function(InputData, #' @importFrom rlang !!! !! := sym syms #' #' @examples -#' DetectedIDs <- MetaProViz::ToyData(Data="Cells_MetaData")%>% rownames_to_column("Metabolite") %>%dplyr::select("Metabolite", "HMDB")%>%tidyr::drop_na() -#' PathwayFile <- MetaProViz::TranslateID(InputData= MetaProViz::LoadKEGG(), SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), From = c("kegg"), To = c("hmdb"))[["TranslatedDF"]]%>%tidyr::drop_na() -#' Res <- MetaProViz::CleanMapping(InputData= DetectedIDs, PriorKnowledge= PathwayFile, SettingsInfo = c(InputID="HMDB", PriorID="hmdb", GroupingVariable="term")) - +#' DetectedIDs <- ToyData(Data="Cells_MetaData") %>% +#' rownames_to_column("Metabolite") %>% +#' dplyr::select("Metabolite", "HMDB") %>% +#' tidyr::drop_na() +#' PathwayFile <- TranslateID(InputData = LoadKEGG(), +#' SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), +#' From = c("kegg"), To = c("hmdb"))[["TranslatedDF"]] %>% +#' tidyr::drop_na() +#' Res <- CleanMapping(InputData= DetectedIDs, PriorKnowledge = PathwayFile, +#' SettingsInfo = c(InputID = "HMDB", PriorID = "hmdb", +#' GroupingVariable = "term")) #' #' @noRd #' - CheckMatchID <- function(InputData, - PriorKnowledge, - SettingsInfo = c(InputID="HMDB", PriorID="HMDB", GroupingVariable="term") -){ + PriorKnowledge, + SettingsInfo = c(InputID = "HMDB", PriorID ="HMDB", GroupingVariable = "term")) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Check Input files ----------- ## + + ## InputData: + if ("InputID" %in% names(SettingsInfo)) { + if (!SettingsInfo[["InputID"]] %in% colnames(InputData)) { + message <- paste0("The ", SettingsInfo[["InputID"]], " column selected as InpuID in SettingsInfo was not found in InputData. Please check your input.") + logger::log_trace(paste("Error ", message, sep="")) + stop(message) + } + } else{ + message <- paste0("No ", SettingsInfo[["InputID"]], " provided. Please check your input.") + logger::log_trace(paste("Error ", message, sep="")) + stop(message) + } + + if (sum(is.na(InputData[[SettingsInfo[["InputID"]]]])) >= 1) { + ## remove NAs: + message <- paste0(sum(is.na(InputData[[SettingsInfo[["InputID"]]]])), + " NA values were removed from column", SettingsInfo[["InputID"]]) + logger::log_trace(paste0("Warning: ", message)) - ## ------------ Create log file ----------- ## - MetaProViz_Init() + InputData <- InputData %>% + filter(!is.na(.data[[SettingsInfo[["InputID"]]]])) + warning(message) + } + + if (nrow(InputData) - nrow(distinct(InputData, .data[[SettingsInfo[["InputID"]]]])) >= 1) { + ## Remove duplicate IDs + message <- paste0( + nrow(InputData) - nrow(distinct(InputData, .data[[SettingsInfo[["InputID"]]]])), + " duplicated IDs were removed from column", SettingsInfo[["InputID"]]) + logger::log_trace(paste("Warning: ", message, sep="")) - ## ------------ Check Input files ----------- ## + InputData <- InputData %>% + distinct(.data[[SettingsInfo[["InputID"]]]], .keep_all = TRUE) - ## InputData: - if("InputID" %in% names(SettingsInfo)){ - if(SettingsInfo[["InputID"]] %in% colnames(InputData)== FALSE){ - message <- paste0("The ", SettingsInfo[["InputID"]], " column selected as InpuID in SettingsInfo was not found in InputData. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + warning(message) } - }else{ - message <- paste0("No ", SettingsInfo[["InputID"]], " provided. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(sum(is.na(InputData[[SettingsInfo[["InputID"]]]])) >=1){#remove NAs: - message <- paste0(sum(is.na(InputData[[SettingsInfo[["InputID"]]]])), " NA values were removed from column", SettingsInfo[["InputID"]]) - logger::log_trace(paste("Warning: ", message, sep="")) - - InputData <- InputData %>% - filter(!is.na(.data[[SettingsInfo[["InputID"]]]])) - - warning(message) - } - - if(nrow(InputData) - nrow(distinct(InputData, .data[[SettingsInfo[["InputID"]]]])) >= 1){# Remove duplicate IDs - message <- paste0(nrow(InputData) - nrow(distinct(InputData, .data[[SettingsInfo[["InputID"]]]])), " duplicated IDs were removed from column", SettingsInfo[["InputID"]]) - logger::log_trace(paste("Warning: ", message, sep="")) - - InputData <- InputData %>% - distinct(.data[[SettingsInfo[["InputID"]]]], .keep_all = TRUE) - - warning(message) - } - - InputData_MultipleIDs <- any( - grepl(",\\s*", InputData[[SettingsInfo[["InputID"]]]]) | # Comma-separated - sapply(InputData[[SettingsInfo[["InputID"]]]] , function(x) { - if (grepl("^c\\(|^list\\(", x)) { - parsed <- tryCatch(eval(parse(text = x)), error = function(e) NULL) - return(is.list(parsed) && length(parsed) > 1 || is.vector(parsed) && length(parsed) > 1) - } - FALSE - }) - ) - - ## PriorKnowledge: - if("PriorID" %in% names(SettingsInfo)){ - if(SettingsInfo[["PriorID"]] %in% colnames(PriorKnowledge)== FALSE){ - message <- paste0("The ", SettingsInfo[["PriorID"]], " column selected as InpuID in SettingsInfo was not found in PriorKnowledge. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + InputData_MultipleIDs <- any( + grepl(",\\s*", InputData[[SettingsInfo[["InputID"]]]]) | # Comma-separated + sapply(InputData[[SettingsInfo[["InputID"]]]], function(x) { + if (grepl("^c\\(|^list\\(", x)) { + parsed <- tryCatch(eval(parse(text = x)), error = function(e) NULL) + return(is.list(parsed) && length(parsed) > 1 || is.vector(parsed) && length(parsed) > 1) + } + FALSE + }) + ) + + ## PriorKnowledge: + if ("PriorID" %in% names(SettingsInfo)) { + if (!SettingsInfo[["PriorID"]] %in% colnames(PriorKnowledge)) { + message <- paste0("The ", SettingsInfo[["PriorID"]], + " column selected as InpuID in SettingsInfo was not found in PriorKnowledge. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + } else { + message <- paste0("No ", SettingsInfo[["PriorID"]], " provided. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - }else{ - message <- paste0("No ", SettingsInfo[["PriorID"]], " provided. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(sum(is.na(PriorKnowledge[[SettingsInfo[["PriorID"]]]])) >=1){#remove NAs: - message <- paste0(sum(is.na(PriorKnowledge[[SettingsInfo[["PriorID"]]]])), " NA values were removed from column", SettingsInfo[["PriorID"]]) - logger::log_trace(paste("Warning: ", message, sep="")) - - PriorKnowledge <- PriorKnowledge %>% - filter(!is.na(.data[[SettingsInfo[["PriorID"]]]])) - - warning(message) - } - - if("GroupingVariable" %in% names(SettingsInfo)){#Add GroupingVariable - if(SettingsInfo[["GroupingVariable"]] %in% colnames(PriorKnowledge)== FALSE){ - message <- paste0("The ", SettingsInfo[["GroupingVariable"]], " column selected as InpuID in SettingsInfo was not found in PriorKnowledge. Please check your input.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + if (sum(is.na(PriorKnowledge[[SettingsInfo[["PriorID"]]]])) >= 1) { + ## remove NAs: + message <- paste0(sum(is.na(PriorKnowledge[[SettingsInfo[["PriorID"]]]])), + " NA values were removed from column", SettingsInfo[["PriorID"]]) + logger::log_trace(paste0("Warning: ", message)) + + PriorKnowledge <- PriorKnowledge %>% + filter(!is.na(.data[[SettingsInfo[["PriorID"]]]])) + warning(message) } - }else{ - #Add GroupingVariable - SettingsInfo["GroupingVariable"] <- "GroupingVariable" - PriorKnowledge["GroupingVariable"] <- "None" - message <- paste0("No ", SettingsInfo[["PriorID"]], " provided. If this was not intentional, please check your input.") - logger::log_trace(message) - message(message) - } - - if(nrow(PriorKnowledge) - nrow(distinct(PriorKnowledge, .data[[SettingsInfo[["PriorID"]]]], .data[[SettingsInfo[["GroupingVariable"]]]])) >= 1){# Remove duplicate IDs - message <- paste0(nrow(PriorKnowledge) - nrow(distinct(PriorKnowledge, .data[[SettingsInfo[["PriorID"]]]], .data[[SettingsInfo[["GroupingVariable"]]]])) , " duplicated IDs were removed from column", SettingsInfo[["PriorID"]]) - logger::log_trace(paste("Warning: ", message, sep="")) - - PriorKnowledge <- PriorKnowledge %>% - distinct(.data[[SettingsInfo[["PriorID"]]]], !!sym(SettingsInfo[["GroupingVariable"]]), .keep_all = TRUE)%>% - group_by(!!sym(SettingsInfo[["PriorID"]])) %>% - mutate(across(everything(), ~ if (is.character(.)) paste(unique(.), collapse = ", ")))%>% - ungroup()%>% - distinct(.data[[SettingsInfo[["PriorID"]]]], .keep_all = TRUE) - - warning(message) - } - - PK_MultipleIDs <- any(# Check if multiple IDs are present: - grepl(",\\s*", PriorKnowledge[[SettingsInfo[["PriorID"]]]]) | # Comma-separated - sapply(PriorKnowledge[[SettingsInfo[["PriorID"]]]] , function(x) { - if (grepl("^c\\(|^list\\(", x)) { - parsed <- tryCatch(eval(parse(text = x)), error = function(e) NULL) - return(is.list(parsed) && length(parsed) > 1 || is.vector(parsed) && length(parsed) > 1) + if ("GroupingVariable" %in% names(SettingsInfo)) { + ## add GroupingVariable + if (!SettingsInfo[["GroupingVariable"]] %in% colnames(PriorKnowledge)) { + message <- paste0("The ", SettingsInfo[["GroupingVariable"]], + " column selected as InpuID in SettingsInfo was not found in ", + "PriorKnowledge. Please check your input.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - FALSE - }) - ) - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Table)==FALSE){ - Folder <- SavePath(FolderName= "PriorKnowledgeChecks", - FolderPath=FolderPath) - SubFolder <- file.path(Folder, "CheckMatchID_Detected-to-PK") - if (!dir.exists(SubFolder)) {dir.create(SubFolder)} - } - - ###################################################################################################################################### - ## ------------ Check how IDs match and if needed remove unmatched IDs ----------- ## - - # 1. Create long DF - create_long_df <- function(df, id_col, df_name) { - df %>% - mutate(row_id = dplyr::row_number()) %>% - mutate(!!paste0("OriginalEntry_", df_name, sep="") := !!sym(id_col)) %>% # Store original values - separate_rows(!!sym(id_col), sep = ",\\s*") %>% - group_by(row_id) %>% - mutate(!!(paste0("OriginalGroup_", df_name, sep="")) := paste0(df_name, "_", dplyr::cur_group_id())) %>% - ungroup() - } - - if(InputData_MultipleIDs){ - InputData_long <- create_long_df(InputData, SettingsInfo[["InputID"]], "InputData")%>% - select(SettingsInfo[["InputID"]],"OriginalEntry_InputData", OriginalGroup_InputData) - }else{ - InputData_long <- InputData %>% - mutate(OriginalGroup_InputData := paste0("InputData_", dplyr::row_number()))%>% - select(SettingsInfo[["InputID"]], OriginalGroup_InputData) - } - - if(PK_MultipleIDs){ - PK_long <- create_long_df(PriorKnowledge, SettingsInfo[["PriorID"]], "PK")%>% - select(SettingsInfo[["PriorID"]], "OriginalEntry_PK", OriginalGroup_PK, SettingsInfo[["GroupingVariable"]]) - }else{ - PK_long <- PriorKnowledge %>% - mutate(OriginalGroup_PK := paste0("PK_", dplyr::row_number()))%>% - select(SettingsInfo[["PriorID"]],OriginalGroup_PK, SettingsInfo[["GroupingVariable"]]) - } - - # 2. Merge DF - merged_df <- merge(PK_long, InputData_long, by.x= SettingsInfo[["PriorID"]], by.y= SettingsInfo[["InputID"]], all=TRUE)%>% - distinct(!!sym(SettingsInfo[["PriorID"]]), OriginalGroup_InputData, .keep_all = TRUE) - - #3. Add information to summarize and describe problems - merged_df <- merged_df %>% - # num_PK_entries - group_by(OriginalGroup_PK, !!sym(SettingsInfo[["GroupingVariable"]])) %>% - mutate( - num_PK_entries = sum(!is.na(OriginalGroup_PK)), - num_PK_entries_groups = dplyr::n_distinct(OriginalGroup_PK, na.rm = TRUE)) %>% # count the times we have the same PK_entry match with multiple InputData entries --> extend below! - ungroup()%>% - # num_Input_entries - group_by(OriginalGroup_InputData, !!sym(SettingsInfo[["GroupingVariable"]])) %>% - mutate( - num_Input_entries = sum(!is.na(OriginalGroup_InputData)), - num_Input_entries_groups = dplyr::n_distinct(OriginalGroup_InputData,, na.rm = TRUE))%>% - ungroup()%>% - mutate( - ActionRequired = case_when( - num_Input_entries ==1 & num_Input_entries_groups == 1 & num_PK_entries_groups == 1 ~ "None", - num_Input_entries ==1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "Check", - num_Input_entries ==1 & num_Input_entries_groups >= 2 & num_PK_entries_groups == 1 ~ "Check", - num_Input_entries > 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "Check", - num_Input_entries > 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups >= 2 ~ "Check", - num_Input_entries == 0 ~ "None", # ID(s) of PK not measured - TRUE ~ NA_character_ - ) - )%>% - mutate( - Detection = case_when( - num_Input_entries ==1 & num_Input_entries_groups == 1 & num_PK_entries_groups == 1 ~ "One input ID of the same group maps to at least ONE PK ID of ONE group", - num_Input_entries ==1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "One input ID of the same group maps to at least ONE PK ID of MANY groups", - num_Input_entries ==1 & num_Input_entries_groups >= 2 & num_PK_entries_groups == 1 ~ "One input ID of MANY groups maps to at least ONE PK ID of ONE groups", - num_Input_entries > 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "MANY input IDs of the same group map to at least ONE PK ID of MANY PK groups", - num_Input_entries > 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups >= 2 ~ "MANY input IDs of the MANY groups map to at least ONE PK ID of MANY PK groups", - num_Input_entries == 0 ~ "Not Detected", # ID(s) of PK not measured - TRUE ~ NA_character_ - ) + } else{ + ## add GroupingVariable + SettingsInfo["GroupingVariable"] <- "GroupingVariable" + PriorKnowledge["GroupingVariable"] <- "None" + + message <- paste0("No ", SettingsInfo[["PriorID"]], + " provided. If this was not intentional, please check your input.") + logger::log_trace(message) + message(message) + } + + if (nrow(PriorKnowledge) - nrow(distinct(PriorKnowledge, .data[[SettingsInfo[["PriorID"]]]], .data[[SettingsInfo[["GroupingVariable"]]]])) >= 1) { + # Remove duplicate IDs + message <- paste0( + nrow(PriorKnowledge) - nrow(distinct(PriorKnowledge, .data[[SettingsInfo[["PriorID"]]]], .data[[SettingsInfo[["GroupingVariable"]]]])), + " duplicated IDs were removed from column", SettingsInfo[["PriorID"]]) + logger::log_trace(paste("Warning: ", message, sep="")) + + PriorKnowledge <- PriorKnowledge %>% + distinct(.data[[SettingsInfo[["PriorID"]]]], !!sym(SettingsInfo[["GroupingVariable"]]), .keep_all = TRUE) %>% + group_by(!!sym(SettingsInfo[["PriorID"]])) %>% + mutate(across(everything(), ~ if (is.character(.)) paste(unique(.), collapse = ", "))) %>% + ungroup() %>% + distinct(.data[[SettingsInfo[["PriorID"]]]], .keep_all = TRUE) + + warning(message) + } + + PK_MultipleIDs <- any( + ## check if multiple IDs are present: + grepl(",\\s*", PriorKnowledge[[SettingsInfo[["PriorID"]]]]) | # Comma-separated + sapply(PriorKnowledge[[SettingsInfo[["PriorID"]]]] , + function(x) { + if (grepl("^c\\(|^list\\(", x)) { + parsed <- tryCatch(eval(parse(text = x)), error = function(e) NULL) + return(is.list(parsed) && length(parsed) > 1 || is.vector(parsed) && length(parsed) > 1) + } + FALSE + }) ## EDIT: is this the same as above, if so, it should be simplified (functionised?) ) - # Handle "Detected-to-PK" (When PK has multiple IDs) + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Table)) { + Folder <- SavePath(FolderName = "PriorKnowledgeChecks", + FolderPath = FolderPath) + SubFolder <- file.path(Folder, "CheckMatchID_Detected-to-PK") + if (!dir.exists(SubFolder)) { + dir.create(SubFolder) + } + } + + ############################################################################ + ## ------------ Check how IDs match and if needed remove unmatched IDs ----------- ## + + # 1. Create long DF + create_long_df <- function(df, id_col, df_name) { ## EDIT: function should be not defined within other functions + df %>% + mutate(row_id = dplyr::row_number()) %>% + mutate(!!paste0("OriginalEntry_", df_name, sep="") := !!sym(id_col)) %>% + ## Store original values + separate_rows(!!sym(id_col), sep = ",\\s*") %>% + group_by(row_id) %>% + mutate(!!(paste0("OriginalGroup_", df_name)) := paste0(df_name, "_", dplyr::cur_group_id())) %>% + ungroup() + } + + if (InputData_MultipleIDs) { + InputData_long <- create_long_df(InputData, SettingsInfo[["InputID"]], "InputData") %>% + select(SettingsInfo[["InputID"]], "OriginalEntry_InputData", OriginalGroup_InputData) + } else{ + InputData_long <- InputData %>% + mutate(OriginalGroup_InputData := paste0("InputData_", dplyr::row_number()))%>% + select(SettingsInfo[["InputID"]], OriginalGroup_InputData) + } + + if (PK_MultipleIDs) { + PK_long <- create_long_df(PriorKnowledge, SettingsInfo[["PriorID"]], "PK") %>% + select(SettingsInfo[["PriorID"]], "OriginalEntry_PK", OriginalGroup_PK, SettingsInfo[["GroupingVariable"]]) + } else{ + PK_long <- PriorKnowledge %>% + mutate(OriginalGroup_PK := paste0("PK_", dplyr::row_number()))%>% + select(SettingsInfo[["PriorID"]],OriginalGroup_PK, SettingsInfo[["GroupingVariable"]]) + } + + ## 2. merge DF + merged_df <- merge(PK_long, InputData_long, + by.x = SettingsInfo[["PriorID"]], by.y = SettingsInfo[["InputID"]], + all = TRUE) %>% + distinct(!!sym(SettingsInfo[["PriorID"]]), OriginalGroup_InputData, + .keep_all = TRUE) + + ## 3. add information to summarize and describe problems + merged_df <- merged_df %>% + ## num_PK_entries + group_by(OriginalGroup_PK, !!sym(SettingsInfo[["GroupingVariable"]])) %>% + mutate( + num_PK_entries = sum(!is.na(OriginalGroup_PK)), + num_PK_entries_groups = dplyr::n_distinct(OriginalGroup_PK, na.rm = TRUE)) %>% # count the times we have the same PK_entry match with multiple InputData entries --> extend below! + ungroup()%>% + # num_Input_entries + group_by(OriginalGroup_InputData, !!sym(SettingsInfo[["GroupingVariable"]])) %>% + mutate( + num_Input_entries = sum(!is.na(OriginalGroup_InputData)), + num_Input_entries_groups = dplyr::n_distinct(OriginalGroup_InputData,, na.rm = TRUE)) %>% + ungroup() %>% + mutate( + ActionRequired = case_when( + num_Input_entries == 1 & num_Input_entries_groups == 1 & num_PK_entries_groups == 1 ~ "None", + num_Input_entries == 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "Check", + num_Input_entries == 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups == 1 ~ "Check", + num_Input_entries > 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "Check", + num_Input_entries > 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups >= 2 ~ "Check", + num_Input_entries == 0 ~ "None", # ID(s) of PK not measured + TRUE ~ NA_character_ + )) %>% + mutate( + Detection = case_when( + num_Input_entries == 1 & num_Input_entries_groups == 1 & num_PK_entries_groups == 1 ~ "One input ID of the same group maps to at least ONE PK ID of ONE group", + num_Input_entries == 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "One input ID of the same group maps to at least ONE PK ID of MANY groups", + num_Input_entries == 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups == 1 ~ "One input ID of MANY groups maps to at least ONE PK ID of ONE groups", + num_Input_entries > 1 & num_Input_entries_groups == 1 & num_PK_entries_groups >= 2 ~ "MANY input IDs of the same group map to at least ONE PK ID of MANY PK groups", + num_Input_entries > 1 & num_Input_entries_groups >= 2 & num_PK_entries_groups >= 2 ~ "MANY input IDs of the MANY groups map to at least ONE PK ID of MANY PK groups", + num_Input_entries == 0 ~ "Not Detected", # ID(s) of PK not measured + TRUE ~ NA_character_)) + + ## Handle "Detected-to-PK" (When PK has multiple IDs) #group_by(OriginalGroup_PK, !!sym(SettingsInfo[["GroupingVariable"]])) %>% #mutate( # `Detected-to-PK` = case_when( @@ -897,95 +1006,116 @@ CheckMatchID <- function(InputData, # ) #) - # 4. Create summary table - Values_InputData <- unique(InputData[[SettingsInfo[["InputID"]]]]) - Values_PK <- unique(PK_long[[SettingsInfo[["PriorID"]]]]) - - summary_df <- tibble::tibble( - !!sym(SettingsInfo[["InputID"]]) := Values_InputData, - found_match_in_PK = NA, - matches = NA_character_, - match_overlap_percentage = NA_real_, - original_count = NA_integer_, - matches_count = NA_integer_ - ) - - # Populate the summary data frame - for(i in seq_along(Values_InputData)) { - # Handle NA case explicitly - if (is.na(Values_InputData[i])) { - summary_df$original_count[i] <- 0 - summary_df$matches_count[i] <- 0 - summary_df$match_overlap_percentage[i] <- NA - summary_df$found_match_in_PK[i] <- NA # could also set it to FALSE but making NA for now for plotting - summary_df$matches[i] <- NA - } else { - # Split each cell into individual entries and trim whitespace - entries <- trimws(unlist(strsplit(as.character(Values_InputData[i]), ",\\s*"))) # delimiter = "," or ", " - - # Identify which entries are in the lookup set - matched <- entries[entries %in% Values_PK] - - # Determine if any match was found - summary_df$found_match_in_PK[i] <- length(matched) > 0 - - # Concatenate matched entries into a single string - summary_df$matches[i] <- paste(matched, collapse = ", ") - - # Calculate and store counts - summary_df$original_count[i] <- length(entries) - summary_df$matches_count[i] <- length(matched) + ## 4. Create summary table + Values_InputData <- unique(InputData[[SettingsInfo[["InputID"]]]]) + Values_PK <- unique(PK_long[[SettingsInfo[["PriorID"]]]]) + + summary_df <- tibble::tibble( + !!sym(SettingsInfo[["InputID"]]) := Values_InputData, + found_match_in_PK = NA, + matches = NA_character_, + match_overlap_percentage = NA_real_, + original_count = NA_integer_, + matches_count = NA_integer_ + ) - # Calculate fraction: matched entries / total entries - if(length(entries) > 0) { - summary_df$match_overlap_percentage[i] <- (length(matched) / length(entries))*100 - } else { - summary_df$match_overlap_percentage[i] <- NA - } + ## populate the summary data frame + for (i in seq_along(Values_InputData)) { + # Handle NA case explicitly + if (is.na(Values_InputData[i])) { + summary_df$original_count[i] <- 0 + summary_df$matches_count[i] <- 0 + summary_df$match_overlap_percentage[i] <- NA + ## could also set it to FALSE but making NA for now for plotting + summary_df$found_match_in_PK[i] <- NA + summary_df$matches[i] <- NA + } else { + ## split each cell into individual entries and trim whitespace + entries <- trimws( + unlist(strsplit(as.character(Values_InputData[i]), ",\\s*"))) ## delimiter = "," or ", " + + ## identify which entries are in the lookup set + matched <- entries[entries %in% Values_PK] + + ## determine if any match was found + summary_df$found_match_in_PK[i] <- length(matched) > 0 + + ## concatenate matched entries into a single string + summary_df$matches[i] <- paste(matched, collapse = ", ") + + ## calculate and store counts + summary_df$original_count[i] <- length(entries) + summary_df$matches_count[i] <- length(matched) + + ## calculate fraction: matched entries / total entries + if (length(entries) > 0) { + summary_df$match_overlap_percentage[i] <- (length(matched) / length(entries))*100 + } else { + summary_df$match_overlap_percentage[i] <- NA + } + } } - } - summary_df <- merge(x= summary_df, - y= merged_df%>% - dplyr::select(-c(OriginalGroup_PK, OriginalGroup_InputData))%>% - distinct(!!sym(SettingsInfo[["PriorID"]]), .keep_all = TRUE), - by.x= SettingsInfo[["InputID"]] , - by.y= SettingsInfo[["PriorID"]], - all.x=TRUE) + summary_df <- merge( + x = summary_df, + y = merged_df %>% + dplyr::select(-c(OriginalGroup_PK, OriginalGroup_InputData)) %>% + distinct(!!sym(SettingsInfo[["PriorID"]]), .keep_all = TRUE), + by.x = SettingsInfo[["InputID"]] , + by.y = SettingsInfo[["PriorID"]], + all.x = TRUE) + + summary_df <- merge(x = summary_df, y = InputData, + by = SettingsInfo[["InputID"]], all.x = TRUE) %>% + distinct(!!sym(SettingsInfo[["InputID"]]), OriginalEntry_PK, + .keep_all = TRUE) + + ## 5. Messages and summarise + message <- paste0("InputData has multiple IDs per measurement = ", + InputData_MultipleIDs, ". PriorKnowledge has multiple IDs per entry = ", + PK_MultipleIDs, ".") + message1 <- paste0("InputData has ", + dplyr::n_distinct(unique(InputData[[SettingsInfo[["InputID"]]]])), + " unique entries with ", + dplyr::n_distinct(unique(InputData_long[[SettingsInfo[["InputID"]]]])), + " unique ", SettingsInfo[["InputID"]], " IDs. Of those IDs, ", + nrow(dplyr::filter(summary_df, matches_count == 1)), + " match, which is ", + nrow(dplyr::filter(summary_df, matches_count == 1)) / dplyr::n_distinct(unique(InputData_long[[SettingsInfo[["InputID"]]]])) * 100, "%." , sep = "") + message2 <- paste0("PriorKnowledge has ", + dplyr::n_distinct(PriorKnowledge[[SettingsInfo[["PriorID"]]]]), + " unique entries with ", + dplyr::n_distinct(PK_long[[SettingsInfo[["PriorID"]]]]), + " unique ", SettingsInfo[["PriorID"]], " IDs. Of those IDs, ", + nrow(dplyr::filter(summary_df, matches_count == 1)), + " are detected in the data, which is ", + nrow(dplyr::filter(summary_df, matches_count == 1)) / dplyr::n_distinct(PK_long[[SettingsInfo[["PriorID"]]]]) * 100, "%.") ## EDIT: consider precomputing repeated objects + + if (nrow(dplyr::filter(summary_df, ActionRequired == "Check")) >= 1) { + #warning <- paste0("There are cases where multiple detected IDs match to multiple prior knowledge IDs of the same category") # "Check" - summary_df <- merge(x= summary_df, y= InputData, by=SettingsInfo[["InputID"]], all.x=TRUE)%>% - distinct(!!sym(SettingsInfo[["InputID"]]), OriginalEntry_PK, .keep_all = TRUE) - - # 5. Messages and summarise - message <- paste0("InputData has multiple IDs per measurement = ", InputData_MultipleIDs, ". PriorKnowledge has multiple IDs per entry = ", PK_MultipleIDs, ".", sep="") - message1 <- paste0("InputData has ", dplyr::n_distinct(unique(InputData[[SettingsInfo[["InputID"]]]])), " unique entries with " ,dplyr::n_distinct(unique(InputData_long[[SettingsInfo[["InputID"]]]])) ," unique ", SettingsInfo[["InputID"]], " IDs. Of those IDs, ", nrow(summary_df%>% dplyr::filter(matches_count == 1)), " match, which is ", (nrow(summary_df%>% dplyr::filter(matches_count == 1)) / dplyr::n_distinct(unique(InputData_long[[SettingsInfo[["InputID"]]]])))*100, "%." , sep="") - message2 <- paste0("PriorKnowledge has ", dplyr::n_distinct(PriorKnowledge[[SettingsInfo[["PriorID"]]]]), " unique entries with " ,dplyr::n_distinct(PK_long[[SettingsInfo[["PriorID"]]]]) ," unique ", SettingsInfo[["PriorID"]], " IDs. Of those IDs, ", nrow(summary_df%>% dplyr::filter(matches_count == 1)), " are detected in the data, which is ", (nrow(summary_df%>% dplyr::filter(matches_count == 1)) / dplyr::n_distinct(PK_long[[SettingsInfo[["PriorID"]]]]))*100, "%.") - - if(nrow(summary_df%>% dplyr::filter(ActionRequired == "Check"))>=1){ - #warning <- paste0("There are cases where multiple detected IDs match to multiple prior knowledge IDs of the same category") # "Check" - - } - - ## ------------------ Plot Summary ----------------------## - # x = "Class" and y = Frequency. Match Status can be colour of if no class provided class = Match status. - # Check Biocrates code. - - - ## ------------------ Save Results ----------------------## - ResList <- list("InputData_Matched" = summary_df) - - suppressMessages(suppressWarnings( - MetaProViz:::SaveRes(InputList_DF=ResList, - InputList_Plot= NULL, - SaveAs_Table=SaveAs_Table, - SaveAs_Plot=NULL, - FolderPath= SubFolder, - FileName= "CheckMatchID_Detected-to-PK", - CoRe=FALSE, - PrintPlot=FALSE))) + } - #Return - invisible(return(ResList[["InputData_Matched"]])) + ## ------------------ Plot Summary ----------------------## + # x = "Class" and y = Frequency. Match Status can be colour of if no class provided class = Match status. + # Check Biocrates code. + + ## ------------------ Save Results ----------------------## + ResList <- list("InputData_Matched" = summary_df) + + suppressMessages( + suppressWarnings( + SaveRes(InputList_DF = ResList, + InputList_Plot = NULL, + SaveAs_Table = SaveAs_Table, + SaveAs_Plot = NULL, + FolderPath = SubFolder, + FileName = "CheckMatchID_Detected-to-PK", + CoRe = FALSE, + PrintPlot = FALSE))) + + ## return + invisible(ResList[["InputData_Matched"]]) } @@ -999,127 +1129,147 @@ CheckMatchID <- function(InputData, #' @param SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), #' #' @examples -#' KEGG_Pathways <- MetaProViz::LoadKEGG() +#' KEGG_Pathways <- LoadKEGG() #' InputData = KEGG_Pathways #' #' #' @noRd +ClusterPK <- function( + InputData, # This can be either the original PK (e.g. KEGG pathways), but it can also be the output of enrichment results (--> meaning here we would cluster based on detection!) + SettingsInfo = c(InputID = "MetaboliteID", GroupingVariable = "term"), + Clust = c("Graph", "Hierarchical"), # Options: "Graph", "Hierarchical", + matrix = c("percentage", "pearson", "spearman", "kendall"), # Choose "pearson", "spearman", "kendall", or "percentage" + min = 2) { # minimum pathways per cluster + + # Cluster PK before running enrichment analysis --> add another column that groups the data based on the pathway overlap: + # provide different options for clustering (e.g. % of overlap, semantics similarity) --> Ramp uses % of overlap, semnatics similarity: https://yulab-smu.top/biomedical-knowledge-mining-book/GOSemSim.html + + + ## ------------------ Check Input ------------------- ## + ## match arguments + Clust <- match.arg(Clust) + matrix <- match.arg(matrix) + + ## ------------------ Create output folders and path ------------------- ## + + + + ############################################################################ + ## ------------------ Cluster the data ------------------- ## + ## 1. create a list of unique MetaboliteIDs for each term + term_metabolites <- InputData %>% + dplyr::group_by(!!sym(SettingsInfo[["GroupingVariable"]])) %>% + dplyr::summarize(MetaboliteIDs = list(unique(!!sym(SettingsInfo[["InputID"]])))) %>% + dplyr::ungroup() + + ## 2. Create the overlap matrix based on different methods: + if (matrix == "percentage") { + # Compute pairwise overlaps + term_overlap <- combn( + term_metabolites[[SettingsInfo[["GroupingVariable"]]]], 2, + function(terms) { + term1_ids <- term_metabolites$MetaboliteIDs[term_metabolites[[SettingsInfo[["GroupingVariable"]]]] == terms[1]][[1]] + term2_ids <- term_metabolites$MetaboliteIDs[term_metabolites[[SettingsInfo[["GroupingVariable"]]]] == terms[2]][[1]] + + overlap <- length(intersect(term1_ids, term2_ids)) / length(union(term1_ids, term2_ids)) + data.frame(Term1 = terms[1], Term2 = terms[2], Overlap = overlap) + }, simplify = FALSE) %>% + dplyr::bind_rows() + + ## create overlap matrix: An overlap matrix is typically used to + ## quantify the degree of overlap between two sets or groups, + ## overlap coefficient (or Jaccard Index) Overlap(A,B)= ∣A∪B∣ / ∣A∩B + ## the overlap matrix measures the similarity between sets or groups based on common elements. + terms <- unique(c(term_overlap$Term1, term_overlap$Term2)) + overlap_matrix <- matrix(1, nrow = length(terms), + ncol = length(terms), dimnames = list(terms, terms)) + for (i in seq_len(nrow(term_overlap))) { + t1 <- term_overlap$Term1[i] + t2 <- term_overlap$Term2[i] + overlap_matrix[t1, t2] <- 1 - term_overlap$Overlap[i] + overlap_matrix[t2, t1] <- 1 - term_overlap$Overlap[i] + } + } else { + ## create a binary matrix for correlation methods + terms <- term_metabolites[[SettingsInfo[["GroupingVariable"]]]] + metabolites <- unique(unlist(term_metabolites$MetaboliteIDs)) #[[SettingsInfo[["InputID"]]]] + + binary_matrix <- matrix(0, nrow = length(terms), + ncol = length(metabolites), dimnames = list(terms, metabolites)) + + for (i in seq_along(terms)) { + metabolites_for_term <- term_metabolites$MetaboliteIDs[[i]] #[[SettingsInfo[["InputID"]]]] + binary_matrix[i, colnames(binary_matrix) %in% metabolites_for_term] <- 1 + } - - -ClusterPK <- function(InputData, # This can be either the original PK (e.g. KEGG pathways), but it can also be the output of enrichment results (--> meaning here we would cluster based on detection!) - SettingsInfo= c(InputID="MetaboliteID", GroupingVariable="term"), - Clust = "Graph", # Options: "Graph", "Hierarchical", - matrix ="percentage", # Choose "pearson", "spearman", "kendall", or "percentage" - min= 2 # minimum pathways per cluster - -){ - - # Cluster PK before running enrichment analysis --> add another column that groups the data based on the pathway overlap: - # provide different options for clustering (e.g. % of overlap, semantics similarity) --> Ramp uses % of overlap, semnatics similarity: https://yulab-smu.top/biomedical-knowledge-mining-book/GOSemSim.html - - - ## ------------------ Check Input ------------------- ## - - - ## ------------------ Create output folders and path ------------------- ## - - - - ###################################################################################################################################### - ## ------------------ Cluster the data ------------------- ## - # 1. Create a list of unique MetaboliteIDs for each term - term_metabolites <- InputData %>% - dplyr::group_by(!!sym(SettingsInfo[["GroupingVariable"]])) %>% - dplyr::summarize(MetaboliteIDs = list(unique(!!sym(SettingsInfo[["InputID"]])))) %>% - dplyr::ungroup() - - #2. Create the overlap matrix based on different methods: - if (matrix == "percentage") {# Compute pairwise overlaps - term_overlap <- combn(term_metabolites[[SettingsInfo[["GroupingVariable"]]]], 2, function(terms) { - term1_ids <- term_metabolites$MetaboliteIDs[term_metabolites[[SettingsInfo[["GroupingVariable"]]]] == terms[1]][[1]] - term2_ids <- term_metabolites$MetaboliteIDs[term_metabolites[[SettingsInfo[["GroupingVariable"]]]] == terms[2]][[1]] - - overlap <- length(intersect(term1_ids, term2_ids)) / length(union(term1_ids, term2_ids)) - data.frame(Term1 = terms[1], Term2 = terms[2], Overlap = overlap) - }, simplify = FALSE) %>% - dplyr::bind_rows() - - # Create overlap matrix: An overlap matrix is typically used to quantify the degree of overlap between two sets or groups. - # overlap coefficient (or Jaccard Index) Overlap(A,B)= ∣A∪B∣ / ∣A∩B - #The overlap matrix measures the similarity between sets or groups based on common elements. - terms <- unique(c(term_overlap$Term1, term_overlap$Term2)) - overlap_matrix <- matrix(1, nrow = length(terms), ncol = length(terms), dimnames = list(terms, terms)) - for (i in seq_len(nrow(term_overlap))) { - t1 <- term_overlap$Term1[i] - t2 <- term_overlap$Term2[i] - overlap_matrix[t1, t2] <- 1 - term_overlap$Overlap[i] - overlap_matrix[t2, t1] <- 1 - term_overlap$Overlap[i] + ## Compute correlation matrix: square matrix used to represent the + ## pairwise correlation coefficients between variables or terms + ## correlation matrix 𝐶 C is an 𝑛 × 𝑛 n×n matrix where each + ## element 𝐶 𝑖 𝑗 C ij is the correlation coefficient between the + ## variables 𝑋𝑖 Xi and 𝑋 𝑗 X j + ## the correlation matrix measures the strength and direction of + ## linear relationships between variables. + correlation_matrix <- cor(t(binary_matrix), method = matrix) + + ## Convert to distance matrix + overlap_matrix <- 1 - correlation_matrix } - } else { - # Create a binary matrix for correlation methods - terms <- term_metabolites[[SettingsInfo[["GroupingVariable"]]]] - metabolites <- unique(unlist(term_metabolites$MetaboliteIDs)) #[[SettingsInfo[["InputID"]]]] - - binary_matrix <- matrix(0, nrow = length(terms), ncol = length(metabolites), dimnames = list(terms, metabolites)) - for (i in seq_along(terms)) { - metabolites_for_term <- term_metabolites$MetaboliteIDs[[i]] #[[SettingsInfo[["InputID"]]]] - binary_matrix[i, colnames(binary_matrix) %in% metabolites_for_term] <- 1 + + ## 3. Cluster terms based on overlap threshold + ## define similarity threshold + threshold <- 0.7 + term_clusters <- term_overlap %>% + dplyr::filter(Overlap >= threshold) %>% + dplyr::select(Term1, Term2) + + ## 4. Clustering + if (Clust == "Graph") { + ## use Graph-based clustering + ## calculate the distance matrix: + overlap_matrix <- 1 - correlation_matrix + + ## an adjacency matrix represents a graph structure and encodes the + ## relationships between nodes (vertices) + ## add weight (can also represent unweighted graphs) + ## Applying Gaussian kernel to convert distance into similarity + adjacency_matrix <- exp(-overlap_matrix ^ 2) + + ## create a graph from the adjacency matrix + g <- igraph::graph_from_adjacency_matrix(adjacency_matrix, + mode = "undirected", weighted = TRUE) + initial_clusters <- igraph::components(g)$membership + term_metabolites$Cluster <- initial_clusters[ + match(term_metabolites[[SettingsInfo[["GroupingVariable"]]]], + names(initial_clusters))] + } else if (Clust == "Hierarchical") { + ## hierarchical clustering + ## make methods into parameters! + hclust_result <- hclust(as.dist(distance_matrix), method = "average") + num_clusters <- 4 + term_clusters_hclust <- cutree(hclust_result, k = num_clusters) + + term_metabolites$Cluster <- paste0("Cluster", + term_clusters_hclust[match(terms, names(term_clusters_hclust))]) + #term_metabolites$Cluster <- clusters[match(term_metabolites[[SettingsInfo[["GroupingVariable"]]]], names(clusters))] + } else { ## EDIT: not needed with match.arg + stop("Invalid clustering method specified in Clust parameter.") } - # Compute correlation matrix: square matrix used to represent the pairwise correlation coefficients between variables or terms - # correlation matrix 𝐶 C is an 𝑛 × 𝑛 n×n matrix where each element 𝐶 𝑖 𝑗 C ij is the correlation coefficient between the variables 𝑋𝑖 Xi and 𝑋 𝑗 X j - #The correlation matrix measures the strength and direction of linear relationships between variables. - correlation_matrix <- cor(t(binary_matrix), method = matrix) - - # Convert to distance matrix - overlap_matrix <- 1 - correlation_matrix - } - # 3. Cluster terms based on overlap threshold - threshold <- 0.7 # Define similarity threshold - term_clusters <- term_overlap %>% - dplyr::filter(Overlap >= threshold) %>% - dplyr::select(Term1, Term2) - - # 4. Clustering - if (Clust == "Graph") { #Use Graph-based clustering - # Here we need the distance matrix: - overlap_matrix <- 1 - correlation_matrix - - # An adjacency matrix represents a graph structure and encodes the relationships between nodes (vertices) - # Add weight (can also represent unweighted graphs) - adjacency_matrix <- exp(-overlap_matrix^2) # Applying Gaussian kernel to convert distance into similarity - - # Create a graph from the adjacency matrix - g <- igraph::graph_from_adjacency_matrix(adjacency_matrix, mode = "undirected", weighted = TRUE) - initial_clusters <- igraph::components(g)$membership - term_metabolites$Cluster <- initial_clusters[match(term_metabolites[[SettingsInfo[["GroupingVariable"]]]], names(initial_clusters))] - } else if (Clust == "Hierarchical") { # Hierarchical clustering - hclust_result <- hclust(as.dist(distance_matrix), method = "average") # make methods into parameters! - num_clusters <- 4 - term_clusters_hclust <- cutree(hclust_result, k = num_clusters) - - term_metabolites$Cluster <- paste0("Cluster", term_clusters_hclust[match(terms, names(term_clusters_hclust))]) - #term_metabolites$Cluster <- clusters[match(term_metabolites[[SettingsInfo[["GroupingVariable"]]]], names(clusters))] - } else { - stop("Invalid clustering method specified in Clust parameter.") - } - - # 5. Merge cluster group information back to the original data - df <- InputData %>% - dplyr::left_join(term_metabolites %>% select(!!sym(SettingsInfo[["GroupingVariable"]]), Cluster), by = SettingsInfo[["GroupingVariable"]])%>% - dplyr::mutate(Cluster = ifelse( - is.na(Cluster), - "None", # Assign "None" to NAs - paste0("Cluster", Cluster) # Convert numeric IDs to descriptive labels - ) - ) - - # 6. Summarize the clustering results - + ## 5. Merge cluster group information back to the original data + df <- InputData %>% + dplyr::left_join( + select(term_metabolites, !!sym(SettingsInfo[["GroupingVariable"]]), Cluster), + by = SettingsInfo[["GroupingVariable"]]) %>% + dplyr::mutate(Cluster = ifelse( + is.na(Cluster), + ## assign "None" to NAs + "None", + ## convert numeric IDs to descriptive labels + paste0("Cluster", Cluster))) - ## ------------------ Save and return ------------------- ## + # 6. Summarize the clustering results + ## ------------------ Save and return ------------------- ## } @@ -1142,68 +1292,69 @@ ClusterPK <- function(InputData, # This can be either the original PK (e.g. KEGG # Use in ORA functions and showcase in vignette with decoupleR output AddInfo <- function(mat, - net, - res, - .source, - .target, - complete=FALSE){ + net, + res, + .source, + .target, + complete = FALSE) { - ## ------------------ Check Input ------------------- ## + ## ------------------ check input ------------------- ## - ## ------------------ Create output folders and path ------------------- ## + ## ------------------ create output folders and path ------------------- ## - ## ------------------ Add information to enrichment results ------------------- ## + ## ------------------ add information to enrichment results ------------------- ## - # add number of Genes_targeted_by_TF_num - net$Count <- 1 - net_Mean <- aggregate(net$Count, by=list(source=net[[.source]]), FUN=sum)%>% - rename("targets_num" = 2) + ## add number of Genes_targeted_by_TF_num + net$Count <- 1 + net_Mean <- aggregate(net$Count, + by = list(source = net[[.source]]), FUN = sum) %>% + rename("targets_num" = 2) - if(complete==TRUE){ - res_Add<- merge(x= res, y=net_Mean, by="source", all=TRUE) - }else{ - res_Add<- merge(x= res, y=net_Mean, by="source", all.x =TRUE) - } + if (complete) { + res_Add <- merge(x = res, y = net_Mean, by = "source", all = TRUE) + } else{ + res_Add <- merge(x = res, y = net_Mean, by = "source", all.x = TRUE) + } ## EDIT: would a left_join do the same without the if/else? - # add list of Genes_targeted_by_TF_chr - net_List <- aggregate(net[[.target]]~net[[.source]], FUN=toString)%>% - rename("source" = 1, - "targets_chr"=2) - res_Add<- merge(x= res_Add, y=net_List, by="source", all.x=TRUE) + ## add list of Genes_targeted_by_TF_chr + net_List <- aggregate(net[[.target]] ~ net[[.source]], FUN = toString) %>% + rename("source" = 1, "targets_chr" = 2) + res_Add <- merge(x = res_Add, y = net_List, by = "source", all.x = TRUE) - # add number of Genes_targeted_by_TF_detected_num - mat <- as.data.frame(mat)%>% #Are these the normalised counts? - tibble::rownames_to_column("Symbol") + ## add number of Genes_targeted_by_TF_detected_num + mat <- as.data.frame(mat) %>% ## Are these the normalised counts? + tibble::rownames_to_column("Symbol") - Detected <- merge(x= mat , y=net[,c(.source, .target)], by.x="Symbol", by.y=.target, all.x=TRUE)%>% - filter(!is.na(across(all_of(.source)))) - Detected$Count <-1 - Detected_Mean <- aggregate(Detected$Count, by=list(source=Detected[[.source]]), FUN=sum)%>% - rename("targets_detected_num" = 2) + Detected <- merge(x = mat , y = net[,c(.source, .target)], + by.x = "Symbol", by.y = .target, all.x = TRUE) %>% + filter(!is.na(across(all_of(.source)))) + Detected$Count <-1 + Detected_Mean <- aggregate(Detected$Count, + by = list(source = Detected[[.source]]), FUN = sum) %>% + rename("targets_detected_num" = 2) - res_Add<- merge(x= res_Add, y=Detected_Mean, by="source", all.x=TRUE)%>% + res_Add <- merge(x= res_Add, y = Detected_Mean, by = "source", + all.x = TRUE) %>% mutate(targets_detected_num = replace_na(targets_detected_num, 0)) - # add list of Genes_targeted_by_TF_detected_chr - Detected_List <- aggregate(Detected$Symbol~Detected[[.source]], FUN=toString)%>% - rename("source"=1, - "targets_detected_chr" = 2) + ## add list of Genes_targeted_by_TF_detected_chr + Detected_List <- aggregate(Detected$Symbol ~ Detected[[.source]], + FUN = toString) %>% + rename("source" = 1, "targets_detected_chr" = 2) - res_Add<- merge(x= res_Add, y=Detected_List, by="source", all.x=TRUE) + res_Add <- merge(x = res_Add, y = Detected_List, by = "source", + all.x = TRUE) - #add percentage of Percentage_of_Genes_detected - res_Add$targets_detected_percentage <-round(((res_Add$targets_detected_num/res_Add$targets_num)*100),digits=2) + ## add percentage of Percentage_of_Genes_detected + res_Add$targets_detected_percentage <- round( + res_Add$targets_detected_num / res_Add$targets_num * 100, digits = 2) - #sort by score - res_Add<-res_Add%>% - arrange(desc(as.numeric(as.character(score)))) + ## sort by score + res_Add <- res_Add %>% + arrange(desc(as.numeric(as.character(score)))) - ## ------------------ Save and return ------------------- ## - Output<-res_Add + ## ------------------ Save and return ------------------- ## + res_Add } - - - - diff --git a/R/ToyData.R b/R/ToyData.R index 306b37a2..90ac4f4a 100644 --- a/R/ToyData.R +++ b/R/ToyData.R @@ -45,7 +45,7 @@ #' @description Import and process .csv file to create toy data DF. #' #' @examples -#' Intra <- MetaProViz::ToyData("IntraCells_Raw") +#' ToyData("IntraCells_Raw") #' #' @importFrom readr read_csv cols #' @importFrom magrittr %>% extract2 @@ -55,44 +55,46 @@ #' @export #' ToyData <- function(Dataset) { - ## ------------ Create log file ----------- ## - MetaProViz_Init() + + ## ------------ Create log file ----------- ## + MetaProViz_Init() - #Available Datasets: - datasets <- list( - IntraCells_Raw = "MS55_RawPeakData.csv", - IntraCells_DMA = "MS55_DMA_786M1A_vs_HK2.csv", - CultureMedia_Raw = "MS51_RawPeakData.csv", - Cells_MetaData = "MappingTable_SelectPathways.csv", - Tissue_Norm = "Hakimi_ccRCC-Tissue_Data.csv", - Tissue_MetaData = "Hakimi_ccRCC-Tissue_FeatureMetaData.csv", - Tissue_DMA = "Hakimi_ccRCC-Tissue_DMA_TvsN.csv", - Tissue_DMA_Old ="Hakimi_ccRCC-Tissue_DMA_TvsN-Old.csv", - Tissue_DMA_Young ="Hakimi_ccRCC-Tissue_DMA_TvsN-Young.csv", - Tissue_TvN_Proteomics ="ccRCC-Tissue_TvN_Proteomics.csv", - Tissue_TvN_RNAseq = "ccRCC-Tissue_TvN_RNAseq.csv", - AlaninePathways = "AlaninePathways.csv", - EquivalentFeatures = "EquivalentFeatureTable.csv", - BiocratesFeatureTable = "BiocratesFeatureTable.csv" - ) + ## available Datasets: + datasets <- list( + IntraCells_Raw = "MS55_RawPeakData.csv", + IntraCells_DMA = "MS55_DMA_786M1A_vs_HK2.csv", + CultureMedia_Raw = "MS51_RawPeakData.csv", + Cells_MetaData = "MappingTable_SelectPathways.csv", + Tissue_Norm = "Hakimi_ccRCC-Tissue_Data.csv", + Tissue_MetaData = "Hakimi_ccRCC-Tissue_FeatureMetaData.csv", + Tissue_DMA = "Hakimi_ccRCC-Tissue_DMA_TvsN.csv", + Tissue_DMA_Old ="Hakimi_ccRCC-Tissue_DMA_TvsN-Old.csv", + Tissue_DMA_Young ="Hakimi_ccRCC-Tissue_DMA_TvsN-Young.csv", + Tissue_TvN_Proteomics ="ccRCC-Tissue_TvN_Proteomics.csv", + Tissue_TvN_RNAseq = "ccRCC-Tissue_TvN_RNAseq.csv", + AlaninePathways = "AlaninePathways.csv", + EquivalentFeatures = "EquivalentFeatureTable.csv", + BiocratesFeatureTable = "BiocratesFeatureTable.csv" + ) - rncols <- c("Code", "Metabolite") + rncols <- c("Code", "Metabolite") - #Load dataset: - if (!Dataset %in% names(datasets)) { - message <- sprintf("No such dataset: `%s`. Available datasets: %s", Dataset, paste(names(datasets), collapse = ", ")) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + ## Load dataset: + if (!Dataset %in% names(datasets)) { + message <- sprintf("No such dataset: `%s`. Available datasets: %s", + Dataset, paste(names(datasets), collapse = ", ")) + logger::log_trace(paste("Error ", message, sep="")) ## EDIT: why not use match.arg? + stop(message) } - datasets %>% - magrittr::extract2(Dataset) %>% - system.file("data", ., package = "MetaProViz") %>% - readr::read_csv(col_types = readr::cols()) %>% - {`if`( - (rncol <- names(.) %>% intersect(rncols)) %>% length, - tibble::column_to_rownames(., rncol), - . - )} + datasets %>% + magrittr::extract2(Dataset) %>% ## EDIT: why? can you not just use datasets[[Dataset]]? + system.file("data", ., package = "MetaProViz") %>% + readr::read_csv(col_types = readr::cols()) %>% + {`if`( + (rncol <- names(.) %>% intersect(rncols)) %>% length, + tibble::column_to_rownames(., rncol), + . + )} ## EDIT: this looks quite complicated, could it be simplified or documentation be added? } diff --git a/R/VizHeatmap.R b/R/VizHeatmap.R index 72d4738d..afcc3e39 100644 --- a/R/VizHeatmap.R +++ b/R/VizHeatmap.R @@ -37,9 +37,26 @@ #' #' @return List with two elements: Plot and Plot_Sized #' -#' @examples +#' @examples#' +#' ## load the data and mapping Info #' Intra <- ToyData("IntraCells_Raw") -#' Res <- MetaProViz::VizHeatmap(InputData=Intra[,-c(1:3)]) +#' MappingInfo <- ToyData(Data = "Cells_MetaData") +#' Media <- ToyData("CultureMedia_Raw") +#' +#' ## create SummarizedExperiment objects +#' ## se_intra +#' rD <- MappingInfo +#' cD <- Intra[-c(49:58), c(1:3)] +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' +#' ## obtain overlapping metabolites +#' metabolites <- intersect(rownames(a), rownames(rD)) +#' rD <- rD[metabolites, ] +#' a <- a[metabolites, ] +#' se_intra <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) +#' +#' +#' Res <- VizHeatmap(se = se_intra, Scale = "row") #' #' @keywords Heatmap #' @@ -51,631 +68,783 @@ #' #' @export #' -VizHeatmap <- function(InputData, - SettingsInfo= NULL, - SettingsFile_Sample=NULL, - SettingsFile_Metab= NULL, - PlotName= "", +VizHeatmap <- function(se, #InputData, + SettingsInfo = NULL, + #SettingsFile_Sample = NULL, + #SettingsFile_Metab = NULL, + PlotName = "", Scale = "row", SaveAs_Plot = "svg", - Enforce_FeatureNames= FALSE, - Enforce_SampleNames= FALSE, - PrintPlot=TRUE, - FolderPath = NULL -){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=SettingsFile_Metab, - SettingsInfo=SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=NULL, - CoRe=FALSE, - PrintPlot= PrintPlot) - - # CheckInput` Specific - if(is.logical(Enforce_FeatureNames) == FALSE | is.logical(Enforce_SampleNames) == FALSE){ - message <- paste0("Check input. The Enforce_FeatureNames and Enforce_SampleNames value should be either =TRUE or = FALSE.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - Scale_options <- c("row","column", "none") - if(Scale %in% Scale_options == FALSE){ - message <- paste0("Check input. The selected Scale option is not valid. Please select one of the folowwing: ",paste(Scale_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + Enforce_FeatureNames = FALSE, + Enforce_SampleNames = FALSE, + PrintPlot = TRUE, + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Check Input files ----------- ## + # HelperFunction `CheckInput` + CheckInput(se, #InputData = InputData, + #SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = SettingsFile_Metab, + SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, + SaveAs_Table = NULL, + CoRe = FALSE, + PrintPlot = PrintPlot) + + # CheckInput` Specific + if (!is.logical(Enforce_FeatureNames) | !is.logical(Enforce_SampleNames)) { + message <- paste0("Check input. The Enforce_FeatureNames and Enforce_SampleNames value should be either TRUE or FALSE.") + logger::log_trace(paste0("Error ", message)) + stop(message) } + Scale_options <- c("row","column", "none") + if (!Scale %in% Scale_options) { + message <- paste0("Check input. The selected Scale option is not valid. Please select one of the folowwing: ",paste(Scale_options,collapse = ", "),"." ) + logger::log_trace(paste0("Error ", message)) + stop(message) + } - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Plot)==FALSE){ - Folder <- SavePath(FolderName= "Heatmap", - FolderPath=FolderPath) - } - ##################################################### - ## -------------- Load Data --------------- ## - data <- InputData + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Plot)) { + Folder <- SavePath(FolderName = "Heatmap", FolderPath = FolderPath) + } - if(is.null(SettingsFile_Metab)==FALSE){#removes information about metabolites that are not included in the InputData - SettingsFile_Metab <- merge(x=SettingsFile_Metab, y=as.data.frame(t(InputData)), by=0, all.y=TRUE)%>% - tibble::column_to_rownames("Row.names") - SettingsFile_Metab <- SettingsFile_Metab[,-c((ncol(SettingsFile_Metab)-nrow(InputData)+1):ncol(SettingsFile_Metab))] - } + ##################################################### + ## -------------- Load Data --------------- ## + data <- assay(se) |> t() #InputData ## EDIT: the objects should be adjusted downstream + SettingsFile_Metab <- rowData(se) |> + as.data.frame() + + SettingsFile_Sample <- colData(se) |> + as.data.frame() + + if (!is.null(SettingsFile_Metab)) { ##removes information about metabolites that are not included in the InputData + SettingsFile_Metab <- merge(x = SettingsFile_Metab, + y = as.data.frame(t(InputData)), by = 0, all.y = TRUE) %>% + tibble::column_to_rownames("Row.names") + SettingsFile_Metab <- SettingsFile_Metab[, -c((ncol(SettingsFile_Metab)-nrow(InputData)+1):ncol(SettingsFile_Metab))] + } - if(is.null(SettingsFile_Sample)==FALSE){#removes information about samples that are not included in the InputData - SettingsFile_Sample <- merge(x=SettingsFile_Sample, y=InputData, by=0, all.y=TRUE)%>% - tibble::column_to_rownames("Row.names") + if (!is.null(SettingsFile_Sample)) { ## removes information about samples that are not included in the InputData + SettingsFile_Sample <- merge(x = SettingsFile_Sample, + y = InputData, by = 0, all.y = TRUE) %>% + tibble::column_to_rownames("Row.names") SettingsFile_Sample <- SettingsFile_Sample[,-c((ncol(SettingsFile_Sample)-ncol(InputData)+1):ncol(SettingsFile_Sample))] } - ## -------------- Plot --------------- ## - if("individual_Metab" %in% names(SettingsInfo)==TRUE & "individual_Sample" %in% names(SettingsInfo)==FALSE){ - #Ensure that groups that are assigned NAs do not cause problems: - SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]] <-ifelse(is.na(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]), "NA", SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) - unique_paths <- unique(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) - - for (i in unique_paths){# Check pathways with 1 metabolite - selected_path <- SettingsFile_Metab %>% filter(get(SettingsInfo[["individual_Metab"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - if(length(selected_path_metabs)==1 ){ - message <- paste0("The metadata group ", i, " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - unique_paths <- unique_paths[!unique_paths %in% i] # Remove the pathway - } - } + ## -------------- Plot --------------- ## + if ("individual_Metab" %in% names(SettingsInfo) & !"individual_Sample" %in% names(SettingsInfo)) { + + ## ensure that groups that are assigned NAs do not cause problems: + SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]] <-ifelse( + is.na(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]), + "NA", + SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) + unique_paths <- unique(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) - IndividualPlots <-unique_paths + for (i in unique_paths) { + ## check pathways with 1 metabolite + selected_path <- SettingsFile_Metab %>% + filter(get(SettingsInfo[["individual_Metab"]]) == i) + selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] + + if (length(selected_path_metabs) == 1) { + message <- paste0("The metadata group ", i, " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + unique_paths <- unique_paths[!unique_paths %in% i] # Remove the pathway + } + } - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots + IndividualPlots <-unique_paths - for (i in IndividualPlots){ - selected_path <- SettingsFile_Metab %>% filter(get(SettingsInfo[["individual_Metab"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - data_path <- data %>% dplyr::select(all_of(selected_path_metabs)) + ## empty list to store all the plots + PlotList <- list() + ## empty list to store all the plots + PlotList_adaptedGrid <- list() - # Column annotation - col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] - col_annot<- NULL - if(length(col_annot_vars)>0){ - for (x in 1:length(col_annot_vars)){ - annot_sel <- col_annot_vars[[x]] - col_annot[x] <- SettingsFile_Sample %>% select(annot_sel) %>% as.data.frame() - names(col_annot)[x] <- annot_sel - } - col_annot<- as.data.frame(col_annot) - rownames(col_annot) <- rownames(data_path) - } - - # Row annotation - row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] - row_annot<- NULL - if(length(row_annot_vars)>0){ - for (y in 1:length(row_annot_vars)){ - annot_sel <- row_annot_vars[[y]] - row_annot[y] <- SettingsFile_Metab %>% select(all_of(annot_sel)) - row_annot <- row_annot %>% as.data.frame() - names(row_annot)[y] <- annot_sel - } - row_annot<- as.data.frame(row_annot) - rownames(row_annot) <- rownames(SettingsFile_Metab) - } + for (i in IndividualPlots) { + selected_path <- SettingsFile_Metab %>% + filter(get(SettingsInfo[["individual_Metab"]]) == i) + selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] + data_path <- data %>% + dplyr::select(all_of(selected_path_metabs)) - #Check number of features: - Features <- as.data.frame(t(data_path)) - if(Enforce_FeatureNames==TRUE){ - show_rownames <- TRUE - cellheight_Feature <- 9 - }else if(nrow(Features)>100){ - show_rownames <- FALSE - cellheight_Feature <- 1 - }else{ - show_rownames <- TRUE - cellheight_Feature <- 9 - } + ## column annotation + col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] + col_annot<- NULL + if (length(col_annot_vars) > 0) { + for (x in seq_along(col_annot_vars)) { + annot_sel <- col_annot_vars[[x]] + col_annot[x] <- SettingsFile_Sample %>% + select(annot_sel) %>% a + s.data.frame() + names(col_annot)[x] <- annot_sel + } + col_annot<- as.data.frame(col_annot) + rownames(col_annot) <- rownames(data_path) + } - #Check number of samples - if(Enforce_SampleNames==TRUE){ - show_colnames <- TRUE - cellwidth_Sample <- 9 - }else if(nrow(data_path)>50){ - show_colnames <- FALSE - cellwidth_Sample <- 1 - }else{ - show_colnames <- TRUE - cellwidth_Sample <- 9 - } - - # Make the plot - if(nrow(t(data_path))>= 2){ - set.seed(1234) - - heatmap <- pheatmap::pheatmap(t(data_path), - show_rownames = as.logical(show_rownames), - show_colnames = as.logical(show_colnames), - clustering_method = "complete", - scale = Scale, - clustering_distance_rows = "correlation", - annotation_col = col_annot, - annotation_row = row_annot, - legend = T, - cellwidth = cellwidth_Sample, - cellheight = cellheight_Feature, - fontsize_row= 10, - fontsize_col = 10, - fontsize=9, - main = paste(PlotName, " Metabolites: ", i, sep=" " ), - silent = TRUE) - - ## Store the plot in the 'plots' list - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList[[cleaned_i]] <- heatmap - - #Width and height according to Sample and metabolite number - Plot_Sized <- PlotGrob_Heatmap(InputPlot=heatmap, SettingsInfo=SettingsInfo, SettingsFile_Sample=SettingsFile_Sample, SettingsFile_Metab=SettingsFile_Metab, PlotName= cleaned_i) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= PlotList_adaptedGrid, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName=paste("Heatmap_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - - }else{ - message <- paste0(i , " includes <= 2 objects and is hence not plotted.") - logger::log_trace(paste("Message ", message, sep="")) - message(message) - } - } - #Return if assigned: - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) - - }else if("individual_Metab" %in% names(SettingsInfo)==FALSE & "individual_Sample" %in% names(SettingsInfo)==TRUE){ - #Ensure that groups that are assigned NAs do not cause problems: - SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]] <-ifelse(is.na(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]), "NA", SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) - - unique_paths_Sample <- unique(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) - - for (i in unique_paths_Sample){# Check pathways with 1 metabolite - selected_path <- SettingsFile_Sample %>% filter(get(SettingsInfo[["individual_Sample"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - if(length(selected_path_metabs)==1 ){ - message <- paste0("The metadata group ", i, " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - unique_paths_Sample <- unique_paths_Sample[!unique_paths_Sample %in% i] # Remove the pathway - } - } + # Row annotation + row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] + row_annot<- NULL + if (length(row_annot_vars) > 0) { + for (y in seq_along(row_annot_vars)) { + annot_sel <- row_annot_vars[[y]] + row_annot[y] <- SettingsFile_Metab %>% + select(all_of(annot_sel)) + row_annot <- row_annot %>% + as.data.frame() + names(row_annot)[y] <- annot_sel + } + row_annot <- as.data.frame(row_annot) + rownames(row_annot) <- rownames(SettingsFile_Metab) + } + + # Check number of features: + Features <- as.data.frame(t(data_path)) + + ## this can be simplified to + show_rownames <- TRUE + cellheight_Feature <- 9 + if (!Enforce_FeatureNames & nrow(Features) > 100) { + show_rownames <- FALSE + cellheight_Feature <- 1 + } + + ## was: + # if (Enforce_FeatureNames) { + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # } else if (nrow(Features) > 100) { + # show_rownames <- FALSE + # cellheight_Feature <- 1 + # } else { + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # } + + # Check number of samples + ## this can be simplified to + show_colnames <- TRUE + cellwidth_Sample <- 9 + if (!Enforce_SampleNames & nrow(data_path) > 50) { + show_colnames <- FALSE + cellwidth_Sample <- 1 + } + # if (Enforce_SampleNames) { + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # } else if (nrow(data_path) > 50) { + # show_colnames <- FALSE + # cellwidth_Sample <- 1 + # } else { + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # } - IndividualPlots <-unique_paths_Sample - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots + # Make the plot + if (nrow(t(data_path)) >= 2) { + set.seed(1234) + + heatmap <- pheatmap::pheatmap(t(data_path), + show_rownames = as.logical(show_rownames), + show_colnames = as.logical(show_colnames), + clustering_method = "complete", + scale = Scale, + clustering_distance_rows = "correlation", + annotation_col = col_annot, + annotation_row = row_annot, + legend = T, + cellwidth = cellwidth_Sample, + cellheight = cellheight_Feature, + fontsize_row = 10, + fontsize_col = 10, + fontsize = 9, + main = paste(PlotName, " Metabolites: ", i, sep = " "), + silent = TRUE) + + ## store the plot in the 'plots' list + ## removes empty spaces and replaces /,\ with - + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i) + PlotList[[cleaned_i]] <- heatmap + + ## width and height according to Sample and metabolite number + Plot_Sized <- PlotGrob_Heatmap(InputPlot = heatmap, + SettingsInfo = SettingsInfo, + se = se, + #SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = SettingsFile_Metab, + PlotName = cleaned_i) + PlotHeight <- grid::convertUnit(Plot_Sized$height, "cm", valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, "cm", valueOnly = TRUE) + Plot_Sized %<>% ## EDIT: what is the added value here to use %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + #----- Save + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = NULL, + InputList_Plot = PlotList_adaptedGrid, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Heatmap_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } else { + message <- paste0(i , " includes <= 2 objects and is hence not plotted.") + logger::log_trace(paste0("Message ", message)) + message(message) + } + } + + ## Return if assigned: + return(invisible(list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) ## EDIT: needed? I would return at the end of fct and not somewhere in the middle - for (i in IndividualPlots){ - #Select the data: - selected_path <- SettingsFile_Sample %>% filter(get(SettingsInfo[["individual_Sample"]]) == i)%>% - tibble::rownames_to_column("UniqueID") - selected_path <- as.data.frame(selected_path[,1])%>% - dplyr::rename("UniqueID"=1) - data_path <- merge(selected_path, data%>% tibble::rownames_to_column("UniqueID"), by="UniqueID", all.x=TRUE) - data_path <- data_path%>% - tibble::column_to_rownames("UniqueID") + } else if (!"individual_Metab" %in% names(SettingsInfo) & "individual_Sample" %in% names(SettingsInfo)) { + ##Ensure that groups that are assigned NAs do not cause problems: + SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]] <- ifelse( + is.na(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]), + "NA", + SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) - # Column annotation - selected_SettingsFile_Sample <- merge(selected_path, SettingsFile_Sample%>% tibble::rownames_to_column("UniqueID"), by="UniqueID", all.x=TRUE) + unique_paths_Sample <- unique(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) - col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] - col_annot<- NULL - if(length(col_annot_vars)>0){ - for (x in 1:length(col_annot_vars)){ - annot_sel <- col_annot_vars[[x]] - col_annot[x] <- selected_SettingsFile_Sample %>% select(annot_sel) %>% as.data.frame() - names(col_annot)[x] <- annot_sel - } - col_annot<- as.data.frame(col_annot) - rownames(col_annot) <- rownames(data_path) + for (i in unique_paths_Sample) { # Check pathways with 1 metabolite + selected_path <- SettingsFile_Sample %>% + filter(get(SettingsInfo[["individual_Sample"]]) == i) + selected_path_metabs <- colnames(data)[colnames(data) %in% row.names(selected_path)] + if (length(selected_path_metabs) == 1) { + message <- paste0("The metadata group ", i, + " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + unique_paths_Sample <- unique_paths_Sample[!unique_paths_Sample %in% i] # Remove the pathway + } } - # Row annotation - row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] - row_annot<- NULL - if(length(row_annot_vars)>0){ - for (y in 1:length(row_annot_vars)){ - annot_sel <- row_annot_vars[[y]] - row_annot[y] <- SettingsFile_Metab %>% select(all_of(annot_sel)) - row_annot <- row_annot %>% as.data.frame() - names(row_annot)[y] <- annot_sel - } - row_annot<- as.data.frame(row_annot) - rownames(row_annot) <- rownames(SettingsFile_Metab) - } + IndividualPlots <- unique_paths_Sample + ## empty list to store all the plots + PlotList <- list() ## EDIT: why not moving this to before/outside the if/else statements as you do this for every condition and delete it in the other conditions + ## empty list to store all the plots + PlotList_adaptedGrid <- list() ## EDIT: why not moving this to before/outside the if/else statements as you do this for every condition and delete it in the other conditions + + for (i in IndividualPlots) { + + ## Select the data: + selected_path <- SettingsFile_Sample %>% + filter(get(SettingsInfo[["individual_Sample"]]) == i) %>% + tibble::rownames_to_column("UniqueID") + selected_path <- as.data.frame(selected_path[,1]) %>% + dplyr::rename("UniqueID" = 1) + data_path <- merge(selected_path, + tibble::rownames_to_column(data, "UniqueID"), + by = "UniqueID", all.x = TRUE) + data_path <- data_path %>% + tibble::column_to_rownames("UniqueID") - #Check number of features: - Features <- as.data.frame(t(data_path)) - if(Enforce_FeatureNames==TRUE){ - show_rownames <- TRUE - cellheight_Feature <- 9 - }else if(nrow(Features)>100){ - show_rownames <- FALSE - cellheight_Feature <- 1 - }else{ - show_rownames <- TRUE - cellheight_Feature <- 9 - } + # Column annotation + selected_SettingsFile_Sample <- merge(selected_path, + tibble::rownames_to_column(SettingsFile_Sample, "UniqueID"), + by = "UniqueID", all.x = TRUE) - #Check number of samples - if(Enforce_SampleNames==TRUE){ - show_colnames <- TRUE - cellwidth_Sample <- 9 - }else if(nrow(data_path)>50){ - show_colnames <- FALSE - cellwidth_Sample <- 1 - }else{ - show_colnames <- TRUE - cellwidth_Sample <- 9 - } + col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] + col_annot <- NULL + if (length(col_annot_vars) > 0) { + for (x in 1:length(col_annot_vars)) { + annot_sel <- col_annot_vars[[x]] + col_annot[x] <- selected_SettingsFile_Sample %>% + select(annot_sel) %>% + as.data.frame() + names(col_annot)[x] <- annot_sel + } + col_annot<- as.data.frame(col_annot) + rownames(col_annot) <- rownames(data_path) + } - # Make the plot - if(nrow(t(data_path))>= 2){ - set.seed(1234) - - heatmap <- pheatmap::pheatmap(t(data_path), - show_rownames = as.logical(show_rownames), - show_colnames = as.logical(show_colnames), - clustering_method = "complete", - scale = Scale, - clustering_distance_rows = "correlation", - annotation_col = col_annot, - annotation_row = row_annot, - legend = T, - cellwidth = cellwidth_Sample, - cellheight = cellheight_Feature, - fontsize_row= 10, - fontsize_col = 10, - fontsize=9, - main = paste(PlotName," Samples: ", i, sep=" " ), - silent = TRUE) - - #----- Save - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList[[cleaned_i]] <- heatmap - - #Width and height according to Sample and metabolite number - Plot_Sized <- PlotGrob_Heatmap(InputPlot=heatmap, SettingsInfo=SettingsInfo, SettingsFile_Sample=SettingsFile_Sample, SettingsFile_Metab=SettingsFile_Metab, PlotName= cleaned_i) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= PlotList_adaptedGrid, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Heatmap_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - }else{ - message <- paste0(i , " includes <= 2 objects and is hence not plotted.") - logger::log_trace(paste("Message ", message, sep="")) - message(message) - } + # Row annotation + row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] + row_annot<- NULL + if (length(row_annot_vars) > 0) { + for (y in 1:length(row_annot_vars)) { + annot_sel <- row_annot_vars[[y]] + row_annot[y] <- SettingsFile_Metab %>% + select(all_of(annot_sel)) + row_annot <- row_annot %>% + as.data.frame() + names(row_annot)[y] <- annot_sel + } + row_annot<- as.data.frame(row_annot) + rownames(row_annot) <- rownames(SettingsFile_Metab) + } + + #Check number of features: + Features <- as.data.frame(t(data_path)) + show_rownames <- TRUE + cellheight_Feature <- 9 + if (!Enforce_FeatureNames & nrow(Features) > 100) { + show_rownames <- FALSE + cellheight_Feature <- 1 + } + # was: + # if (Enforce_FeatureNames) { + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # }else if (nrow(Features)>100) { + # show_rownames <- FALSE + # cellheight_Feature <- 1 + # }else{ + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # } + + #Check number of samples + show_colnames <- TRUE + cellwidth_Sample <- 9 + if (!Enforce_SampleNames & nrow(data_path) > 50) { + show_colnames <- FALSE + cellwidth_Sample <- 1 + } + # if (Enforce_SampleNames==TRUE) { + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # }else if (nrow(data_path)>50) { + # show_colnames <- FALSE + # cellwidth_Sample <- 1 + # }else{ + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # } + + # Make the plot + if (nrow(t(data_path)) >= 2) { + set.seed(1234) + + heatmap <- pheatmap::pheatmap(t(data_path), + show_rownames = as.logical(show_rownames), + show_colnames = as.logical(show_colnames), + clustering_method = "complete", + scale = Scale, + clustering_distance_rows = "correlation", + annotation_col = col_annot, + annotation_row = row_annot, + legend = TRUE, + cellwidth = cellwidth_Sample, + cellheight = cellheight_Feature, + fontsize_row= 10, + fontsize_col = 10, + fontsize = 9, + main = paste(PlotName," Samples: ", i, sep = " "), + silent = TRUE) + + ##----- Save + ## removes empty spaces and replaces /,\ with - + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i) + PlotList[[cleaned_i]] <- heatmap + + ## width and height according to Sample and metabolite number + Plot_Sized <- PlotGrob_Heatmap(InputPlot = heatmap, + SettingsInfo = SettingsInfo, + se = se, + #SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = SettingsFile_Metab, + PlotName= cleaned_i) + PlotHeight <- grid::convertUnit(Plot_Sized$height, "cm", valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, "cm", valueOnly = TRUE) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + ## ----- Save + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = NULL, + InputList_Plot = PlotList_adaptedGrid, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Heatmap_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } else { + message <- paste0(i , " includes <= 2 objects and is hence not plotted.") + logger::log_trace(paste0("Message ", message)) + message(message) + } } - #Return if assigned: - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + ## Return if assigned: + return(invisible(list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) ## EDIT: needed? I would return at the end of the function - }else if("individual_Metab" %in% names(SettingsInfo)==TRUE & "individual_Sample" %in% names(SettingsInfo)==TRUE){ - #Ensure that groups that are assigned NAs do not cause problems: - SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]] <-ifelse(is.na(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]), "NA", SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) + } else if (("individual_Metab" %in% names(SettingsInfo)) & ("individual_Sample" %in% names(SettingsInfo))) { + + ## Ensure that groups that are assigned NAs do not cause problems: + SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]] <- ifelse( + is.na(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]), + "NA", + SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) unique_paths <- unique(SettingsFile_Metab[[SettingsInfo[["individual_Metab"]]]]) - for (i in unique_paths){# Check pathways with 1 metabolite - selected_path <- SettingsFile_Metab %>% filter(get(SettingsInfo[["individual_Metab"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - if(length(selected_path_metabs)==1 ){ - message <- paste0("The metadata group ", i, " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - unique_paths <- unique_paths[!unique_paths %in% i] # Remove the pathway - } + ## check pathways with 1 metabolite + for (i in unique_paths) { + selected_path <- SettingsFile_Metab %>% + filter(get(SettingsInfo[["individual_Metab"]]) == i) + selected_path_metabs <- colnames(data)[colnames(data) %in% row.names(selected_path)] + + if (length(selected_path_metabs) == 1) { + message <- paste0("The metadata group ", i, + " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + ## remove the pathway + unique_paths <- unique_paths[!unique_paths %in% i] + } } - #Ensure that groups that are assigned NAs do not cause problems: - SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]] <-ifelse(is.na(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]), "NA", SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) + ## Ensure that groups that are assigned NAs do not cause problems: + SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]] <- ifelse( + is.na(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]), + "NA", + SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) unique_paths_Sample <- unique(SettingsFile_Sample[[SettingsInfo[["individual_Sample"]]]]) - for (i in unique_paths_Sample){# Check pathways with 1 metabolite - selected_path <- SettingsFile_Sample %>% filter(get(SettingsInfo[["individual_Sample"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - if(length(selected_path_metabs)==1 ){ - message <- paste0("The metadata group ", i, " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - unique_paths_Sample <- unique_paths_Sample[!unique_paths_Sample %in% i] # Remove the pathway - } + ## Check pathways with 1 metabolite + for (i in unique_paths_Sample) { + selected_path <- SettingsFile_Sample %>% + filter(get(SettingsInfo[["individual_Sample"]]) == i) + selected_path_metabs <- colnames(data)[colnames(data) %in% row.names(selected_path)] + + if (length(selected_path_metabs) == 1) { + message <- paste0("The metadata group ", i, + " includes only 1 metabolite. Heatmap cannot be made for 1 metabolite, thus it will be ignored.") + logger::log_trace(paste0("Warning ", message)) + warning(message) + unique_paths_Sample <- unique_paths_Sample[!unique_paths_Sample %in% i] # Remove the pathway + } } - IndividualPlots_Metab <-unique_paths - IndividualPlots_Sample <-unique_paths_Sample - - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - for (i in IndividualPlots_Metab){ - selected_path <- SettingsFile_Metab %>% filter(get(SettingsInfo[["individual_Metab"]]) == i) - selected_path_metabs <- colnames(data) [colnames(data) %in% row.names(selected_path)] - data_path_metab <- data %>% dplyr::select(all_of(selected_path_metabs)) - - # Row annotation - row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] - row_annot<- NULL - if(length(row_annot_vars)>0){ - for (y in 1:length(row_annot_vars)){ - annot_sel <- row_annot_vars[[y]] - row_annot[y] <- SettingsFile_Metab %>% select(all_of(annot_sel)) - row_annot <- row_annot %>% as.data.frame() - names(row_annot)[y] <- annot_sel + IndividualPlots_Metab <- unique_paths + IndividualPlots_Sample <- unique_paths_Sample + + PlotList <- list() ## Empty list to store all the plots + PlotList_adaptedGrid <- list() ## Empty list to store all the plots + + for (i in IndividualPlots_Metab) { + selected_path <- SettingsFile_Metab %>% + filter(get(SettingsInfo[["individual_Metab"]]) == i) + selected_path_metabs <- colnames(data)[colnames(data) %in% row.names(selected_path)] + data_path_metab <- data %>% + dplyr::select(all_of(selected_path_metabs)) + + ## Row annotation + row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] + row_annot<- NULL + + if (length(row_annot_vars) > 0) { + for (y in 1:length(row_annot_vars)) { + annot_sel <- row_annot_vars[[y]] + row_annot[y] <- SettingsFile_Metab %>% + select(all_of(annot_sel)) + row_annot <- row_annot %>% + as.data.frame() + names(row_annot)[y] <- annot_sel + } + row_annot<- as.data.frame(row_annot) + rownames(row_annot) <- rownames(SettingsFile_Metab) } - row_annot<- as.data.frame(row_annot) - rownames(row_annot) <- rownames(SettingsFile_Metab) - } - - #Col annotation: - for (s in IndividualPlots_Sample){ - #Select the data: - selected_path <- SettingsFile_Sample %>% filter(get(SettingsInfo[["individual_Sample"]]) == s)%>% - tibble::rownames_to_column("UniqueID") - selected_path <- as.data.frame(selected_path[,1])%>% - dplyr::rename("UniqueID"=1) - data_path <- merge(selected_path, data_path_metab%>% tibble::rownames_to_column("UniqueID"), by="UniqueID", all.x=TRUE) - data_path <- data_path%>% - tibble::column_to_rownames("UniqueID") - # Column annotation - selected_SettingsFile_Sample <- merge(selected_path, SettingsFile_Sample%>% tibble::rownames_to_column("UniqueID"), by="UniqueID", all.x=TRUE) - - col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] - col_annot<- NULL - if(length(col_annot_vars)>0){ - for (x in 1:length(col_annot_vars)){ - annot_sel <- col_annot_vars[[x]] - col_annot[x] <- selected_SettingsFile_Sample %>% select(annot_sel) %>% as.data.frame() - names(col_annot)[x] <- annot_sel - } - col_annot<- as.data.frame(col_annot) - rownames(col_annot) <- rownames(data_path) + ## Col annotation: + for (s in IndividualPlots_Sample) { + ## Select the data: + selected_path <- SettingsFile_Sample %>% + filter(get(SettingsInfo[["individual_Sample"]]) == s) %>% + tibble::rownames_to_column("UniqueID") + selected_path <- as.data.frame(selected_path[,1]) %>% + dplyr::rename("UniqueID" = 1) + data_path <- merge(selected_path, + tibble::rownames_to_column(data_path_metab, "UniqueID"), + by = "UniqueID", all.x = TRUE) + data_path <- data_path %>% + tibble::column_to_rownames("UniqueID") + + ## Column annotation + selected_SettingsFile_Sample <- merge(selected_path, + tibble::rownames_to_column(SettingsFile_Sample, "UniqueID"), + by = "UniqueID", all.x = TRUE) + + col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] + col_annot<- NULL + if (length(col_annot_vars) > 0) { + for (x in 1:length(col_annot_vars)) { + annot_sel <- col_annot_vars[[x]] + col_annot[x] <- selected_SettingsFile_Sample %>% + select(annot_sel) %>% + as.data.frame() + names(col_annot)[x] <- annot_sel + } + col_annot<- as.data.frame(col_annot) + rownames(col_annot) <- rownames(data_path) + } + + ## Check number of features: + Features <- as.data.frame(t(data_path)) + show_rownames <- TRUE + cellheight_Feature <- 9 + if (!Enforce_FeatureNames & nrow(Features) > 100) { + show_rownames <- FALSE + cellheight_Feature <- 1 + } + # if (Enforce_FeatureNames==TRUE) { + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # }else if (nrow(Features)>100) { + # show_rownames <- FALSE + # cellheight_Feature <- 1 + # }else{ + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # } + + #Check number of samples + show_colnames <- TRUE + cellwidth_Sample <- 9 + if (!Enforce_SampleNames & nrow(data_path) > 50) { + show_colnames <- FALSE + cellwidth_Sample <- 1 + } + # if (Enforce_SampleNames==TRUE) { + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # }else if (nrow(data_path)>50) { + # show_colnames <- FALSE + # cellwidth_Sample <- 1 + # }else{ + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # } + + # Make the plot + if (nrow(t(data_path)) >= 2) { + set.seed(1234) + + heatmap <- pheatmap::pheatmap(t(data_path), + show_rownames = as.logical(show_rownames), + show_colnames = as.logical(show_colnames), + clustering_method = "complete", + scale = Scale, + clustering_distance_rows = "correlation", + annotation_col = col_annot, + annotation_row = row_annot, + legend = TRUE, + cellwidth = cellwidth_Sample, + cellheight = cellheight_Feature, + fontsize_row= 10, + fontsize_col = 10, + fontsize=9, + main = paste0(PlotName," Metabolites: ", i, " Sample:", s), + silent = TRUE) + + ## Store the plot in the 'plots' list + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - + cleaned_s <- gsub("[[:space:],/\\\\]", "-", s)#removes empty spaces and replaces /,\ with - + PlotList[[paste(cleaned_i, cleaned_s, sep = "_")]] <- heatmap + + #-------- Plot width and heights + #Width and height according to Sample and metabolite number + PlotName <- paste(cleaned_i, cleaned_s, sep = "_") + Plot_Sized <- PlotGrob_Heatmap(InputPlot = heatmap, + SettingsInfo = SettingsInfo, + se = se, + #SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = SettingsFile_Metab, + PlotName = PlotName) + PlotHeight <- grid::convertUnit(Plot_Sized$height, "cm", + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, "cm", + valueOnly = TRUE) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) ## EDIT: not sure if the %<>% makes this call so much easier to understand. What is the added value? + + PlotList_adaptedGrid[[paste(cleaned_i,cleaned_s, sep = "_")]] <- Plot_Sized + + #----- Save + suppressMessages(suppressWarnings( + SaveRes(InputList_DF = NULL, + InputList_Plot = PlotList_adaptedGrid, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Heatmap_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } + else { + message(i , " includes <= 2 objects and is hence not plotted.") + } } + } + return(invisible(list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) ## EDIT: needed? I would return at the end of the fct + + } else if (!"individual_Metab" %in% names(SettingsInfo) & !"individual_Sample" %in% names(SettingsInfo)) { - #Check number of features: - Features <- as.data.frame(t(data_path)) - if(Enforce_FeatureNames==TRUE){ - show_rownames <- TRUE - cellheight_Feature <- 9 - }else if(nrow(Features)>100){ - show_rownames <- FALSE - cellheight_Feature <- 1 - }else{ - show_rownames <- TRUE - cellheight_Feature <- 9 + ## empty list to store all the plots + PlotList <- list() + ## empty list to store all the plots + PlotList_adaptedGrid <- list() + + ## Column annotation + col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] + col_annot<- NULL + if (length(col_annot_vars) > 0) { + for (i in 1:length(col_annot_vars)) { + annot_sel <- col_annot_vars[[i]] + col_annot[i] <- SettingsFile_Sample %>% + select(annot_sel) %>% + as.data.frame() + names(col_annot)[i] <- annot_sel } + col_annot<- as.data.frame(col_annot) + rownames(col_annot) <- rownames(data) + } - #Check number of samples - if(Enforce_SampleNames==TRUE){ - show_colnames <- TRUE - cellwidth_Sample <- 9 - }else if(nrow(data_path)>50){ - show_colnames <- FALSE - cellwidth_Sample <- 1 - }else{ - show_colnames <- TRUE - cellwidth_Sample <- 9 + ## Row annotation + row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] + row_annot<- NULL + if (length(row_annot_vars) > 0) { + for (i in 1:length(row_annot_vars)) { + annot_sel <- row_annot_vars[[i]] + row_annot[i] <- SettingsFile_Metab %>% + select(all_of(annot_sel)) + row_annot <- row_annot %>% + as.data.frame() + names(row_annot)[i] <- annot_sel } + row_annot<- as.data.frame(row_annot) + rownames(row_annot) <- rownames(SettingsFile_Metab) + } - # Make the plot - if(nrow(t(data_path))>= 2){ + ## Check number of features: + Features <- as.data.frame(t(data)) + show_rownames <- TRUE + cellheight_Feature <- 9 + if (!Enforce_FeatureNames & nrow(Features) > 100) { + show_rownames <- FALSE + cellheight_Feature <- 1 + } + # if (Enforce_FeatureNames==TRUE) { + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # }else if (nrow(Features)>100) { + # show_rownames <- FALSE + # cellheight_Feature <- 1 + # }else{ + # show_rownames <- TRUE + # cellheight_Feature <- 9 + # } + + #Check number of samples + show_colnames <- TRUE + cellwidth_Sample <- 9 + if (Enforce_SampleNames & nrow(data) > 50) { + show_colnames <- FALSE + cellwidth_Sample <- 1 + } + # if (Enforce_SampleNames==TRUE) { + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # }else if (nrow(data)>50) { + # show_colnames <- FALSE + # cellwidth_Sample <- 1 + # }else{ + # show_colnames <- TRUE + # cellwidth_Sample <- 9 + # } + + #Make the plot: + if (nrow(t(data)) >= 2) { set.seed(1234) - heatmap <- pheatmap::pheatmap(t(data_path), - show_rownames = as.logical(show_rownames), - show_colnames = as.logical(show_colnames), - clustering_method = "complete", - scale = Scale, - clustering_distance_rows = "correlation", - annotation_col = col_annot, - annotation_row = row_annot, - legend = T, - cellwidth = cellwidth_Sample, - cellheight = cellheight_Feature, - fontsize_row= 10, - fontsize_col = 10, - fontsize=9, - main = paste(PlotName," Metabolites: ", i, " Sample:", s, sep="" ), - silent = TRUE) + heatmap <- pheatmap::pheatmap(t(data), + show_rownames = as.logical(show_rownames), + show_colnames = as.logical(show_colnames), + clustering_method = "complete", + scale = Scale, + clustering_distance_rows = "correlation", + annotation_col = col_annot, + annotation_row = row_annot, + legend = TRUE, + cellwidth = cellwidth_Sample, + cellheight = cellheight_Feature, + fontsize_row = 10, + fontsize_col = 10, + fontsize = 9, + main = PlotName, + silent = TRUE) ## Store the plot in the 'plots' list - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - cleaned_s <- gsub("[[:space:],/\\\\]", "-", s)#removes empty spaces and replaces /,\ with - - PlotList[[paste(cleaned_i,cleaned_s, sep="_")]] <- heatmap + PlotList[[PlotName]] <- heatmap #-------- Plot width and heights #Width and height according to Sample and metabolite number - PlotName <- paste(cleaned_i,cleaned_s, sep="_") - Plot_Sized <- PlotGrob_Heatmap(InputPlot=heatmap, SettingsInfo=SettingsInfo, SettingsFile_Sample=SettingsFile_Sample, SettingsFile_Metab=SettingsFile_Metab, PlotName= PlotName) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[[paste(cleaned_i,cleaned_s, sep="_")]] <- Plot_Sized + Plot_Sized <- PlotGrob_Heatmap(InputPlot = heatmap, + SettingsInfo = SettingsInfo, + se = se, + #SettingsFile_Sample = SettingsFile_Sample, + #SettingsFile_Metab = SettingsFile_Metab, + PlotName = PlotName) + PlotHeight <- grid::convertUnit(Plot_Sized$height, "cm", + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, "cm", + valueOnly = TRUE) + Plot_Sized %<>% ## EDIT: added value of using %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + PlotList_adaptedGrid[[paste0("Heatmap_", PlotName)]] <- Plot_Sized #----- Save suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= PlotList_adaptedGrid, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName=paste("Heatmap_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth= PlotWidth, - PlotUnit="cm"))) - - - } - else{ - message(i , " includes <= 2 objects and is hence not plotted.") - } - } + SaveRes(data = NULL, + plot = PlotList_adaptedGrid, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Heatmap_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } else { + message <- paste0(PlotName , " includes <= 2 objects and is hence not plotted.") + logger::log_trace(paste0("Message ", message)) + message(message) } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) - } else if("individual_Metab" %in% names(SettingsInfo)==FALSE & "individual_Sample" %in% names(SettingsInfo)==FALSE){ - - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - # Column annotation - col_annot_vars <- SettingsInfo[grepl("color_Sample", names(SettingsInfo))] - col_annot<- NULL - if(length(col_annot_vars)>0){ - for (i in 1:length(col_annot_vars)){ - annot_sel <- col_annot_vars[[i]] - col_annot[i] <- SettingsFile_Sample %>% select(annot_sel) %>% as.data.frame() - names(col_annot)[i] <- annot_sel - } - col_annot<- as.data.frame(col_annot) - rownames(col_annot) <- rownames(data) - } - - # Row annotation - row_annot_vars <- SettingsInfo[grepl("color_Metab", names(SettingsInfo))] - row_annot<- NULL - if(length(row_annot_vars)>0){ - for (i in 1:length(row_annot_vars)){ - annot_sel <- row_annot_vars[[i]] - row_annot[i] <- SettingsFile_Metab %>% select(all_of(annot_sel)) - row_annot <- row_annot %>% as.data.frame() - names(row_annot)[i] <- annot_sel - } - row_annot<- as.data.frame(row_annot) - rownames(row_annot) <- rownames(SettingsFile_Metab) - } - - #Check number of features: - Features <- as.data.frame(t(data)) - if(Enforce_FeatureNames==TRUE){ - show_rownames <- TRUE - cellheight_Feature <- 9 - }else if(nrow(Features)>100){ - show_rownames <- FALSE - cellheight_Feature <- 1 - }else{ - show_rownames <- TRUE - cellheight_Feature <- 9 - } - - #Check number of samples - if(Enforce_SampleNames==TRUE){ - show_colnames <- TRUE - cellwidth_Sample <- 9 - }else if(nrow(data)>50){ - show_colnames <- FALSE - cellwidth_Sample <- 1 - }else{ - show_colnames <- TRUE - cellwidth_Sample <- 9 - } - - #Make the plot: - if(nrow(t(data))>= 2){ - set.seed(1234) - - heatmap <- pheatmap::pheatmap(t(data), - show_rownames = as.logical(show_rownames), - show_colnames = as.logical(show_colnames), - clustering_method = "complete", - scale = Scale, - clustering_distance_rows = "correlation", - annotation_col = col_annot, - annotation_row = row_annot, - legend = T, - cellwidth = cellwidth_Sample, - cellheight = cellheight_Feature, - fontsize_row= 10, - fontsize_col = 10, - fontsize=9, - main = PlotName, - silent = TRUE) - - ## Store the plot in the 'plots' list - PlotList[[PlotName]] <- heatmap - - #-------- Plot width and heights - #Width and height according to Sample and metabolite number - Plot_Sized <- PlotGrob_Heatmap(InputPlot=heatmap, SettingsInfo=SettingsInfo, SettingsFile_Sample=SettingsFile_Sample, SettingsFile_Metab=SettingsFile_Metab, PlotName= PlotName) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[[paste("Heatmap_",PlotName, sep="")]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= PlotList_adaptedGrid, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Heatmap_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - - - - }else{ - message <- paste0(PlotName , " includes <= 2 objects and is hence not plotted.") - logger::log_trace(paste("Message ", message, sep="")) - message(message) - } } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + + ## return + invisible(list( + "data" = list(NULL), + "plot" = list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) ## EDIT: make sure there is one return statement at the end of the fct } diff --git a/R/VizPCA.R b/R/VizPCA.R index 2e9e5f52..a4d18bac 100644 --- a/R/VizPCA.R +++ b/R/VizPCA.R @@ -46,257 +46,286 @@ #' @return List with two elements: Plot and Plot_Sized #' #' @examples -#' Intra <- ToyData("IntraCells_Raw")[,-c(1:3)] -#' Res <- VizPCA(Intra) +#' Intra <- ToyData("IntraCells_Raw") +#' MappingInfo <- ToyData(Data = "Cells_MetaData") +#' +#' ## create SummarizedExperiment objects +#' ## se_intra +#' rD <- MappingInfo +#' cD <- Intra[-c(49:58), c(1:3)] +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' +#' ## obtain overlapping metabolites +#' metabolites <- intersect(rownames(a), rownames(rD)) +#' rD <- rD[metabolites, ] +#' a <- a[metabolites, ] +#' se_intra <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) +#' +#' Res <- VizPCA(se = se) #' #' @keywords PCA #' #' @importFrom ggplot2 ggplot theme element_rect autoplot scale_shape_manual geom_hline geom_vline ggtitle +#' @import ggfortify #' @importFrom dplyr rename #' @importFrom magrittr %>% %<>% #' @importFrom tibble rownames_to_column column_to_rownames #' @importFrom rlang !! := #' @importFrom logger log_info log_trace +#' @importFrom S4Vectors DataFrame #' #' @export #' -VizPCA <- function(InputData, - SettingsInfo= NULL, - SettingsFile_Sample = NULL, - ColorPalette= NULL, - ColorScale="discrete", - ShapePalette=NULL, +VizPCA <- function(se, #InputData, + SettingsInfo = NULL, + #SettingsFile_Sample = NULL, + ColorPalette = NULL, + ColorScale = "discrete", ## EDIT: would list here the option and use match.arg + ShapePalette = NULL, ShowLoadings = FALSE, Scaling = TRUE, - PCx=1, - PCy=2, - Theme=NULL,#theme_classic() - PlotName= '', - SaveAs_Plot = "svg", - PrintPlot=TRUE, - FolderPath = NULL -){ + PCx = 1, + PCy = 2, + Theme = NULL, ##theme_classic() ## EDIT: why not preset it, would simplify some things downstream? + PlotName = '', + SaveAs_Plot = "svg", ## EDIT: would list here the option and use match.arg + PrintPlot = TRUE, + FolderPath = NULL) { - ########################################################################### - ## ------------ Create log file ----------- ## - MetaProViz_Init() + ########################################################################### + ## ------------ Create log file ----------- ## + MetaProViz_Init() - logger::log_info("VizPCA: PCA plot visualization") - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo=SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=NULL, - CoRe=FALSE, - PrintPlot= PrintPlot) + logger::log_info("VizPCA: PCA plot visualization") + ## ------------ Check Input files ----------- ## + ## HelperFunction `CheckInput` + CheckInput(se = se, ##InputData = InputData, + ##SettingsFile_Sample = SettingsFile_Sample, + ##SettingsFile_Metab = NULL, + SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, + SaveAs_Table = NULL, + CoRe = FALSE, + PrintPlot = PrintPlot) - # CheckInput` Specific - if(is.logical(ShowLoadings) == FALSE){ - message <- paste("The Show_Loadings value should be either =TRUE if loadings are to be shown on the PCA plot or = FALSE if not.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.logical(Scaling) == FALSE){ - message <- paste("The Scaling value should be either =TRUE if data scaling is to be performed prior to the PCA or = FALSE if not.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } + # CheckInput` Specific + if (!is.logical(ShowLoadings)) { + message <- paste("The Show_Loadings value should be either TRUE if loadings are to be shown on the PCA plot or FALSE if not.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(Scaling)) { + message <- paste("The Scaling value should be either TRUE if data scaling is to be performed prior to the PCA or FALSE if not.") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - if(any(is.na(InputData))==TRUE){ - InputData[is.na(InputData)] <- 0#replace NA with 0 - message <- paste("NA values are included in InputData that were set to 0 prior to performing PCA.") - logger::log_info(message) - message(message) - } + if (any(is.na(assay(se)))) { + assay(se)[is.na(assay(se))] <- 0 #replace NA with 0 + message <- paste("NA values are included in InputData that were set to 0 prior to performing PCA.") + logger::log_info(message) + message(message) + } - ## ------------ Create Results output folder ----------- ## - Folder <- NULL - if(is.null(SaveAs_Plot)==FALSE){ - Folder <- SavePath(FolderName= "PCAPlots", - FolderPath=FolderPath) - } - logger::log_info("VizPCA results saved at ", Folder) + ## ------------ Create Results output folder ----------- ## + Folder <- NULL + if (!is.null(SaveAs_Plot)) { + Folder <- SavePath(FolderName = "PCAPlots", FolderPath = FolderPath) + } + logger::log_info("VizPCA results saved at ", Folder) - ########################################################################### - ## ----------- Set the plot parameters: ------------ ## - ##--- Prepare colour and shape palette - if(is.null(ColorPalette)){ - if((ColorScale=="discrete")==TRUE){ - safe_colorblind_palette <- c("#88CCEE", "#DDCC77","#661100", "#332288", "#AA4499","#999933", "#44AA99", "#882215", "#6699CC", "#117733", "#888888","#CC6677", "black","gold1","darkorchid4","red","orange", "blue") - }else if(ColorScale=="continuous"){ - safe_colorblind_palette <- NULL + ########################################################################### + ## ----------- Set the plot parameters: ------------ ## + ##--- Prepare colour and shape palette + if (is.null(ColorPalette)) { + if ((ColorScale == "discrete")) { + safe_colorblind_palette <- c("#88CCEE", "#DDCC77","#661100", ## EDIT: could this be defined outside of the function? + "#332288", "#AA4499","#999933", "#44AA99", "#882215", "#6699CC", + "#117733", "#888888","#CC6677", "black", "gold1", "darkorchid4", + "red", "orange", "blue") + } else if(ColorScale == "continuous") { + safe_colorblind_palette <- NULL + } + } else { + safe_colorblind_palette <-ColorPalette + } + + if (is.null(ShapePalette)) { + safe_shape_palette <- c(15, 17, 16, 18, 6, 7, 8, 11, 12) + } else { + safe_shape_palette <-ShapePalette } - } else{ - safe_colorblind_palette <-ColorPalette - } - if(is.null(ShapePalette)){ - safe_shape_palette <- c(15,17,16,18,6,7,8,11,12) - } else{ - safe_shape_palette <-ShapePalette - } - logger::log_info(paste("VizPCA colour:", paste(safe_colorblind_palette, collapse = ", "))) - logger::log_info(paste("VizPCA shape:", paste(safe_shape_palette, collapse = ", "))) + logger::log_info(paste("VizPCA colour:", paste(safe_colorblind_palette, collapse = ", "))) + logger::log_info(paste("VizPCA shape:", paste(safe_shape_palette, collapse = ", "))) - ##--- Prepare the color scheme: - if("color" %in% names(SettingsInfo)==TRUE & "shape" %in% names(SettingsInfo)==TRUE){ - if((SettingsInfo[["shape"]] == SettingsInfo[["color"]])==TRUE){ - SettingsFile_Sample$shape <- SettingsFile_Sample[,paste(SettingsInfo[["color"]])] - SettingsFile_Sample<- SettingsFile_Sample%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]])) - }else{ - SettingsFile_Sample <- SettingsFile_Sample%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]]), - "shape"=paste(SettingsInfo[["shape"]])) - } - }else if("color" %in% names(SettingsInfo)==TRUE & "shape" %in% names(SettingsInfo)==FALSE){ - if("color" %in% names(SettingsInfo)==TRUE){ - SettingsFile_Sample <- SettingsFile_Sample%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]])) - } - if("shape" %in% names(SettingsInfo)==TRUE){ - SettingsFile_Sample <- SettingsFile_Sample%>% - dplyr::rename("shape"=paste(SettingsInfo[["shape"]])) - } - } + ##--- Prepare the color scheme: + if ("color" %in% names(SettingsInfo) & "shape" %in% names(SettingsInfo)) { + if((SettingsInfo[["shape"]] == SettingsInfo[["color"]])){ + colData(se)[, "shape"] <- colData(se)[, SettingsInfo[["color"]]] + se@colData <- colData(se) |> + as.data.frame() |> + dplyr::rename("color" = SettingsInfo[["color"]]) |> + DataFrame() + } else { + se@colData <- colData(se) |> + as.data.frame() |> + dplyr::rename( + "color" = SettingsInfo[["color"]], + "shape" = SettingsInfo[["shape"]]) |> + DataFrame() + } + } else if("color" %in% names(SettingsInfo) & !"shape" %in% names(SettingsInfo)) { + if ("color" %in% names(SettingsInfo)) { + se@colData <- colData(se) %>% + as.data.frame() |> + dplyr::rename("color" = SettingsInfo[["color"]]) |> + DataFrame() + } + if ("shape" %in% names(SettingsInfo)) { + se@colData <- colData(se) %>% + as.data.frame() |> + dplyr::rename("shape" = SettingsInfo[["shape"]]) |> + DataFrame() + } + } - ##--- Prepare Input Data: - if(is.null(SettingsFile_Sample)==FALSE){ - InputPCA <- merge(x=SettingsFile_Sample%>%tibble::rownames_to_column("UniqueID") , y=InputData%>%tibble::rownames_to_column("UniqueID"), by="UniqueID", all.y=TRUE)%>% - tibble::column_to_rownames("UniqueID") - }else{ - InputPCA <- InputData - } + ##--- Prepare Input Data: + ##if (!is.null(SettingsFile_Sample)){ + InputPCA <- merge(colData(se), t(assay(se)), by = "row.names", all.y = TRUE) + ##InputPCA <- merge( + ## x = tibble::rownames_to_column(as.data.frame(colData(se)), "UniqueID"), + ## y = tibble::rownames_to_column(InputData, "UniqueID"), + ## by = "UniqueID", all.y = TRUE) %>% + ## tibble::column_to_rownames("UniqueID") + ## } else { +## InputPCA <- InputData + ## } - ##--- Prepare the color and shape settings: - if("color" %in% names(SettingsFile_Sample)==TRUE){ - if(ColorScale=="discrete"){ - InputPCA$color <- as.factor(InputPCA$color) - color_select <- safe_colorblind_palette[1:length(unique(InputPCA$color))] - }else if(ColorScale=="continuous"){ - if(is.numeric(InputPCA$color) == TRUE | is.integer(InputPCA$color) == TRUE){ - InputPCA$color <- as.numeric(InputPCA$color) - color_select <- safe_colorblind_palette - }else{ - InputPCA$color <- as.factor(InputPCA$color) - #Overwrite color pallette - safe_colorblind_palette <- metaproviz_palette() - #color that will be used for distinct - color_select <- safe_colorblind_palette[1:length(unique(InputPCA$color))] - #Overwrite color_scale - ColorScale <- "discrete" - logger::log_info("Warning: ColorScale=continuous, but is.numeric or is.integer is FALSE, hence colour scale is set to discrete.") - warning("ColorScale=continuous, but is.numeric or is.integer is FALSE, hence colour scale is set to discrete.") - } + ##--- Prepare the color and shape settings: + if ("color" %in% names(colData(se))) { + if (ColorScale == "discrete") { + InputPCA$color <- as.factor(InputPCA$color) + color_select <- safe_colorblind_palette[1:length(unique(InputPCA$color))] + } else if (ColorScale=="continuous") { + if (is.numeric(InputPCA$color) | is.integer(InputPCA$color)) { + InputPCA$color <- as.numeric(InputPCA$color) + color_select <- safe_colorblind_palette + } else { + InputPCA$color <- as.factor(InputPCA$color) + ## Overwrite color pallette + safe_colorblind_palette <- metaproviz_palette() + ## color that will be used for distinct + color_select <- safe_colorblind_palette[1:length(unique(InputPCA$color))] + ## Overwrite color_scale + ColorScale <- "discrete" + logger::log_info("Warning: ColorScale=continuous, but is.numeric or is.integer is FALSE, hence colour scale is set to discrete.") + warning("ColorScale=continuous, but is.numeric or is.integer is FALSE, hence colour scale is set to discrete.") + } + } } - } - logger::log_info("VizPCA ColorScale: ", ColorScale) + logger::log_info("VizPCA ColorScale: ", ColorScale) - if("shape" %in% names(SettingsFile_Sample)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputPCA$shape))] + if ("shape" %in% names(colData(se))) { + shape_select <- safe_shape_palette[1:length(unique(InputPCA$shape))] - if (!is.character(InputPCA$shape)) { - # Convert the column to character - InputPCA$shape <- as.character(InputPCA$shape) + if (!is.character(InputPCA$shape)) { + ## Convert the column to character + InputPCA$shape <- as.character(InputPCA$shape) + } } - } - ##--- #assign column and legend name - if("color" %in% names(SettingsFile_Sample)==TRUE){ - InputPCA <- InputPCA%>% - dplyr::rename(!!paste(SettingsInfo[["color"]]) :="color") - Param_Col <-paste(SettingsInfo[["color"]]) - } else{ - color_select <- NULL - Param_Col <- NULL - } + ##--- #assign column and legend name + if ("color" %in% names(colData(se))) { + InputPCA <- InputPCA %>% + dplyr::rename(!!SettingsInfo[["color"]] :="color") + Param_Col <- SettingsInfo[["color"]] + } else{ + color_select <- NULL + Param_Col <- NULL + } - if("shape" %in% names(SettingsFile_Sample)==TRUE){ - InputPCA <- InputPCA%>% - dplyr::rename(!!paste(SettingsInfo[["shape"]]) :="shape") - Param_Sha <-paste(SettingsInfo[["shape"]]) - } else{ - shape_select <-NULL - Param_Sha <-NULL - } + if ("shape" %in% names(colData(se))) { + InputPCA <- InputPCA %>% + dplyr::rename(!!SettingsInfo[["shape"]] :="shape") + Param_Sha <- SettingsInfo[["shape"]] + } else { + shape_select <-NULL + Param_Sha <-NULL + } - ## ----------- Make the plot based on the choosen parameters ------------ ## - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list() + ## ----------- Make the plot based on the choosen parameters ------------ ## + PlotList <- list() #Empty list to store all the plots + PlotList_adaptedGrid <- list() - #Make the plot: - PCA <- ggplot2::autoplot(stats::prcomp(as.matrix(InputData), scale. = as.logical(Scaling)), - data= InputPCA, - x= PCx , - y= PCy, - colour = Param_Col, - fill = Param_Col, - shape = Param_Sha, - size = 3, - alpha = 0.8, - label=T, - label.size=2.5, - label.repel = TRUE, - loadings= as.logical(ShowLoadings), #draws Eigenvectors - loadings.label = as.logical(ShowLoadings), - loadings.label.vjust = 1.2, - loadings.label.size=2.5, - loadings.colour="grey10", - loadings.label.colour="grey10" ) + - ggplot2::scale_shape_manual(values=shape_select)+ - ggplot2::ggtitle(paste(PlotName)) + - ggplot2::geom_hline(yintercept=0, color = "black", linewidth=0.1)+ - ggplot2::geom_vline(xintercept=0, color = "black", linewidth=0.1) + ## Make the plot: + PCA <- ggplot2::autoplot( + object = stats::prcomp(as.matrix(InputPCA[, rownames(se)]), + scale. = as.logical(Scaling)), + data = InputPCA, + x = PCx, y = PCy, colour = Param_Col, fill = Param_Col, + shape = Param_Sha, size = 3, alpha = 0.8, label = TRUE, + label.size = 2.5, label.repel = TRUE, + loadings = as.logical(ShowLoadings), #draws Eigenvectors + loadings.label = as.logical(ShowLoadings), + loadings.label.vjust = 1.2, loadings.label.size=2.5, + loadings.colour = "grey10", loadings.label.colour = "grey10") + + ggplot2::scale_shape_manual(values = shape_select) + + ggplot2::ggtitle(paste(PlotName)) + + ggplot2::geom_hline(yintercept = 0, color = "black", linewidth = 0.1) + + ggplot2::geom_vline(xintercept = 0, color = "black", linewidth = 0.1) - if(ColorScale=="discrete"){ - PCA <-PCA + ggplot2::scale_color_manual(values=color_select) - }else if(ColorScale=="continuous" & is.null(ColorPalette)){ - PCA <-PCA + color_select + if (ColorScale == "discrete") { + PCA <- PCA + + ggplot2::scale_color_manual(values = color_select) + } else if (ColorScale == "continuous" & is.null(ColorPalette)) { + PCA <- PCA + + color_select } - #Add the theme - if(is.null(Theme)==FALSE){ - PCA <- PCA+Theme - }else{ - PCA <- PCA+ggplot2::theme_classic() - } + ## Add the theme + if(!is.null(Theme)){ + PCA <- PCA + + Theme + } else { + PCA <- PCA + ggplot2::theme_classic() + } - ## Store the plot in the 'plots' list - PlotList[["Plot"]] <- PCA + ## Store the plot in the 'plots' list + PlotList[["Plot"]] <- PCA - #Set the total heights and widths - PCA %<>% PlotGrob_PCA(SettingsInfo=SettingsInfo, PlotName=PlotName) - PlotHeight <- grid::convertUnit(PCA$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(PCA$width, 'cm', valueOnly = TRUE) - PCA %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) + ## Set the total heights and widths + PCA %<>% + PlotGrob_PCA(SettingsInfo = SettingsInfo, PlotName = PlotName) + PlotHeight <- grid::convertUnit(PCA$height, 'cm', valueOnly = TRUE) + PlotWidth <- grid::convertUnit(PCA$width, 'cm', valueOnly = TRUE) + PCA %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) - PlotList_adaptedGrid[["Plot_Sized"]] <- PCA + PlotList_adaptedGrid[["Plot_Sized"]] <- PCA - ########################################################################### - ##----- Save and Return - #Here we make a list in which we will save the outputs: - FileName <- PlotName %>% {`if`(nchar(.), sprintf('PCA_%s', .), 'PCA')} + ########################################################################### + ##----- Save and Return + #Here we make a list in which we will save the outputs: + FileName <- PlotName %>% + {`if`(nchar(.), sprintf('PCA_%s', .), 'PCA')} - suppressMessages(suppressWarnings( - SaveRes( - InputList_DF=NULL, - InputList_Plot= PlotList_adaptedGrid, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= FileName, - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm") - )) + suppressMessages(suppressWarnings( + SaveRes( + data = NULL, + plot = PlotList_adaptedGrid, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = FileName, + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm") + )) - invisible(list(Plot = PlotList, Plot_Sized = PlotList_adaptedGrid)) + invisible(list(Plot = PlotList, Plot_Sized = PlotList_adaptedGrid)) } diff --git a/R/VizSuperplots.R b/R/VizSuperplots.R index 2904af89..29b8cf8e 100644 --- a/R/VizSuperplots.R +++ b/R/VizSuperplots.R @@ -43,8 +43,24 @@ #' @return List with two elements: Plot and Plot_Sized #' #' @examples -#' Intra <- ToyData("IntraCells_Raw")[,c(1:6)] -#' Res <- VizSuperplot(InputData=Intra[,-c(1:3)], SettingsFile_Sample=Intra[,c(1:3)], SettingsInfo = c(Conditions="Conditions", Superplot = NULL)) +#' Intra <- ToyData("IntraCells_Raw") +#' MappingInfo <- ToyData(Data = "Cells_MetaData") +#' +#' ## create SummarizedExperiment objects +#' ## se_intra +#' rD <- MappingInfo +#' cD <- Intra[-c(49:58), c(1:3)] +#' a <- t(Intra[-c(49:58), -c(1:3)]) +#' +#' ## obtain overlapping metabolites +#' metabolites <- intersect(rownames(a), rownames(rD)) +#' rD <- rD[metabolites, ] +#' a <- a[metabolites, ] +#' se_intra <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) +#' +#' ## apply the functions +#' Res <- VizSuperplot(se = se_intra, +#' SettingsInfo = c(Conditions = "Conditions", Superplot = NULL)) #' #' @keywords Barplot, Boxplot, Violinplot, Superplot #' @@ -59,365 +75,446 @@ #' #' @export #' -VizSuperplot <- function(InputData, - SettingsFile_Sample, - SettingsInfo = c(Conditions="Conditions", Superplot = NULL), - PlotType = "Box", # Bar, Box, Violin - PlotName = "", - PlotConditions = NULL, - StatComparisons = NULL, - StatPval =NULL, - StatPadj=NULL, - xlab= NULL, - ylab= NULL, - Theme = NULL, - ColorPalette = NULL, - ColorPalette_Dot =NULL, - SaveAs_Plot = "svg", - PrintPlot=TRUE, - FolderPath = NULL){ - - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - logger::log_info("VizSuperplot: Superplot visualization") - - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - CheckInput(InputData=InputData, - SettingsFile_Sample=SettingsFile_Sample, - SettingsFile_Metab=NULL, - SettingsInfo=SettingsInfo, - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=NULL, - CoRe=FALSE, - PrintPlot= PrintPlot) - - # CheckInput` Specific - if(is.null(SettingsInfo)==TRUE){ - message <- paste0("You must provide the column name for Conditions via SettingsInfo=c(Conditions=ColumnName) in order to plot the x-axis conditions.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(PlotType %in% c("Box", "Bar", "Violin") == FALSE){ - message <- paste0("PlotType must be either Box, Bar or Violin.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(PlotConditions) == FALSE){ - for (Condition in PlotConditions){ - if(Condition %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]]==FALSE){ - message <- paste0("Check Input. The PlotConditions ",Condition," were not found in the Conditions Column.") +VizSuperplot <- function(se, + SettingsInfo = c(Conditions="Conditions", Superplot = NULL), + PlotType = "Box", # Bar, Box, Violin + PlotName = "", + PlotConditions = NULL, + StatComparisons = NULL, + StatPval = NULL, + StatPadj = NULL, + xlab = NULL, + ylab = NULL, + Theme = NULL, + ColorPalette = NULL, + ColorPalette_Dot = NULL, + SaveAs_Plot = "svg", + PrintPlot = TRUE, + FolderPath = NULL) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + logger::log_info("VizSuperplot: Superplot visualization") + + ## ------------ Check Input files ----------- ## + ## HelperFunction `CheckInput` + CheckInput(se, + SettingsInfo = SettingsInfo, + SaveAs_Plot = SaveAs_Plot, + SaveAs_Table = NULL, + CoRe = FALSE, + PrintPlot = PrintPlot) + + ## CheckInput` Specific + if(is.null(SettingsInfo)){ + message <- paste0("You must provide the column name for Conditions via SettingsInfo=c(Conditions=ColumnName) in order to plot the x-axis conditions.") logger::log_trace(paste("Error ", message, sep="")) stop(message) - } } - } - - if(is.null(StatComparisons)==FALSE){ - for (Comp in StatComparisons){ - if(is.null(PlotConditions)==FALSE){ - if(PlotConditions[Comp[1]] %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] ==FALSE){ - message <- paste0("Check Input. The StatComparisons condition ",Comp[1], " is not found in the Conditions Column of the SettingsFile_Sample.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + if (!PlotType %in% c("Box", "Bar", "Violin")) { ## EDIT: why not with match.arg? + message <- paste0("PlotType must be either Box, Bar or Violin.") + logger::log_trace(paste("Error ", message, sep = "")) + stop(message) + } + + if(!is.null(PlotConditions)) { + for (Condition in PlotConditions) { + if(!Condition %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + message <- paste0("Check Input. The PlotConditions ",Condition," were not found in the Conditions Column.") + logger::log_trace(paste("Error ", message, sep = "")) + stop(message) + } } - if(PlotConditions[Comp[2]] %in% SettingsFile_Sample[[SettingsInfo[["Conditions"]]]] ==FALSE){ - message <- paste0("Check Input. The StatComparisons condition ",Comp[2], " is not found in the Conditions Column of the SettingsFile_Sample.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + } + + if (!is.null(StatComparisons)) { + for (Comp in StatComparisons) { + if (!is.null(PlotConditions)) { + if (!PlotConditions[Comp[1]] %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + message <- paste0( + "Check Input. The StatComparisons condition ", Comp[1], + " is not found in the Conditions Column of colData(se).") + stop(message) + } + if (!PlotConditions[Comp[2]] %in% colData(se)[[SettingsInfo[["Conditions"]]]]) { + message <- paste0( + "Check Input. The StatComparisons condition ", Comp[2], + " is not found in the Conditions Column of colData(se).") + logger::log_trace(paste("Error ", message, sep = "")) + stop(message) + } + } } - } } - } - - if(is.null(ColorPalette)){ - ColorPalette <- "grey" - } - - ## ------------ Check Input SettingsInfo ----------- ## - #7. Check StatComparisons & PlotConditions - if(is.null(PlotConditions)){ - Number_Cond <- length(unique(tolower(SettingsFile_Sample[["Conditions"]]))) - if(Number_Cond<=2){ - MultipleComparison = FALSE - }else{ - MultipleComparison = TRUE + + if (is.null(ColorPalette)) { + ColorPalette <- "grey" } - }else if(length(PlotConditions)>2){ - MultipleComparison = TRUE - }else if(length(PlotConditions)<=2){ - Number_Cond <- length(unique(tolower(SettingsFile_Sample[["Conditions"]]))) - if(Number_Cond<=2){ - MultipleComparison = FALSE - }else{ - MultipleComparison = TRUE + + ## ------------ Check Input SettingsInfo ----------- ## + #7. Check StatComparisons & PlotConditions + if (is.null(PlotConditions)) { + Number_Cond <- length(unique(tolower(colData(se)[["Conditions"]]))) + if (Number_Cond <= 2) { + MultipleComparison <- FALSE + } else { + MultipleComparison <- TRUE + } + } else if(length(PlotConditions) > 2) { + MultipleComparison <- TRUE + } else if(length(PlotConditions) <= 2) { + Number_Cond <- length(unique(tolower(colData(se)[["Conditions"]]))) + if (Number_Cond <= 2) { + MultipleComparison <- FALSE + } else { + MultipleComparison <- TRUE + } + } + + if(!is.null(StatPval)) { + if (MultipleComparison & (StatPval == "t.test" | StatPval == "wilcox.test")) { + message <- paste0( + "Check input. The selected StatPval option for Hypothesis testing,", + StatPval, + " is for multiple comparison, but you have only 2 conditions. Hence aov is performed.") + logger::log_trace(paste("Warning ", message, sep = "")) + warning(message) + StatPval <- "aov" + } else if(!MultipleCompariso & (StatPval=="aov" | StatPval=="kruskal.test")) { + message <- paste0( + "Check input. The selected StatPval option for Hypothesis testing,", + StatPval, + " is for multiple comparison, but you have only 2 conditions. Hence t.test is performed.") + logger::log_trace(paste("Warning ", message, sep="")) + warning(message) + StatPval <- "t.test" + } + } + + if (is.null(StatPval) & !MultipleComparison) { + StatPval <- "t.test" } - } - - if(is.null(StatPval)==FALSE){ - if(MultipleComparison == TRUE & (StatPval=="t.test" | StatPval=="wilcox.test")){ - message <- paste0("Check input. The selected StatPval option for Hypothesis testing,", StatPval, " is for multiple comparison, but you have only 2 conditions. Hence aov is performed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - StatPval <- "aov" - }else if(MultipleComparison == FALSE & (StatPval=="aov" | StatPval=="kruskal.test")){ - message <- paste0("Check input. The selected StatPval option for Hypothesis testing,", StatPval, " is for multiple comparison, but you have only 2 conditions. Hence t.test is performed.") - logger::log_trace(paste("Warning ", message, sep="")) - warning(message) - StatPval <- "t.test" - } + + if(is.null(StatPval) & MultipleComparison) { + StatPval <- "aov" } - if(is.null(StatPval)==TRUE & MultipleComparison == FALSE){ - StatPval <- "t.test" - } - - if(is.null(StatPval)==TRUE & MultipleComparison == TRUE){ - StatPval <- "aov" - } - - STAT_padj_options <- c("holm", "hochberg", "hommel", "bonferroni", "BH", "BY", "fdr", "none") - if(is.null(StatPadj)==FALSE){ - if(StatPadj %in% STAT_padj_options == FALSE){ - message <- paste0("Check input. The selected StatPadj option for multiple Hypothesis testing correction is not valid. Please select NULL or one of the folowing: ",paste(STAT_padj_options,collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - if(is.null(StatPadj)==TRUE){ - StatPadj <- "fdr" - } - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Plot)==FALSE){ - Folder <- SavePath(FolderName= paste(PlotType, "Plots", sep=""), - FolderPath=FolderPath) - } - logger::log_info("VizSuperplot results saved at ", Folder) - - ############################################################################################################################################################################################################### - ## ------------ Prepare Input ----------- ## - SettingsFile_Sample<- SettingsFile_Sample%>% - dplyr::rename("Conditions"= paste(SettingsInfo[["Conditions"]]) ) - - if("Superplot" %in% names(SettingsInfo)){ - SettingsFile_Sample<- SettingsFile_Sample%>% - dplyr::rename("Superplot"= paste(SettingsInfo[["Superplot"]]) ) - - data <- merge(SettingsFile_Sample[c("Conditions","Superplot")] ,InputData, by=0) - data <- tibble::column_to_rownames(data, "Row.names") - }else{ - data <- merge(SettingsFile_Sample[c("Conditions")] ,InputData, by=0) - data <- tibble::column_to_rownames(data, "Row.names") - } - - # Rename the x and y lab if the information has been passed: - if(is.null(xlab)==TRUE){#use column name of x provided by user - xlab <- bquote(.(as.symbol(SettingsInfo[["Conditions"]]))) - }else if(is.null(xlab)==FALSE){ - xlab <- bquote(.(as.symbol(xlab))) - } - - if(is.null(ylab)==TRUE){#use column name of x provided by user - ylab <- bquote(.(as.symbol("Intensity"))) - }else if(is.null(ylab)==FALSE){ - ylab <- bquote(.(as.symbol(ylab))) - } - - #Set the theme: - if(is.null(Theme)==TRUE){ - Theme <- ggplot2::theme_classic() - } - - ## ------------ Create plots ----------- ## - # make a list for plotting all plots together - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - for (i in colnames(InputData)){ - #Prepare the dfs: - suppressWarnings(dataMeans <- data %>% - dplyr::select(i, Conditions) - %>% dplyr::group_by(Conditions) - %>% dplyr::summarise_at(vars(i), list(mean = mean, sd = sd)) - %>% as.data.frame()) - names(dataMeans)[2] <- "Intensity" - - if("Superplot" %in% names(SettingsInfo)){ - suppressWarnings(plotdata <- data %>% - dplyr::select(i,Conditions, Superplot) - %>% dplyr::group_by(Conditions) - %>% as.data.frame() ) - }else{ - suppressWarnings(plotdata <- data %>% - dplyr::select(i,Conditions) - %>% dplyr::group_by(Conditions) - %>% as.data.frame() ) + STAT_padj_options <- c("holm", "hochberg", "hommel", "bonferroni", + "BH", "BY", "fdr", "none") ## EDIT: p.adjust.methods?, use match.arg + if (!is.null(StatPadj)) { + if (!StatPadj %in% STAT_padj_options) { + message <- paste0( + "Check input. The selected StatPadj option for multiple Hypothesis testing correction is not valid. Please select NULL or one of the folowing: ", + paste(STAT_padj_options, collapse = ", "), "." ) + logger::log_trace(paste("Error ", message, sep="")) + stop(message) + } } - names(plotdata)[1] <- c("Intensity") - plotdata$Conditions <- factor(plotdata$Conditions)# Change conditions to factor - - # Take only selected conditions - if(is.null(PlotConditions) == FALSE){ - dataMeans <- dataMeans %>% dplyr::filter(Conditions %in% PlotConditions) - plotdata <- plotdata %>% dplyr::filter(Conditions %in% PlotConditions) - plotdata$Conditions <- factor(plotdata$Conditions, levels = PlotConditions) + + if (is.null(StatPadj)) { + StatPadj <- "fdr" } - # Make the Plot - Plot <- ggplot2::ggplot(plotdata, aes(x = Conditions, y = Intensity)) + ## ------------ Create Results output folder ----------- ## + if(!is.null(SaveAs_Plot)) { + Folder <- SavePath(FolderName = paste(PlotType, "Plots", sep = ""), + FolderPath = FolderPath) + } + logger::log_info("VizSuperplot results saved at ", Folder) + + ############################################################################ + ## ------------ Prepare Input ----------- ## + se@colData <- colData(se) |> + as.data.frame() |> + dplyr::rename("Conditions"= paste(SettingsInfo[["Conditions"]])) |> + DataFrame() + + if("Superplot" %in% names(SettingsInfo)) { + se@colData <- colData(se) %>% + as.data.frame() |> + dplyr::rename("Superplot" = paste(SettingsInfo[["Superplot"]])) |> + DataFrame() + + + data <- merge(colData(se)[c("Conditions", "Superplot")], + t(assay(se)), by = 0) |> + tibble::column_to_rownames("Row.names") + } else { + data <- merge(colData(se)[c("Conditions")], t(assay(se)), + by = 0) |> + tibble::column_to_rownames("Row.names") + } - # Add graph style and error bar - data_summary <- function(x){#calculate error bar! - m <- mean(x) - ymin <- m-sd(x) - ymax <- m+sd(x) - return(c(y=m,ymin=ymin,ymax=ymax)) + ## Rename the x and y lab if the information has been passed: + if(is.null(xlab)) { #use column name of x provided by user + xlab <- bquote(.(as.symbol(SettingsInfo[["Conditions"]]))) + } else if(!is.null(xlab)) { + xlab <- bquote(.(as.symbol(xlab))) } - if (PlotType == "Bar"){ - Plot <- Plot+ ggplot2::geom_bar(stat = "summary", fun = "mean", fill = ColorPalette)+ ggplot2::stat_summary(fun.data=data_summary, - geom="errorbar", color="black", width=0.2) - } else if (PlotType == "Violin"){ - Plot <- Plot+ ggplot2::geom_violin(fill = ColorPalette)+ ggplot2::stat_summary(fun.data=data_summary, - geom="errorbar", color="black", width=0.2) - } else if (PlotType == "Box"){ - Plot <- Plot + ggplot2::geom_boxplot(fill=ColorPalette, width=0.5, position=position_dodge(width = 0.5)) + if(is.null(ylab)) { ## use column name of x provided by user + ylab <- bquote(.(as.symbol("Intensity"))) + } else if(!is.null(ylab)) { + ylab <- bquote(.(as.symbol(ylab))) } - # Add Superplot - if ("Superplot" %in% names(SettingsInfo)){ - if(is.null(ColorPalette_Dot)==FALSE){ - Plot <- Plot+ ggbeeswarm::geom_beeswarm(aes(x=Conditions,y=Intensity,color=as.factor(Superplot)),size=3)+ - ggplot2::labs(color=SettingsInfo[["Superplot"]], fill = SettingsInfo[["Superplot"]])+ - ggplot2::scale_color_manual(values = ColorPalette_Dot) - }else{ - Plot <- Plot+ ggbeeswarm::geom_beeswarm(aes(x=Conditions,y=Intensity,color=as.factor(Superplot)),size=3)+ - ggplot2::labs(color=SettingsInfo[["Superplot"]], fill = SettingsInfo[["Superplot"]]) - } - }else{ - Plot <- Plot+ ggbeeswarm::geom_beeswarm(aes(x=Conditions,y=Intensity),size=2) + ## Set the theme: + if(is.null(Theme)){ + Theme <- ggplot2::theme_classic() } - ####---- Add stats: - if(StatPval=="t.test" | StatPval=="wilcox.test"){ - # One vs. One comparison: t-test - if(is.null(StatComparisons)==FALSE){ - Plot <- Plot+ ggpubr::stat_compare_means(comparisons = StatComparisons, - label = "p.format", method = StatPval, hide.ns = TRUE, - position = position_dodge(0.9), vjust = 0.25, show.legend = FALSE) - }else{ - comparison <- unique(plotdata$Conditions) - Plot <- Plot+ ggpubr::stat_compare_means(comparisons = comparison , - label = "p.format", method = StatPval, hide.ns = TRUE, - position = position_dodge(0.9), vjust = 0.25, show.legend = FALSE) - - } - Plot <- Plot +ggplot2::labs(caption = paste("p.val using pairwise ", StatPval)) - }else{ - #All-vs-All comparisons table: - conditions <- SettingsFile_Sample$Conditions - denominator <-unique(SettingsFile_Sample$Conditions) - numerator <-unique(SettingsFile_Sample$Conditions) - comparisons <- combn(unique(conditions), 2) %>% as.matrix() - - #Prepare Stat results using DMA STAT helper functions - if(StatPval=="aov"){ - STAT_C1vC2 <- AOV(InputData=data.frame("Intensity" = plotdata[,-c(2:3)]), - SettingsInfo=c(Conditions="Conditions", Numerator = unique(SettingsFile_Sample$Conditions), Denominator = unique(SettingsFile_Sample$Conditions)), - SettingsFile_Sample= SettingsFile_Sample, - Log2FC_table=NULL) - }else if(StatPval=="kruskal.test"){ - STAT_C1vC2 <-Kruskal(InputData=data.frame("Intensity" = plotdata[,-c(2:3)]), - SettingsInfo=c(Conditions="Conditions", Numerator = unique(SettingsFile_Sample$Conditions), Denominator = unique(SettingsFile_Sample$Conditions)), - SettingsFile_Sample= SettingsFile_Sample, - Log2FC_table=NULL) + ## ------------ Create plots ----------- ## + ## make a list for plotting all plots together + PlotList <- list() #Empty list to store all the plots + PlotList_adaptedGrid <- list() #Empty list to store all the plots + + for (i in rownames(se)) { + #Prepare the dfs: + suppressWarnings( + dataMeans <- data %>% + dplyr::select(i, Conditions) %>% + dplyr::group_by(Conditions) %>% + dplyr::summarise_at(vars(i), list(mean = mean, sd = sd)) %>% + as.data.frame()) + names(dataMeans)[2] <- "Intensity" + + if ("Superplot" %in% names(SettingsInfo)) { + suppressWarnings( ## EDIT: could be simplified with less code duplications + plotdata <- data %>% + dplyr::select(i, Conditions, Superplot) %>% + dplyr::group_by(Conditions) %>% + as.data.frame() ) + } else { + suppressWarnings( + plotdata <- data %>% + dplyr::select(i, Conditions) %>% + dplyr::group_by(Conditions) %>% + as.data.frame()) + } + names(plotdata)[1] <- c("Intensity") + plotdata$Conditions <- factor(plotdata$Conditions) ## Change conditions to factor + + ## Take only selected conditions + if (!is.null(PlotConditions)) { + dataMeans <- dataMeans %>% + dplyr::filter(Conditions %in% PlotConditions) + plotdata <- plotdata %>% + dplyr::filter(Conditions %in% PlotConditions) + plotdata$Conditions <- factor(plotdata$Conditions, + levels = PlotConditions) } - #Prepare df to add stats to plot - df <- data.frame(comparisons = names(STAT_C1vC2), stringsAsFactors = FALSE)%>% - tidyr::separate(comparisons, into=c("group1", "group2"), sep="_vs_", remove=FALSE)%>% - tidyr::unite(comparisons_rev, c("group2", "group1"), sep="_vs_", remove=FALSE) - df$p.adj <- round(sapply(STAT_C1vC2, function(x) x$p.adj),5) - - # Add the 'res' column by repeating 'position' to match the number of rows - position <- c(max(dataMeans$Intensity + 2*dataMeans$sd), - max(dataMeans$Intensity + 2*dataMeans$sd)+0.04* max(dataMeans$Intensity + 2*dataMeans$sd) , - max(dataMeans$Intensity + 2*dataMeans$sd)+0.08* max(dataMeans$Intensity + 2*dataMeans$sd)) - - df <- df %>% - dplyr::mutate(y.position = rep(position, length.out = dplyr::n())) - - # select stats based on comparison_table - if(is.null(StatComparisons)== FALSE){ - # Generate the comparisons - df_select <- data.frame() - for(comp in StatComparisons){ - entry <- paste0(PlotConditions[comp[1]], "_vs_", PlotConditions[comp[2]]) - df_select <- rbind(df_select, data.frame(entry)) - } - - df_merge <- merge(df_select, df, by.x="entry", by.y="comparisons", all.x=TRUE)%>% - tibble::column_to_rownames("entry") - - if(all(is.na(df_merge))==TRUE){#in case the reverse comparisons are needed - df_merge <- merge(df_select, df, by.x="entry", by.y="comparisons_rev", all.x=TRUE)%>% - tibble::column_to_rownames("entry") - } - }else{ - df_merge <- df[,-2]%>% - tibble::column_to_rownames("comparisons") - } - - - # add stats to plot - if(PlotType == "Bar"){ - Plot <- Plot +ggpubr::stat_pvalue_manual(df_merge, hide.ns = FALSE, size = 3, tip.length = 0.01, step.increase=0.05)#http://rpkgs.datanovia.com/ggpubr/reference/stat_pvalue_manual.html - }else{ - Plot <- Plot +ggpubr::stat_pvalue_manual(df_merge, hide.ns = FALSE, size = 3, tip.length = 0.01, step.increase=0.01)#http://rpkgs.datanovia.com/ggpubr/reference/stat_pvalue_manual.html + ## Make the Plot + Plot <- ggplot2::ggplot(plotdata, aes(x = Conditions, y = Intensity)) + + ## Add graph style and error bar + data_summary <- function(x){ #calculate error bar! #### should this be moved outside of the function? + m <- mean(x) + ymin <- m-sd(x) + ymax <- m+sd(x) + c(y = m,ymin = ymin, ymax = ymax) } - Plot <- Plot +ggplot2::labs(caption = paste("p.adj using ", StatPval, "and", StatPadj)) - } - - Plot <- Plot + Theme+ ggplot2::labs(title = PlotName, - subtitle = i)# ggtitle(paste(i)) - Plot <- Plot + ggplot2::theme(legend.position = "right",plot.title = element_text(size=12, face = "bold"), axis.text.x = element_text(angle = 90, hjust = 1))+ ggplot2::xlab(xlab)+ ggplot2::ylab(ylab) - - ## Store the plot in the 'plots' list - PlotList[[i]] <- Plot - - # Make plot into nice format: - Plot_Sized <- plotGrob_Superplot(InputPlot=Plot, SettingsInfo=SettingsInfo, SettingsFile_Sample=SettingsFile_Sample, PlotName = PlotName, Subtitle = i, PlotType=PlotType) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - #################################################################################################################################### - ## --------------- save -----------------## - cleaned_i <- gsub("[[:space:],/\\\\*]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - SaveList <- list() - SaveList[[cleaned_i]] <- Plot_Sized - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= SaveList, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste(PlotType, "Plots_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + + if (PlotType == "Bar") { + Plot <- Plot + + ggplot2::geom_bar(stat = "summary", fun = "mean", + fill = ColorPalette) + + ggplot2::stat_summary(fun.data = data_summary, geom = "errorbar", + color = "black", width = 0.2) + } else if (PlotType == "Violin") { + Plot <- Plot + ggplot2::geom_violin(fill = ColorPalette) + + ggplot2::stat_summary(fun.data = data_summary, geom = "errorbar", + color = "black", width = 0.2) + } else if (PlotType == "Box") { + Plot <- Plot + + ggplot2::geom_boxplot(fill = ColorPalette, width = 0.5, + position = position_dodge(width = 0.5)) + } + + ## Add Superplot + if ("Superplot" %in% names(SettingsInfo)) { + if(!is.null(ColorPalette_Dot)) { + Plot <- Plot + + ggbeeswarm::geom_beeswarm( + aes(x = Conditions, y = Intensity, color = as.factor(Superplot)), + size = 3) + + ggplot2::labs(color = SettingsInfo[["Superplot"]], + fill = SettingsInfo[["Superplot"]]) + + ggplot2::scale_color_manual(values = ColorPalette_Dot) + } else { + Plot <- Plot + + ggbeeswarm::geom_beeswarm( + aes(x = Conditions, y = Intensity, color = as.factor(Superplot)), + size = 3) + + ggplot2::labs(color = SettingsInfo[["Superplot"]], + fill = SettingsInfo[["Superplot"]]) + } + } else { + Plot <- Plot + + ggbeeswarm::geom_beeswarm(aes(x = Conditions, y = Intensity), + size = 2) + } + + ####---- Add stats: + if (StatPval == "t.test" | StatPval == "wilcox.test") { + ## One vs. One comparison: t-test + if (!is.null(StatComparisons)) { + Plot <- Plot + + ggpubr::stat_compare_means(comparisons = StatComparisons, + label = "p.format", method = StatPval, hide.ns = TRUE, + position = position_dodge(0.9), vjust = 0.25, + show.legend = FALSE) + } else { + comparison <- unique(plotdata$Conditions) + Plot <- Plot + + ggpubr::stat_compare_means(comparisons = comparison , + label = "p.format", method = StatPval, hide.ns = TRUE, + position = position_dodge(0.9), vjust = 0.25, + show.legend = FALSE) + + } + Plot <- Plot + + ggplot2::labs(caption = paste("p.val using pairwise ", StatPval)) + } else { + ## All-vs-All comparisons table: + conditions <- colData(se)$Conditions + denominator <- unique(colData(se)$Conditions) + numerator <- unique(colData(se)$Conditions) + comparisons <- combn(unique(conditions), 2) %>% + as.matrix() + + ## Prepare Stat results using DMA STAT helper functions + cols_tmp <- "Intensity" + cD_tmp <- plotdata[, !colnames(plotdata) %in% cols_tmp, drop = FALSE] + a_tmp <- as.matrix(plotdata[, cols_tmp, drop = FALSE]) |> + t() + colnames(a_tmp) <- rownames(plotdata) + rD_tmp <- DataFrame(feature = "Intensity") + rownames(rD_tmp) <- "Intensity" + se_tmp <- SummarizedExperiment(assays = a_tmp, rowData = rD_tmp, colData = cD_tmp) + if (StatPval == "aov") { + STAT_C1vC2 <- AOV( + se = se_tmp, + SettingsInfo = c( + Conditions = "Conditions", + Numerator = "Conditions", #unique(colData(se)$Conditions), + Denominator = "Conditions"), #unique(colData(se)$Conditions)), + #SettingsFile_Sample = SettingsFile_Sample, + Log2FC_table = NULL) + + } else if (StatPval == "kruskal.test") { + STAT_C1vC2 <- Kruskal( + se = se_tmp, + SettingsInfo = c( + Conditions = "Conditions", + Numerator = "Conditions",##unique(SettingsFile_Sample$Conditions), + Denominator = "Conditions"),##unique(SettingsFile_Sample$Conditions)), + #SettingsFile_Sample= SettingsFile_Sample, + Log2FC_table=NULL) + } + + ## Prepare df to add stats to plot + df <- data.frame(comparisons = names(STAT_C1vC2), stringsAsFactors = FALSE) %>% + tidyr::separate(comparisons, into = c("group1", "group2"), + sep = "_vs_", remove = FALSE) %>% + tidyr::unite(comparisons_rev, c("group2", "group1"), + sep="_vs_", remove = FALSE) + df$p.adj <- round(sapply(STAT_C1vC2, function(x) x$p.adj), 5) + + ## Add the 'res' column by repeating 'position' to match the number of rows + position <- c(max(dataMeans$Intensity + 2 * dataMeans$sd), + max(dataMeans$Intensity + 2 * dataMeans$sd) + 0.04 * max(dataMeans$Intensity + 2 * dataMeans$sd), + max(dataMeans$Intensity + 2 * dataMeans$sd) + 0.08 * max(dataMeans$Intensity + 2 * dataMeans$sd)) + + df <- df %>% + dplyr::mutate(y.position = rep(position, length.out = dplyr::n())) + + ## select stats based on comparison_table + if (!is.null(StatComparisons)) { + # Generate the comparisons + df_select <- data.frame() + for (comp in StatComparisons) { + entry <- paste0(PlotConditions[comp[1]], "_vs_", PlotConditions[comp[2]]) + df_select <- rbind(df_select, data.frame(entry)) + } + + df_merge <- merge(df_select, df, by.x = "entry", + by.y = "comparisons", all.x = TRUE) %>% + tibble::column_to_rownames("entry") + + if (all(is.na(df_merge))) { ##in case the reverse comparisons are needed + df_merge <- merge(df_select, df, by.x = "entry", + by.y = "comparisons_rev", all.x = TRUE) %>% + tibble::column_to_rownames("entry") + } + } else { + df_merge <- df[, -2] %>% + tibble::column_to_rownames("comparisons") + } + + ## add stats to plot + if (PlotType == "Bar") { + Plot <- Plot + + ggpubr::stat_pvalue_manual(df_merge, hide.ns = FALSE, size = 3, + tip.length = 0.01, step.increase = 0.05) ## http://rpkgs.datanovia.com/ggpubr/reference/stat_pvalue_manual.html + } else { + Plot <- Plot + + ggpubr::stat_pvalue_manual(df_merge, hide.ns = FALSE, size = 3, + tip.length = 0.01, step.increase = 0.01) ## http://rpkgs.datanovia.com/ggpubr/reference/stat_pvalue_manual.html + } + Plot <- Plot + + ggplot2::labs(caption = paste("p.adj using ", StatPval, "and", StatPadj)) + } + + Plot <- Plot + + Theme + + ggplot2::labs(title = PlotName, subtitle = i) + ## ggtitle(paste(i)) + ggplot2::theme(legend.position = "right", + plot.title = element_text(size = 12, face = "bold"), + axis.text.x = element_text(angle = 90, hjust = 1)) + + ggplot2::xlab(xlab) + ggplot2::ylab(ylab) + + ## Store the plot in the 'plots' list + PlotList[[i]] <- Plot + + # Make plot into nice format: + Plot_Sized <- plotGrob_Superplot(InputPlot = Plot, + SettingsInfo = SettingsInfo, se = se, + PlotName = PlotName, Subtitle = i, PlotType = PlotType) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + ############################################################################ + ## --------------- save -----------------## + cleaned_i <- gsub("[[:space:],/\\\\*]", "-", i) ##removes empty spaces and replaces /,\ with - + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + SaveList <- list() + SaveList[[cleaned_i]] <- Plot_Sized + + ##----- Save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, + plot = SaveList, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste(PlotType, "Plots_",PlotName, sep=""), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } + + ## return + invisible(list( + "data" = list(NULL), + "plot" = list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) } + diff --git a/R/VizVolcano.R b/R/VizVolcano.R index a1f36eb5..4556a462 100644 --- a/R/VizVolcano.R +++ b/R/VizVolcano.R @@ -53,8 +53,8 @@ #' @return List with two elements: Plot and Plot_Sized #' #' @examples -#' Intra <- MetaProViz::ToyData("IntraCells_DMA") -#' Res <- MetaProViz::VizVolcano(InputData=Intra) +#' Intra <- ToyData("IntraCells_DMA") +#' Res <- VizVolcano(InputData=Intra) #' #' @keywords Volcano plot, pathways #' @@ -66,268 +66,250 @@ #' #' @export #' -VizVolcano <- function(PlotSettings="Standard", - InputData, - SettingsInfo= NULL, - SettingsFile_Metab=NULL, - InputData2= NULL, - y= "p.adj", - x= "Log2FC", - xlab= NULL,#"~Log[2]~FC" - ylab= NULL,#"~-Log[10]~p.adj" - xCutoff= 0.5, - yCutoff= 0.05, - Connectors= FALSE, - SelectLab= "", - PlotName= "", - Subtitle= "", - ComparisonName= c(InputData="Cond1", InputData2= "Cond2"), - ColorPalette= NULL, - ShapePalette=NULL, - Theme= NULL, - SaveAs_Plot= "svg", - FolderPath = NULL, - Features="Metabolites", - PrintPlot=TRUE){ - ## ------------ Create log file ----------- ## - MetaProViz_Init() - - ## ------------ Check Input files ----------- ## - # HelperFunction `CheckInput` - if(PlotSettings=="PEA"){ - #Those relationships are checked in the VizVolcano_PEA() function! - SettingsFile <- NULL # For PEA the SettingsFile_Metab is the prior knowledge file, and hence this will not have features as row names. - Info <- NULL # If SettingsFileMetab=NULL, SetingsInfo has to be NULL to, otherwise we will get an error. - }else{ - SettingsFile <-SettingsFile_Metab - Info <- SettingsInfo - } - - CheckInput(InputData=as.data.frame(t(InputData)), - InputData_Num=FALSE, - SettingsFile_Sample=NULL, - SettingsFile_Metab=SettingsFile,#Set above - SettingsInfo=Info,#Set above - SaveAs_Plot=SaveAs_Plot, - SaveAs_Table=NULL, - CoRe=FALSE, - PrintPlot= PrintPlot, - PlotSettings="Feature") - - # CheckInput` Specific: - if(is.numeric(yCutoff)== FALSE |yCutoff > 1 | yCutoff < 0){ - message<- paste0("Check input. The selected yCutoff value should be numeric and between 0 and 1.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) +VizVolcano <- function(PlotSettings = "Standard", ## EDIT: name here the options and use match.arg + se, + SettingsInfo = NULL, + se2 = NULL, + y = "p.adj", + x = "Log2FC", + xlab = NULL,#"~Log[2]~FC" + ylab = NULL,#"~-Log[10]~p.adj" + xCutoff = 0.5, + yCutoff = 0.05, + Connectors = FALSE, + SelectLab = "", + PlotName = "", + Subtitle = "", + ComparisonName = c(se = "Cond1", se2 = "Cond2"), + ColorPalette = NULL, + ShapePalette = NULL, + Theme = NULL, + SaveAs_Plot = "svg", + FolderPath = NULL, + Features = "Metabolites", + PrintPlot = TRUE) { + + ## ------------ Create log file ----------- ## + MetaProViz_Init() + + ## ------------ Check Input files ----------- ## + ## HelperFunction `CheckInput` + if (PlotSettings == "PEA") { + ## those relationships are checked in the VizVolcano_PEA() function! + SettingsFile <- NULL ## for PEA the SettingsFile_Metab is the prior knowledge file, and hence this will not have features as row names. + Info <- NULL ## if SettingsFileMetab=NULL, SetingsInfo has to be NULL to, otherwise we will get an error. + } else { + SettingsFile <- rowData(se) + Info <- SettingsInfo } - if(is.numeric(xCutoff)== FALSE | xCutoff < 0){ - message<- paste0("Check input. The selected xCutoff value should be numeric and between 0 and +oo.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + + CheckInput(se, #InputData = as.data.frame(t(InputData)), + InputData_Num = FALSE, #SettingsFile_Sample = NULL, + #SettingsFile_Metab = SettingsFile, ## set above + SettingsInfo = Info, ## set above + SaveAs_Plot = SaveAs_Plot, + SaveAs_Table = NULL, CoRe = FALSE, PrintPlot = PrintPlot, + PlotSettings = "Feature") + + ## CheckInput` Specific: + if (!is.numeric(yCutoff) | yCutoff > 1 | yCutoff < 0) { + message <- "Check input. The selected 'yCutoff' value should be numeric and between 0 and 1." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.numeric(xCutoff) | xCutoff < 0) { + message <- "Check input. The selected 'xCutoff' value should be numeric and between 0 and +oo." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!x %in% colnames(se) | !y %in% colnames(se)) { + message <- "Check input. The column name of x and/or y does not exist in 'Input_data'." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.null(SelectLab) & !is.vector(SelectLab)) { + message <- "Check input. 'SelectLab' must be either NULL or a vector." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.logical(Connectors)) { + message <- "Check input. The 'Connectors' value should be either TRUE if connectors from names to points are to be added to the plot or FALSE if not." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + if (!is.null(PlotName) & !is.vector(PlotName)) { + message <- "Check input. 'PlotName' must be either NULL or a vector." + logger::log_trace(paste0("Error ", message)) + stop(message) + } + Plot_options <- c("Standard", "Compare", "PEA") + if (!PlotSettings %in% Plot_options) { + message <- paste0( + "'PlotSettings' option is incorrect. The allowed options are the following: ", + paste(Plot_options, collapse = ", "), ".") + logger::log_trace(paste0("Error ", message)) + stop(message) + } + + ## ------------ Create Results output folder ----------- ## + if (!is.null(SaveAs_Plot)) { + Folder <- SavePath(FolderName = "VolcanoPlots", + FolderPath = FolderPath) } - if(paste(x) %in% colnames(InputData)==FALSE | paste(y) %in% colnames(InputData)==FALSE){ - message<- paste0("Check your input. The column name of x and/ore y does not exist in Input_data.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(SelectLab)==FALSE & is.vector(SelectLab)==FALSE){ - message<- paste0("Check input. SelectLab must be either NULL or a vector.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.logical(Connectors) == FALSE){ - message<- paste0("Check input. The Connectors value should be either = TRUE if connectors from names to points are to be added to the plot or =FALSE if not.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - if(is.null(PlotName)==FALSE & is.vector(PlotName)==FALSE){ - message<- paste0("Check input. PlotName must be either NULL or a vector.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - Plot_options <- c("Standard", "Compare", "PEA") - if (PlotSettings %in% Plot_options == FALSE){ - message<- paste0("PlotSettings option is incorrect. The allowed options are the following: ",paste(Plot_options, collapse = ", "),"." ) - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - ## ------------ Create Results output folder ----------- ## - if(is.null(SaveAs_Plot)==FALSE){ - Folder <- SavePath(FolderName= "VolcanoPlots", - FolderPath=FolderPath) - } - - ############################################################################################################ - ## ----------- Prepare InputData ------------ ## - #Extract required columns and merge with SettingsFile - if(is.null(SettingsFile_Metab)==FALSE){ - ##--- Prepare the color scheme: - if("color" %in% names(SettingsInfo)==TRUE & "shape" %in% names(SettingsInfo)==TRUE){ - if((SettingsInfo[["shape"]] == SettingsInfo[["color"]])==TRUE){ - SettingsFile_Metab$shape <- SettingsFile_Metab[,paste(SettingsInfo[["color"]])] - SettingsFile_Metab<- SettingsFile_Metab%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]])) - }else{ - SettingsFile_Metab <- SettingsFile_Metab%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]]), - "shape"=paste(SettingsInfo[["shape"]])) - } - }else if("color" %in% names(SettingsInfo)==TRUE & "shape" %in% names(SettingsInfo)==FALSE){ - SettingsFile_Metab <- SettingsFile_Metab%>% - dplyr::rename("color"=paste(SettingsInfo[["color"]])) - }else if("color" %in% names(SettingsInfo)==FALSE & "shape" %in% names(SettingsInfo)==TRUE){ - SettingsFile_Metab <- SettingsFile_Metab%>% - dplyr::rename("shape"=paste(SettingsInfo[["shape"]])) - } - if("individual" %in% names(SettingsInfo)==TRUE){ - SettingsFile_Metab <- SettingsFile_Metab%>% - dplyr::rename("individual"=paste(SettingsInfo[["individual"]])) - } - - - ##--- Merge InputData with SettingsFile: - common_columns <- character(0) # Initialize an empty character vector - for(col_name in colnames(InputData[, c(x, y)])) { - if(col_name %in% colnames(SettingsFile_Metab)) { - common_columns <- c(common_columns, col_name) # Add the common column name to the vector - } - } - SettingsFile_Metab <- SettingsFile_Metab%>%#rename those column since they otherwise will cause issues when we merge the DFs later - dplyr::rename_at(vars(common_columns), ~ paste0(., "_SettingsFile_Metab")) - - if(PlotSettings=="PEA"){ - VolcanoData <- merge(x=SettingsFile_Metab ,y=InputData[, c(x, y)], by.x=SettingsInfo[["PEA_Feature"]] , by.y=0, all.y=TRUE)%>% - tibble::remove_rownames()%>% - dplyr::mutate(FeatureNames = SettingsInfo[["PEA_Feature"]])%>% - dplyr::filter(!is.na(x) | !is.na(x)) - }else{ - VolcanoData <- merge(x=SettingsFile_Metab ,y=InputData[, c(x, y)], by=0, all.y=TRUE)%>% - tibble::remove_rownames()%>% - tibble::column_to_rownames("Row.names")%>% - dplyr::mutate(FeatureNames = rownames(InputData))%>% - dplyr::filter(!is.na(x) | !is.na(x)) + + ############################################################################ + ## ----------- Prepare InputData ------------ ## + ## Extract required columns and merge with SettingsFile + ##if (!is.null(SettingsFile_Metab)) { + ##--- Prepare the color scheme: + if ("color" %in% names(SettingsInfo) & "shape" %in% names(SettingsInfo)) { + if (SettingsInfo[["shape"]] == SettingsInfo[["color"]]) { + rowData(se)$shape <- rowData(se)[, SettingsInfo[["color"]]] + rowData(se) <- rowData(se) %>% + dplyr::rename("color" = SettingsInfo[["color"]]) + } else { + rowData(se) <- rowData(se) %>% + dplyr::rename( + "color"= SettingsInfo[["color"]], + "shape" = SettingsInfo[["shape"]]) + } + } else if ("color" %in% names(SettingsInfo) & !"shape" %in% names(SettingsInfo)) { + rowData(se) <- rowData(se) %>% + as.data.frame() |> + dplyr::rename("color" = SettingsInfo[["color"]]) + } else if (!"color" %in% names(SettingsInfo) & "shape" %in% names(SettingsInfo)) { + rowData(se) <- rowData(se) %>% + dplyr::rename("shape" = SettingsInfo[["shape"]]) + } + if ("individual" %in% names(SettingsInfo)) { + rowData(se) <- rowData(se) %>% + dplyr::rename("individual" = paste(SettingsInfo[["individual"]])) } - }else{ - VolcanoData <- InputData[, c(x, y)]%>% - dplyr::mutate(FeatureNames = rownames(InputData))%>% - dplyr::filter(!is.na(x) | !is.na(x)) - } - - # Rename the x and y lab if the information has been passed: - if(is.null(xlab)==TRUE){#use column name of x provided by user - xlab <- bquote(.(as.symbol(x))) - }else if(is.null(xlab)==FALSE){ - xlab <- bquote(.(as.symbol(xlab))) + + ##--- Merge assay(se) with SettingsFile: + common_columns <- character() ## Initialize an empty character vector + for (col_name in colnames(assay(se)[, c(x, y)])) { + if (col_name %in% colnames(rowData(se))) { + common_columns <- c(common_columns, col_name) # Add the common column name to the vector + } + } + rowData(se) <- rowData(se) %>% #rename those column since they otherwise will cause issues when we merge the DFs later + as.data.frame() |> + dplyr::rename_at(vars(common_columns), ~ paste0(., "_rowData")) |> + DataFrame() + + if (PlotSettings == "PEA") { + VolcanoData <- merge(x = as.data.frame(rowData(se)), + y = assay(se)[, c(x, y)], + by.x = SettingsInfo[["PEA_Feature"]], by.y = 0, + all.y = TRUE) %>% + tibble::remove_rownames() %>% + dplyr::mutate(FeatureNames = SettingsInfo[["PEA_Feature"]]) + } else { + VolcanoData <- merge(x = as.data.frame(rowData(se)), + y = assay(se)[, c(x, y)], by = 0, all.y = TRUE) %>% + tibble::remove_rownames() %>% + tibble::column_to_rownames("Row.names") %>% + dplyr::mutate(FeatureNames = rownames(se)) + } + VolcanoData <- VolcanoData |> + dplyr::filter(!is.na(x) | !is.na(x)) ## EDIT: why two times?? + + ##} else { + ## VolcanoData <- InputData[, c(x, y)] %>% + ## dplyr::mutate(FeatureNames = rownames(InputData)) %>% + ## dplyr::filter(!is.na(x) | !is.na(x)) + ##} + + ## Rename the x and y lab if the information has been passed: + if (is.null(xlab)) { #use column name of x provided by user + xlab <- bquote(.(as.symbol(x))) + } else if (!is.null(xlab)) { + xlab <- bquote(.(as.symbol(xlab))) } - if(is.null(ylab)==TRUE){#use column name of x provided by user - ylab <- bquote(.(as.symbol(y))) - }else if(is.null(ylab)==FALSE){ - ylab <- bquote(.(as.symbol(ylab))) - } - - ## ----------- Set the plot parameters: ------------ ## - ##--- Prepare colour and shape palette - if(is.null(ColorPalette)){ - if("color" %in% names(SettingsInfo)==TRUE){ - safe_colorblind_palette <- c("#88CCEE", "#DDCC77","#661100", "#332288", "#AA4499","#999933", "#44AA99", "#882215", "#6699CC", "#117733", "#888888","#CC6677", "black","gold1","darkorchid4","red","orange", "blue") - }else{ - safe_colorblind_palette <- c("#888888", "#44AA99", "#44AA99","#CC6677") + if (is.null(ylab)) { + ## use column name of x provided by user + ylab <- bquote(.(as.symbol(y))) + } else if (!is.null(ylab)) { + ylab <- bquote(.(as.symbol(ylab))) } - #check that length is enough for what the user wants to colour - #stop(" The maximum number of pathways in the Input_pathways must be less than ",length(safe_colorblind_palette),". Please summarize sub-pathways together where possible and repeat.") - } else{ - safe_colorblind_palette <-ColorPalette - #check that length is enough for what the user wants to colour - } - if(is.null(ShapePalette)){ - safe_shape_palette <- c(15,17,16,18,25,7,8,11,12) - #check that length is enough for what the user wants to shape - } else{ - safe_shape_palette <-shape_palette - #check that length is enough for what the user wants to shape - } - - ############################################################################################################ - ## ----------- Make the plot based on the chosen parameters ------------ ## - - if(PlotSettings=="Standard"){#####--- 1. Standard - VolcanoRes <- VizVolcano_Standard(InputData= VolcanoData, - SettingsFile_Metab=SettingsFile_Metab, - SettingsInfo=SettingsInfo, - y= y, - x= x, - xlab= xlab, - ylab= ylab, - xCutoff= xCutoff, - yCutoff= yCutoff, - Connectors= Connectors, - SelectLab=SelectLab, - PlotName= PlotName, - Subtitle= Subtitle, - ColorPalette=safe_colorblind_palette, - ShapePalette=safe_shape_palette, - Theme= Theme, - Features=Features, - SaveAs_Plot=SaveAs_Plot, - PrintPlot=PrintPlot, - Folder=Folder) - - }else if(PlotSettings=="Compare"){#####--- 2. Compare - VolcanoRes <- VizVolcano_Compare(InputData= VolcanoData, - InputData2=InputData2, - SettingsFile_Metab=SettingsFile_Metab, - SettingsInfo=SettingsInfo, - y= y, - x= x, - xlab= xlab, - ylab= ylab, - xCutoff= xCutoff, - yCutoff= yCutoff, - Connectors= Connectors, - SelectLab=SelectLab, - PlotName= PlotName, - Subtitle= Subtitle, - ColorPalette=safe_colorblind_palette, - ShapePalette=safe_shape_palette, - Theme= Theme, - Features=Features, - ComparisonName=ComparisonName, - SaveAs_Plot=SaveAs_Plot, - PrintPlot=PrintPlot, - Folder=Folder) - - } else if(PlotSettings=="PEA"){#####--- 3. PEA - VolcanoRes <- VizVolcano_PEA(InputData= VolcanoData, - InputData2=InputData2, - SettingsFile_Metab=SettingsFile_Metab,#Problem: we need to know the column name of the features! - SettingsInfo=SettingsInfo, - y= y, - x= x, - xlab= xlab, - ylab= ylab, - xCutoff= xCutoff, - yCutoff= yCutoff, - Connectors= Connectors, - SelectLab=SelectLab, - PlotName= PlotName, - Subtitle= Subtitle, - ColorPalette=safe_colorblind_palette, - ShapePalette=safe_shape_palette, - Theme= Theme, - Features=Features, - SaveAs_Plot=SaveAs_Plot, - PrintPlot=PrintPlot, - Folder=Folder) - } - return(invisible(VolcanoRes)) + ## ----------- Set the plot parameters: ------------ ## + ##--- Prepare colour and shape palette + if (is.null(ColorPalette)) { + if ("color" %in% names(SettingsInfo)) { + safe_colorblind_palette <- c("#88CCEE", "#DDCC77","#661100", ## EDIT: could this be defined outside of the function? + "#332288", "#AA4499", "#999933", "#44AA99", "#882215", + "#6699CC", "#117733", "#888888", "#CC6677", "black", "gold1", + "darkorchid4", "red", "orange", "blue") + } else { + safe_colorblind_palette <- c("#888888", "#44AA99", "#44AA99","#CC6677") ## EDIT: could this be defined outside of the function? + } + ## check that length is enough for what the user wants to colour + ## stop(" The maximum number of pathways in the Input_pathways must be less than ",length(safe_colorblind_palette),". Please summarize sub-pathways together where possible and repeat.") + } else { + safe_colorblind_palette <- ColorPalette + ## check that length is enough for what the user wants to colour + } + if (is.null(ShapePalette)) { + safe_shape_palette <- c(15, 17, 16, 18, 25, 7, 8, 11, 12) + ## check that length is enough for what the user wants to shape + } else { + safe_shape_palette <- shape_palette + #check that length is enough for what the user wants to shape + } + + ############################################################################ + ## ----------- Make the plot based on the chosen parameters ------------ ## + + ## update SummarizedExperiment + assay(se) <- VolcanoData[, colnames(se)] + rowData(se) <- VolcanoData + + if (PlotSettings == "Standard") { + #####--- 1. Standard + VolcanoRes <- VizVolcano_Standard(se = se, #InputData = VolcanoData, + ##SettingsFile_Metab = SettingsFile_Metab, + SettingsInfo = SettingsInfo, + y = y, x = x, xlab = xlab, ylab = ylab, + xCutoff = xCutoff, yCutoff = yCutoff, + Connectors = Connectors, SelectLab = SelectLab, + PlotName = PlotName, Subtitle = Subtitle, + ColorPalette = safe_colorblind_palette, + ShapePalette = safe_shape_palette, Theme = Theme, + Features = Features, SaveAs_Plot = SaveAs_Plot, + PrintPlot = PrintPlot, Folder = Folder) + + } else if (PlotSettings == "Compare") { + #####--- 2. Compare + VolcanoRes <- VizVolcano_Compare(se = se, #InputData = VolcanoData, + se2 = se2, ##InputData2 = InputData2, SettingsFile_Metab = SettingsFile_Metab, + SettingsInfo = SettingsInfo, y = y, x = x, xlab = xlab, ylab = ylab, + xCutoff = xCutoff, yCutoff = yCutoff, Connectors = Connectors, + SelectLab = SelectLab, PlotName = PlotName, Subtitle = Subtitle, + ColorPalette = safe_colorblind_palette, + ShapePalette = safe_shape_palette, Theme = Theme, + Features = Features, ComparisonName = ComparisonName, + SaveAs_Plot = SaveAs_Plot, PrintPlot = PrintPlot, Folder = Folder) + + } else if (PlotSettings=="PEA") { + #####--- 3. PEA + VolcanoRes <- VizVolcano_PEA(se = se, ##InputData = VolcanoData, + se2 = se2, ##InputData2 = InputData2, SettingsFile_Metab = SettingsFile_Metab, + ## Problem: we need to know the column name of the features! + SettingsInfo = SettingsInfo, y = y, x = x, xlab = xlab, ylab = ylab, + xCutoff = xCutoff, yCutoff = yCutoff, Connectors = Connectors, + SelectLab = SelectLab, PlotName = PlotName, Subtitle = Subtitle, + ColorPalette = safe_colorblind_palette, + ShapePalette = safe_shape_palette, Theme = Theme, + Features = Features, SaveAs_Plot = SaveAs_Plot, + PrintPlot = PrintPlot, Folder = Folder) + } + + ## return + invisible(VolcanoRes) } ################################################################################################ @@ -368,267 +350,273 @@ VizVolcano <- function(PlotSettings="Standard", #' #' @noRd #' -VizVolcano_Standard <- function(InputData, - SettingsFile_Metab, - SettingsInfo, - y= "p.adj", - x= "Log2FC", - xlab= NULL,#"~Log[2]~FC" - ylab= NULL,#"~-Log[10]~p.adj" - xCutoff= 0.5, - yCutoff= 0.05, - Connectors= FALSE, - SelectLab= "", - PlotName= "", - Subtitle= "", - ColorPalette, - ShapePalette, - Theme= NULL, - Features="Metabolites", - SaveAs_Plot, - PrintPlot, - Folder){ - - #Pass colours/shapes - safe_colorblind_palette <- ColorPalette - safe_shape_palette <- ShapePalette - - #Plots - if("individual" %in% names(SettingsInfo)==TRUE){ - # Create the list of individual plots that should be made: - IndividualPlots <- unique(InputData$individual) - - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - for (i in IndividualPlots){ - InputVolcano <- subset(InputData, individual == paste(i)) - - if(nrow(InputVolcano)>=1){ - if("color" %in% names(SettingsInfo)==TRUE ){ - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$color))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] - names(col) <- InputVolcano$color[row] - keyvals <- c(keyvals, col) - } - - LegendPos<- "right" - } else{ - keyvals <-NULL +VizVolcano_Standard <- function(se, #InputData, + #SettingsFile_Metab, + SettingsInfo, + y = "p.adj", + x = "Log2FC", + xlab = NULL,#"~Log[2]~FC" + ylab = NULL,#"~-Log[10]~p.adj" + xCutoff = 0.5, + yCutoff = 0.05, + Connectors = FALSE, + SelectLab = "", + PlotName = "", + Subtitle = "", + ColorPalette, + ShapePalette, + Theme = NULL, ## EDIT: preset the Theme to simplify downstream + Features = "Metabolites", + SaveAs_Plot, + PrintPlot, + Folder) { + + #Pass colours/shapes + safe_colorblind_palette <- ColorPalette + safe_shape_palette <- ShapePalette + + #Plots + if ("individual" %in% names(SettingsInfo)) { + ## Create the list of individual plots that should be made: + IndividualPlots <- unique(rowData(se)$individual) + + ## empty list to store all the plots + PlotList <- list() ## EDIT: define once outside the if/else statements for all conditions and delete the other instances + ## empty list to store all the plots + PlotList_adaptedGrid <- list() ## EDIT: define once outside the if/else statements for all conditions and delete the other instances + + for (i in IndividualPlots) { + InputVolcano <- subset(assay(se), rowData(se)$individual == i) + + if (nrow(InputVolcano) >= 1) { + if ("color" %in% names(SettingsInfo)) { + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$color))] + + keyvals <- c() + for (row in seq_along(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] + names(col) <- InputVolcano$color[row] + keyvals <- c(keyvals, col) + } + + LegendPos<- "right" + } else { + keyvals <-NULL + } + + ## Prepare the shape scheme: + if ("shape" %in% names(SettingsInfo)) { + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$shape))] + + keyvalsshape <- c() + for(row in seq_along(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] + names(sha) <- InputVolcano$shape[row] + keyvalsshape <- c(keyvalsshape, sha) + } + + LegendPos <- "right" + } else { + keyvalsshape <-NULL + } + + if (!"color" %in% names(SettingsInfo) & !"shape" %in% names(SettingsInfo)) { + LegendPos<- "none" + } + + ## Prepare the Plot: + Plot <- EnhancedVolcano::EnhancedVolcano(InputVolcano, + lab = rownames(se), ## metabolite name + selectLab = SelectLab, x = paste(x), y = paste(y), + xlab = xlab, ylab = ylab, pCutoff = yCutoff, + FCcutoff = xCutoff, ## cut off Log2FC, automatically 2 + pointSize = 3, labSize = 3, axisLabSize = 10, + titleLabSize = 12, subtitleLabSize = 11, + captionLabSize = 10, col = safe_colorblind_palette, + colCustom = keyvals, shapeCustom = keyvalsshape, + colAlpha = 1, title = paste0(PlotName, ": ", i), + subtitle = Subtitle, + caption = paste0("Total = ", nrow(InputVolcano), " ", Features), + xlim = c( + min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )]) - 0.2, + max(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) + 1.2), + ylim = c(0, + ceiling(-log10(Reduce(min, InputVolcano[[y]])))), + cutoffLineType = "dashed", cutoffLineCol = "black", + cutoffLineWidth = 0.5, + legendLabels = c( + paste(x," < |", xCutoff, "|"), + paste(x," > |", xCutoff, "|"), + paste(y, ' < ', yCutoff) , + paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), + legendPosition = LegendPos, legendLabSize = 7, + legendIconSize = 4, gridlines.major = FALSE, + gridlines.minor = FALSE, drawConnectors = Connectors) + + ## Add the theme + if (!is.null(Theme)) { + Plot <- Plot + + Theme + } + + ## store the plot in the 'plots' list + PlotList[[i]] <- Plot + + ## set the total heights and widths + PlotTitle <- paste0(PlotName, ": ", i) + Plot_Sized <- plotGrob_Volcano(InputPlot = Plot, + SettingsInfo = SettingsInfo, PlotName = PlotTitle, + Subtitle = Subtitle) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', + valueOnly = TRUE) + Plot_Sized %<>% ## EDIT: what is the added value to use %<>% ? + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + ## removes empty spaces and replaces /,\ with - + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i) + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + SaveList <- list() + SaveList[[cleaned_i]] <- Plot_Sized + + #----- Save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, + plot = SaveList, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Volcano_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } } - #Prepare the shape scheme: - if("shape" %in% names(SettingsInfo)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$shape))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] - names(sha) <- InputVolcano$shape[row] - keyvalsshape <- c(keyvalsshape, sha) - } - - LegendPos<- "right" - } else{ - keyvalsshape <-NULL - } - - if("color" %in% names(SettingsInfo)==FALSE & "shape" %in% names(SettingsInfo)==FALSE){ - LegendPos<- "none" + } else if (!"individual" %in% names(SettingsInfo)) { ## EDIT: idnetify what is identical in the two ifs and simplify as much as possible + + PlotList <- list() ##Empty list to store all the plots + PlotList_adaptedGrid <- list() ## Empty list to store all the plots + + InputVolcano <- assay(se) + if (nrow(InputVolcano) >= 1) { + if ("color" %in% names(SettingsInfo)) { + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$color))] + + keyvals <- c() + + for (row in seq_along(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] + names(col) <- InputVolcano$color[row] + keyvals <- c(keyvals, col) + } + + LegendPos<- "right" + } else { + keyvals <-NULL + } + + ## Prepare the shape scheme: + if ("shape" %in% names(SettingsInfo)) { + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$shape))] + + keyvalsshape <- c() + for (row in seq_along(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] + names(sha) <- InputVolcano$shape[row] + keyvalsshape <- c(keyvalsshape, sha) + } + + LegendPos<- "right" + } else { + keyvalsshape <-NULL + } + + if (!"color" %in% names(SettingsInfo) & !"shape" %in% names(SettingsInfo)) { + LegendPos<- "none" + } + + ## Prepare the Plot: + Plot <- EnhancedVolcano::EnhancedVolcano(InputVolcano, + lab = rownames(se), ## metabolite name + selectLab = SelectLab, x = paste(x), y = paste(y), + xlab = xlab, ylab = ylab, pCutoff = yCutoff, + FCcutoff = xCutoff, ## Cut off Log2FC, automatically 2 + pointSize = 3, labSize = 3, axisLabSize = 10, + titleLabSize = 12, subtitleLabSize = 11, + captionLabSize = 10, col = safe_colorblind_palette, + colCustom = keyvals, shapeCustom = keyvalsshape, + colAlpha = 1, title = paste(PlotName), + subtitle = Subtitle, + caption = paste0("Total = ", nrow(InputVolcano), " ", Features), + xlim = c( + min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )]) - 0.2, + max(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) + 1.2), + ylim = c(0, ceiling(-log10(Reduce(min, InputVolcano[[y]])))), + cutoffLineType = "dashed", cutoffLineCol = "black", + cutoffLineWidth = 0.5, + legendLabels = c( + paste(x," < |", xCutoff, "|"), + paste(x," > |", xCutoff, "|"), + paste(y, ' < ', yCutoff) , + paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), + legendPosition = LegendPos, legendLabSize = 9, + legendIconSize = 4, gridlines.major = FALSE, + gridlines.minor = FALSE, drawConnectors = Connectors) + + ## Add the theme + if (!is.null(Theme)) { + Plot <- Plot+Theme + } + + ## Store the plot in the 'plots' list + PlotList[["Plot"]] <- Plot + + ## Set the total heights and widths + Plot_Sized <- plotGrob_Volcano(InputPlot = Plot, + SettingsInfo = SettingsInfo, PlotName = PlotName, + Subtitle = Subtitle) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', + valueOnly = TRUE) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + PlotList_adaptedGrid[["Plot_Sized"]] <- Plot_Sized + + #----- Save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, + plot = list( + "Plot_Sized" = PlotList_adaptedGrid[["Plot_Sized"]]), + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Volcano_", PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) } - - #Prepare the Plot: - Plot<- EnhancedVolcano::EnhancedVolcano(InputVolcano, - lab = InputVolcano$FeatureNames,#Metabolite name - selectLab = SelectLab, - x = paste(x), - y = paste(y), - xlab =xlab, - ylab =ylab, - pCutoff = yCutoff, - FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 - pointSize = 3, - labSize = 3, - axisLabSize = 10, - titleLabSize = 12, - subtitleLabSize = 11, - captionLabSize = 10, - col=safe_colorblind_palette, - colCustom = keyvals, - shapeCustom = keyvalsshape, - colAlpha = 1, - title= paste(PlotName, ": ", i, sep=""), - subtitle = Subtitle, - caption = paste0("Total = ", nrow(InputVolcano), " ", Features), - xlim = c(min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )])-0.2, max(InputVolcano[[x]][is.finite(InputVolcano[[x]])])+1.2), - ylim = c(0,(ceiling(-log10(Reduce(min,InputVolcano[[y]]))))), - cutoffLineType = "dashed", - cutoffLineCol = "black", - cutoffLineWidth = 0.5, - legendLabels=c(paste(x," < |", xCutoff, "|"), paste(x," > |", xCutoff, "|"), paste(y, ' < ', yCutoff) , paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), - legendPosition = LegendPos, - legendLabSize = 7, - legendIconSize =4, - gridlines.major = FALSE, - gridlines.minor = FALSE, - drawConnectors = Connectors) - #Add the theme - if(is.null(Theme)==FALSE){ - Plot <- Plot+Theme - } - - ## Store the plot in the 'plots' list - PlotList[[i]] <- Plot - - #Set the total heights and widths - PlotTitle <- paste(PlotName, ": ", i, sep="") - Plot_Sized <- plotGrob_Volcano(InputPlot=Plot, SettingsInfo=SettingsInfo, PlotName = PlotTitle, Subtitle = Subtitle) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - SaveList <- list() - SaveList[[cleaned_i]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= SaveList, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Volcano_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight= PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - } } - }else if("individual" %in% names(SettingsInfo)==FALSE){ - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - InputVolcano <- InputData - if(nrow(InputVolcano)>=1){ - if("color" %in% names(SettingsInfo)==TRUE ){ - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$color))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] - names(col) <- InputVolcano$color[row] - keyvals <- c(keyvals, col) - } - - LegendPos<- "right" - } else{ - keyvals <-NULL - } - #Prepare the shape scheme: - if("shape" %in% names(SettingsInfo)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$shape))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] - names(sha) <- InputVolcano$shape[row] - keyvalsshape <- c(keyvalsshape, sha) - } - - LegendPos<- "right" - } else{ - keyvalsshape <-NULL - } - - if("color" %in% names(SettingsInfo)==FALSE & "shape" %in% names(SettingsInfo)==FALSE){ - LegendPos<- "none" - } - - #Prepare the Plot: - Plot<- EnhancedVolcano::EnhancedVolcano(InputVolcano, - lab = InputVolcano$FeatureNames,#Metabolite name - selectLab = SelectLab, - x = paste(x), - y = paste(y), - xlab =xlab, - ylab =ylab, - pCutoff = yCutoff, - FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 - pointSize = 3, - labSize = 3, - axisLabSize = 10, - titleLabSize = 12, - subtitleLabSize = 11, - captionLabSize = 10, - col=safe_colorblind_palette, - colCustom = keyvals, - shapeCustom = keyvalsshape, - colAlpha = 1, - title= paste(PlotName), - subtitle = Subtitle, - caption = paste0("Total = ", nrow(InputVolcano), " ", Features), - xlim = c(min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )])-0.2, max(InputVolcano[[x]][is.finite(InputVolcano[[x]])])+1.2), - ylim = c(0,(ceiling(-log10(Reduce(min,InputVolcano[[y]]))))), - cutoffLineType = "dashed", - cutoffLineCol = "black", - cutoffLineWidth = 0.5, - legendLabels=c(paste(x," < |", xCutoff, "|"), paste(x," > |", xCutoff, "|"), paste(y, ' < ', yCutoff) , paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), - legendPosition = LegendPos, - legendLabSize = 9, - legendIconSize =4, - gridlines.major = FALSE, - gridlines.minor = FALSE, - drawConnectors = Connectors) - #Add the theme - if(is.null(Theme)==FALSE){ - Plot <- Plot+Theme - } - - ## Store the plot in the 'plots' list - PlotList[["Plot"]] <- Plot - - #Set the total heights and widths - Plot_Sized <- plotGrob_Volcano(InputPlot=Plot, SettingsInfo=SettingsInfo, PlotName = PlotName, Subtitle = Subtitle) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[["Plot_Sized"]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= list("Plot_Sized"= PlotList_adaptedGrid[["Plot_Sized"]]), - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Volcano_", PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - } - } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + + invisible(list( + "data" = list(NULL), + "plot" = list( + "Plot" = PlotList, + "Plot_Sized" = PlotList_adaptedGrid))) } - - - -################################################################################################ -### ### ### VizVolcano helper function: Internal Function for PlotSettings Compare ### ### ### -################################################################################################ +################################################################################ +### VizVolcano helper function: Internal Function for PlotSettings Compare ### +################################################################################ #' Check input parameters #' @@ -667,342 +655,351 @@ VizVolcano_Standard <- function(InputData, #' #' @noRd #' -VizVolcano_Compare <- function(InputData, - InputData2, - SettingsFile_Metab, - SettingsInfo, - y= "p.adj", - x= "Log2FC", - xlab= NULL,#"~Log[2]~FC" - ylab= NULL,#"~-Log[10]~p.adj" - xCutoff= 0.5, - yCutoff= 0.05, - Connectors= FALSE, - SelectLab= "", - PlotName= "", - Subtitle= "", - ColorPalette, - ShapePalette, - Theme= NULL, - Features="Metabolites", - ComparisonName, - SaveAs_Plot, - PrintPlot, - Folder){ - - ##################### - ##--- Check InputData - if(is.data.frame(InputData2)==FALSE){ - if(paste(x) %in% colnames(InputData2)==FALSE | paste(y) %in% colnames(InputData2)==FALSE){ - message <- paste("Check your InputData2. The column name of ", x, " and/or ", y, " does not exist in InputData2.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - } - - if(any(duplicated(row.names(InputData2)))==TRUE){ - message <- paste("Duplicated row.names of InputData2, whilst row.names must be unique") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - - #Pass colours/shapes - safe_colorblind_palette <- ColorPalette - safe_shape_palette <- ShapePalette - - ##--- Prepare Input Data - if(is.null(SettingsFile_Metab)==FALSE){ - InputData2 <- merge(x=SettingsFile_Metab%>%tibble::rownames_to_column("FeatureNames") , y=InputData2[, c(x, y)]%>%tibble::rownames_to_column("FeatureNames") , by="FeatureNames", all.y=TRUE)%>% - filter(!is.na(x) | !is.na(x)) - InputData[,"comparison"] <- as.character(paste(ComparisonName[["InputData"]])) - InputData2[,"comparison"] <- as.character(paste(ComparisonName[["InputData2"]])) - InputCompare <- rbind(InputData,InputData2) - - }else{ - InputData2 <- InputData2[, c(x, y)]%>% - mutate(FeatureNames = rownames(InputData2))%>% - na.omit() - - #Combine DFs and add appropriate column names - InputData[,"comparison"] <- as.character(paste(ComparisonName[["InputData"]])) - InputData2[,"comparison"] <- as.character(paste(ComparisonName[["InputData2"]])) - InputCompare <- rbind(InputData[,c("FeatureNames", x, y, "comparison")],InputData2[,c("FeatureNames", x, y, "comparison")]) - } - - - - ##################### - ##--- Plots - if("individual" %in% names(SettingsInfo)==TRUE){ - # Create the list of individual plots that should be made: - IndividualPlots <- unique(InputCompare$individual) - - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - for (i in IndividualPlots){ - InputVolcano <- subset(InputCompare, individual == paste(i)) - - if(nrow(InputVolcano)>=1){ - #Prepare the colour scheme: - if("color" %in% names(SettingsInfo)==TRUE){ - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$color))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] - names(col) <- InputVolcano$color[row] - keyvals <- c(keyvals, col) - } - } else{#here we will use the conditions if no other color is provided! - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$comparison))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(col) <- InputVolcano$comparison[row] - keyvals <- c(keyvals, col) - } - } - #Prepare the shape scheme: - if("shape" %in% names(SettingsInfo)==TRUE & "color" %in% names(SettingsInfo)==FALSE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$shape))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] - names(sha) <- InputVolcano$shape[row] - keyvalsshape <- c(keyvalsshape, sha) - } - } else if("shape" %in% names(SettingsInfo)==TRUE & "color" %in% names(SettingsInfo)==TRUE){ - #Here we have already used color from SettingsInfo and we need to use shape for the conditions - message("For Plot_setting= `Consitions`we can only use colour or shape from SettingsFile_Metab. We ignore shape and use it to label the Comparison_name.") - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$comparison))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(sha) <- InputVolcano$comparison[row] - keyvalsshape <- c(keyvalsshape, sha) - } - } else if("shape" %in% names(SettingsInfo)==FALSE & "color" %in% names(SettingsInfo)==FALSE | "shape" %in% names(SettingsInfo)==FALSE & "color" %in% names(SettingsInfo)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$comparison))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(sha) <- InputVolcano$comparison[row] - keyvalsshape <- c(keyvalsshape, sha) - } +VizVolcano_Compare <- function(se, + se2, + ##SettingsFile_Metab, + SettingsInfo, + y = "p.adj", + x = "Log2FC", + xlab = NULL,#"~Log[2]~FC" + ylab = NULL,#"~-Log[10]~p.adj" + xCutoff = 0.5, + yCutoff = 0.05, + Connectors = FALSE, + SelectLab = "", + PlotName = "", + Subtitle = "", + ColorPalette, + ShapePalette, + Theme = NULL, ## EDIT: preset the Theme to simplify downstream + Features = "Metabolites", + ComparisonName, + SaveAs_Plot, + PrintPlot, + Folder) { + + ##################### + ##--- Check InputData + if (!is.data.frame(assay(se2))) { + if (!x %in% colnames(se2) | !y %in% colnames(se2)) { + message <- paste0("Check 'se2'. The column name of ", x, " and/or ", y, " does not exist in 'se2'.") + logger::log_trace(paste0("Error ", message)) + stop(message) } - #Prepare the Plot: - Plot<- EnhancedVolcano::EnhancedVolcano(InputVolcano, - lab = InputVolcano$FeatureNames,#Metabolite name - selectLab = SelectLab, - x = paste(x), - y = paste(y), - xlab =xlab, - ylab =ylab, - pCutoff = yCutoff, - FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 - pointSize = 3, - labSize = 3, - axisLabSize = 10, - titleLabSize = 12, - subtitleLabSize = 11, - captionLabSize = 10, - col=safe_colorblind_palette, - colCustom = keyvals, - shapeCustom = keyvalsshape, - colAlpha = 1, - title= paste(PlotName, ": ", i, sep=""), - subtitle = Subtitle, - caption = paste0("Total = ", (nrow(InputVolcano)/2), " ", Features), - xlim = c(min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )])-0.2, max(InputVolcano[[x]][is.finite(InputVolcano[[x]])])+1.2), - ylim = c(0,(ceiling(-log10(Reduce(min,InputVolcano[[y]]))))), - cutoffLineType = "dashed", - cutoffLineCol = "black", - cutoffLineWidth = 0.5, - legendLabels=c(paste(x," < |", xCutoff, "|"), paste(x," > |", xCutoff, "|"), paste(y, ' < ', yCutoff) , paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), - legendPosition = 'right', - legendLabSize = 7, - legendIconSize =4, - gridlines.major = FALSE, - gridlines.minor = FALSE, - drawConnectors = Connectors) - #Add the theme - if(is.null(Theme)==FALSE){ - Plot <- Plot+Theme - } - - ## Store the plot in the 'plots' list - PlotList[[i]] <- Plot - - #Set the total heights and widths - PlotTitle <- paste(PlotName, ": ", i, sep="") - Plot_Sized <- plotGrob_Volcano(InputPlot=Plot, SettingsInfo=SettingsInfo, PlotName = PlotTitle, Subtitle = Subtitle) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - SaveList <- list() - SaveList[[cleaned_i]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= SaveList, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Volcano_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - } } + if (any(duplicated(rownames(se2)))) { + message <- paste("Duplicated rownames of 'se2', whilst rownames must be unique") + logger::log_trace(paste0("Error ", message)) + stop(message) + } - } else if("individual" %in% names(SettingsInfo)==FALSE){ - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - if(nrow(InputCompare)>=1){ - InputVolcano <- InputCompare - #Prepare the colour scheme: - if("color" %in% names(SettingsInfo)==TRUE){ - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$color))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] - names(col) <- InputVolcano$color[row] - keyvals <- c(keyvals, col) - } - } else{#here we will use the conditions if no other color is provided! - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$comparison))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(col) <- InputVolcano$comparison[row] - keyvals <- c(keyvals, col) - } - } - #Prepare the shape scheme: - if("shape" %in% names(SettingsInfo)==TRUE & "color" %in% names(SettingsInfo)==FALSE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$shape))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] - names(sha) <- InputVolcano$shape[row] - keyvalsshape <- c(keyvalsshape, sha) - } - } else if("shape" %in% names(SettingsInfo)==TRUE & "color" %in% names(SettingsInfo)==TRUE){ - #Here we have already used color from SettingsInfo and we need to use shape for the conditions - message("For PlotSettings Comparison we can only use colour or shape from SettingsFile_Metab. Hence, we ignore shape and use it to label the ComparisonName.") - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$comparison))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(sha) <- InputVolcano$comparison[row] - keyvalsshape <- c(keyvalsshape, sha) - } - } else if("shape" %in% names(SettingsInfo)==FALSE & "color" %in% names(SettingsInfo)==FALSE | "shape" %in% names(SettingsInfo)==FALSE & "color" %in% names(SettingsInfo)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$comparison))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] - names(sha) <- InputVolcano$comparison[row] - keyvalsshape <- c(keyvalsshape, sha) + ## Pass colours/shapes + safe_colorblind_palette <- ColorPalette + safe_shape_palette <- ShapePalette + + ##--- Prepare Input Data + if (!is.null(rowData(se))) { + rowData(se2) <- merge( + x = tibble::rownames_to_column(rowData(se), "FeatureNames"), + y = tibble::rownames_to_column(assay(se2[, c(x, y)], "FeatureNames"), + by = "FeatureNames", all.y = TRUE) %>% + filter(!is.na(x) | !is.na(x)) + rowData(se)[,"comparison"] <- as.character(paste(ComparisonName[["se"]])) + rowData(se2)[,"comparison"] <- as.character(paste(ComparisonName[["se2"]])) + InputCompare <- rbind(rowData(se), rowData(se2)) + + } else { + rowData(se2) <- rowData(se2[, c(x, y)] %>% + mutate(FeatureNames = rownames(se2)) %>% + na.omit() + + ## Combine DFs and add appropriate column names + rowData(se)[,"comparison"] <- as.character(paste(ComparisonName[["se"]])) + rowData(se2)[,"comparison"] <- as.character(paste(ComparisonName[["se2"]])) + InputCompare <- rbind( + rowData(se)[, c("FeatureNames", x, y, "comparison")], + rowData(se2)[, c("FeatureNames", x, y, "comparison")]) + } + + ##################### + ##--- Plots + if ("individual" %in% names(SettingsInfo)) { + ## Create the list of individual plots that should be made: + IndividualPlots <- unique(InputCompare$individual) + + ## empty list to store all the plots + PlotList <- list() ## EDIT: define outside and use for all conditions + ## empty list to store all the plots + PlotList_adaptedGrid <- list() ## EDIT: define outside and use for all conditions + + for (i in IndividualPlots) { + InputVolcano <- subset(InputCompare, individual == paste(i)) + + if (nrow(InputVolcano) >= 1) { + ## prepare the colour scheme: + if ("color" %in% names(SettingsInfo)) { + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$color))] + + keyvals <- c() + for (row in seq_len(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] + names(col) <- InputVolcano$color[row] + keyvals <- c(keyvals, col) + } + } else { + ## here we will use the conditions if no other color is provided! + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$comparison))] + + keyvals <- c() + for (row in seq_len(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(col) <- InputVolcano$comparison[row] + keyvals <- c(keyvals, col) + } + } + + ## prepare the shape scheme: + if ("shape" %in% names(SettingsInfo) & !"color" %in% names(SettingsInfo)) { + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$shape))] + + keyvalsshape <- c() + + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] + names(sha) <- InputVolcano$shape[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } else if ("shape" %in% names(SettingsInfo) & "color" %in% names(SettingsInfo)) { + + ## here we have already used color from SettingsInfo and + ## we need to use shape for the conditions + message("For Plot_setting= `Consitions`we can only use colour or shape from SettingsFile_Metab. We ignore shape and use it to label the Comparison_name.") + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$comparison))] + + keyvalsshape <- c() + + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(sha) <- InputVolcano$comparison[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } else if (!"shape" %in% names(SettingsInfo) & !"color" %in% names(SettingsInfo) | !"shape" %in% names(SettingsInfo) & "color" %in% names(SettingsInfo)) { ## EDIT: correct? Are there brackets missing between OR? + + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$comparison))] + keyvalsshape <- c() + + for (row in seq_len(nrow(InputVolcano))) { + + sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(sha) <- InputVolcano$comparison[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } + + ## prepare the Plot: + Plot <- EnhancedVolcano::EnhancedVolcano(InputVolcano, + lab = rownames(se), ## metabolite name + selectLab = SelectLab, x = paste(x), y = paste(y), + xlab = xlab, ylab = ylab, pCutoff = yCutoff, + FCcutoff = xCutoff, ## Cut off Log2FC, automatically 2 + pointSize = 3, labSize = 3, axisLabSize = 10, + titleLabSize = 12, subtitleLabSize = 11, + captionLabSize = 10, col = safe_colorblind_palette, + colCustom = keyvals, shapeCustom = keyvalsshape, + colAlpha = 1, title = paste0(PlotName, ": ", i), + subtitle = Subtitle, + caption = paste0("Total = ", (nrow(InputVolcano) / 2), " ", Features), + xlim = c( + min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )]) - 0.2, + max(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) + 1.2), + ylim = c(0, ceiling(-log10(Reduce(min, InputVolcano[[y]])))), + cutoffLineType = "dashed", cutoffLineCol = "black", + cutoffLineWidth = 0.5, + legendLabels = c(paste(x," < |", xCutoff, "|"), + paste(x," > |", xCutoff, "|"), + paste(y, ' < ', yCutoff) , + paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), + legendPosition = 'right', legendLabSize = 7, + legendIconSize = 4, gridlines.major = FALSE, + gridlines.minor = FALSE, drawConnectors = Connectors) + ## add the theme + if (!is.null(Theme)) { + Plot <- Plot+Theme + } + + ## store the plot in the 'plots' list + PlotList[[i]] <- Plot + + ## set the total heights and widths + PlotTitle <- paste(PlotName, ": ", i, sep = "") + Plot_Sized <- plotGrob_Volcano(InputPlot = Plot, + SettingsInfo = SettingsInfo, + PlotName = PlotTitle, Subtitle = Subtitle) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', + valueOnly = TRUE) + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + ## remove empty spaces and replaces /,\ with - + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i) + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + SaveList <- list() + SaveList[[cleaned_i]] <- Plot_Sized + + ##----- save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, + plot = SaveList, + SaveAs_Table = NULL, + SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Volcano_",PlotName), + CoRe = FALSE, + PrintPlot = PrintPlot, + PlotHeight = PlotHeight, + PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } } - } - #Prepare the Plot: - Plot<- EnhancedVolcano::EnhancedVolcano(InputVolcano, - lab = InputVolcano$FeatureNames,#Metabolite name - selectLab = SelectLab, - x = paste(x), - y = paste(y), - xlab =xlab, - ylab =ylab, - pCutoff = yCutoff, - FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 - pointSize = 3, - labSize = 3, - axisLabSize = 10, - titleLabSize = 12, - subtitleLabSize = 11, - captionLabSize = 10, - col=safe_colorblind_palette, - colCustom = keyvals, - shapeCustom = keyvalsshape, - colAlpha = 1, - title= paste(PlotName), - subtitle = Subtitle, - caption = paste0("Total = ", (nrow(InputVolcano)/2)," ", Features), - xlim = c(min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )])-0.2, max(InputVolcano[[x]][is.finite(InputVolcano[[x]])])+1.2), - ylim = c(0,(ceiling(-log10(Reduce(min,InputVolcano[[y]]))))), - cutoffLineType = "dashed", - cutoffLineCol = "black", - cutoffLineWidth = 0.5, - legendLabels=c(paste(x," < |", xCutoff, "|"), paste(x," > |", xCutoff, "|"), paste(y, ' < ', yCutoff) , paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), - legendPosition = 'right', - legendLabSize = 7, - legendIconSize =4, - gridlines.major = FALSE, - gridlines.minor = FALSE, - drawConnectors = Connectors) - #Add the theme - if(is.null(Theme)==FALSE){ - Plot <- Plot+Theme - } - - ## Store the plot in the 'plots' list - PlotList[["Plot"]] <- Plot - - Plot_Sized <- plotGrob_Volcano(InputPlot=Plot, SettingsInfo=SettingsInfo, PlotName = PlotName, Subtitle = Subtitle) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - PlotList_adaptedGrid[["Plot_Sized"]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= list("Plot_Sized"= PlotList_adaptedGrid[["Plot_Sized"]]), - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Volcano_", PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) + } else if (!"individual" %in% names(SettingsInfo)) { + PlotList <- list() ## Empty list to store all the plots + PlotList_adaptedGrid <- list() ## Empty list to store all the plots + + if (nrow(InputCompare) >= 1) { + InputVolcano <- InputCompare + + ## Prepare the colour scheme: + if ("color" %in% names(SettingsInfo)) { + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$color))] + + keyvals <- c() + for (row in seq_len(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] + names(col) <- InputVolcano$color[row] + keyvals <- c(keyvals, col) + } + } else { #here we will use the conditions if no other color is provided! + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$comparison))] + + keyvals <- c() + for (row in seq_len(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(col) <- InputVolcano$comparison[row] + keyvals <- c(keyvals, col) + } + } + ## Prepare the shape scheme: + if ("shape" %in% names(SettingsInfo) & !"color" %in% names(SettingsInfo)) { + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$shape))] + + keyvalsshape <- c() + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] + names(sha) <- InputVolcano$shape[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } else if ("shape" %in% names(SettingsInfo) & "color" %in% names(SettingsInfo)) { + ## Here we have already used color from SettingsInfo and we need to use shape for the conditions + message("For PlotSettings Comparison we can only use colour or shape from SettingsFile_Metab. Hence, we ignore shape and use it to label the ComparisonName.") + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$comparison))] + + keyvalsshape <- c() + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(sha) <- InputVolcano$comparison[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } else if (!"shape" %in% names(SettingsInfo) & !"color" %in% names(SettingsInfo) | !"shape" %in% names(SettingsInfo) & "color" %in% names(SettingsInfo)) { + + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$comparison))] + keyvalsshape <- c() + + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$comparison) %in% InputVolcano[row, "comparison"]] + names(sha) <- InputVolcano$comparison[row] + keyvalsshape <- c(keyvalsshape, sha) + } + } + ## Prepare the Plot: + Plot <- EnhancedVolcano::EnhancedVolcano(InputVolcano, + lab = rownames(se), ##Metabolite name + selectLab = SelectLab, x = paste(x), y = paste(y), + xlab =xlab, ylab =ylab, pCutoff = yCutoff, + FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 + pointSize = 3, labSize = 3, axisLabSize = 10, + titleLabSize = 12, subtitleLabSize = 11, captionLabSize = 10, + col = safe_colorblind_palette, colCustom = keyvals, + shapeCustom = keyvalsshape, colAlpha = 1, + title= paste(PlotName), subtitle = Subtitle, + caption = paste0("Total = ", nrow(InputVolcano) / 2, " ", Features), + xlim = c( + min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )]) - 0.2, + max(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) + 1.2), + ylim = c(0, ceiling(-log10(Reduce(min,InputVolcano[[y]])))), + cutoffLineType = "dashed", cutoffLineCol = "black", + cutoffLineWidth = 0.5, + legendLabels = c( + paste(x," < |", xCutoff, "|"), + paste(x," > |", xCutoff, "|"), + paste(y, ' < ', yCutoff) , + paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), + legendPosition = 'right', legendLabSize = 7, legendIconSize = 4, + gridlines.major = FALSE, gridlines.minor = FALSE, + drawConnectors = Connectors) + + ## Add the theme + if (!is.null(Theme)) { + Plot <- Plot + Theme + } + + ## Store the plot in the 'plots' list + PlotList[["Plot"]] <- Plot + + Plot_Sized <- plotGrob_Volcano(InputPlot = Plot, + SettingsInfo = SettingsInfo, PlotName = PlotName, + Subtitle = Subtitle) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', + valueOnly = TRUE) + Plot_Sized %<>% ## EDIT: added value of %<>%? + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + PlotList_adaptedGrid[["Plot_Sized"]] <- Plot_Sized + + ##----- Save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, + plot = list( + "Plot_Sized" = PlotList_adaptedGrid[["Plot_Sized"]]), + SaveAs_Table = NULL, SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste("Volcano_", PlotName, sep = ""), + CoRe = FALSE, PrintPlot = PrintPlot, + PlotHeight = PlotHeight, PlotWidth = PlotWidth, + PlotUnit = "cm"))) + } } - } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + + ## return + invisible(list( + "data" = list(NULL), + "plot" = list( + "Plot" = PlotList, + "Plot_Sized" = PlotList_adaptedGrid))) } -################################################################################################ -### ### ### VizVolcano helper function: Internal Function for PlotSettings PEA ### ### ### -################################################################################################ +################################################################################ +### VizVolcano helper function: Internal Function for PlotSettings PEA ### +################################################################################ #' Check input parameters #' @@ -1039,196 +1036,275 @@ VizVolcano_Compare <- function(InputData, #' @importFrom logger log_trace #' #' @noRd +#' +#' @examples +#' Intra <- ToyData("IntraCells_Raw") +#' MappingInfo <- ToyData(Data = "Cells_MetaData") +#' +#' ## find overlapping metabolites +#' features <- intersect(colnames(Intra[, -c(1:3)]), rownames(MappingInfo)) +#' +#' ## create SummarizedExperiment object +#' a <- t(Intra[-c(49:58), features]) +#' rD <- DataFrame(MappingInfo[features, ]) +#' rD$feature <- rownames(rD) +#' cD <- DataFrame(Intra[-c(49:58), c(1:3)]) +#' se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) +#' +#' l_preprocessed <- PreProcessing(se = se, +#' SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates"), +#' FeatureFilt = "Modified", +#' FeatureFilt_Value = 0.8, +#' TIC = TRUE, +#' MVI = TRUE, +#' HotellinsConfidence = 0.99, +#' CoRe = FALSE, +#' SaveAs_Plot = "svg", +#' SaveAs_Table = "csv", +#' PrintPlot = TRUE, +#' FolderPath = NULL) +#' +#' se_preprocessed <- l_preprocessed[["data"]][["se_processed"]] +#' +#' ## run Anova +#' DMA_Annova <- DMA(se = se_preprocessed, +#' SettingsInfo = c(Conditions = "Conditions", Numerator = NULL , Denominator = "HK2"), ## we compare all_vs_HK2 +#' StatPval = "aov", +#' StatPadj = "fdr") +#' +#' ## run ORA +#' DM_ORA_res<- list() +#' LoadKEGG() +#' comparisons <- names(DMA_Annova[["DMA"]]) +#' for (comparison in comparisons) { +#' ## Ensure that the Metabolite names match with KEGG IDs or KEGG trivial names. +#' DMA <- DMA_Annova[["DMA"]][[comparison]] +#' ## we remove metabolites that do not have a KEGG ID/KEGG pathway +#' DMA <- DMA[!is.na(assay(DMA)$KEGG.ID) & !is.na(assay(DMA)$KEGGCompound), ] #%>% +#' ## we use the KEGG trivial names to match with the KEGG pathways +#' #dplyr::rename("Metabolite"="KEGGCompound") +#' +#' ## Perform ORA +#' DM_ORA_res[[comparison]] <- StandardORA(se = DMA, #Input data requirements: column `t.val` and column `Metabolite` +#' SettingsInfo = c(pvalColumn="p.adj", PercentageColumn="t.val", PathwayTerm= "term", PathwayFeature= "Metabolite"), +#' PathwayFile = KEGG_Pathways,#Pathway file requirements: column `term`, `Metabolite` and `Description`. +#' PathwayName = "KEGG", +#' minGSSize = 3, +#' maxGSSize = 1000, +#' pCutoff = 0.01, +#' PercentageCutoff = 10) +#' } +#' +#' ## obtain DMA_786M1A_vs_HK2 and DM_ORA_786M1A_vs_HK2 objects +#' DMA_786M1A_vs_HK2 <- DMA_Annova[["DMA"]][["786-M1A_vs_HK2"]] +#' DM_ORA_786M1A_vs_HK2 <- DM_ORA_res[["786-M1A_vs_HK2"]][["ClusterGoSummary"]] +#' +#' +#' InputPEA <- DMA_786M1A_vs_HK2 %>% +#' filter(!is.na(KEGGCompound)) %>% +#' tibble::column_to_rownames("KEGGCompound") #' -VizVolcano_PEA <- function(InputData, - InputData2, - SettingsFile_Metab, +#' ## InputData2=Pathway analysis output: Must have same column names as SettingsFile_Metab for Pathway name +#' InputPEA2 <- DM_ORA_786M1A_vs_HK2 %>% +#' dplyr::rename("term" = "ID") +#' +#' VizVolcano_PEA(se, se2, SettingsInfo = ) +VizVolcano_PEA <- function(se, + se2, #InputData2, + ##SettingsFile_Metab, SettingsInfo, - y= "p.adj", - x= "Log2FC", - xlab= NULL,#"~Log[2]~FC" - ylab= NULL,#"~-Log[10]~p.adj" - xCutoff= 0.5, - yCutoff= 0.05, - Connectors= FALSE, - SelectLab= "", - PlotName= "", - Subtitle= "", + y = "p.adj", + x = "Log2FC", + xlab = NULL,#"~Log[2]~FC" + ylab = NULL,#"~-Log[10]~p.adj" + xCutoff = 0.5, + yCutoff = 0.05, + Connectors = FALSE, + SelectLab = "", + PlotName = "", + Subtitle = "", ColorPalette, ShapePalette, - Theme= NULL, - Features="Metabolites", + Theme = NULL, ## EDIT: predefine the theme and simplify downstream + Features = "Metabolites", SaveAs_Plot, PrintPlot, - Folder){ - ##################### - ##--- Check PEA settings - if(is.vector(SettingsInfo)==FALSE){ - message <- paste0("You have chosen Settings=`PEA` that requires you to provide a vector for SettingsInfo.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.null(SettingsFile_Metab)==TRUE){ - message <- pasteo("You have chosen Settings=`PEA` that requires you to provide a DF SettingsFile_Metab including the pathways used for the enrichment analysis.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) - } - if(is.null(SettingsFile_Metab)==FALSE & is.null(SettingsFile_Metab)==FALSE){ - if("PEA_Feature" %in% names(SettingsInfo)==FALSE | "PEA_score" %in% names(SettingsInfo)==FALSE | "PEA_stat" %in% names(SettingsInfo)==FALSE | "PEA_Pathway" %in% names(SettingsInfo)==FALSE){ - message <- paste0("You have chosen Settings=`PEA` that requires you to provide a vector for SettingsInfo including `PEA_Feature`, `PEA_Pathway`, `PEA_stat` and `PEA_score`.") - logger::log_trace(paste("Error ", message, sep="")) - stop(message) + Folder) { + + ##################### + ##--- Check PEA settings + if (!is.vector(SettingsInfo)) { + message <- "You have chosen Settings=`PEA` that requires to provide a vector for 'SettingsInfo'." + logger::log_trace(paste0("Error ", message)) + stop(message) } - } - - #Pass colours/shapes - safe_colorblind_palette <- ColorPalette - safe_shape_palette <- ShapePalette - - #Prepare data: - InputData <- InputData%>% - dplyr::rename("PEA_Feature"= !!SettingsInfo[["PEA_Feature"]]) - - - InputData2 <- InputData2%>% - dplyr::rename("PEA_score"= !!SettingsInfo[["PEA_score"]], - "PEA_stat"= !!SettingsInfo[["PEA_stat"]], - "PEA_Pathway"= !!SettingsInfo[["PEA_Pathway"]]) - - SettingsFile_Metab <- SettingsFile_Metab%>% - dplyr::rename("PEA_Pathway"= !!SettingsInfo[["PEA_Pathway"]], - "PEA_Feature"= !!SettingsInfo[["PEA_Feature"]]) - - ################# - ##--- Plot - # Create the list of individual plots that should be made: - IndividualPlots <- unique(InputData2$PEA_Pathway) - - PlotList <- list()#Empty list to store all the plots - PlotList_adaptedGrid <- list()#Empty list to store all the plots - - for (i in IndividualPlots){ - InputData2_Select<- InputData2%>% - filter(PEA_Pathway == paste(i)) #Select pathway we plot and use the score and stats - - SettingsFile_Metab_Select <- SettingsFile_Metab%>% - filter(PEA_Pathway == paste(i)) - - InputVolcano <-merge(SettingsFile_Metab_Select, InputData, by="PEA_Feature", all.x=TRUE)%>% - distinct(PEA_Feature, .keep_all = TRUE) %>% - filter(!is.na(!!sym(y)) & !is.na(!!sym(x))) - - if(nrow(InputVolcano)>=1){ - #Prepare the colour scheme: - if("color" %in% names(SettingsInfo)==TRUE){ - color_select <- safe_colorblind_palette[1:length(unique(InputVolcano$color))] - - keyvals <- c() - for(row in 1:nrow(InputVolcano)){ - col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] - names(col) <- InputVolcano$color[row] - keyvals <- c(keyvals, col) + #if (is.null(SettingsFile_Metab)) { + ## message <- "You have chosen Settings=`PEA` that requires to provide a DF 'SettingsFile_Metab' including the pathways used for the enrichment analysis." + # logger::log_trace(paste0("Error ", message)) + # stop(message) + #} + if (!is.null(rowData(se))) { + if (!"PEA_Feature" %in% names(SettingsInfo) | !"PEA_score" %in% names(SettingsInfo) | !"PEA_stat" %in% names(SettingsInfo) | !"PEA_Pathway" %in% names(SettingsInfo)) { + message <- "You have chosen Settings=`PEA` that requires to provide a vector for 'SettingsInfo' including `PEA_Feature`, `PEA_Pathway`, `PEA_stat` and `PEA_score`." + logger::log_trace(paste0("Error ", message)) + stop(message) } + } - LegendPos<- "right" - } else{ - keyvals <-NULL - } - #Prepare the shape scheme: - if("shape" %in% names(SettingsInfo)==TRUE){ - shape_select <- safe_shape_palette[1:length(unique(InputVolcano$shape))] - - keyvalsshape <- c() - for(row in 1:nrow(InputVolcano)){ - sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] - names(sha) <- InputVolcano$shape[row] - keyvalsshape <- c(keyvalsshape, sha) + ## Pass colours/shapes + safe_colorblind_palette <- ColorPalette + safe_shape_palette <- ShapePalette + + ## Prepare data: + InputData <- assay(se) |> + t() |> + data.frame() |> + dplyr::rename("PEA_Feature"= !!SettingsInfo[["PEA_Feature"]]) + + + InputData2 <- assay(se2) |> + t() |> + data.frame() %>% + dplyr::rename("PEA_score"= !!SettingsInfo[["PEA_score"]], + "PEA_stat"= !!SettingsInfo[["PEA_stat"]], + "PEA_Pathway"= !!SettingsInfo[["PEA_Pathway"]]) + + SettingsFile_Metab <- rowData(se) %>% + dplyr::rename("PEA_Pathway"= !!SettingsInfo[["PEA_Pathway"]], + "PEA_Feature"= !!SettingsInfo[["PEA_Feature"]]) + + ################# + ##--- Plot + ## Create the list of individual plots that should be made: + IndividualPlots <- unique(InputData2$PEA_Pathway) + + ## empty list to store all the plots + PlotList <- list() ## EDIT: define outside the if/else and delete other instances + ## empty list to store all the plots + + for (i in IndividualPlots) { + InputData2_Select<- InputData2 %>% + filter(PEA_Pathway == paste(i)) ## Select pathway we plot and use the score and stats + + SettingsFile_Metab_Select <- SettingsFile_Metab %>% + filter(PEA_Pathway == paste(i)) + + InputVolcano <- merge(SettingsFile_Metab_Select, InputData, + by = "PEA_Feature", all.x = TRUE) %>% + distinct(PEA_Feature, .keep_all = TRUE) %>% + filter(!is.na(!!sym(y)) & !is.na(!!sym(x))) + + if (nrow(InputVolcano) >= 1) { + ## Prepare the colour scheme: + if ("color" %in% names(SettingsInfo)) { + color_select <- safe_colorblind_palette[seq_along(unique(InputVolcano$color))] + + keyvals <- c() + for (row in seq_len(nrow(InputVolcano))) { + col <- color_select[unique(InputVolcano$color) %in% InputVolcano[row, "color"]] + names(col) <- InputVolcano$color[row] + keyvals <- c(keyvals, col) + } + + LegendPos<- "right" + } else { + keyvals <- NULL + } + ## Prepare the shape scheme: + if ("shape" %in% names(SettingsInfo)) { + shape_select <- safe_shape_palette[seq_along(unique(InputVolcano$shape))] + + keyvalsshape <- c() + for (row in seq_len(nrow(InputVolcano))) { + sha <- shape_select[unique(InputVolcano$shape) %in% InputVolcano[row, "shape"]] + names(sha) <- InputVolcano$shape[row] + keyvalsshape <- c(keyvalsshape, sha) + } + + LegendPos <- "right" + } else { + keyvalsshape <-NULL + } + + if (!"color" %in% names(SettingsInfo) & !"shape" %in% names(SettingsInfo)) { + LegendPos <- "none" + } + + ## prepare the Plot: + Plot <- EnhancedVolcano::EnhancedVolcano(InputVolcano, + lab = InputVolcano$PEA_Feature, ## metabolite name + selectLab = SelectLab, x = paste(x), y = paste(y), + xlab = xlab, ylab = ylab, pCutoff = yCutoff, + FCcutoff = xCutoff, ## Cut off Log2FC, automatically 2 + pointSize = 3, labSize = 3, axisLabSize = 10, + titleLabSize = 12, subtitleLabSize = 11, + captionLabSize = 10, col=safe_colorblind_palette, + colCustom = keyvals, shapeCustom = keyvalsshape, + colAlpha = 1, title = paste0(PlotName, ": ", i), + subtitle = paste0(SettingsInfo[["PEA_score"]],"= ", + InputData2_Select$PEA_score, ", ", + SettingsInfo[["PEA_stat"]], "= ", + InputData2_Select$PEA_stat), + caption = paste0("Total = ", nrow(InputVolcano), " of ", + nrow(SettingsFile_Metab_Select), " ", Features, + " in pathway"), + xlim = c( + min(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) - 0.2, + max(InputVolcano[[x]][is.finite(InputVolcano[[x]])]) + 1.2), + ylim = c(0, ceiling(-log10(Reduce(min,InputVolcano[[y]])))), + cutoffLineType = "dashed", cutoffLineCol = "black", + cutoffLineWidth = 0.5, + legendLabels=c( + paste(x," < |", xCutoff, "|"), + paste(x," > |", xCutoff, "|"), + paste(y, ' < ', yCutoff), + paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), + legendPosition = LegendPos, legendLabSize = 7, + legendIconSize = 4, gridlines.major = FALSE, + gridlines.minor = FALSE, drawConnectors = Connectors) + + ## Add the theme + if (!is.null(Theme)) { + Plot <- Plot + Theme + } + + ## Store the plot in the 'plots' list + PlotList[[i]] <- Plot + + ## Set the total heights and widths + PlotTitle <- paste(PlotName, ": ", i, sep = "") + Plot_Sized <- plotGrob_Volcano(InputPlot = Plot, + SettingsInfo = SettingsInfo, PlotName = PlotTitle, + Subtitle = Subtitle) + PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', + valueOnly = TRUE) + PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', + valueOnly = TRUE) + + Plot_Sized %<>% + {ggplot2::ggplot() + annotation_custom(.)} %>% + add(theme(panel.background = element_rect(fill = "transparent"))) + + cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - + PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized + + SaveList <- list() + SaveList[[cleaned_i]] <- Plot_Sized + + #----- Save + suppressMessages(suppressWarnings( + SaveRes(data = NULL, plot = SaveList, + SaveAs_Table = NULL, SaveAs_Plot = SaveAs_Plot, + FolderPath = Folder, + FileName = paste0("Volcano_", PlotName), + CoRe = FALSE, PrintPlot = PrintPlot, + PlotHeight = PlotHeight, PlotWidth = PlotWidth, + PlotUnit = "cm"))) } - - LegendPos<- "right" - } else{ - keyvalsshape <-NULL - } - - if("color" %in% names(SettingsInfo)==FALSE & "shape" %in% names(SettingsInfo)==FALSE){ - LegendPos<- "none" - } - - #Prepare the Plot: - Plot<- EnhancedVolcano::EnhancedVolcano(InputVolcano, - lab = InputVolcano$PEA_Feature,#Metabolite name - selectLab = SelectLab, - x = paste(x), - y = paste(y), - xlab =xlab, - ylab =ylab, - pCutoff = yCutoff, - FCcutoff = xCutoff,#Cut off Log2FC, automatically 2 - pointSize = 3, - labSize = 3, - axisLabSize = 10, - titleLabSize = 12, - subtitleLabSize = 11, - captionLabSize = 10, - col=safe_colorblind_palette, - colCustom = keyvals, - shapeCustom = keyvalsshape, - colAlpha = 1, - title= paste(PlotName, ": ", i, sep=""), - subtitle = paste(SettingsInfo[["PEA_score"]],"= ", InputData2_Select$PEA_score, ", ",SettingsInfo[["PEA_stat"]] , "= ", InputData2_Select$PEA_stat, sep=""), - caption = paste0("Total = ", nrow(InputVolcano), " of ", nrow(SettingsFile_Metab_Select), " ", Features, " in pathway"), - xlim = c(min(InputVolcano[[x]][is.finite(InputVolcano[[x]] )])-0.2, max(InputVolcano[[x]][is.finite(InputVolcano[[x]])])+1.2), - ylim = c(0,(ceiling(-log10(Reduce(min,InputVolcano[[y]]))))), - cutoffLineType = "dashed", - cutoffLineCol = "black", - cutoffLineWidth = 0.5, - legendLabels=c(paste(x," < |", xCutoff, "|"), paste(x," > |", xCutoff, "|"), paste(y, ' < ', yCutoff) , paste(y, ' < ', yCutoff,' & ',x," < |", xCutoff, "|")), - legendPosition = LegendPos, - legendLabSize = 7, - legendIconSize =4, - gridlines.major = FALSE, - gridlines.minor = FALSE, - drawConnectors = Connectors) - #Add the theme - if(is.null(Theme)==FALSE){ - Plot <- Plot+Theme - } - - ## Store the plot in the 'plots' list - PlotList[[i]] <- Plot - - #Set the total heights and widths - PlotTitle <- paste(PlotName, ": ", i, sep="") - Plot_Sized <- plotGrob_Volcano(InputPlot=Plot, SettingsInfo=SettingsInfo, PlotName = PlotTitle, Subtitle = Subtitle) - PlotHeight <- grid::convertUnit(Plot_Sized$height, 'cm', valueOnly = TRUE) - PlotWidth <- grid::convertUnit(Plot_Sized$width, 'cm', valueOnly = TRUE) - - Plot_Sized %<>% - {ggplot2::ggplot() + annotation_custom(.)} %>% - add(theme(panel.background = element_rect(fill = "transparent"))) - - cleaned_i <- gsub("[[:space:],/\\\\]", "-", i)#removes empty spaces and replaces /,\ with - - PlotList_adaptedGrid[[cleaned_i]] <- Plot_Sized - - SaveList <- list() - SaveList[[cleaned_i]] <- Plot_Sized - - #----- Save - suppressMessages(suppressWarnings( - SaveRes(InputList_DF=NULL, - InputList_Plot= SaveList, - SaveAs_Table=NULL, - SaveAs_Plot=SaveAs_Plot, - FolderPath= Folder, - FileName= paste("Volcano_",PlotName, sep=""), - CoRe=FALSE, - PrintPlot=PrintPlot, - PlotHeight=PlotHeight, - PlotWidth=PlotWidth, - PlotUnit="cm"))) - } - } - return(invisible(list("Plot"=PlotList,"Plot_Sized" = PlotList_adaptedGrid))) + ## return + invisible(list( + "data" = list(NULL), + "plot" = list("Plot" = PlotList, "Plot_Sized" = PlotList_adaptedGrid))) } diff --git a/man/DMA.Rd b/man/DMA.Rd index 0b089fc4..5b6a3b65 100644 --- a/man/DMA.Rd +++ b/man/DMA.Rd @@ -8,8 +8,8 @@ DMA( InputData, SettingsFile_Sample, SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = NULL), - StatPval = "lmFit", - StatPadj = "fdr", + StatPval = c("lmFit", "aov", "krustal.test", "welch"), + StatPadj = p.adjust.methods, SettingsFile_Metab = NULL, CoRe = FALSE, VST = FALSE, diff --git a/man/EquivalentIDs.Rd b/man/EquivalentIDs.Rd index fe101407..ca4ef976 100644 --- a/man/EquivalentIDs.Rd +++ b/man/EquivalentIDs.Rd @@ -30,8 +30,11 @@ Input DF with additional column including potential additional IDs. Find additional potential IDs for "kegg", "pubchem", "chebi", "hmdb" } \examples{ -DetectedIDs <- MetaProViz::ToyData(Data="Cells_MetaData")\%>\% tibble::rownames_to_column("TrivialName")\%>\%tidyr::drop_na() -Res <- MetaProViz::EquivalentIDs(InputData= DetectedIDs, SettingsInfo = c(InputID="HMDB"), From = "hmdb") +DetectedIDs <- ToyData(Data="Cells_MetaData") \%>\% + tibble::rownames_to_column("TrivialName") \%>\% + tidyr::drop_na() +Res <- EquivalentIDs(InputData = DetectedIDs, + SettingsInfo = c(InputID = "HMDB"), From = "hmdb") } \keyword{Find} diff --git a/man/LoadKEGG.Rd b/man/LoadKEGG.Rd index 177b26cc..369b532c 100644 --- a/man/LoadKEGG.Rd +++ b/man/LoadKEGG.Rd @@ -16,6 +16,6 @@ Import and process KEGG. Imports KEGG pathways into the environment } \examples{ -KEGG_Pathways <- MetaProViz::LoadKEGG() +KEGG_Pathways <- LoadKEGG() } diff --git a/man/LoadRAMP.Rd b/man/LoadRAMP.Rd index eb42a29a..0b95bfa4 100644 --- a/man/LoadRAMP.Rd +++ b/man/LoadRAMP.Rd @@ -20,6 +20,6 @@ A data frame containing the Prior Knowledge. Import and process file to create Prior Knowledge. } \examples{ -ChemicalClass <- MetaProViz::LoadRAMP() +ChemicalClass <- LoadRAMP() } diff --git a/man/MCA_2Cond.Rd b/man/MCA_2Cond.Rd index 1c345f5c..db9dc0a0 100644 --- a/man/MCA_2Cond.Rd +++ b/man/MCA_2Cond.Rd @@ -47,10 +47,12 @@ This script performs metabolite clustering analysis and computes clusters of met } } \examples{ -Intra <- MetaProViz::ToyData("IntraCells_Raw") -Input <- MetaProViz::DMA(InputData=Intra[-c(49:58) ,-c(1:3)], SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2")) +Intra <- ToyData("IntraCells_Raw") -Res <- MetaProViz::MCA_2Cond(InputData_C1 = Input[["DMA"]][["786-O_vs_HK2"]], +## create +Input <- DMA(InputData = Intra[-c(49:58) ,-c(1:3)], SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2")) + +Res <- MCA_2Cond(InputData_C1 = Input[["DMA"]][["786-O_vs_HK2"]], InputData_C2 = Input[["DMA"]][["786-M1A_vs_HK2"]]) } diff --git a/man/MCA_CoRe.Rd b/man/MCA_CoRe.Rd index 62a8c2ba..9bd697c4 100644 --- a/man/MCA_CoRe.Rd +++ b/man/MCA_CoRe.Rd @@ -42,21 +42,21 @@ This script performs metabolite clustering analysis and computes clusters of met } \examples{ -Media <- MetaProViz::ToyData("CultureMedia_Raw") -ResM <- MetaProViz::PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], +Media <- ToyData("CultureMedia_Raw") +ResM <- PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], SettingsFile_Sample = Media[-c(40:45) ,c(1:3)] , SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates", CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), CoRe=TRUE) -MediaDMA <- MetaProViz::DMA(InputData=ResM[["DF"]][["Preprocessing_output"]][ ,-c(1:4)], +MediaDMA <- DMA(InputData=ResM[["DF"]][["Preprocessing_output"]][ ,-c(1:4)], SettingsFile_Sample=ResM[["DF"]][["Preprocessing_output"]][ , c(1:4)], SettingsInfo = c(Conditions = "Conditions", Numerator = NULL, Denominator = "HK2"), StatPval ="aov", CoRe=TRUE) -IntraDMA <- MetaProViz::ToyData(Data="IntraCells_DMA") +IntraDMA <- ToyData(Data="IntraCells_DMA") -Res <- MetaProViz::MCA_CoRe(InputData_Intra = IntraDMA\%>\%tibble::rownames_to_column("Metabolite"), +Res <- MCA_CoRe(InputData_Intra = IntraDMA\%>\%tibble::rownames_to_column("Metabolite"), InputData_CoRe = MediaDMA[["DMA"]][["786-M1A_vs_HK2"]]) } diff --git a/man/MCA_rules.Rd b/man/MCA_rules.Rd index 43bd9b34..5222bb6e 100644 --- a/man/MCA_rules.Rd +++ b/man/MCA_rules.Rd @@ -4,7 +4,7 @@ \alias{MCA_rules} \title{MCA regulatory rules Import} \usage{ -MCA_rules(Method) +MCA_rules(Method = c("2Cond", "CoRe")) } \arguments{ \item{Method}{Either "2Cond" or "CoRe" depending which regulatory rules you would like to load} diff --git a/man/MappingAmbiguity.Rd b/man/MappingAmbiguity.Rd index df793504..4b43a52b 100644 --- a/man/MappingAmbiguity.Rd +++ b/man/MappingAmbiguity.Rd @@ -36,9 +36,12 @@ List with at least 4 DFs: 1-3) From-to-To: 1. MappingIssues, 2. MappingIssues Su Create Mapping Ambiguities between two ID types } \examples{ -KEGG_Pathways <- MetaProViz::LoadKEGG() -InputDF <- MetaProViz::TranslateID(InputData= KEGG_Pathways, SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), From = c("kegg"), To = c("pubchem"))[["TranslatedDF"]] -Res <- MetaProViz::MappingAmbiguity(InputData= InputDF, From = "MetaboliteID", To = "pubchem", GroupingVariable = "term", Summary=TRUE) +KEGG_Pathways <- LoadKEGG() +InputDF <- TranslateID(InputData= KEGG_Pathways, + SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), + From = c("kegg"), To = c("pubchem"))[["TranslatedDF"]] +Res <- MappingAmbiguity(InputData = InputDF, From = "MetaboliteID", + To = "pubchem", GroupingVariable = "term", Summary = TRUE) } \keyword{Mapping} diff --git a/man/MetaAnalysis.Rd b/man/MetaAnalysis.Rd index 03f355b9..5079cf0b 100644 --- a/man/MetaAnalysis.Rd +++ b/man/MetaAnalysis.Rd @@ -45,8 +45,8 @@ List of DFs: prcomp results, loadings, Top-Bottom features, annova results, resu This function performs a PCA analysis on the input data and combines it with the sample metadata to perform an ANOVA test to identify significant differences between the groups. } \examples{ -Tissue_Norm <- MetaProViz::ToyData("Tissue_Norm") -Res <- MetaProViz::MetaAnalysis(InputData=Tissue_Norm[,-c(1:13)], +Tissue_Norm <- ToyData("Tissue_Norm") +Res <- MetaAnalysis(InputData=Tissue_Norm[,-c(1:13)], SettingsFile_Sample= Tissue_Norm[,c(2,4:5,12:13)]) } diff --git a/man/MetaPK.Rd b/man/MetaPK.Rd index f2833a86..557d8f02 100644 --- a/man/MetaPK.Rd +++ b/man/MetaPK.Rd @@ -30,8 +30,8 @@ DF with prior knowledge based on patient metadata Meta prior-knowledge } \examples{ -Tissue_Norm <- MetaProViz::ToyData("Tissue_Norm") -Res <- MetaProViz::MetaPK(InputData=Tissue_Norm[,-c(1:13)], +Tissue_Norm <- ToyData("Tissue_Norm") +Res <- MetaPK(InputData=Tissue_Norm[,-c(1:13)], SettingsFile_Sample= Tissue_Norm[,c(2,4:5,12:13)]) } diff --git a/man/PoolEstimation.Rd b/man/PoolEstimation.Rd index 02c0b9f7..566cbf11 100644 --- a/man/PoolEstimation.Rd +++ b/man/PoolEstimation.Rd @@ -5,8 +5,8 @@ \title{Find metabolites with high variability across total pool samples} \usage{ PoolEstimation( + se, InputData, - SettingsFile_Sample = NULL, SettingsInfo = NULL, CutoffCV = 30, SaveAs_Plot = "svg", @@ -18,9 +18,7 @@ PoolEstimation( \arguments{ \item{InputData}{DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. Can be either a full dataset or a dataset with only the pool samples.} -\item{SettingsFile_Sample}{\emph{Optional: } DF which contains information about the samples when a full dataset is inserted as Input_data. Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), has to exist.\strong{Default = NULL}} - -\item{SettingsInfo}{\emph{Optional: } NULL or Named vector including the Conditions and PoolSample information (Name of the Conditions column and Name of the pooled samples in the Conditions in the Input_SettingsFile) : c(Conditions="ColumnNameConditions, PoolSamples=NamePoolCondition. If no Conditions is added in the Input_SettingsInfo, it is assumed that the conditions column is named 'Conditions' in the Input_SettingsFile. ). \strong{Default = NULL}} +\item{SettingsInfo}{\emph{Optional: } NULL or Named vector including the Conditions and PoolSample information (Name of the Conditions column and Name of the pooled samples in the Conditions in the Input_SettingsFile) : c(Conditions="ColumnNameConditions, PoolSamples=NamePoolCondition. If no Conditions is added in the Input_SettingsInfo, it is assumed that the conditions column is named 'Conditions' in the Input_SettingsFile.). \strong{Default = NULL}} \item{CutoffCV}{\emph{Optional: } Filtering cutoff for high variance metabolites using the Coefficient of Variation. \strong{Default = 30}} @@ -31,6 +29,8 @@ PoolEstimation( \item{PrintPlot}{\emph{Optional: } If TRUE prints an overview of resulting plots. \strong{Default = TRUE}} \item{FolderPath}{\emph{Optional:} Path to the folder the results should be saved at. \strong{default: NULL}} + +\item{SettingsFile_Sample}{\emph{Optional: } DF which contains information about the samples when a full dataset is inserted as Input_data. Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), has to exist.\strong{Default = NULL}} } \value{ List with two elements: DF (including input and output table) and Plot (including all plots generated) @@ -39,10 +39,18 @@ List with two elements: DF (including input and output table) and Plot (includin Find metabolites with high variability across total pool samples } \examples{ +## load the data Intra <- ToyData("IntraCells_Raw") -Res <- PoolEstimation(InputData=Intra[ ,-c(1:3)], - SettingsFile_Sample=Intra[ , c(1:3)], - SettingsInfo = c(PoolSamples = "Pool", Conditions="Conditions")) + +## create SummarizedExperiment +a <- t(Intra[, -c(1:3)]) +rD <- DataFrame(feature = rownames(a)) +cD <- Intra[, c(1:3)] +se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) + +## apply the function +PoolEstimation(se = se, + SettingsInfo = c(Conditions = "Conditions", PoolSamples = "Pool")) } \keyword{Coefficient} diff --git a/man/PreProcessing.Rd b/man/PreProcessing.Rd index 299dc277..27ffbb3f 100644 --- a/man/PreProcessing.Rd +++ b/man/PreProcessing.Rd @@ -5,8 +5,7 @@ \title{Modularised Normalization: 80\%-filtering rule, total-ion count normalization, missing value imputation and Outlier Detection: HotellingT2.} \usage{ PreProcessing( - InputData, - SettingsFile_Sample, + se, SettingsInfo, FeatureFilt = "Modified", FeatureFilt_Value = 0.8, @@ -22,10 +21,6 @@ PreProcessing( ) } \arguments{ -\item{InputData}{DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected.} - -\item{SettingsFile_Sample}{DF which contains information about the samples, which will be combined with the input data based on the unique sample identifiers used as rownames.} - \item{SettingsInfo}{Named vector containing the information about the names of the experimental parameters. c(Conditions="ColumnName_Plot_SettingsFile", Biological_Replicates="ColumnName_Plot_SettingsFile"). Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), can be used for feature filtering and colour coding in the PCA. Column "BiologicalReplicates" including numerical values. For CoRe = TRUE a CoRe_norm_factor = "Columnname_Input_SettingsFile" and CoRe_media = "Columnname_Input_SettingsFile", have to also be added. Column CoRe_norm_factor is used for normalization and CoRe_media is used to specify the name of the media controls in the Conditions.} \item{FeatureFilt}{\emph{Optional: }If NULL, no feature filtering is performed. If set to "Standard" then it applies the 80\%-filtering rule (Bijlsma S. et al., 2006) on the metabolite features on the whole dataset. If is set to "Modified",filtering is done based on the different conditions, thus a column named "Conditions" must be provided in the Input_SettingsFile input file including the individual conditions you want to apply the filtering to (Yang, J et al., 2015). \strong{Default = "Standard"}} @@ -49,6 +44,10 @@ PreProcessing( \item{PrintPlot}{\emph{Optional: } If TRUE prints an overview of resulting plots. \strong{Default = TRUE}} \item{FolderPath}{\emph{Optional:} Path to the folder the results should be saved at. \strong{default: NULL}} + +\item{InputData}{DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected.} + +\item{SettingsFile_Sample}{DF which contains information about the samples, which will be combined with the input data based on the unique sample identifiers used as rownames.} } \value{ List with two elements: DF (including all output tables generated) and Plot (including all plots generated) @@ -57,16 +56,46 @@ List with two elements: DF (including all output tables generated) and Plot (inc Modularised Normalization: 80\%-filtering rule, total-ion count normalization, missing value imputation and Outlier Detection: HotellingT2. } \examples{ -Intra <- MetaProViz::ToyData("IntraCells_Raw") -ResI <- MetaProViz::PreProcessing(InputData=Intra[-c(49:58) ,-c(1:3)], - SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], - SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates")) - -Media <- MetaProViz::ToyData("CultureMedia_Raw") -ResM <- MetaProViz::PreProcessing(InputData = Media[-c(40:45) ,-c(1:3)], - SettingsFile_Sample = Media[-c(40:45) ,c(1:3)] , - SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates", CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), - CoRe=TRUE) +## load the data and mapping Info +Intra <- ToyData("IntraCells_Raw") +MappingInfo <- ToyData(Data = "Cells_MetaData") +Media <- ToyData("CultureMedia_Raw") + +## create SummarizedExperiment objects +## se_intra +rD <- MappingInfo +cD <- Intra[-c(49:58), c(1:3)] +a <- t(Intra[-c(49:58), -c(1:3)]) + +## obtain overlapping metabolites +metabolites <- intersect(rownames(a), rownames(rD)) +rD <- rD[metabolites, ] +a <- a[metabolites, ] +se_intra <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) + +## se_media +rD <- MappingInfo +cD <- Media[, 1:3] +a <- t(Media[, 4:ncol(Media)]) + +## obtain overlapping metabolites +metabolites <- intersect(rownames(a), rownames(rD)) +rD <- rD[metabolites, ] +a <- a[metabolites, ] +se_media <- SummarizedExperiment::SummarizedExperiment(assays = a, rowData = rD, colData = cD) + +## apply the functions +ResI <- PreProcessing( + se = se_intra, + SettingsInfo = c(Conditions = "Conditions", + Biological_Replicates = "Biological_Replicates")) + +ResM <- PreProcessing( + se = se_media, + SettingsInfo = c(Conditions = "Conditions", + Biological_Replicates = "Biological_Replicates", + CoRe_norm_factor = "GrowthFactor", CoRe_media = "blank"), + CoRe = TRUE) } \keyword{80} diff --git a/man/ReplicateSum.Rd b/man/ReplicateSum.Rd index 9be6d87d..1ef95cca 100644 --- a/man/ReplicateSum.Rd +++ b/man/ReplicateSum.Rd @@ -5,8 +5,7 @@ \title{Merges the analytical replicates of an experiment} \usage{ ReplicateSum( - InputData, - SettingsFile_Sample, + se, SettingsInfo = c(Conditions = "Conditions", Biological_Replicates = "Biological_Replicates", Analytical_Replicates = "Analytical_Replicates"), SaveAs_Table = "csv", @@ -14,14 +13,14 @@ ReplicateSum( ) } \arguments{ -\item{InputData}{DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. -#@param SettingsFile_Sample DF which contains information about the samples Column "Conditions", "Biological_replicates" and "Analytical_Replicates has to exist.} - \item{SettingsInfo}{\emph{Optional: } Named vector including the Conditions and Replicates information: c(Conditions="ColumnNameConditions", Biological_Replicates="ColumnName_SettingsFile_Sample", Analytical_Replicates="ColumnName_SettingsFile_Sample").\strong{Default = NULL}} \item{SaveAs_Table}{\emph{Optional: } File types for the analysis results are: "csv", "xlsx", "txt", ot NULL \strong{default: "csv"}} \item{FolderPath}{\emph{Optional:} Path to the folder the results should be saved at. \strong{default: NULL}} + +\item{InputData}{DF which contains unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. +#@param SettingsFile_Sample DF which contains information about the samples Column "Conditions", "Biological_replicates" and "Analytical_Replicates has to exist.} } \value{ DF with the merged analytical replicates @@ -30,10 +29,20 @@ DF with the merged analytical replicates Merges the analytical replicates of an experiment } \examples{ +## load the data Intra <- ToyData("IntraCells_Raw") -Res <- ReplicateSum(InputData=Intra[-c(49:58) ,-c(1:3)], - SettingsFile_Sample=Intra[-c(49:58) , c(1:3)], - SettingsInfo = c(Conditions="Conditions", Biological_Replicates="Biological_Replicates", Analytical_Replicates="Analytical_Replicates")) + +## create SummarizedExperiment +a <- t(Intra[-c(49:58), -c(1:3)]) +rD <- DataFrame(feature = rownames(a)) +cD <- Intra[-c(49:58), c(1:3)] +se <- SummarizedExperiment(assay = a, rowData = rD, colData = cD) + +## apply the function +ReplicateSum(se = se, + SettingsInfo = c(Conditions = "Conditions", + Biological_Replicates = "Biological_Replicates", + Analytical_Replicates = "Analytical_Replicates")) } \keyword{Analytical} diff --git a/man/ToyData.Rd b/man/ToyData.Rd index 6fe901f2..90220214 100644 --- a/man/ToyData.Rd +++ b/man/ToyData.Rd @@ -30,6 +30,6 @@ A data frame containing the toy data. Import and process .csv file to create toy data DF. } \examples{ -Intra <- MetaProViz::ToyData("IntraCells_Raw") +ToyData("IntraCells_Raw") } diff --git a/man/TranslateID.Rd b/man/TranslateID.Rd index 42d359e2..677801c9 100644 --- a/man/TranslateID.Rd +++ b/man/TranslateID.Rd @@ -36,8 +36,10 @@ List with at least three DFs: 1) Original data and the new column of translated Translate IDs to/from KEGG, PubChem, Chebi, HMDB } \examples{ -KEGG_Pathways <- MetaProViz::LoadKEGG() -Res <- MetaProViz::TranslateID(InputData= KEGG_Pathways, SettingsInfo = c(InputID="MetaboliteID", GroupingVariable="term"), From = c("kegg"), To = c("pubchem", "hmdb")) +KEGG_Pathways <- LoadKEGG() +Res <- TranslateID(InputData = KEGG_Pathways, + SettingsInfo = c(InputID = "MetaboliteID", GroupingVariable = "term"), + From = c("kegg"), To = c("pubchem", "hmdb")) } \keyword{IDs} diff --git a/man/VizHeatmap.Rd b/man/VizHeatmap.Rd index 428a8cb4..1c1c6612 100644 --- a/man/VizHeatmap.Rd +++ b/man/VizHeatmap.Rd @@ -47,7 +47,7 @@ Heatmap visualization } \examples{ Intra <- ToyData("IntraCells_Raw") -Res <- MetaProViz::VizHeatmap(InputData=Intra[,-c(1:3)]) +Res <- VizHeatmap(InputData = Intra[,-c(1:3)]) } \keyword{Heatmap} diff --git a/man/VizPCA.Rd b/man/VizPCA.Rd index 7bcf0e67..f6af67ed 100644 --- a/man/VizPCA.Rd +++ b/man/VizPCA.Rd @@ -6,9 +6,8 @@ PCA plot visualization} \usage{ VizPCA( - InputData, + se, SettingsInfo = NULL, - SettingsFile_Sample = NULL, ColorPalette = NULL, ColorScale = "discrete", ShapePalette = NULL, @@ -26,8 +25,6 @@ VizPCA( \arguments{ \item{SettingsInfo}{\emph{Optional: } NULL or Named vector including at least one of those three information : c(color="ColumnName_Plot_SettingsFile", shape= "ColumnName_Plot_SettingsFile"). \strong{Default = NULL}} -\item{SettingsFile_Sample}{\emph{Optional: } DF which contains information about the samples, which will be combined with your input data based on the unique sample identifiers used as rownames. Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), can be used for feature filtering and colour coding in the PCA. Column "AnalyticalReplicate" including numerical values, defines technical repetitions of measurements, which will be summarised. Column "BiologicalReplicates" including numerical values. Please use the following names: "Conditions", "Biological_Replicates", "Analytical_Replicates".\strong{Default = NULL}} - \item{ColorPalette}{\emph{Optional: } Provide customiced color-palette in vector format. For continuous scale use e.g. scale_color_gradient(low = "#88CCEE", high = "red") and for discrete scale c("#88CCEE", "#DDCC77","#661100", "#332288")\strong{Default = NULL}} \item{ColorScale}{\emph{Optional: } Either "continuous" or "discrete" colour scale. For numeric or integer you can choose either, for character you have to choose discrete. \strong{Default = NULL}} @@ -53,6 +50,8 @@ VizPCA( \item{FolderPath}{\emph{Optional:} Path to the folder the results should be saved at. \strong{default: NULL}} \item{Input_data}{DF with unique sample identifiers as row names and metabolite numerical values in columns with metabolite identifiers as column names. Use NA for metabolites that were not detected. includes experimental design and outlier column.} + +\item{SettingsFile_Sample}{\emph{Optional: } DF which contains information about the samples, which will be combined with your input data based on the unique sample identifiers used as rownames. Column "Conditions" with information about the sample conditions (e.g. "N" and "T" or "Normal" and "Tumor"), can be used for feature filtering and colour coding in the PCA. Column "AnalyticalReplicate" including numerical values, defines technical repetitions of measurements, which will be summarised. Column "BiologicalReplicates" including numerical values. Please use the following names: "Conditions", "Biological_Replicates", "Analytical_Replicates".\strong{Default = NULL}} } \value{ List with two elements: Plot and Plot_Sized diff --git a/man/VizSuperplot.Rd b/man/VizSuperplot.Rd index 944b6f9a..c0ec95f5 100644 --- a/man/VizSuperplot.Rd +++ b/man/VizSuperplot.Rd @@ -68,8 +68,10 @@ This script allows you to perform different visualizations (bar, box, violin plo Bar, Box or Violin plot in Superplot style visualization } \examples{ -Intra <- ToyData("IntraCells_Raw")[,c(1:6)] -Res <- VizSuperplot(InputData=Intra[,-c(1:3)], SettingsFile_Sample=Intra[,c(1:3)], SettingsInfo = c(Conditions="Conditions", Superplot = NULL)) +Intra <- ToyData("IntraCells_Raw")[, c(1:6)] +Res <- VizSuperplot(InputData = Intra[, -c(1:3)], + SettingsFile_Sample = Intra[, c(1:3)], + SettingsInfo = c(Conditions = "Conditions", Superplot = NULL)) } \keyword{Barplot,} diff --git a/man/VizVolcano.Rd b/man/VizVolcano.Rd index f0832d71..5130f766 100644 --- a/man/VizVolcano.Rd +++ b/man/VizVolcano.Rd @@ -86,8 +86,8 @@ This script allows you to perform different data visualizations using the result Volcano plot visualization } \examples{ -Intra <- MetaProViz::ToyData("IntraCells_DMA") -Res <- MetaProViz::VizVolcano(InputData=Intra) +Intra <- ToyData("IntraCells_DMA") +Res <- VizVolcano(InputData=Intra) } \keyword{Volcano} diff --git a/vignettes/Standard Metabolomics.Rmd b/vignettes/Standard Metabolomics.Rmd index 92759cd0..d7de862a 100644 --- a/vignettes/Standard Metabolomics.Rmd +++ b/vignettes/Standard Metabolomics.Rmd @@ -317,7 +317,7 @@ Shapiro <- DMA_Annova[["ShapiroTest"]][["DF"]][["Shapiro_result"]] ```
-```{r, warning=FALSE, echo=FALSE, fig.width=7, fig.height=5, fig.align="left"} +```{r dma_anova, warning=FALSE, echo=FALSE, fig.width=7, fig.height=5, fig.align="left"} # Perform multiple comparison All_vs_One using annova: DMA_Annova <- MetaProViz::DMA(InputData=Intra_Preprocessed[,-c(1:3)], #we need to remove columns that do not include metabolite measurements SettingsFile_Sample=Intra_Preprocessed[,c(1:3)],#only maintain the information about condition and replicates