So I am having a little trouble with listing inputs within functions, particularly ezANOVA(). Here is what I have for code so far:
ui.R:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel('Analysis of Variance'),
sidebarPanel(
fileInput("file1", "CSV File", accept=c("text/csv", "text/comma-separated-values,text/plain", ".csv")),
checkboxInput("header", "Header", TRUE),
radioButtons('sep', 'Separator',c(Comma=',',Semicolon=';',Tab='\t'),','),
uiOutput('var')
),
mainPanel(
tableOutput('aovSummary')
)
)
)
server.R:
library(shiny)
library(ez)
shinyServer(function(input, output) {
csvfile <- reactive({
csvfile <- input$file1
if (is.null(csvfile)){return(NULL)}
dt <- read.csv(csvfile$datapath, header=input$header, sep=input$sep)
dt
})
output$var <- renderUI({
if(is.null(input$file1$datapath)){return()}
else{
return(list(radioButtons("estimate", "Please Pick The Dependent Variable", choices = names(csvfile())),
radioButtons("between1", "Please Pick The Between Subjects Factor", choices = names(csvfile())),
radioButtons("within1", "Please Pick The Within Subjects Factor", choices = names(csvfile())),
radioButtons("sid", "Please Pick The Subject Id Variable", choices = names(csvfile())),
actionButton("submit", "Submit")))
}
})
output$aovSummary = renderTable({
if(is.null(input$file1$datapath)){return()}
if(input$submit > 0){
aov.out <- ezANOVA(data = csvfile(), dv = .(input$estimate), wid = .(input$sid), between = .(input$between1),
within = .(input$within1), detailed = TRUE, type = "III")
return(aov.out)
}
})
})
Here is the data I have been testing it with:
Animal Visit Dose Estimate
2556 0 3 1.813206946
2557 0 3 1.933397744
2558 0 3 1.689893603
2559 0 3 1.780301984
2560 0 3 1.654374476
2566 0 10 3.401283412
2567 0 10 3.015958525
2568 0 10 2.808705611
2569 0 10 3.185718418
2570 0 10 2.767128836
2576 0 30 3.941412617
2577 0 30 3.793328436
2578 0 30 4.240736154
2579 0 30 3.859611218
2580 0 30 4.049743097
2586 0 100 5.600261483
2587 0 100 5.588115651
2588 0 100 5.089081008
2589 0 100 5.108262681
2590 0 100 5.343876403
2556 27 3 1.453587471
2557 27 3 1.994413484
2558 27 3 1.638132168
2559 27 3 2.138289747
2560 27 3 1.799769874
2566 27 10 3.302851871
2567 27 10 3.014199997
2568 27 10 3.190990162
2569 27 10 3.577924375
2570 27 10 3.537461068
2576 27 30 4.470837132
2577 27 30 4.081833308
2578 27 30 4.497192825
2579 27 30 4.205494309
2580 27 30 4.234496088
2586 27 100 6.054284369
2587 27 100 5.436697078
2588 27 100 5.398721492
2589 27 100 4.990794986
2590 27 100 5.573305744
2551 0 3 1.838550166
2552 0 3 1.847992942
2553 0 3 1.349892703
2554 0 3 1.725937126
2555 0 3 1.534652719
2561 0 10 2.931535704
2562 0 10 2.947599556
2563 0 10 3.092658629
2564 0 10 2.837625632
2565 0 10 2.970227467
2571 0 30 4.00746885
2572 0 30 3.921844968
2573 0 30 3.575724773
2574 0 30 4.17137839
2575 0 30 4.25251528
2581 0 100 4.785295667
2582 0 100 5.610955803
2583 0 100 5.497109771
2584 0 100 5.262724458
2585 0 100 5.430003698
2551 27 3 1.9326519
2552 27 3 2.313193186
2553 27 3 1.815261865
2554 27 3 1.345218914
2555 27 3 1.339432001
2561 27 10 3.305894401
2562 27 10 3.192621055
2563 27 10 3.76947789
2564 27 10 3.127887366
2565 27 10 3.231750087
2571 27 30 4.306556353
2572 27 30 4.232038905
2573 27 30 4.042378186
2574 27 30 4.784843929
2575 27 30 4.723665015
2581 27 100 5.601181262
2582 27 100 5.828647795
2583 27 100 5.652171222
2584 27 100 5.326512658
2585 27 100 6.009774247
The error I receive in the browser is:
"input$estimate" is not a variable in the data frame provided.
So, the function ezANOVA() is not using the actual variable name but rather the string "input$estimate", that is not what I want it to do.
How would I go about fixing this problem or is it helpless?
Thanks in advance for all your help!
You need to dynamically construct the call to ezANOVA(), i.e. use the value of the strings in your input variables to define the function call. Due to its LISP heritage, this is relatively easy in R via eval. (Relatively easy because strings are still painful in R and you need to manipulate strings to make this work). Here's a minimal working version of your code.
server.R
library(shiny)
library(ez)
shinyServer(function(input, output) {
csvfile <- reactive({
csvfile <- input$file1
if (is.null(csvfile)){return(NULL)}
dt <- read.csv(csvfile$datapath, header=input$header, sep=input$sep)
dt
})
output$var <- renderUI({
if(!is.null(input$file1$datapath)){
d <- csvfile()
anova.opts <- list(
radioButtons("estimate", "Please Pick The Dependent Variable", choices = names(d)),
radioButtons("between1", "Please Pick The Between Subjects Factor", choices = names(d)),
radioButtons("within1", "Please Pick The Within Subjects Factor", choices = names(d)),
radioButtons("sid", "Please Pick The Subject Id Variable", choices = names(d)),
actionButton("submit", "Submit")
)
anova.opts
}
})
output$aovSummary = renderTable({
if(!is.null(input$submit)){
aov.out <- eval(parse(text=paste(
"ezANOVA(data = csvfile()
, dv = .(", input$estimate, ")
, wid = .(", input$sid, ")
, between = .(", input$between1, ")
, within = .(", input$within1, ")
, detailed = TRUE, type = \"III\")")))
aov.out$ANOVA
}
})
})
ui.R
library(shiny)
shinyUI(pageWithSidebar(
headerPanel('Analysis of Variance'),
sidebarPanel(
fileInput("file1", "CSV File", accept=c("text/csv", "text/comma-separated-values,text/plain", ".csv")),
checkboxInput("header", "Header", TRUE),
radioButtons('sep', 'Separator',c(Comma=',',Semicolon=';',Tab='\t', `White Space`=''),''),
uiOutput('var')
),
mainPanel(
tableOutput('aovSummary')
)
)
)
I've changed/fixed a number of smaller issues, but the two most significant changes not related to eval() were:
Including an option for letting R do its usual thing with white-space as a field separater.
Changed the render function to include the actual ANOVA table. ezANOVA returns a list, the first entry of which is always ANOVA and contains the ANOVA table. However, there are sometimes further entries for assumption tests and post-hoc corrections, e.g. Mauchly's Test for Sphericity and Huynh-Feldt correction. You really need to add logic to deal with these when they're present.
Code style is also an issue -- it's better to get rid of empty if blocks followed by a full else and instead just test for the condition where you actually have code to run. Let R "fall off" the end of the function simulate a non existent return value.
I'm assuming UI improvements were waiting for a working example, but you need to consider:
meaningful defaults, perhaps on variable type, for the different arguments and/or not reacting to the radio buttons, instead only reacting to an action button. Otherwise you get confusing errors from ezANOVA while you're setting the values.
what happens if you have pure between or pure within designs?
You might also want to take a look at conditionalPanel() for hiding further options until an initial option (data file) is set in a meaningful way.
Related
I just started to learn shiny few days, and I have been troubled by this problem for a long time.
I need to generate a table(Two-column table), and the data in the table needs to be calculated based on the input (then I can use this table to generate a scatter plot in ggplot()).
I try to make the code more visible, so I want to use for loop to replace potentially hundreds of lines of highly repetitive code. Otherwise, it will look like (input$meansy1)-1)^2, (input$meansy1)-2)^2......(input$meansy1)-100)^2.
I don't know why it can't be used correctly in data.frame().
This is part of the code,
shinyUI(fluidPage(
numericInput("y1", "y1:", sample(1:100,1), min = 1, max = 100)),
tableOutput("tb")
))
shinyServer(function(input, output,session) {
list <-c()
for (i in 1:100) {
local({
list[[i]] <-reactive(((input$y1)-i)^2)}
)}
dt = data.frame(y_roof = 1:100, B=list)
output$tb <- renderTable({
dt
})
})
When developing a feature for a shiny app it makes sense to look at the underlying operation separately from the shiny context. That way you can figure out if you have a shiny specific issue or not.
Let's look at the operation you want to do first: Iteratively subtracting the values 1 to 100 from x and squaring the result.
You can do this in base R, like this:
x <- 1
dt1 <- data.frame(y_roof = 1:100)
(x - dt1$y_roof)^2
#> [1] 0 1 4 9 16 25 36 49 64 81 100 121 144 169 196
#> [16] 225 256 289 324 361 400 441 484 529 576 625 676 729 784 841
#> [31] 900 961 1024 1089 1156 1225 1296 1369 1444 1521 1600 1681 1764 1849 1936
#> [46] 2025 2116 2209 2304 2401 2500 2601 2704 2809 2916 3025 3136 3249 3364 3481
#> [61] 3600 3721 3844 3969 4096 4225 4356 4489 4624 4761 4900 5041 5184 5329 5476
#> [76] 5625 5776 5929 6084 6241 6400 6561 6724 6889 7056 7225 7396 7569 7744 7921
#> [91] 8100 8281 8464 8649 8836 9025 9216 9409 9604 9801
To store the results in a dataframe change the last line to:
dt1$col2 <- (x - dt1$y_roof)^2
head(dt1)
#> y_roof col2
#> 1 1 0
#> 2 2 1
#> 3 3 4
#> 4 4 9
#> 5 5 16
#> 6 6 25
Doing the same in the tidyverse would look like this:
library(dplyr)
dt2 <-
data.frame(y_roof = 1:100) %>%
mutate(col2 = (x - y_roof)^2)
head(dt2)
#> y_roof col2
#> 1 1 0
#> 2 2 1
#> 3 3 4
#> 4 4 9
#> 5 5 16
#> 6 6 25
Now we can work this into the shiny app:
library(shiny)
library(dplyr)
ui <-
shinyUI(fluidPage(
numericInput("y1", "y1:", sample(1:100, 1), min = 1, max = 100),
tableOutput("tb")
))
server <-
shinyServer(function(input, output, session) {
output$tb <- renderTable({
data.frame(y_roof = 1:100) %>%
mutate(col2 = (input$y1 - y_roof) ^ 2)
})
})
shinyApp(ui, server, options = list(launch.browser = TRUE))
I have question about rendering datatable in shiny.
Here is my sample code:
head(pm)
product previous current rate
1 a 0 2 2.00000
2 b 12 28 133.33333
3 c 22 76 245.45455
4 d 26 52 100.00000
5 e 18 24 33.33333
6 f 32 92 187.50000
And my shiny codes are:
##ignoring some other codes
## in server.R
library(shiny)
library(DT)
output$matrix <- renderDataTable(DT::datatable(pm, options = list(searching = TRUE,
pageLength = 10,
lengthMenu = c(10, 50, 100))))
## in ui.R, ignoring main page stuff
tabPanel("matrix testing",
DT::dataTableOutput("matrix"))
These codes are modified as suggested from some other SO posts. However when I run shiny, it returns:
I run out of solutions and have no idea how to deal with it. Any help will be appreciated!
Based on your little info, this works:
pm <- read.table(header=T,text="
product previous current rate
1 a 0 2 2.00000
2 b 12 28 133.33333
3 c 22 76 245.45455
4 d 26 52 100.00000
5 e 18 24 33.33333
6 f 32 92 187.50000")
library(shiny)
library(DT)
server <- function(input, output, session) {
output$matrix <- renderDataTable(DT::datatable(pm, options = list(searching = TRUE,
pageLength = 10,
lengthMenu = c(10, 50, 100))))
}
ui <- fluidPage(
tabsetPanel(
tabPanel("matrix testing", dataTableOutput("matrix"))))
shinyApp(ui, server)
I'm having trouble creating a dynamic table that produces a calculated field based on four sliderInput controls, where the once sliderInput determines the length of the dataframe.
library(shiny)
# Define server logic for random distribution application
shinyServer(function(input, output) {
sliderValues <- reactive ({
#compose data frame
ws<- as.numeric (c(0:input$sws))
df<-data.frame(
WindSpeed = as.character (c(ws)
),
CBH = as.character (c(input$sCBH)
),
FFMC = as.character(c(input$sFFMC)
),
DC = as.character (c(input$sDC)
),
PCFI = as.character (c((exp(-66.62+(-0.993*input$sCBH)+(0.568*ws)+(0.671*input$sFFMC)+(0.018*input$sDC)))/(1+(exp(-66.62+(-0.993*input$sCBH)+(0.568*input$sws)+(0.671*input$sFFMC)+(0.018*input$sDC)))))
)
)
return(df)
})
#Show the values using an HTML table
output$values <- renderTable({
sliderValues()
})
})
Basically I would like to use renderTable to produce a table that multiplies the fields in PCFI based on the other sliderInputs. However, currently by using ws<- as.numeric (c(0:input$sws)), it is multiplying the entire list by the variables. I've been trying all day to produce the correct product, so any help would be amazing.
shinyUI
(fluidPage(
titlePanel("Behaviour Model"),
#Sidebar with sliders that demonstrate various available
#options
sidebarLayout(
sidebarPanel(
#Simple integer interval
sliderInput ("sws", "10m Wind Speed (km/hr):",
min=0,
max=50,
value=15),
sliderInput ("sCBH", "Crown Base Height (m):",
min=0,
max=25,
value=5),
sliderInput ("sFFMC", "Fine Fuel Moisutre Code:",
min = 77,
max=98,
value = 88,
step=1.0),
sliderInput("sDC", "Drought Code:",
min=0,
max= 1000,
value = 200)
),
#Show a table summarizing the values entered
mainPanel(
tableOutput("values")
)
)
))
Ideally, in the end I will have a table that resembles the following and not have the PCFI field calculate the entirety of the ws<- as.numeric (c(0:input$sws)), just the single increment in windspeed per line:
WindSpeed CBH FFMC DC PCFI
0 5 88 200 *calculated field*
1 5 88 200 *calculated field*
2 5 88 200 *calculated field*
3 5 88 200 *calculated field*
4 5 88 200 *calculated field*
5 5 88 200 *calculated field*
... ...
Length Dependent on Windspeed Slider, as each record is calculated in +1km/hr increments.
Once again, I really appreciate any help on this.
Kevin
This is what the output table should look like:
CBH WindSpeed FFMC DC PCFI
4 0 92 200 0.005168453
4 1 92 200 0.009085037
4 2 92 200 0.015922053
4 3 92 200 0.027760177
4 4 92 200 0.047970947
4 5 92 200 0.081660255
4 6 92 200 0.135638245
4 7 92 200 0.216870104
4 8 92 200 0.328274418
4 9 92 200 0.46306739
4 10 92 200 0.60348325
I have a working app that I would like to enhance with a checkboxInput.
1> Here is a sample of the data:
StudentID StudentGender GradeName TermName MeasurementScaleName TestPercentile GoalRITScore1 GoalRITScore2 GoalRITScore3 GoalRITScore4
1 1374 M 3 Fall 2009 Reading 32 188 181 179 NA
50 1297 F 8 Fall 2009 Language Usage 48 224 214 209 228
101 1608 F 8 Fall 2009 Mathematics 40 225 210 211 244
1500 1286 M 1 Fall 2011 Language Usage NA 218 225 238 221
2345 1196 F 8 Fall 2012 Language Usage 78 230 227 239 223
5498 1376 F 3 Spring 2010 Reading 24 188 194 185 NA
8954 486 M 2 Spring 2014 Reading 2 146 152 174 NA
9000 577 F 2 Spring 2014 Reading 71 196 189 207 NA
GoalRITScore5 GoalRITScore6
1 NA NA
50 NA NA
101 233 227
1500 NA NA
2345 NA NA
5498 NA NA
8954 NA NA
9000 NA NA
2> Here is part of the working script.
Shiny UI
library(shiny)
shinyUI(navbarPage("MAP results",
tabPanel("Summaries",
sidebarLayout(
sidebarPanel(
selectInput("testname",
"Select the test to visualize",
levels(mapdata$MeasurementScaleName)),
selectInput("termname",
"Select the term the test was taken",
levels(mapdata$TermName)),
selectInput("ritorpercent",
"Display RIT scores or percentiles",
choices = c("RIT Scores", "Percentiles")),
checkboxInput("gender", "Display Gender differences"),
),
mainPanel(
plotOutput("mapgraph")
)
)
),
tabPanel("Growth visualizations")
)
)
And part of the Server.R script.
Server.R
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
mapdata <- read.csv("MAP data raw.csv")
shinyServer(function(input, output) {
output$mapgraph <- renderPlot({
graph1RIT <- reactive (mapdata %>%
filter(TermName == input$termname, MeasurementScaleName == input$testname) %>%
group_by(GradeName) %>%
summarise(meanPer = mean(TestPercentile)))
ggplot(graph1RIT(), aes(as.factor(GradeName), meanPer, fill = as.factor(GradeName))) +
geom_bar(stat="identity") +
#coord_cartesian(ylim = c(150, 250)) +
labs(x = "Grade Level", y = "Mean RIT Percentile") +
guides(fill = FALSE)
})
})
Now I want to use my checkboxInput("gender"), to make the same bargraph but with gender segregation. ... and I thought I could just add this into the server.r
if(input$gender) {
graph3RIT <- reactive (mapdata %>%
filter(TermName == input$termname, MeasurementScaleName == input$testname) %>%
group_by(GradeName, StudentGender) %>%
summarise(meanPer = mean(TestPercentile)))
ggplot(graph3RIT(), aes(as.factor(GradeName), meanPer, fill = as.factor(StudentGender))) +
geom_bar(stat="identity", position = "dodge") +
labs(x = "Grade Level", y = "Mean RIT Percentile")
}
But if I do that, then the first graph doesn't show up anymore. I've tried to look on the showmeshiny website for similar situation, but all the ones I could find didn't have the code available.
Any guidance on how I could use that checkbox, to change the graph
Franky found the answer on his own. He wrote in the comments
OK ... thanks NicE. I did figure it out in the meantime. All I needed
to do was to put my code in between else {}. Then it worked nicely. –
Franky Feb 10 '15 at 9:43
Right now I have the R code below. It reads in data that looks like this:
track_id day hour month year rate gate_id pres_inter vmax_inter
9 10 0 7 1 9.6451E-06 2 97809 23.545
9 10 0 7 1 9.6451E-06 17 100170 13.843
10 3 6 7 1 9.6451E-06 2 96662 31.568
13 22 12 8 1 9.6451E-06 1 94449 48.466
13 22 12 8 1 9.6451E-06 17 96749 30.55
16 13 0 8 1 9.6451E-06 4 98702 19.205
16 13 0 8 1 9.6451E-06 16 98585 18.143
19 27 6 9 1 9.6451E-06 9 98838 20.053
19 27 6 9 1 9.6451E-06 17 99221 17.677
30 13 12 6 2 9.6451E-06 2 97876 27.687
30 13 12 6 2 9.6451E-06 16 99842 18.163
32 20 18 6 2 9.6451E-06 1 99307 17.527
##################################################################
# Input / Output variables
##################################################################
for (N in (59:96)){
if (N < 10){
# TrackID <- "000$N"
TrackID <- paste("000",N, sep="")
}
else{
# TrackID <- "00$N"
TrackID <- paste("00",N, sep="")
}
print(TrackID)
# For 2010_08_24 trackset
# fname_in <- paste('input/2010_08_24/intersections_track_calibrated_jma_from1951_',TrackID,'.csv', sep="")
# fname_out <- paste('output/2010_08_24/tracks_crossing_regional_polygon_',TrackID,'.csv', sep="")
# For 2012_05_01 trackset
fname_in <- paste('input/2012_05_01/intersections_track_param_',TrackID,'.csv', sep="")
fname_out <- paste('output/2012_05_01/tracks_crossing_regional_polygon_',TrackID,'.csv', sep="")
fname_out2 <- paste('output/2012_05_01/GateID_',TrackID,'.csv', sep="")
#######################################################################
# we read the gate crossing track date
cat('reading the crosstat output file', fname_in, '\n')
header <- read.table(fname_in, nrows=1)
track <- read.table(fname_in, sep=',', skip=1)
colnames(track) <- c("ID", "day", "month", "year", "hour", "rate", "gate_id", "pres_inter", "vmax_inter")
# track_id=track[,1]
# pres_inter=track[,15]
# Function to select maximum surge by stormID
ByTrack <- ddply(track, "ID", function(x) x[which.max(x$vmax_inter),])
ByGate <- count(track, vars="gate_id")
# Write the output file with a single record per storm
cat('Writing the full output file', fname_out, '\n')
write.table(ByTrack, fname_out, col.names=T, row.names=F, sep = ',')
# Write the output file with a single record per storm
cat('Writing the full output file', fname_out2, '\n')
write.table(ByGate, fname_out2, col.names=T, row.names=F, sep = ',')
}
My output for the final section of code is a file the groups by GateID and outputs the frequency of occurrence. It looks like this:
gate_id freq
1 935
2 2096
3 1363
4 963
5 167
6 17
7 43
8 62
9 208
10 267
11 64
12 162
13 178
14 632
15 807
16 2003
17 838
18 293
The thing is that I output a file that looks just like this for 96 different input files. Instead of outputting 96 separate files, I'd like to calculate these aggregations per input file, and then sum the frequency across all 96 inputs and print out one SINGLE output file. Can anyone help?
Thanks,
K
You are going to need to do something like the function below. This would grab all the .csv files in one directory, so that directory would have to have only the files you want to analyze in it.
myFun <- function(out.file = "mydata") {
files <- list.files(pattern = "\\.(csv|CSV)$")
# Use this next line if you are going use the file name as a variable/output etc
files.noext <- substr(basename(files), 1, nchar(basename(files)) - 4)
for (i in 1:length(files)) {
temp <- read.csv(files[i], header = FALSE)
# YOUR CODE HERE
# Use the code you have already written but operate on files[i] or temp
# Save the important stuff into one data frame that grows
# Think carefully ahead of time what structure makes the most sense
}
datafile <- paste(out.file, ".csv", sep = "")
write.csv(yourDataFrame, file = datafile)
}