Skip to content

Commit 78d0ebc

Browse files
SumedhSankheSumedhSankhe
authored
Merge pull request #3 from SumedhSankhe/update-app
use mtcars dataset with some nice tabs
2 parents 80fd6ad + 629f51e commit 78d0ebc

1 file changed

Lines changed: 168 additions & 75 deletions

File tree

‎app.R‎

Lines changed: 168 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -1,105 +1,198 @@
11
## Example Shiny Application for Docker Optimization Demo
2-
## Simple proteomics QC dashboard to demonstrate containerization
2+
## Interactive mtcars dataset explorer to demonstrate containerization
33

44
library(shiny)
55
library(ggplot2)
66
library(dplyr)
77
library(DT)
88

9-
# Simulate proteomics QC data
10-
generate_qc_data <- function(n_samples = 50) {
11-
data.frame(
12-
sample_id = paste0("S", 1:n_samples),
13-
protein_count = rnorm(n_samples, mean = 5000, sd = 500),
14-
cv = rnorm(n_samples, mean = 15, sd = 3),
15-
missing_values = rbinom(n_samples, size = 100, prob = 0.05),
16-
stringsAsFactors = FALSE
17-
)
18-
}
9+
# Load mtcars dataset and add car names as a column
10+
cars_data <- mtcars %>%
11+
mutate(car_name = rownames(mtcars)) %>%
12+
select(car_name, everything())
1913

2014
ui <- fluidPage(
21-
titlePanel("Proteomics QC Dashboard - Docker Demo"),
22-
15+
titlePanel("Motor Trend Cars Dashboard - Docker Demo"),
16+
2317
sidebarLayout(
2418
sidebarPanel(
25-
sliderInput("n_samples",
26-
"Number of Samples:",
27-
min = 10,
28-
max = 100,
29-
value = 50),
30-
31-
numericInput("cv_threshold",
32-
"CV Threshold (%):",
33-
value = 20,
34-
min = 5,
35-
max = 50),
36-
37-
actionButton("refresh", "Refresh Data", class = "btn-primary")
19+
selectInput("x_var",
20+
"X-axis Variable:",
21+
choices = c("Weight (1000 lbs)" = "wt",
22+
"Horsepower" = "hp",
23+
"Displacement" = "disp",
24+
"1/4 Mile Time" = "qsec"),
25+
selected = "wt"),
26+
27+
selectInput("y_var",
28+
"Y-axis Variable:",
29+
choices = c("MPG" = "mpg",
30+
"Horsepower" = "hp",
31+
"Displacement" = "disp",
32+
"1/4 Mile Time" = "qsec"),
33+
selected = "mpg"),
34+
35+
selectInput("color_var",
36+
"Color By:",
37+
choices = c("Cylinders" = "cyl",
38+
"Transmission" = "am",
39+
"Engine Type" = "vs",
40+
"Gears" = "gear"),
41+
selected = "cyl"),
42+
43+
sliderInput("mpg_filter",
44+
"Minimum MPG:",
45+
min = 10,
46+
max = 35,
47+
value = 10,
48+
step = 1),
49+
50+
hr(),
51+
h4("Dataset Info"),
52+
p("The mtcars dataset comprises fuel consumption and 10 aspects of automobile design and performance for 32 automobiles (1973-74 models)."),
53+
p(strong("Total cars:"), nrow(cars_data))
3854
),
39-
55+
4056
mainPanel(
4157
tabsetPanel(
42-
tabPanel("Summary",
43-
h3("Quality Control Metrics"),
44-
plotOutput("protein_dist"),
45-
plotOutput("cv_plot")
58+
tabPanel("Scatter Plot",
59+
h3("Relationship Explorer"),
60+
plotOutput("scatter_plot", height = "500px"),
61+
hr(),
62+
h4("Summary Statistics"),
63+
verbatimTextOutput("summary_stats")
64+
),
65+
66+
tabPanel("Distribution",
67+
h3("MPG Distribution"),
68+
plotOutput("mpg_dist", height = "400px"),
69+
h3("Horsepower vs Cylinders"),
70+
plotOutput("hp_by_cyl", height = "400px")
4671
),
47-
72+
4873
tabPanel("Data Table",
49-
DTOutput("qc_table")
74+
h3("Full Dataset"),
75+
DTOutput("cars_table")
5076
)
5177
)
5278
)
5379
)
5480
)
5581

5682
server <- function(input, output, session) {
57-
58-
# Reactive data generation
59-
qc_data <- eventReactive(input$refresh, {
60-
generate_qc_data(input$n_samples)
61-
}, ignoreNULL = FALSE)
62-
63-
# Protein count distribution
64-
output$protein_dist <- renderPlot({
65-
data <- qc_data()
66-
67-
ggplot(data, aes(x = protein_count)) +
68-
geom_histogram(bins = 30, fill = "#2563eb", alpha = 0.7) +
69-
labs(title = "Protein Count Distribution",
70-
x = "Proteins Identified",
71-
y = "Frequency") +
72-
theme_minimal()
83+
84+
# Reactive filtered data
85+
filtered_data <- reactive({
86+
cars_data %>%
87+
filter(mpg >= input$mpg_filter)
88+
})
89+
90+
# Scatter plot
91+
output$scatter_plot <- renderPlot({
92+
data <- filtered_data()
93+
94+
# Convert color variable to factor for better legend
95+
data[[input$color_var]] <- as.factor(data[[input$color_var]])
96+
97+
ggplot(data, aes_string(x = input$x_var, y = input$y_var, color = input$color_var)) +
98+
geom_point(size = 4, alpha = 0.7) +
99+
geom_smooth(method = "lm", se = TRUE, alpha = 0.2) +
100+
scale_color_brewer(palette = "Set1") +
101+
labs(title = paste(input$y_var, "vs", input$x_var),
102+
x = names(which(c("wt" = "Weight (1000 lbs)",
103+
"hp" = "Horsepower",
104+
"disp" = "Displacement (cu.in.)",
105+
"qsec" = "1/4 Mile Time (sec)") == input$x_var)),
106+
y = names(which(c("mpg" = "Miles Per Gallon",
107+
"hp" = "Horsepower",
108+
"disp" = "Displacement (cu.in.)",
109+
"qsec" = "1/4 Mile Time (sec)") == input$y_var)),
110+
color = names(which(c("cyl" = "Cylinders",
111+
"am" = "Transmission",
112+
"vs" = "Engine",
113+
"gear" = "Gears") == input$color_var))) +
114+
theme_minimal(base_size = 14) +
115+
theme(legend.position = "right")
73116
})
74-
75-
# CV plot with threshold
76-
output$cv_plot <- renderPlot({
77-
data <- qc_data()
78-
79-
ggplot(data, aes(x = sample_id, y = cv)) +
80-
geom_point(aes(color = cv > input$cv_threshold), size = 3) +
81-
geom_hline(yintercept = input$cv_threshold,
82-
linetype = "dashed",
83-
color = "red") +
84-
scale_color_manual(values = c("TRUE" = "red", "FALSE" = "#2563eb"),
85-
labels = c("Pass", "Fail"),
86-
name = "QC Status") +
87-
labs(title = "Coefficient of Variation by Sample",
88-
x = "Sample ID",
89-
y = "CV (%)") +
90-
theme_minimal() +
91-
theme(axis.text.x = element_blank())
117+
118+
# Summary statistics
119+
output$summary_stats <- renderPrint({
120+
data <- filtered_data()
121+
cat("Filtered Data Summary\n")
122+
cat("=====================\n\n")
123+
cat("Cars displayed:", nrow(data), "\n\n")
124+
cat("MPG Statistics:\n")
125+
cat(" Mean:", round(mean(data$mpg), 2), "\n")
126+
cat(" Median:", round(median(data$mpg), 2), "\n")
127+
cat(" Range:", round(min(data$mpg), 2), "-", round(max(data$mpg), 2), "\n\n")
128+
cat("Horsepower Statistics:\n")
129+
cat(" Mean:", round(mean(data$hp), 2), "\n")
130+
cat(" Median:", round(median(data$hp), 2), "\n")
131+
cat(" Range:", round(min(data$hp), 2), "-", round(max(data$hp), 2), "\n")
132+
})
133+
134+
# MPG distribution
135+
output$mpg_dist <- renderPlot({
136+
data <- filtered_data()
137+
138+
ggplot(data, aes(x = mpg)) +
139+
geom_histogram(bins = 15, fill = "#2563eb", alpha = 0.7, color = "white") +
140+
geom_vline(aes(xintercept = mean(mpg)),
141+
color = "red", linetype = "dashed", size = 1) +
142+
labs(title = "Miles Per Gallon Distribution",
143+
subtitle = paste("Mean:", round(mean(data$mpg), 2), "MPG"),
144+
x = "Miles Per Gallon",
145+
y = "Count") +
146+
theme_minimal(base_size = 14)
92147
})
93-
148+
149+
# HP by cylinders
150+
output$hp_by_cyl <- renderPlot({
151+
data <- filtered_data()
152+
153+
ggplot(data, aes(x = as.factor(cyl), y = hp, fill = as.factor(cyl))) +
154+
geom_boxplot(alpha = 0.7) +
155+
geom_jitter(width = 0.2, alpha = 0.5, size = 2) +
156+
scale_fill_brewer(palette = "Set2") +
157+
labs(title = "Horsepower by Number of Cylinders",
158+
x = "Number of Cylinders",
159+
y = "Horsepower",
160+
fill = "Cylinders") +
161+
theme_minimal(base_size = 14)
162+
})
163+
94164
# Data table
95-
output$qc_table <- renderDT({
96-
data <- qc_data() %>%
97-
mutate(qc_status = ifelse(cv > input$cv_threshold, "Fail", "Pass"))
98-
99-
datatable(data,
100-
options = list(pageLength = 10),
101-
rownames = FALSE)
165+
output$cars_table <- renderDT({
166+
data <- filtered_data() %>%
167+
mutate(
168+
am = ifelse(am == 0, "Automatic", "Manual"),
169+
vs = ifelse(vs == 0, "V-shaped", "Straight")
170+
) %>%
171+
rename(
172+
Car = car_name,
173+
MPG = mpg,
174+
Cylinders = cyl,
175+
Displacement = disp,
176+
Horsepower = hp,
177+
`Rear Axle Ratio` = drat,
178+
`Weight (1000lbs)` = wt,
179+
`1/4 Mile Time` = qsec,
180+
Engine = vs,
181+
Transmission = am,
182+
Gears = gear,
183+
Carburetors = carb
184+
)
185+
186+
datatable(data,
187+
options = list(
188+
pageLength = 15,
189+
scrollX = TRUE,
190+
dom = 'Bfrtip'
191+
),
192+
rownames = FALSE,
193+
filter = 'top')
102194
})
103195
}
104196

105197
shinyApp(ui = ui, server = server)
198+
# Test comment 1766040179

0 commit comments

Comments
 (0)