Skip to content

Commit a8d5670

Browse files
committed
Roll app
1 parent 61bee13 commit a8d5670

17 files changed

+1933
-2
lines changed

.Rbuildignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
^.*\.Rproj$
2+
^\.Rproj\.user$
Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
on:
2+
push:
3+
branches: [main, master]
4+
release:
5+
types: [published]
6+
workflow_dispatch: {}
7+
8+
name: demo-r-shinylive-app
9+
10+
jobs:
11+
demo-r-shinylive-app:
12+
runs-on: ubuntu-latest
13+
# Only restrict concurrency for non-PR jobs
14+
concurrency:
15+
group: r-shinylive-website-${{ github.event_name != 'pull_request' || github.run_id }}
16+
# Describe the permissions for obtain repository contents and
17+
# deploying a GitHub pages website for the repository
18+
permissions:
19+
contents: read
20+
pages: write
21+
id-token: write
22+
steps:
23+
# Obtain the contents of the repository
24+
- name: "Check out repository"
25+
uses: actions/checkout@v4
26+
27+
# Install R on the GitHub Actions worker
28+
- name: "Setup R"
29+
uses: r-lib/actions/setup-r@v2
30+
31+
# Install and pin the shinylive R package dependency
32+
- name: "Setup R dependency for Shinylive App export"
33+
uses: r-lib/actions/setup-r-dependencies@v2
34+
with:
35+
packages:
36+
cran::shinylive,
37+
local::.
38+
39+
# Export the current working directory as the shiny app
40+
# using the pinned version of the Shinylive R package
41+
- name: Create Shinylive App from working directory files
42+
shell: Rscript {0}
43+
run: |
44+
shinylive::export(".", "_site")
45+
46+
# Upload a tar file that will work with GitHub Pages
47+
# Make sure to set a retention day to avoid running into a cap
48+
# This artifact shouldn't be required after deployment onto pages was a success.
49+
- name: Upload Pages artifact
50+
uses: actions/upload-pages-artifact@v2
51+
with:
52+
retention-days: 1
53+
54+
# Use an Action deploy to push the artifact onto GitHub Pages
55+
# This requires the `Action` tab being structured to allow for deployment
56+
# instead of using `docs/` or the `gh-pages` branch of the repository
57+
- name: Deploy to GitHub Pages
58+
id: deployment
59+
uses: actions/deploy-pages@v2

.gitignore

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
.Rproj.user
2+
.Rhistory
3+
.RData
4+
.Ruserdata
5+
.DS_Store

DESCRIPTION

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
Package: numericaloptimization
2+
Title: Numerical Optimization Explorer
3+
Version: 0.0.0.9000
4+
Authors@R:
5+
person("James Joseph", "Balamuta", email = "[email protected]",
6+
role = c("aut", "cre", "cph"),
7+
comment = c(ORCID = "0000-0003-2826-8458"))
8+
Description: A Shiny application for exploring numerical optimization techniques.
9+
URL: https://github.com/coatless-shiny/numerical-optimization, https://shiny.thecoatlessprofessor.com/numerical-optimization/
10+
BugReports: https://github.com/coatless-shiny/numerical-optimization/issues
11+
License: AGPL (>= 3)
12+
Encoding: UTF-8
13+
Roxygen: list(markdown = TRUE)
14+
RoxygenNote: 7.3.2
15+
Imports:
16+
shiny,
17+
plotly,
18+
bslib,
19+
bsicons
20+
Depends:
21+
R (>= 4.3.0)
22+
LazyData: true

R/modules/landscape-analysis.R

Lines changed: 228 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,228 @@
1+
# UI for the landscape analysis module ----
2+
landscapeAnalysisUI <- function(id) {
3+
ns <- NS(id)
4+
5+
## Sidebar layout ----
6+
layout_sidebar(
7+
sidebar = sidebar(
8+
title = "Analysis Settings",
9+
10+
### Function Selection ----
11+
selectInput(ns("func"), "Test Function", choices = TEST_FUNCTIONS),
12+
13+
### Analysis Type ----
14+
radioButtons(
15+
ns("analysis_type"),
16+
"Analysis Type",
17+
choices = c(
18+
"Contour Plot" = "contour",
19+
"3D Surface" = "surface",
20+
"Gradient Field" = "gradient"
21+
)
22+
),
23+
24+
### Gradient Field specific settings ----
25+
conditionalPanel(
26+
condition = sprintf("input['%s'] == 'gradient'", ns("analysis_type")),
27+
checkboxInput(ns("show_contours"), "Show Contour Lines", value = TRUE)
28+
),
29+
30+
### Resolution Settings ----
31+
sliderInput(
32+
ns("grid_size"),
33+
"Grid Resolution",
34+
min = GRID_RESOLUTION_RANGE[1],
35+
max = GRID_RESOLUTION_RANGE[2],
36+
value = DEFAULT_GRID_SIZE
37+
),
38+
39+
### Run Button ----
40+
actionButton(
41+
ns("analyze"),
42+
"Generate Analysis",
43+
class = "btn-lg btn-primary w-100",
44+
icon = icon("calculator")
45+
)
46+
),
47+
48+
## Main content ----
49+
layout_column_wrap(
50+
width = 1,
51+
### Plot card ----
52+
card(
53+
full_screen = TRUE,
54+
card_header(
55+
class = "bg-primary",
56+
span(class = "text-white", "Function Landscape")
57+
),
58+
card_body(
59+
height = "600px",
60+
conditionalPanel(
61+
condition = sprintf("!output['%s']", ns("hasAnalysis")),
62+
div(
63+
class = "text-center text-muted p-4",
64+
"Click 'Generate Analysis' to visualize the function landscape"
65+
)
66+
),
67+
plotlyOutput(ns("landscapePlot"), height = "100%")
68+
)
69+
),
70+
71+
### Function information section ----
72+
card(
73+
full_screen = TRUE,
74+
card_header(
75+
class = "bg-primary",
76+
span(class = "text-white", "Function Information")
77+
),
78+
card_body(
79+
# Formula section
80+
div(
81+
class = "mb-4",
82+
h4("Mathematical Formula", class = "mb-3"),
83+
div(
84+
class = "p-3 rounded",
85+
style = "min-height: 100px; overflow-x: auto;",
86+
withMathJax(),
87+
uiOutput(ns("formulaDisplay"))
88+
)
89+
),
90+
91+
#### Function Properties section ----
92+
div(
93+
class = "mb-4",
94+
h4("Properties", class = "mb-3"),
95+
div(
96+
class = "row g-3",
97+
div(
98+
class = "col-md-4",
99+
div(
100+
class = "p-3 border rounded h-100",
101+
div(class = "d-flex align-items-center mb-2",
102+
bsicons::bs_icon("arrows-angle-expand", class = "me-2"),
103+
span("Domain", class = "fw-bold")
104+
),
105+
textOutput(ns("domainValue"))
106+
)
107+
),
108+
div(
109+
class = "col-md-4",
110+
div(
111+
class = "p-3 border rounded h-100",
112+
div(class = "d-flex align-items-center mb-2",
113+
bsicons::bs_icon("bullseye", class = "me-2"),
114+
span("Global Minimum", class = "fw-bold")
115+
),
116+
textOutput(ns("minimumValue"))
117+
)
118+
),
119+
div(
120+
class = "col-md-4",
121+
div(
122+
class = "p-3 border rounded h-100",
123+
div(class = "d-flex align-items-center mb-2",
124+
bsicons::bs_icon("geo-alt", class = "me-2"),
125+
span("Minimum Location", class = "fw-bold")
126+
),
127+
textOutput(ns("minimumLocation"))
128+
)
129+
)
130+
)
131+
)
132+
133+
)
134+
)
135+
)
136+
)
137+
}
138+
139+
# Server logic for the landscape analysis module ----
140+
landscapeAnalysisServer <- function(id) {
141+
moduleServer(id, function(input, output, session) {
142+
# Store current function info in a reactive
143+
current_function <- reactive({ get_function_info(input$func) })
144+
145+
# Reactive value to track if analysis exists
146+
has_analysis <- reactiveVal(FALSE)
147+
148+
# Expose has_analysis to UI
149+
output$hasAnalysis <- reactive({
150+
has_analysis()
151+
})
152+
outputOptions(output, "hasAnalysis", suspendWhenHidden = FALSE)
153+
154+
# Render the LaTeX formula
155+
output$formulaDisplay <- renderUI({
156+
req(current_function())
157+
158+
withMathJax(
159+
sprintf(
160+
"$$%s$$",
161+
current_function()$latex %||% "\\text{Formula not available}"
162+
)
163+
)
164+
})
165+
166+
# Render domain value
167+
output$domainValue <- renderText({
168+
req(current_function())
169+
func <- current_function()
170+
sprintf("[%g, %g]", func$domain[1], func$domain[2])
171+
})
172+
173+
# Render minimum value
174+
output$minimumValue <- renderText({
175+
req(current_function())
176+
sprintf("%g", current_function()$minimum)
177+
})
178+
179+
# Render minimum location
180+
output$minimumLocation <- renderText({
181+
req(current_function())
182+
func <- current_function()
183+
if(length(func$minimum_at) <= 6) {
184+
sprintf("(%s)", paste(sprintf("%g", func$minimum_at), collapse = ", "))
185+
} else {
186+
"x* = 0 (all dims)"
187+
}
188+
})
189+
190+
# Render function description
191+
output$functionDescription <- renderText({
192+
req(current_function())
193+
current_function()$description
194+
})
195+
196+
# Clear plot and reset has_analysis when function or analysis type changes
197+
observeEvent(c(input$func, input$analysis_type), {
198+
has_analysis(FALSE)
199+
output$landscapePlot <- renderPlotly({
200+
plot_ly() %>%
201+
layout(
202+
xaxis = list(visible = FALSE),
203+
yaxis = list(visible = FALSE),
204+
paper_bgcolor = "rgba(0,0,0,0)",
205+
plot_bgcolor = "rgba(0,0,0,0)"
206+
)
207+
})
208+
})
209+
210+
# Generate landscape plot only when analyze button is clicked
211+
observeEvent(input$analyze, {
212+
req(input$analysis_type, current_function())
213+
214+
withProgress(message = 'Generating analysis', value = 0, {
215+
output$landscapePlot <- renderPlotly({
216+
plot <- create_landscape_plot(
217+
current_function(),
218+
input$analysis_type,
219+
input$grid_size,
220+
input$show_contours
221+
)
222+
has_analysis(TRUE)
223+
plot
224+
})
225+
})
226+
})
227+
})
228+
}

0 commit comments

Comments
 (0)