-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathapp.R
5060 lines (3886 loc) · 197 KB
/
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
# --------------------------------------------------------------
# Shiny Web Application for Soil Security: Connectivity Evaluation Tool
# --------------------------------------------------------------
#
# Purpose: This Shiny self-evaluation tool uses quantifies the connectivity dimension of the Soil Security Assessment Framework.
# Author(s): Julio C. Pachón Maldonado (julio.pachon@sydney.edu.au), Emma Leonard, Damien Field, Katie McRobert, Richard Heath, Alex McBratney
# Funding: This research was supported by the Australian Research Council Laureate Fellowship (FL210100054) on Soil Security, titled A Calculable Approach to Securing Australia’s Soils.
# License: Creative Commons Attribution 4.0 International License (CC BY 4.0)
#
# Usage:
# - This application supports an offline mode, using a local SQLite database if no SQL server is available.
# - To toggle between offline and online modes, adjust the `mode` variable in the configuration section below.
# - In offline mode, data is stored locally in `TestDatabase.sqlite`, which is generated in the project directory.
#
# Files Required:
# - 202308_SS_Connectivity_EvalTool_StrataInfo2.csv: CSV file that is used to centre the map on page 2 based on the postal code provided in page 1.
# - www holds the FAQ page and images.
#
# Notes:
# - To ensure reproducibility, dependencies are managed via `renv`. Run `renv::restore()` to replicate the required environment.
# - For Docker usage, build and run the container as per instructions in the README file.
#
# --------------------------------------------------------------
library(shiny)
library(vroom)
library(leaflet)
library(RMariaDB)
library(DBI)
library(RMySQL)
library(shinyjs)
library(RSQLite) #only needed for creating a local SQL database
dbtable <- "Evaltool_data" #name of the table with raw inputs in the SQL database
dbtable2<- "EvalTool_Score" #name of the table with quantified inputs in the SQL database
mode="offline" #comment out or erase this line if SQL database is available
sqlite_path <- "./TestDatabase.sqlite"
# Creates an SQLite database if the mode is offline
if (mode == "offline") {
conn <- dbConnect(RSQLite::SQLite(), sqlite_path)
# Create the Evaltool_data table with all required columns
if (!dbExistsTable(conn, dbtable)) {
dbExecute(conn, "
CREATE TABLE Evaltool_data (
session_token TEXT PRIMARY KEY,
start_time TEXT,
Role_Q TEXT,
other_role TEXT,
Farm_Enterprises TEXT,
other_Farm_Enterprises TEXT,
Perceived_Threats TEXT,
other_Perceived_Threats TEXT,
Number_soil_types TEXT,
Main_Soil_Type TEXT,
postal_code TEXT,
town_select TEXT,
lat REAL,
lon REAL,
E_K REAL,
E_Ac REAL,
E_At REAL,
Legislated_erosion TEXT,
A_K REAL,
A_Ac REAL,
A_At REAL,
A_pH REAL,
SD_K REAL,
SD_Ac REAL,
SD_At REAL,
SD_Val REAL,
other_SD_Val TEXT,
S_K REAL,
S_Ac REAL,
S_At REAL,
S_Val REAL,
HL_K REAL,
HL_Ac REAL,
HL_At REAL,
HL_Val REAL,
other_HL_Val TEXT,
HL_Val2 REAL,
other_HL_Val2 TEXT,
NM_K REAL,
NM_Ac REAL,
NM_At REAL,
NM_Val REAL,
NM_Val2 REAL,
SW_K REAL,
SW_Ac REAL,
SW_At REAL,
SW_Val REAL,
SW_Val2 REAL,
DC_K REAL,
DC_Ac REAL,
DC_At REAL,
DC_Val REAL,
other_DC_Val TEXT,
DC_Val2 REAL,
Threat_Val_E REAL,
Threat_Val_E_comment TEXT,
Threat_Val_A REAL,
Threat_Val_A_comment TEXT,
Threat_Val_SD REAL,
Threat_Val_SD_comment TEXT,
Threat_Val_DC REAL,
Threat_Val_DC_comment TEXT,
Threat_Val_S REAL,
Threat_Val_S_comment TEXT,
Threat_Val_HL REAL,
Threat_Val_HL_comment TEXT,
End_time TEXT,
Submission_time TEXT,
Age REAL,
education_level TEXT,
Land_type TEXT,
other_land_type TEXT,
Land_area REAL,
Word_Familiarity TEXT,
Val_DC_comment TEXT
)
")
}
# Create the EvalTool_Score table with all required columns
if (!dbExistsTable(conn, dbtable2)) {
dbExecute(conn, "
CREATE TABLE EvalTool_Score (
session_token TEXT PRIMARY KEY,
start_time TEXT,
E_K_score_num REAL,
E_Ac_score_num REAL,
E_At_score_num REAL,
E_total_score_num REAL,
A_K_score_num REAL,
A_Ac_score_num REAL,
A_At_score_num REAL,
A_total_score_num REAL,
SD_K_score_num REAL,
SD_Ac_score_num REAL,
SD_At_score_num REAL,
SD_total_score_num REAL,
S_K_score_num REAL,
S_Ac_score_num REAL,
S_At_score_num REAL,
S_total_score_num REAL,
HL_K_score_num REAL,
HL_Ac_score_num REAL,
HL_At_score_num REAL,
HL_total_score_num REAL,
NM_K_score_num REAL,
NM_Ac_score_num REAL,
NM_At_score_num REAL,
NM_total_score_num REAL,
SW_K_score_num REAL,
SW_Ac_score_num REAL,
SW_At_score_num REAL,
SW_total_score_num REAL,
DC_K_score_num REAL,
DC_Ac_score_num REAL,
DC_At_score_num REAL,
DC_total_score_num REAL
)
")
}
dbDisconnect(conn)
}
# make a progress bar
progressBar <- function(id,
value,
total = NULL,
display_pct = FALSE,
size = NULL,
status = NULL,
striped = FALSE,
title = NULL,
range_value = NULL,
commas = TRUE,
unit_mark = "%") {
if (!is.null(total)) {
percent <- round(value / total * 100)
} else {
value <- round(value)
if (!is.null(range_value)) {
percent <- rescale(x = value, from = range_value, to = c(0, 100))
} else {
percent <- value
}
}
if (!is.null(title) | !is.null(total)) {
title <- tags$span(
class = "progress-text",
id = paste0(id, "-title"),
title, HTML(" ")
)
}
value_for_display <- value
total_for_display <- total
if (!is.null(total)) {
total <- tags$span(
class = "progress-number",
tags$b(value_for_display, id = paste0(id, "-value")),
"/",
tags$span(id = paste0(id, "-total"), total_for_display)
)
}
tagPB <- tags$div(
class = "progress-group",
title, total,
tags$div(
class = "progress",
class = if (!is.null(size)) paste0("progress-", size),
tags$div(
id = id,
style = if (percent > 0) paste0("width:", percent, "%;"),
style = if (display_pct) "min-width: 2em;",
class = "progress-bar",
class = if (!is.null(status)) paste0("progress-bar-", status),
class = if (!is.null(status)) paste0("bg-", status),
class = if (striped) "progress-bar-striped",
role = "progressbar",
if (display_pct) paste0(percent, unit_mark)
)
)
)
tagPB <- tagList(
singleton(
tags$head(tags$style(".progress-number {position: absolute; right: 40px;}"))
), tagPB
)
}
# Supporting functions to interact with SQL database
saveData0 <- function(data, data2) {
# Establish a database connection based on the selected mode
if (mode == "offline") {
db <- dbConnect(RSQLite::SQLite(), sqlite_path)
} else {
readRenviron("~/.Renviron")
db_config <- list(
"host" = Sys.getenv("MYSQL_HOST"),
"port" = as.numeric(Sys.getenv("MYSQL_PORT")),
"user" = Sys.getenv("MYSQL_USER"),
"password" = Sys.getenv("MYSQL_PASSWORD"),
"dbname" = Sys.getenv("MYSQL_DBNAME")
)
db <- dbConnect(RMySQL::MySQL(), host = db_config$host, port = db_config$port,
user = db_config$user, password = db_config$password,
dbname = db_config$dbname)
}
# Check if session_token with specific data exists
session_token <- data[1, 1]
check_query <- sprintf("SELECT COUNT(*) FROM %s WHERE session_token = '%s'",
dbtable, session_token)
existing_count <- dbGetQuery(db, check_query)$'COUNT(*)'
if (existing_count == 0) {
query <- sprintf(
"INSERT INTO %s (%s) VALUES ('%s')",
dbtable,
paste(names(data), collapse = ", "),
paste(data, collapse = "', '")
)
dbGetQuery(db, query)
query <- sprintf(
"INSERT INTO %s (%s) VALUES ('%s')",
dbtable2,
paste(names(data2), collapse = ", "),
paste(data2, collapse = "', '")
)
dbGetQuery(db, query)
}
else {
return()
}
dbDisconnect(db)
}
saveData1 <- function(data = NULL, data2 = NULL) {
if (mode == "offline") {
db <- dbConnect(RSQLite::SQLite(), sqlite_path)
} else {
readRenviron("~/.Renviron")
db_config <- list(
"host" = Sys.getenv("MYSQL_HOST"),
"port" = as.numeric(Sys.getenv("MYSQL_PORT")),
"user" = Sys.getenv("MYSQL_USER"),
"password" = Sys.getenv("MYSQL_PASSWORD"),
"dbname" = Sys.getenv("MYSQL_DBNAME")
)
db <- dbConnect(RMySQL::MySQL(), host = db_config$host, port = db_config$port,
user = db_config$user, password = db_config$password,
dbname = db_config$dbname)
}
if (!is.null(data) && nrow(data) > 0 && !is.null(dbtable)) {
query <- sprintf(
"UPDATE %s SET %s WHERE session_token = '%s'",
dbtable,
paste(paste0(names(data)[-1], " = '", data[,-1], "'"), collapse = ", "),
data$session_token
)
dbGetQuery(db, query)
}
if (!is.null(data2) && nrow(data2) > 0 && !is.null(dbtable2)) {
query <- sprintf(
"UPDATE %s SET %s WHERE session_token = '%s'",
dbtable2,
paste(paste0(names(data2)[-1], " = '", data2[,-1], "'"), collapse = ", "),
data2$session_token
)
dbGetQuery(db, query)
}
dbDisconnect(db)
}
return_results_data <- function(session_token, table_input) {
if (mode == "offline") {
db <- dbConnect(RSQLite::SQLite(), sqlite_path)
} else {
readRenviron("~/.Renviron")
db_config <- list(
"host" = Sys.getenv("MYSQL_HOST"),
"port" = as.numeric(Sys.getenv("MYSQL_PORT")),
"user" = Sys.getenv("MYSQL_USER"),
"password" = Sys.getenv("MYSQL_PASSWORD"),
"dbname" = Sys.getenv("MYSQL_DBNAME")
)
db <- dbConnect(RMySQL::MySQL(), host = db_config$host, port = db_config$port,
user = db_config$user, password = db_config$password,
dbname = db_config$dbname)
}
query <- sprintf("SELECT * FROM %s WHERE session_token = '%s'", table_input, session_token)
data <- dbGetQuery(db, query)
dbDisconnect(db)
return(data)
}
# textInput2: Custom text input with validation to limit SQL injection risk by restricting input format and length
textInput2 <- function(inputId, label, value = "", width = NULL,
placeholder = NULL, maxlength = 350) {
# Regular expression pattern to allow only letters, hyphens, and spaces up to maxlength
regex_pattern <- paste0("^[a-zA-Z''\\-\\s]{1,", maxlength, "}$")
tag <- shiny::textInput(
inputId = inputId,
label = label,
value = value,
width = width,
placeholder = placeholder
)
tag <- shiny::div(
tag,
`data-regex` = regex_pattern
)
tag <- htmltools::tagQuery(tag)$
children("input")$
addAttrs(pattern = regex_pattern)$
allTags()
tag
}
digitize <- function(x) {
suppressWarnings(!is.na(as.numeric(x)))
}
# Sanitize: Cleans user text input by removing problematic characters (like quotes) to prevent SQL injection
Sanitize <- function(text) {
if (is.null(text) || text == "") {
return("No answer")
}
text <- tolower(text)
text <- gsub("'", '', text)
text <- gsub("-", ' ', text)
return(text)
}
start_time_reactive <- reactiveVal()
Strata_info <- vroom::vroom("./202308_SS_Connectivity_EvalTool_StrataInfo2.csv",
col_types = cols(POA_CODE21 = col_character()))
start_time <- Sys.time()
#Defining UI Modules####
# page0_content: Intro page
page0_content <- function(id) {
tagList(
tags$a(name = "top"),
# JavaScript functions to trigger navigation and FAQ modal actions
tags$head(
tags$script("
function navigateToPage() {
Shiny.setInputValue('navigate_to_page', true);
}
function showFAQModal() {
// Directly trigger the FAQ modal here
Shiny.setInputValue('show_faq_modal', true, {priority: 'event'});
}
")
),
h2("How connected are you to your soil?", style = "color: #e04b2f;"),
h4("Please give us 15 minutes of your valuable time – it could change how you think about and manage a very precious asset – your ",
HTML("<u>soil.</u>")),
br(),
div(
HTML('<center><img src="Soil connection report graphic.png" width="200"></center>', )
),
br(),
div(
p("We are undertaking groundbreaking research that aims to provide a way to measure the human influence on soil security. By completing this evaluation, your insights will help the Australian Farm Institute and University of Sydney researchers uncover the complex relationships between farmers, farming practices, and soil security."),
p("The evaluation is entirely confidential, and you will only be required to choose whether or not to pin-point your soil location data if you are comfortable"),
p("After completion, you can access ", HTML("<u>your personalised soil connectivity report</u>"),
" to help you in maintaining and improving your soil quality and its security."),
p(HTML("We appreciate that soil types can vary even within a paddock, let alone across enterprises, so please:<br><br>
• Consider your answers <u>in relation to a particular paddock or area in your farming business</u>, and<br>
• Provide the nearest town and postcode for the location of <u>that</u> area.<br><br>
We will then apply a weighted scoring to produce results appropriate to the field specified.")),
p("Our advanced analytics can differentiate between a farmer that would benefit from greater connectivity to their soil, and one who farms in an environment where there are few management options to minimise soil threats."),
p(HTML("By continuing this evaluation, you have voluntarily agreed to share your <i>anonymised data</i> with the research team.")),
p("Thank you in advance for your participation."),
br(),
p(HTML("<i>Richard Heath - AFI</i>")),
p(HTML("<i>Dr. Julio Pachon Maldonado - University of Sydney</i>")),
p(HTML("<i>Dr. Emma Leonard - AgriKnowHow</i>")),
p(HTML("<i>Professor Alex McBratney - University of Sydney</i>")),
p(HTML("<i>Professor Damien Field - University of Sydney</i>")),
br(),
p("Questions? Check out our ",
HTML("<a href='#' onclick='showFAQModal()' style='text-decoration: underline;'>FAQs</a>."))
),
br(),
div(
class = "d-flex flex-column align-items-center",
h4("Do you manage soil/land as part of a farming business?"),
actionButton("next_page0", "Yes"),
actionButton("Intro_no", "No"),
),
div(
class = "footer",
p("Note: This research is funded (partially or fully) by the Australian Government through the Australian Research Council (ARC). Professor McBratney is the recipient of an ARC Australian Laureate Fellowship (project number FL210100054) funded by the Australian Government.")
),
br(),
br(),
)
}
FAQ_content <- function(id){
tagList(
tags$script(HTML('
function toggleDetails(id) {
var element = document.getElementById(id);
if (element.style.display === "none") {
element.style.display = "block";
} else {
element.style.display = "none";
}
}
')),
h2("Frequently Asked Questions", style = "color: #e04b2f;"),
h4(actionLink("faq_button", "What is this evaluation for?"), onclick = "toggleDetails('FAQ1');"),
p("The purpose of this evaluation is to improve the connectivity of people who manage soil with this important resource to ensure its long-term security. The evaluation also serves to collect information from land managers about their knowledge, attitudes and practices regarding soil security.", id = "FAQ1", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "How will this evaluation benefit me?"), onclick = "toggleDetails('FAQ2');"),
p("If you don’t measure it you cannot manage it, is an old but true adage. This evaluation will provide you with quantified evidence of your connectivity to your soil and how that links to whether you are maintaining or improving the sustainable productivity from your soil. All this information will be provided in a farmer friendly, personalised report. ", id = "FAQ2", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "Who will be able to access my data?"), onclick = "toggleDetails('FAQ3');"),
p("The members of the research team: Richard Heath, Julio Pachon Maldonado, Alex McBratney, Damien Field, Emma Leonard. But dont forget, all data is de-identified and only reported in an aggregated form", id = "FAQ3", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "How will my data be used?"), onclick = "toggleDetails('FAQ4');"),
p("Data will be aggregated regionally and analyzed to find patterns in land manager connection to their soil which will be used by researchers to submit a publication and use as a basis for future work. Your participation is anonymous even to the researchers.", id = "FAQ4", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "Where will my data be stored?"), onclick = "toggleDetails('FAQ5');"),
p("No identifying data is recorded and responses are kept in a secure database managed by AFI. ", id = "FAQ5", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "Why do you need my postcode?"), onclick = "toggleDetails('FAQ6');"),
p("Many farms and farming businesses are spread across multiple locations. We have asked you to answer the evaluation questions in relation to the key soil type associated with this postcode so that we can cross reference your answers to national soil maps. We also need to be able to illustrate the locations across Australia from where data has been contributed to ensure the dataset is robust.",
id = "FAQ6", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "Do you use cookies?"), onclick = "toggleDetails('FAQ7');"),
p(HTML("We use local storage, which is different from cookies, to enhance your experience with our application. Local storage allows us to save certain data directly in your browser. This feature is particularly useful for ensuring that you can complete the evaluation even if there are issues with internet connectivity.<br><br>
Local storage is used to temporarily store your progress in the evaluation tool. This means if your connection is interrupted, or if you close and reopen your browser, you can pick up right where you left off. Unlike cookies, local storage does not involve sending data back to our servers, and it is solely managed by your browser. You do need to use the same device and browser in order to resume the evaluation tool. We prioritize your privacy and security, ensuring that no sensitive personal information is stored in this process."),
id = "FAQ7", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
h4(actionLink("faq_button", "Can I share the evaluation link with other farmers?"), onclick = "toggleDetails('FAQ9');"),
p("Yes, we would be delighted if you would like to share the link with other farmers in your area or further afield in Australia",
id = "FAQ9", style = "display:none; padding: 10px; background-color: #f0f0f0;"),
)}
page1_content <- function(id){
start_time <- Sys.time()
tagList(
tags$a(name = "top"),
tags$style(
HTML("
.leaflet-overlay-pane svg {
-webkit-user-select: none; /* Chrome/Safari */
-moz-user-select: none; /* Firefox */
-ms-user-select: none; /* Internet Explorer/Edge */
user-select: none; /* Non-prefixed version, currently supported by modern browsers */
}
")
),
h2("Tell us about yourself", style = "color: #e04b2f;"),
mainPanel(
progressBar(id = "progress", value = 1/12*100, display_pct = TRUE)
),
mainPanel(
p("After completing this 15-minute evaluation, you can access your personalised report to help you manage your soil security. The evaluation is entirely confidential. Please answer all the questions before moving on to ensure your contribution is represented in building a comprehensive national picture of Australian soil connectivity.")
),
mainPanel(
HTML('<center><img src="Soil connection report graphic.png" width="200"></center>', )
),
radioButtons("Role_Q", "1. What is your role?",
choices = c("Land Manager", "Landowner", "Other"),
selected = character(0)),
conditionalPanel(
condition = "input.Role_Q == 'Other'",
textInput2("other_role", label = "Please specify your role (required):", maxlength = 150),
textOutput('other_role_count')
),
br(),
checkboxGroupInput("Farm_Enterprises", "2. What enterprises do you run? (Multiple selection)",
choices = c("Grain crops",
"Sugar",
"Cotton",
"Dairy",
"Extensive sheep or cattle",
"Feedlot sheep or cattle",
"Free range pork or poultry",
"Horticultural field crops (this refers to potatoes, onions, carrots tomatoes, brassicas, peas, beans etc.)",
"Grapes",
"Orchard – fruit, nuts",
"Other")),
conditionalPanel(
condition = "Array.isArray(input.Farm_Enterprises) && input.Farm_Enterprises.includes('Other')",
textInput2("other_Farm_Enterprises", "Please specify your enterprise(s) (required):", maxlength = 255),
textOutput('other_Farm_Enterprises_count')
),
br(),
checkboxGroupInput("Perceived_Threats", "3. Across your farm(s) do you experience any of these following soil threats? (Multiple selection)",
choices = c("Erosion", "Acidification", "Structural decline (e.g. caused by soil compaction or sodicity)",
"Soil carbon loss", "Salinisation", "Habitat loss/degradation of soil biology", "Other")),
conditionalPanel(
condition = "Array.isArray(input.Perceived_Threats) && input.Perceived_Threats.includes('Other')",
textInput2("other_Perceived_Threats", "Please specify your enterprise(s) (required):", maxlength = 150),
textOutput('other_Perceived_Threats_count')
),
br(),
radioButtons("Number_soil_types", "4. Different soils require different management. How many different types of soils do you manage?",
choices = c("1", "2-3", "4+"),
selected = character(0)),
br(),
tags$h4("Think of one particular soil type you manage. Please keep this particular soil type in mind when answering the remaining questions (which will be referred to as ‘key soil type’ throughout the evaluation)."),
textInput2("Main_Soil_Type", "5. Describe the key soil type you will refer to in this evaluation", width = "100%", maxlength = 350),
textOutput('Main_Soil_Type_count'),
br(),
p("Where is the key soil type"),
numericInput("postal_code", "6. Enter a 4-digit Postal code:", value = NULL, min = 800, max = 9999),
conditionalPanel(
condition = "input.postal_code?.length >= 3 && !($.inArray(input.postal_code, valid_codes) > -1)",
p("Please input valid Postal code")
),
br(),
conditionalPanel(
condition = "input.postal_code != null",
selectInput("town_select", "Select the closest town or city:", choices = NULL),
),
br(),
#conditionalPanel(
# condition = "($('#next_page1').is(':disabled'))",
# p("Please answer all questions. If `Other` is chosen, please specify. Please make sure you enter a valid postal code.", style = "color: red;")
#),
uiOutput("ans_missing1"),
div(
class = "d-flex justify-content-center",
actionButton("next_page1", "Next page", icon = icon("arrow-right"), disable= TRUE),
p("Next page loads a map and can take an extra second, all over pages load quickly.")
),
br(),
br(),
)
}
page2_content <- function(id){
tagList(
tags$a(name = "top"),
h2("Location of my key soil type", style = "color: #e04b2f;"),
mainPanel(
progressBar(id = "progress", value = 2/12*100, display_pct = TRUE)
),
mainPanel(
p("This page loads a map and can take an extra second, all over pages load quickly."),
p("Zoom and ", HTML("<u><b><span style='font-size: 1.2em;'>click</span></b></u>"), " on the location of the key soil type."),
p("This will be used to unravel the complex relationships between farmers, farming practices and soil security. Coordinates are encrypted and locations are aggregated at a regional scale for reporting."),
p("You may choose to advance by clicking 'Next' without giving coordinates.")
),
leafletOutput("map", width = "90%", height = "300px"),
actionButton("clear_coordinates", "Clear Coordinates"),
br(),
br(),
div(
style = "display: flex; justify-content: space-between;",
actionButton("go_back_button", "Go Back", icon = icon("arrow-left")),
actionButton("next_page2", "Next page", icon = icon("arrow-right")),
),
br(),
br(),
)}
page3_content <- function(id){
tagList(
tags$a(name = "top"),
tags$script(
HTML('
$(document).ready(function() {
$(document).on("click", "input[type=checkbox][value=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
$("input[type=checkbox][value!=\'I am familiar with all these concepts.\']").prop("checked", false);
$(this).trigger("change");
}
});
$(document).on("click", "input[type=checkbox][value!=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
$("input[type=checkbox][value=\'I am familiar with all these concepts.\']").prop("checked", false);
$(this).trigger("change");
}
});
});
')
),
h2("Erosion", style = "color: #1760a2;"),
mainPanel(
progressBar(id = "progress", value = 3/12*100, display_pct = TRUE)
),
mainPanel(
br(),
h4(HTML("<strong>Keeping in mind the key soil type you nominated:<strong>")),
br(),
## Erosion Knowledge
checkboxGroupInput("E_K",
HTML(paste0("1. Select all the concepts that are ",
"<strong><em>NEW</em></strong> to you. (Select all that apply)")),
choices = c("Practices that increase soil cover by more than 50% reduce the risk of soil erosion.",
"Wind erosion can be reduced by planting windbreaks at 90 degrees to the prevailing wind.",
"The severity of water erosion is impacted by position in the landscape and can occur below the surface.",
"A shear test is used to measure soil strength, a soil with high shear is less prone to erosion.",
"I am familiar with all these concepts."),
width = "100%"),
br(),
## Action
radioButtons("E_Ac", "2. For your soils, which statement best describes your approach to soil erosion? (Choose only one)",
choices = c("Soil erosion is not considered in my management practices.",
"Practices that maintain soil cover are used when possible.",
"Practices that maintain soil cover are a priority.",
"We combine information on soil chemical and physical characteristics with topography to identify and manage areas prone to soil erosion."),
width = "100%",
selected = character(0)),
br(),
## Attitude
radioButtons("E_At", "3. Which statement best describes your opinion on managing soil erosion? (Choose only one)",
choices = c("Farming practices do not need to be considered in relation to soil erosion.",
"I feel that the expense and complexity of erosion control makes it prohibitive.",
"I aim to use production and environmental practices that minimise erosion.",
"Our topsoil is our most valuable asset, and we must all work to minimise its loss."),
width = "100%",
selected = character(0)),
br(),
textInput2("Legislated_erosion", "4. Are you implementing any management practices to prevent soil erosion because it is legislated by your state or federal government?",
width = "100%", maxlength = 350),
textOutput('Legislated_erosion_count'),
br(),
uiOutput("ans_missing3"),
div(
style = "display: flex; justify-content: space-between;",
actionButton("go_back_button2", "Go Back", icon = icon("arrow-left")),
actionButton("next_page3", "Next page", icon = icon("arrow-right"), disabled = TRUE),
),
br(),
br(),
)
)
}
page4_content <- function(id){
tagList(
tags$a(name = "top"),
tags$script(
HTML('
$(document).ready(function() {
$(document).on("click", "input[type=checkbox][value=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
$("input[type=checkbox][value!=\'I am familiar with all these concepts.\']").prop("checked", false);
$(this).trigger("change");
}
});
$(document).on("click", "input[type=checkbox][value!=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
$("input[type=checkbox][value=\'I am familiar with all these concepts.\']").prop("checked", false);
$(this).trigger("change");
}
});
});')
),
h2("Acidification", style = "color: #e04b2f;"),
mainPanel(
progressBar(id = "progress", value = 4/12*100, display_pct = TRUE)
),
mainPanel(
br(),
h4(HTML("<strong>Keeping in mind the key soil type you nominated:<strong>")),
br(),
## Acidification Knowledge
checkboxGroupInput("A_K",
HTML(paste0("1. Select all the concepts that are ",
"<strong><em>NEW</em></strong> to you. (Select all that apply)")),
choices = c("A soil with a pH less than 5.5 is considered acidic.",
"Soil pH influences a plant's ability to access nutrients & may cause a deficiency or toxicity.",
"Farm practices can cause soil acidification even in alkaline soils.",
"The buffering capacity of a soil indicates the ability of the soil to resist pH change.",
"I am familiar with all these concepts."),
width = "100%"),
br(),
## Action
radioButtons("A_Ac", "2. For your soils, which statement best describes your approach to soil acidification? (Choose only one)",
choices = c("I have not measured soil pH.",
"I have occasionally tested soil pH, but this knowledge rarely impacts my farm practices.",
"Soil pH is regularly monitored, and amendments are added if cost effective.",
"In my soil testing plan, I geolocate soil pH sampling points within zones and variably apply amendments where required."),
width = "100%",
selected = character(0)),
br(),
## Attitude
radioButtons("A_At", "3. Which statement best describes your opinion on managing soil acidification (Choose only one)",
choices = c("I do not need to know the pH of my soil.",
"Soil acidification is rarely considered when making management decisions.",
"Practices that minimise soil acidification are prioritised if cost effective.",
"Everyone should monitor the pH of their surface and subsurface soil and manage acidification."),
width = "100%",
selected = character(0)),
br(),
radioButtons("A_pH", "4. What is the most common pH of topsoil on your soils?",
choices = c("pH less than 5.5",
"pH 5.6 to 7.5",
"Greater than pH 7.6",
"Do not know"),
width = "100%",
selected = character(0)),
br(),
uiOutput("ans_missing4"),
div(
style = "display: flex; justify-content: space-between;",
actionButton("go_back_button", "Go Back", icon = icon("arrow-left")),
actionButton("next_page4", "Next page", icon = icon("arrow-right"), disabled = TRUE),
),
br(),
br(),
))
}
page5_content <- function(id){
tagList(
tags$a(name = "top"),
h2("Soil Structure Decline", style = "color: #1760a2;"),
mainPanel(
progressBar(id = "progress", value = 5/12*100, display_pct = TRUE)
),
mainPanel(
br(),
h4(HTML("<strong>Keeping in mind the key soil type you nominated:<strong>")),
br(),
## Structural Decline Knowledge
checkboxGroupInput("SD_K",
HTML(paste0("1. Select all the concepts that are ",
"<strong><em>NEW</em></strong> to you. (Select all that apply)")),
choices = c("Poorly structured soil lacks pores to the hold air and water required for roots and soil organisms to flourish.",
"When the exchangeable sodium percent (ESP) is greater than 6.0, a soil is considered sodic and soil structure declines.",
"Soil structure is quickly assessed using a slake test.",
"Irrespective of tyre footprint, the weight and engine vibrations of large farm machinery compacts soil reducing soil functions.",
"I am familiar with all these concepts."),
width = "100%"),
# JavaScript for SD_K checkboxes
tags$script('
$(document).ready(function() {
// Code for handling "I am familiar with all these concepts." checkbox within its question
$(document).on("click", "input[type=checkbox][name=\'SD_K\'][value=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
// Uncheck other checkboxes within the same group
$("input[type=checkbox][name=\'SD_K\'][value!=\'I am familiar with all these concepts.\']").prop("checked", false);
}
$(this).trigger("change"); // Trigger the change event
});
// Code for handling other checkboxes within the same group
$(document).on("click", "input[type=checkbox][name=\'SD_K\'][value!=\'I am familiar with all these concepts.\']", function() {
if ($(this).is(":checked")) {
// Uncheck the "I am familiar with all these concepts." checkbox within the same group
$("input[type=checkbox][name=\'SD_K\'][value=\'I am familiar with all these concepts.\']").prop("checked", false);
}
$(this).trigger("change"); // Trigger the change event
});
});
'),
br(),
## Action
radioButtons("SD_Ac", "2. For your soils, which statement best describes your approach to managing soil structure? (Choose only one)",
choices = c("Changes in soil structure are not considered.",
"Poor and misshapen root growth is used as an indicator of subsurface compaction (hardpan).",
"Grazing and machinery practices are designed to minimise soil compaction.",
"I have assessed soil structure on my soil by digging soil pits or sending for soil testing to a laboratory."),
width = "100%",
selected = character(0)),
br(),
## Attitude
radioButtons("SD_At", "3. Which statement best describes your opinion on managing soil structure (Choose only one)",
choices = c("Changes in soil structure are not measured and recorded.",
"My management is about preventing soil compaction rather than improving soil structure.",
"Maintaining and improving soil structure is built into our long-term management approaches.",
"Soil structural decline has the greatest long-term impact on the viability of farming and its prevention should be central to all farmers management practices."),
width = "100%",
selected = character(0)),
br(),
checkboxGroupInput("SD_Val", "4. Select the practices you use or have used to improve soil structure? (Select all appropriate)",
choices = c("None", "Additions of clay or sand", "Drainage", "Deep ripping", "Minimal tillage",
"Rotational grazing", "Addition of gypsum", "Appropriate stocking rates", "Addition of organic matter",
"Controlled traffic/ raise beds", "Other"),
width = "100%"),
br(),
conditionalPanel(
condition = "Array.isArray(input.SD_Val) && input.SD_Val.includes('Other')",
textInput2("other_SD_Val", "Please specify:", maxlength = 350),
textOutput('other_SD_Val_count')
),
tags$script('
setTimeout(function() {
$(document).ready(function() {
// Code for handling "None" checkbox within its question
$(document).on("click", "input[type=checkbox][name=\'SD_Val\'][value=\'None\']", function() {
if ($(this).is(":checked")) {
// Uncheck other checkboxes within the same group
$("input[type=checkbox][name=\'SD_Val\'][value!=\'None\']").prop("checked", false);
}
$(this).trigger("change"); // Trigger the change event
});