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