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
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 an input data and i would like to create a grouped chart, but when I finish the creation the problem is the order is different from the input, it arranged it as alphabetical, plus I would like to change the font style to italic, for the species names only.
> data <- read.table(
+ text = "Superfamily Drom Bactria Feru Paos
+ ERV 294 224 206 202
+ ERVL-MaLR 103 108 184 231
+ Gypsy 274 187 413 215
+ Pao 6 2 7 4
+ DIRS/Ngaro 15 14 45 25
+ Unknown 26 23 23 37
+ Undefined 76 77 80 95",
+ header = TRUE
+ )
> data
Superfamily Drom Bactria Feru Paos
1 ERV 294 224 206 202
2 ERVL-MaLR 103 108 184 231
3 Gypsy 274 187 413 215
4 Pao 6 2 7 4
5 DIRS/Ngaro 15 14 45 25
6 Unknown 26 23 23 37
7 Undefined 76 77 80 95
> data_long <- gather(data,
+ key = "Species",
+ value = "Distrubution",
+ -Superfamily)
> ggplot(data_long, aes(fill=Superfamily, y=Distrubution, x=Species)) + geom_bar(position="dodge2", stat="identity")
I would like to build the chart as the same as the input order, and italic font style to the species name only ex ( Drom Bactria ....)
I think this is what you're asking for
data_long$Species <- factor(data_long$Species, levels = unique(data_long$Species))
ggplot(data_long, aes(fill=Superfamily, y=Distrubution, x=Species)) + geom_bar(position="dodge2", stat="identity") + theme(axis.text.x = element_text(face = "italic"))
If ggplot recieves a factor, it will use the level-order as the axis order.
When it comes to the fonts, you change that in the theme argument.
--edit--
To get the superfamily in the same order as input, you would have to create a factor as we did with the species-name.
data_long$Superfamily<- factor(data_long$Superfamily, levels = data$Superfamily)
Forgoing the use of the readxl-package to read the excel sheet into R, this should work to change the species name:
colnames(data)[2:5] <- c("Alpha Drom", "Beta Bactria", "Gamma Feru", "Delta Paos")
Add this line before you create data_long.
I've created a model and I'm trying to add curves that fit the two parts of the data, insulation and no insulation. I was thinking about using the insulation coefficient as a true/false term, but I'm not sure how to translate that into code. Entries 1:56 are "w/o" and 57:101 are "w/". I'm not sure how to include the data I'm using but here's the head and tail:
month year kwh days est cost avgT dT.yr kWhd.1 id insulation
1 8 2003 476 21 a 33.32 69 -8 22.66667 1 w/o
2 9 2003 1052 30 e 112.33 73 -1 35.05172 2 w/o
3 10 2003 981 28 a 24.98 60 -6 35.05172 3 w/o
4 11 2003 1094 32 a 73.51 53 2 34.18750 4 w/o
5 12 2003 1409 32 a 93.23 44 6 44.03125 5 w/o
6 1 2004 1083 32 a 72.84 34 3 33.84375 6 w/o
month year kwh days est cost avgT dT.yr kWhd.1 id insulation
96 7 2011 551 29 e 55.56 72 0 19.00000 96 w/
97 8 2011 552 27 a 61.17 78 1 20.44444 97 w/
98 9 2011 666 34 e 73.87 71 -2 19.58824 98 w/
99 10 2011 416 27 a 48.03 64 0 15.40741 99 w/
100 11 2011 653 31 e 72.80 53 1 21.06452 100 w/
101 12 2011 751 33 a 83.94 45 2 22.75758 101 w/
bill$id <- seq(1:101)
bill$insulation <- as.factor(ifelse(bill$id > 56, c("w/"), c("w/o")))
m1 <- lm(kWhd.1 ~ avgT + insulation + I(avgT^2), data=bill)
with(bill, plot(kWhd.1 ~ avgT, xlab="Average Temperature (F)",
ylab="Daily Energy Use (kWh/d)", col=insulation))
no_ins <- data.frame(bill$avgT[1:56], bill$insulation[1:56])
curve(predict(m1, no_ins=x), add=TRUE, col="red")
ins <- data.frame(bill$avgT[57:101], bill$insulation[57:101])
curve(predict(m1, ins=x), add=TRUE, lty=2)
legend("topright", inset=0.01, pch=21, col=c("red", "black"),
legend=c("No Insulation", "Insulation"))
ggplot2 makes this a lot easier than base plotting. Something like this should work:
ggplot(bill, aes(x = avgT, y = kWhd.1, color = insulation)) +
geom_smooth(method = "lm", formula = y ~ x + I(x^2), se = FALSE) +
geom_point()
In base, I'd create a data frame with point you want to predict on, something like
pred_data = expand.grid(
kWhd.1 = seq(min(bill$kWhd.1), max(bill$kWhd.1), length.out = 100),
insulation = c("w/", "w/o")
)
pred_data$prediction = predict(m1, newdata = pred_data)
And then use lines to add the predictions to your plot. My base graphics is pretty rusty, so I'll leave that to you (or another answerer) if you want it.
In base R it's important to order the x-values. Since this is to be done on multiple factors, we can do this with by, resulting in a list L.
Since your example data is not complete, here's an example with iris where we consider Species as the "factor".
L <- by(iris, iris$Species, function(x) x[order(x$Petal.Length), ])
Now we can do the plot and add loess predictions as lines with a sapply.
with(iris, plot(Sepal.Width ~ Petal.Length, col=Species))
sapply(seq(L), function(x)
lines(L[[x]]$Petal.Length,
predict(loess(Sepal.Width ~ Petal.Length, L[[x]], span=1.1)), # span=1.1 for smoothing
col=x))
Yields
I have a slightly complicated plotting task. I am half way there, quite sure how to get it. I have a dataset of the form below, with multiple subjects, each in either Treatgroup 0 or Treatgroup 1, each subject contributing several rows of data. Each row corresponds to a single timepoint at which there are values in columns "count1, count2, weirdname3, etc.
Task 1. I need to calculate "Days", which is just the visitdate - the startdate, for each row. Should be an apply type function, I guess.
Task 2. I have to make a multiplot figure with one scatterplot for each of the count variables (a plot for count1, one for count2, etc). In each scatterplot, I need to plot the value of the count (y axis) against "Days" (x-axis) and connect the dots for each subject. Subjects in Treatgroup 0 are one color, subjects in treatgroup 1 are another color. Each scatterplot should be labeled with count1, count2 etc as appropriate.
I am trying to use the base plotting function, and have taken the approach of writing a plotting function to call later. I think this can work but need some help with syntax.
#Enter example data
tC <- textConnection("
ID StartDate VisitDate Treatstarted count1 count2 count3 Treatgroup
C0098 13-Jan-07 12-Feb-10 NA 457 343 957 0
C0098 13-Jan-06 2-Jul-10 NA 467 345 56 0
C0098 13-Jan-06 7-Oct-10 NA 420 234 435 0
C0098 13-Jan-05 3-Feb-11 NA 357 243 345 0
C0098 14-Jan-06 8-Jun-11 NA 209 567 254 0
C0098 13-Jan-06 9-Jul-11 NA 223 235 54 0
C0098 13-Jan-06 12-Oct-11 NA 309 245 642 0
C0110 13-Jan-06 23-Jun-10 30-Oct-10 629 2436 45 1
C0110 13-Jan-07 30-Sep-10 30-Oct-10 461 467 453 1
C0110 13-Jan-06 15-Feb-11 30-Oct-10 270 365 234 1
C0110 13-Jan-06 22-Jun-11 30-Oct-10 236 245 23 1
C0151 13-Jan-08 2-Feb-10 30-Oct-10 199 653 456 1
C0151 13-Jan-06 24-Mar-10 3-Apr-10 936 25 654 1
C0151 13-Jan-06 7-Jul-10 3-Apr-10 1147 254 666 1
C0151 13-Jan-06 9-Mar-11 3-Apr-10 1192 254 777 1
")
data1 <- read.table(header=TRUE, tC)
close.connection(tC)
# format date
data1$VisitDate <- with(data1,as.Date(VisitDate,format="%d-%b-%y"))
# stuck: need to define days as VisitDate - StartDate for each row of dataframe (I know I need an apply family fxn here)
data1$Days <- [applyfunction of some kind ](VisitDate,ID,function(x){x-data1$StartDate})))
# Unsure here. Need to define plot function
plot_one <- function(d){
with(d, plot(Days, Count, t="n", tck=1, cex.main = 0.8, ylab = "", yaxt = 'n', xlab = "", xaxt="n", xlim=c(0,1000), ylim=c(0,1200))) # set limits
grid(lwd = 0.3, lty = 7)
with(d[d$Treatgroup == 0,], points(Days, Count1, col = 1))
with(d[d$Treatgroup == 1,], points(Days, Count1, col = 2))
}
#Create multiple plot figure
par(mfrow=c(2,2), oma = c(0.5,0.5,0.5,0.5), mar = c(0.5,0.5,0.5,0.5))
#trouble here. I need to call the column names somehow, with; plyr::d_ply(data1, ???, plot_one)
Task 1:
data1$days <- floor(as.numeric(as.POSIXlt(data1$VisitDate,format="%d-%b-%y")
-as.POSIXlt(data1$StartDate,format="%d-%b-%y")))
Task 2:
par(mfrow=c(3,1), oma = c(2,0.5,1,0.5), mar = c(2,0.5,1,0.5))
plot(data1$days, data1$count1, col=as.factor(data1$Treatgroup), main="count1")
plot(data1$days, data1$count2, col=as.factor(data1$Treatgroup), main="count2")
plot(data1$days, data1$count3, col=as.factor(data1$Treatgroup), main="count3")
I'm attempting to add a column to a data frame that consists of normalized values by a factor.
For example:
'data.frame': 261 obs. of 3 variables:
$ Area : Factor w/ 29 levels "Antrim","Ards",..: 1 1 1 1 1 1 1 1 1 2 ...
$ Year : Factor w/ 9 levels "2002","2003",..: 1 2 3 4 5 6 7 8 9 1 ...
$ Arrests: int 18 54 47 70 62 85 96 123 99 38 ...
I'd like to add a column that are the Arrests values normalized in groups by Area.
The best I've come up with is:
data$Arrests.norm <- unlist(unname(by(data$Arrests,data$Area,function(x){ scale(x)[,1] } )))
This command processes but the data is scrambled, ie, the normalized values don't match to the correct Areas in the data frame.
Appreciate your tips.
EDIT:Just to clarify what I mean by scrambled data, subsetting the data frame after my code I get output like the following, where the normalized values clearly belong to another factor group.
Area Year Arrests Arrests.norm
199 Larne 2002 92 -0.992843957
200 Larne 2003 124 -0.404975825
201 Larne 2004 89 -1.169204397
202 Larne 2005 94 -0.581336264
203 Larne 2006 98 -0.228615385
204 Larne 2007 8 0.006531868
205 Larne 2008 31 0.418039561
206 Larne 2009 25 0.947120880
207 Larne 2010 22 2.005283518
Following up your by attempt:
df <- data.frame(A = factor(rep(c("a", "b"), each = 4)),
B = sample(1:4, 8, TRUE))
ll <- by(data = df, df$A, function(x){
x$B_scale <- scale(x$B)
x
}
)
df2 <- do.call(rbind, ll)
data <- transform(data, Arrests.norm = ave(Arrests, Area, FUN = scale))
will do the trick.