Skip to content

Commit 7455f09

Browse files
hmetcalfe1hmetcalfe1
authored
Add files via upload
1 parent 9f31c1e commit 7455f09

File tree

6 files changed

+258
-0
lines changed

6 files changed

+258
-0
lines changed

‎app.R‎

Lines changed: 245 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,245 @@
1+
library(shiny)
2+
3+
4+
##User Interface
5+
ui <-navbarPage("Black-grass model",
6+
7+
##Tabbed pages
8+
##Introduction
9+
tabPanel("Introduction",
10+
fluidPage(
11+
fluidRow(
12+
p("Farmers around the world, face many challenges. We often hear about problems of insect pests or deadly diseases destroying crops worldwide. But in fact, one of the biggest problems faced by farmers is weed control."),
13+
img(src = 'bg.png', align="centre", width="500"),
14+
p("This plant is called black-grass and it is one that is extremely well-known to farmers across north-west Europe. Black-grass is an especially problematic grass weed found in cereal crops, like wheat. To help farmers plan how to manage their fields better we need to be able to predict how many blackgrass plants will grow each year. To do this we can build a", strong("model.")),
15+
p("A model is simply a mathematical description of something that we can observe in the real-world. Here we are going to describe how the number of black-grass plants in year 2 is related to the number of black-grass plants in year 1."),
16+
p("We can build 3 different models, each with a little bit more complexity than the first."),
17+
18+
#3 columns with a short description of each model
19+
column(3,style = "background-color:#EEEEEE;", h2("Simple Model"),
20+
p("We can go to lots of fields in 2 consecutive years and count the number of plants. We can then look at these data to see if there is a connection between the number of plants counted in year 1 and the number of plants counted in year 2."),
21+
p("Click on the", strong("Simple Model"), "tab at the top of the page to explore these data and build a simple model. When you have finished come back here by clicking on the", strong("Introduction"), "tab.")),
22+
column(3, offset = 1, style = "background-color:#EEEEEE;", h2("Life Cycle Model"),
23+
p("A simple model works well if we need an answer quickly and we have some data to help us make the prediction. However, sometimes we want to predict things that will happen in the future or in different circumstances. "),
24+
p("If this is the case we must dig deeper into the biology of the plant. If we can understand the processes that lead to an increase in the number of plants from one year to the next we can describe these processes mathematically giving us more control over our model."),
25+
p("Click on the", strong("Life-cycle Model"), "tab at the top of the page to explore this type of model further. When you have finished come back here by clicking on the", strong("Introduction"), "tab.")),
26+
column(3, offset = 1, style = "background-color:#EEEEEE;", h2("Scenario Model"),
27+
p("A scenario model is basically the same as a life-cycle model but rather than use generic data for each step in the life-cycle we can use different numbers according to a particular scenario.For example - what if we want to use our model to predict what will happen somewhere else where the weather is very different to the fields we went to? In this case we may have done some experiments to see what happens to each process within the life-cycle if there is more rain. "),
28+
p("Click on the", strong("Scenario Model"), "tab at the top of the page to explore this type of model further. When you have finished come back here by clicking on the", strong("Introduction"), "tab."))
29+
)
30+
31+
)),
32+
33+
##Simple Model
34+
tabPanel("Simple Model",
35+
fluidPage(
36+
fluidRow(
37+
h1("Fitting a simple Model"),
38+
p("Here we are going to predict how many black-grass plants will grow in year 2, based on how many grow in year 1. We can fit a linear model to these data. Use the sliders on the right to find the line of best fit.")),
39+
#scatterplot and slider inputs
40+
column(8, plotOutput(outputId="abscatter")),
41+
column(3, offset=1, sliderInput(inputId="mparam",
42+
label="Choose a value for the 'm' parameter",
43+
value=5, min=1, max=10),
44+
sliderInput(inputId="cparam",
45+
label="Choose a value for the 'c' parameter",
46+
value=35, min=10, max=60,step=5))),
47+
fluidRow(#predict y2 based on y1
48+
h1("Using the model to make predictions"),
49+
p("We can use this model to predict how many black-grass plants will grow in year 2 for any given number of blackgrass plants in year 1"),
50+
numericInput(inputId="y1plants",label="Number of plants in year 1",value="20"),
51+
textOutput("y2plants"),
52+
textOutput("simplemodwarning"))),
53+
54+
##Life-cycle Model
55+
tabPanel("Life-cycle Model",
56+
fluidPage(
57+
fluidRow(p("If we want to be able to adapt our predictions to different circumstances we need to have a slightly more detailed model. One common solution is to describe the life-cycle of the plant mathematically." ),
58+
img(src = 'lifcyclepic.png', align="centre", width="500"),
59+
p("Put simply, plants produce seeds which can then grow into more plants and the process starts again. We can describe each of these stages mathematically and so this model is very similar to the previous simple model, only there are more steps along the way."),
60+
p("Let's start with 100 plants and predict how many plants there will be after one year. You need to look at the data for each stage of the life cycle using the tabs below and complete the exercises to describe the process mathematically. The numbers in the panel on the left will update automatically as you do so you can begin to predict how many adult plants will grow."),
61+
62+
sidebarLayout(
63+
## Side panel - The life cycle will go in here and auto update
64+
sidebarPanel( h3("Plants in year 1"),
65+
textOutput("lcstartplants"),
66+
h3("Seeds produced"),
67+
textOutput("lcseedprod"),
68+
h3("Plants in year 2"),
69+
textOutput("lcendplants")),
70+
71+
72+
73+
##Main panel - will have tabs for each stage of the life cycle
74+
mainPanel(
75+
tabsetPanel(type="tabs",
76+
tabPanel("Plants to seed",
77+
p("The number of seeds each plant produces depends on how many plants are nearby. If it is very crowded there is not enough space for the plants to grow big and so they produce fewer seeds. We did an experiment where we grew different numbers of plants together in one pot and counted the number of seeds they produced. You can see these data summarised in the graph below. Do you recognise the shape of this curve? There are lots of different equations we can use to fit curves to our data.", strong("Select the best option from the three given."), "We can then use this equation to predict the number of seeds produced for any number of plants."),
78+
plotOutput(outputId="seedprodscatter"),
79+
radioButtons("lcseedprodtype", "Choose the equation type that best fits the data",
80+
c("Linear" = "lin",
81+
"Quadratic" = "quad",
82+
"Reciprocal" = "rec"))
83+
),
84+
tabPanel("Seed to plants",
85+
p("Not all seeds will start growing. To find out what percentage of seeds will grow we did an experiment. We counted out 100 seeds and gave them enough water and light to start growing. After 14 days we counted how many shoots we could see. We repeated this 10 times. Here you can see the data we collected, and below it are some summary values. How could you use this data to decide what percentage of seeds typically grow into seedlings?", strong("Calculate the percentage of seeds which grow"), "and put your answer in the box below. If you are stuck try looking at some of the summary statistics by clicking the button."),
86+
tableOutput('seedgerm'),
87+
actionButton("showsum", "Show summary statistics"),
88+
verbatimTextOutput("summaryseedgerm"),
89+
h2("Decide which value to use in our model"),
90+
numericInput(inputId="germpercent",label="What percentage of seeds start to grow?",value="50",min = 1, max = 100),
91+
p("Think about what effect this might have on our life-cycle model and then take a look on the left hand side of the page and see if you were right")
92+
93+
))))))),
94+
95+
96+
97+
98+
##Scenario Model
99+
tabPanel("Scenario Model",
100+
fluidPage(
101+
fluidRow(p("We can use the life-cycle model we built to predict what will happen to the number of black-grass plants for many years into the future. This allows us to investigate how we might be able to manage this weed without having to do lots and lots of experiments year after year."),
102+
p("Here is how our life cycle model looks when we loop through it multiple times - in other words we put the number of plants we get out at the end back into the beginning."),
103+
plotOutput(outputId="loopmod2"),
104+
p("We can also explore other scenarios. Select the scenario you would like to explore from the options below. "),
105+
radioButtons("scenariochoice", "Which scenario would you like to explore?",
106+
c("Try to guess what might happen to the model before you look at the output."="none",
107+
"You apply a herbicide which kills 70% of plants before they produce seed each year."="herb",
108+
"Wet weather in the Autumn allows 10% more seeds to germinate."="wet"))
109+
110+
111+
)))
112+
)
113+
114+
##Behind the scenes
115+
server <- function(input,output){
116+
117+
##Calculations for simple model
118+
#Generate the data
119+
adata <- rnorm(50,mean=25,sd=5)
120+
bdata <- adata*7+22+(rnorm(50, mean=0, sd=10))
121+
#create the scatter plot
122+
output$abscatter <- renderPlot(#code to get saved to the hist output
123+
{ #the {} creates a code block - can be multiple lines
124+
plot(adata,bdata,xlim=c(0,40),ylim=c(0,275),xlab="Number of plants in year 1",ylab="Number of plants in year 2")
125+
abline(a=input$cparam,b=input$mparam)
126+
text(x=35,y=25,"y=mx+c", col="blue")
127+
})
128+
output$y2plants <- renderText({
129+
y2plants <- input$mparam*input$y1plants+input$cparam
130+
paste("The predicted number of plants in year 2 is", y2plants, "when there are", input$y1plants, "plants in year 1")
131+
})
132+
output$simplemodwarning <- renderText({
133+
if(input$y1plants<min(adata)){
134+
paste("Warning: Be cautious of extrapolating this model outside of the range of the original data.")
135+
}
136+
else if(input$y1plants>max(adata)){
137+
paste("Warning: Be cautious of extrapolating this model outside of the range of the original data.")
138+
}
139+
else{
140+
paste("")
141+
}
142+
})
143+
144+
145+
##lifecycle model
146+
#plants to seed
147+
plantsdata <- rnorm(100,mean=200,sd=100)
148+
seeddata <- (((8*plantsdata)/(1+(0.006*plantsdata)))+(rnorm(100, mean=0, sd=50)))*7
149+
#create the scatter plot
150+
151+
linfit <- lm(seeddata ~ plantsdata)
152+
quadfit <- lm(seeddata ~ plantsdata+ I(plantsdata^2))
153+
output$seedprodscatter <- renderPlot(#code to get saved to the hist output
154+
{ #the {} creates a code block - can be multiple lines
155+
plot(plantsdata,seeddata,xlim=c(0,450),ylim=c(0,10000),xlab="Number of plants in year 1",ylab="Number of seeds produced")
156+
if (input$lcseedprodtype == "lin"){
157+
abline(linfit)
158+
}
159+
else if (input$lcseedprodtype == "quad"){
160+
lines(sort(plantsdata), fitted(quadfit)[order(plantsdata)], type='l')
161+
}
162+
else if (input$lcseedprodtype == "rec"){
163+
curve((((8*x)/(1+(0.006*x)))*7), add = TRUE)
164+
}
165+
166+
})
167+
168+
##Germination
169+
growingseeds <- as.data.frame(100*0.3+rnorm(10,mean=0,sd=2))
170+
names(growingseeds) <- c("Number of seeds that grow")
171+
growingseeds <- round(growingseeds)
172+
output$seedgerm <- renderTable(growingseeds)
173+
observeEvent(input$showsum, {
174+
output$summaryseedgerm <- renderPrint({summary(growingseeds)})
175+
})
176+
177+
178+
179+
##Life-cycle model
180+
mystartplants <- 100
181+
output$lcstartplants <- renderText(paste(mystartplants))
182+
183+
#seedprod is a function of startplants
184+
myseedprod <- reactive({
185+
if (input$lcseedprodtype == "lin"){
186+
predict(linfit, data.frame(plantsdata = c(mystartplants)))
187+
}
188+
else if (input$lcseedprodtype == "quad"){
189+
predict(quadfit, data.frame(plantsdata = c(mystartplants)))
190+
}
191+
else if (input$lcseedprodtype == "rec"){
192+
((8*mystartplants)/(1+(0.006*mystartplants)))*7
193+
}
194+
})
195+
196+
output$lcseedprod <- renderText({myseedprod()})
197+
198+
myendplants <- reactive({myseedprod()*input$germpercent/100}) #endplants is a function of seed prod
199+
output$lcendplants <- renderText({myendplants()})
200+
201+
#Loop model,
202+
year <- seq(1,10)
203+
plants <- year
204+
plants[1] <- mystartplants
205+
hplants <- year
206+
hplants[1] <- mystartplants
207+
wplants <- year
208+
wplants[1] <- mystartplants
209+
for (i in 1 : 9){
210+
seed <- ((8*plants[i])/(1+(0.006*plants[i])))*7
211+
hseed<- (((8*plants[i])/(1+(0.006*plants[i])))*7)*0.3
212+
213+
plants[i+1] <- seed*30/100
214+
hplants[i+1] <- hseed*30/100
215+
wplants[i+1] <- seed*33/100
216+
}
217+
218+
219+
output$loopmod <- renderPlot(#code to get saved to the hist output
220+
{ #the {} creates a code block - can be multiple lines
221+
plot(year,plants,xlab="Year",ylab="Number of plants", type="b", ylim=c(0,3000))
222+
})
223+
224+
225+
output$loopmod2 <- renderPlot(#code to get saved to the hist output
226+
{ #the {} creates a code block - can be multiple lines
227+
228+
if (input$scenariochoice == "none"){
229+
plot(year,plants,xlab="Year",ylab="Number of plants", type="b", ylim=c(0,3000))
230+
}
231+
if (input$scenariochoice == "herb"){
232+
plot(year,plants,xlab="Year",ylab="Number of plants", type="b", ylim=c(0,3000))
233+
lines(year,hplants,xlab="Year",ylab="Number of plants", col="red", type="b")
234+
text(x=8,y=1000,"Herbicide", col="red")
235+
}
236+
else if (input$scenariochoice == "wet"){
237+
plot(year,plants,xlab="Year",ylab="Number of plants", type="b", ylim=c(0,3000))
238+
lines(year,wplants,xlab="Year",ylab="Number of plants", col="blue", type="b")
239+
text(x=2,y=2500,"Wet", col="blue")
240+
}
241+
242+
})
243+
}
244+
245+
shinyApp(server=server,ui=ui)

‎rsconnect/shinyapps.io/hmetcalfe1/BGmodel.dcf‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
name: BGmodel
2+
title: BGmodel
3+
username:
4+
account: hmetcalfe1
5+
server: shinyapps.io
6+
hostUrl: https://api.shinyapps.io/v1
7+
appId: 3227411
8+
bundleId: 3866086
9+
url: https://hmetcalfe1.shinyapps.io/BGmodel/
10+
when: 1605518725.29579
11+
asMultiple: FALSE
12+
asStatic: FALSE
13+
ignoredFiles: www/bgfield.png|www/ompots.jpg

‎www/bg.png‎

506 KB
Loading

‎www/bgfield.png‎

347 KB
Loading

‎www/lifcyclepic.png‎

303 KB
Loading

‎www/ompots.jpg‎

421 KB
Loading

0 commit comments

Comments
 (0)