Related
Please find my code below (I did not place the updated code for each image here.) The Code below is for the image labeled original :
packages <- c("ggplot2", "dplyr", "quantreg", "officer","tidyverse","here","glue","rvg","viridis","scales")
install.packages(setdiff(packages, rownames(installed.packages())))
lapply(packages, require, character.only = TRUE)
data <- read.csv(file='Spiderplot_data.csv', header=TRUE)
Progressed <- as.factor(data$Progression)
Response <- as.factor(data$X)
Response <- factor(data$X, levels = c("Progressive Disease", "Stable Disease", "Partial Response", "Complete Response"))
highlight_df <- filter(data, Progression == 1)
p <- ggplot() +
geom_line(
data,
mapping = aes(
x = Cycle,
y = Change,
group = Study_ID,
color = Response
)
) +
geom_point(
data,
mapping = aes(
x = Cycle,
y = Change,
group = Study_ID,
color = Response,
shape = Progressed
)
) +
geom_point( # Data set with just points
highlight_df,
shape = 18,
size = 2.8,
mapping = aes(
x = Cycle,
y = Change,
group = Study_ID,
)
) +
scale_shape_manual(
values = c(16,18)
) +
scale_color_brewer(
palette = "Set1"
) +
scale_x_continuous(
name = "Cycle",
breaks = c(0,2,4,6,8,10,12,14,16,18,20,30,40,45),
limits = c(0,45),
expand = expansion(mult = c(0,0.001))
) +
scale_y_continuous(
name = "Percent Change in Lesion SLD (%)",
breaks = c(-1,-.75,-.50,-.40,-.30,-.20,-.10,.10,.20,.30,.40,.50,.65),
limits = c(-1,.65),
labels = percent
) +
ggtitle("Response Plot")
p
p_dml <- rvg::dml(ggobj = p)
# initialize PowerPoint slide ----
officer::read_pptx() %>%
# add slide ----
officer::add_slide() %>%
# specify object and location of object ----
officer::ph_with(p_dml, ph_location(width = 10, height = 5)) %>%
# export slide -----
base::print(
target = here::here(
"demo_3.pptx"
)
)
As you can see the distance between each point on the x axis is linear and equal, is there a way to spread out the distance on the plot between 0-20 and make space between 20-40 smaller?
As you can see I have tried to do this using the expand function, but to no avail, I am using the funciton wrong?
Any help would be much appreciated.
Orginal image
Image with scale_x_sqrt
Image with scale_x_continuous(trans = scales::pseudo_log_trans(sigma = 3))
While this is as close as we've gotten to what I am looking for, is there a function that allows me to customize exactly where the ticks are on the axis?
I am building an app to better understand the differences of the lognormal and the normal distribution. The app should display a using ggplot2 a histogram of simulated data (either normal or lognormal) and fit a normal , a lognormal density and a kernel density to the fake data. For some reason the app below wont display the ggplot2 graph.
# Define UI for application that draws a histogram
library(shiny)
library(ggplot2)
library(stats)
library(gridExtra)
set.seed(15)
ui <- fluidPage(
# Application title
titlePanel("Curve fit with different distributions"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("mean",
"Mean value:",
min = 1,
max = 250,
value = 10)
,
sliderInput("spread",
"Standard deviation:",
min = 0,
max = 25,
step=0.1,
value = 2.5)
,
sliderInput("n",
"How many datapoints:",
min = 10,
max = 10000,
value = 2500)
,
selectInput("dist",
"Which data distribution?" ,
list("Normal"="dnorm" ,
"Lognormal"="dlnorm"
)
)),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot", height = "80%"))
)
)
# Define server logic required to draw a histogram with normal and log normal density
server <- function(input, output) {
sim_data<-reactive({
if(is.null(input$dist) |is.null(input$spread) | is.null(input$mean)) {
return(NULL)
}
mlog<-log(input$mean )
lspread <- log(input$spread)
dat <- data.frame(xn = rnorm(input$n, mean = input$mean, sd = input$spread), ln=rlnorm(input$n, meanlog =mlog , sdlog = lspread))
return(dat)
})
output$distPlot <- renderPlot({
if(is.null(sim_data()) |is.null(input$dist) ){
return(NULL)
}
# generate bins based on input$bins from ui.R
if(input$dist == "dnorm"){
hist_plot<- ggplot(sim_data(), aes(x = xn)) +
geom_histogram(aes(y =..density..),
colour = "black",
fill = "white") +
stat_function(fun = dnorm, colour ="#377EB8", args = list(mean = mymean, sd = mysd))+
stat_function(fun = dlnorm, colour ="#E41A1C", args = list(mean = mylmean, sd = mylsd))+
geom_density(colour="black")+
theme_minimal()
}
else{
hist_plot<- ggplot(sim_data(), aes(x = ln)) +
geom_histogram(aes(y =..density..),
colour = "black",
fill = "white") +
labs(title=distname) +
theme_minimal()+
stat_function(fun = dnorm, colour ="#377EB8", args = list(mean = mymean, sd = mysd))+
stat_function(fun = dlnorm, colour ="#E41A1C", args = list(mean = mylmean, sd = mylsd))+
geom_density(colour="black")+
theme_minimal()
}
if(input$dist == "dnorm"){
box_plot<- ggplot(sim_data(), aes(x="",y = xn)) +
geom_boxplot()+
theme_minimal()
}
else{
box_plot<- ggplot(sim_data(), aes(x="",y = ln)) +
geom_boxplot(
)+
theme_minimal()
}
p=grid.arrange(hist_plot+
theme_minimal(),box_plot+
theme_minimal(), ncol=1,nrow=2, heights = c(4,2))
plot(p)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Hi your problem is here
plotOutput("distPlot", height = "80%")
at the moment you are telling the plot to have the height of 80% of nothing which is nothing. Change the height to 400px for example and it will all work.
Shiny notices that the plot is not visual so it is not even calculating the plot ate the moment.
I am trying to display a map and a plot here in a tab interface using Shiny package in R. Inspite of setting the environment by calling the environment(), I am getting this error. The code snippet is given below:
server.R :
shinyServer(function(input, output, session) {
output$box <- renderPlot({
filtered<- aleast.scores[aleast.scores$team == input$typeInput , ]
ggplot(data=filtered) +
geom_bar(mapping=aes(x=score, fill=team), binwidth=1) +
#facet_grid(team~.) +
theme_bw() + scale_color_brewer() +
labs(title="MOBILE PHONE REVIEW")
})
output$map <- renderPlot({
long <-locations_f$longitude
lat <- locations_f$latitude
worldMap <- map_data("world")
zp1 <- ggplot(worldMap,environment=environment())
zp1 <- zp1 + geom_path(aes(x = long, y = lat, group=group), #Draw map
colour = gray(2/3), lwd = 1/3)
filtered<- locations_f[locations_f$team == input$typeInput , ]
zp1 <- zp1 + geom_point(data = filtered, #Add points indicating users
aes(x = long, y = lat, color=type),
alpha = 1, size = 1.5)#+facet_grid(team~.)# +
zp1<-zp1+theme_bw() # + scale_color_brewer()
zp1 <- zp1 + theme_minimal()
print(zp1)
})
})
UI.R
library(shiny)
# Define UI for random distribution application
shinyUI(fluidPage(
# Application title
titlePanel("Tabsets"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
radioButtons("typeInput", "Product type",
choices = c("motorola","nexus","iphone")),
br()
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("plot", plotOutput("box")),
tabPanel("Map", plotOutput("map"))
)
)
)
))
And This is the error I am getting
Warning: Error in exists: argument "env" is missing, with no default
Stack trace (innermost first):
68: output$box
1: shiny::runApp
Also the program worked fine when the first graph (MOBILE PHONE REVIEW) was alone plotted without any tab interface
You did not provide a reproducible example, so I made up some data, and the app ran fine. Try updating your packages.
I made some changes:
replaced geom_bar with geom_histogram to deal with the Warning: 'geom_bar() no longer has a 'binwidth' parameter. Please use 'geom_histogram()' instead.
replaced long and lat in geom_point(data = filtered, aes(x = longitude, y = latitude, color=type), alpha = 1, size = 1.5) since you want the colours to be from the filtered data
server.R
aleast.scores <- data.frame(score = runif(100, min = 0, max = 10), team = sample(c("motorola","nexus","iphone"), 100, replace = TRUE))
locations_f <- data.frame(latitude = runif(100, min = -35, max = 35), longitude = runif(100, min = -120, max = 150), team = sample(c("motorola","nexus","iphone"), 100, replace = TRUE), type = sample(c("good phone", "crap phone"), 100, replace = TRUE))
library(ggplot2)
shinyServer(function(input, output, session) {
output$box <- renderPlot({
filtered<- aleast.scores[aleast.scores$team == input$typeInput , ]
ggplot(data=filtered) +
geom_histogram(mapping=aes(x=score, fill=team), binwidth=1) +
#facet_grid(team~.) +
theme_bw() + scale_color_brewer() +
labs(title="MOBILE PHONE REVIEW")
})
output$map <- renderPlot({
long <-locations_f$longitude
lat <- locations_f$latitude
worldMap <- map_data("world")
zp1 <- ggplot(worldMap,environment=environment())
zp1 <- zp1 + geom_path(aes(x = long, y = lat, group=group), #Draw map
colour = gray(2/3), lwd = 1/3)
filtered<- locations_f[locations_f$team == input$typeInput , ]
zp1 <- zp1 + geom_point(data = filtered, #Add points indicating users
aes(x = longitude, y = latitude, color=type),
alpha = 1, size = 1.5)#+facet_grid(team~.)# +
zp1<-zp1+theme_bw() # + scale_color_brewer()
zp1 <- zp1 + theme_minimal()
print(zp1)
})
})
ui.R
shinyUI(fluidPage(
# Application title
titlePanel("Tabsets"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
radioButtons("typeInput", "Product type",
choices = c("motorola","nexus","iphone")),
br()
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("plot", plotOutput("box")),
tabPanel("Map", plotOutput("map"))
)
)
)
))
I am using the plotly package to produce two plots styled through their ggplotly integration based on a user's inputs. the user accesses each plot by using the tabset panel choice. Unfortunately, in testing, I was not able to use the plotly package to produce both graphs without causing my R instance to crash.
UI with normal ggplot2 functionality
here's the data as suggested by the comments:
generationData = read.csv("data/statedata.csv", #"https://docs.google.com/spreadsheets/d/1ZbDI31sSKatBoEVKo70TV_A4VwCBHK4pIoCWXB7yfx0/pub?gid=192701245&single=true&output=csv",
header = TRUE) #read csv file
generationDataCleaned = generationData[!(is.null(generationData$Name) | generationData$Name==""), ]
statenames = as.character(generationDataCleaned$Name)
row.names(generationDataCleaned) = statenames
result() is a reactive function to calculate the result data frame that the plot uses
result <- reactive({
state = input$stateInput
pctCoal = input$Coal / 100
if(state == "") {
#handle onload
print("it was blank!")
state = "Alabama"
pctCoal = 15 / 100
}
baseCoal_Energy = generationDataCleaned[state, "Coal.Steam.Electric.Generation..MWh."]
baseNGCC_Energy = generationDataCleaned[state, "NGCC.Electric.Generation..MWh."]
totalEnergy = sum(baseCoal_Energy,
baseNGCC_Energy
)
baseEnergy = totalEnergy
coalEnergy_Reduction = (pctCoal) * baseCoal_Energy
newCoal_Energy = (1 - pctCoal) * baseCoal_Energy
newNGCC_Energy = baseNGCC_Energy + coalEnergy_Reduction
newEnergy = newCoal_Energy + newNGCC_Energy
Energy_Frame <- c(baseEnergy, newEnergy)
#Emissions Rate
baseCoal_CO2_Rate = generationDataCleaned[state, "Coal.Steam.Emission.Rate..lb.MWh."]
baseNGCC_CO2_Rate = generationDataCleaned[state, "NGCC.Emission.Rate..lb.MWh."]
totalCO2_Rate = sum(baseCoal_CO2_Rate,
baseNGCC_CO2_Rate
)
baseCO2_Rate = totalCO2_Rate
coalCO2_Rate_Reduction = (pctCoal) * baseCoal_CO2_Rate
newCoal_CO2_Rate = (1 - pctCoal) * baseCoal_CO2_Rate
newNGCC_CO2_Rate = baseNGCC_CO2_Rate + coalEnergy_Reduction * baseNGCC_CO2_Rate / baseNGCC_Energy
newCO2_Rate = newCoal_CO2_Rate + newNGCC_CO2_Rate
CO2_Rate_Frame <- c(baseCO2_Rate, newCO2_Rate)
#Emissions Mass
baseCoal_CO2_Mass = generationDataCleaned[state, "Coal.Steam.Carbon.Dioxide.Emissions..tons."]
baseNGCC_CO2_Mass = generationDataCleaned[state, "NGCC.Carbon.Dioxide.Emissions..tons."]
totalCO2_Mass = sum(baseCoal_CO2_Mass,
baseNGCC_CO2_Mass
)
baseCO2_Mass = totalCO2_Mass
coalCO2_Mass_Reduction = (pctCoal) * baseCoal_CO2_Mass
newCoal_CO2_Mass = (1 - pctCoal) * baseCoal_CO2_Mass
newNGCC_CO2_Mass = baseNGCC_CO2_Mass + coalEnergy_Reduction * baseNGCC_CO2_Mass / baseNGCC_Energy
newCO2_Mass = newCoal_CO2_Mass + newNGCC_CO2_Mass
CO2_Mass_Frame <- c(baseCO2_Mass, newCO2_Mass)
name_Frame <- c("Base", "New")
result <- data.frame(name_Frame, Energy_Frame, CO2_Rate_Frame, CO2_Mass_Frame)
colnames(result) <- c("Name", "Energy", "Rate", "Mass")
result
})
ui.R
column(8,
tabsetPanel(type = "tabs",
id = "tabset1",
tabPanel("Rate", value = "Rate", plotlyOutput("ratePlot")),
tabPanel("Mass", value = "Mass", plotlyOutput("massPlot"))#, plotOutput("massPlot"))
)
server.R
output$ratePlot <- renderPlotly({
gg <- ggplot(result(), aes(x = Name, y = Rate, fill = Name)) +
theme_minimal() +
geom_bar(stat = "identity") +
scale_fill_brewer(type = "qual", palette = 1)
#gg
p <- ggplotly(gg)
p
})
output$massPlot <- renderPlotly({
gg2 <- ggplot(result(), aes(x = Name, y = Mass, fill = Name)) +
theme_minimal() +
geom_bar(stat = "identity") +
scale_fill_brewer(type = "qual", palette = 1)
#gg2
p2 <- ggplotly(gg2)
p2
})
But when I do just normal ggplot2, the tabPanel works fine:
ui.R
tabsetPanel(type = "tabs",
id = "tabset1",
tabPanel("Rate", value = "Rate", plotOutput("ratePlot")),
tabPanel("Mass", value = "Mass", plotOutput("massPlot"))#, plotlyOutput("massPlot"))
)
server.R
output$ratePlot <- renderPlot({ #ly
gg <- ggplot(result(), aes(x = Name, y = Rate, fill = Name)) +
theme_minimal() +
geom_bar(stat = "identity") +
scale_fill_brewer(type = "qual", palette = 1)
gg
#p <- ggplotly(gg)
#p
})
output$massPlot <- renderPlot({
gg2 <- ggplot(result(), aes(x = Name, y = Mass, fill = Name)) +
theme_minimal() +
geom_bar(stat = "identity") +
scale_fill_brewer(type = "qual", palette = 1)
gg2
})
Is there some functionality that I need to change?
For now, it seems as there is no solution to using tabbed panels with ggplot2 integration within plotly (ggplotly()). Worked around this issue by just using plotly() for each graph between the tabs.
I am trying to create an interactive visualisation of data in shiny. The visualisation shows the distribution (or histogramm) of parts of a series. For example, the following code creates a series and two selections (two is fixed) of parts of the series, which is then displayed using ggplot:
library(ggplot2)
set.seed(123)
dat <- data.frame(x = 1:1000,
y = cumsum(rnorm(1000, mean = 0.1)))
sel1 <- 200:400 # selection 1
sel2 <- 700:900 # Selection 2
# create a plot of the series
ggplot() + geom_line(data = dat, aes(x = x, y = y)) +
geom_rect(aes(xmin = sel1[1], xmax = sel1[length(sel1)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = sel2[1], xmax = sel2[length(sel2)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "blue")
# Histogramm preparation
# create another df that contains the selection of the two selections
pdat <- rbind(data.frame(y = dat[dat$x %in% sel1, 2],
sel = 1),
data.frame(y = dat[dat$x %in% sel2, 2],
sel = 2))
# plot the histograms
ggplot(pdat, aes(x = y, fill = as.factor(sel))) +
geom_histogram(alpha = 0.5, position = "dodge")
which creates:
Now I want the user to be able to move the areas (preferably by dragging the shaded areas in plot 1 around!) using shiny.
I played around with the (new) interactive options of shiny (more info here, look for section "Interactive plots"). I think I can remember that there is an option to specify an area, which the user is able to drag around, but I can't find it anymore.
Any ideas?
As mentioned in the comments do look into rCharts and dygraphs, below is the example taken from tutorials with some modifications. Please note that the dygraphs require a timeseries object to plot, refer to official docs for more information. The summary statistics can be performed by a package of your choice. Also note that the shaded regions are user specified...
rm(list = ls())
library(shiny)
library(dygraphs)
library(xts)
library(rCharts)
index <- as.Date(c(seq(Sys.time(), length.out = 1000, by = "days")))
dat <- data.frame(x = index,y = cumsum(rnorm(1000, mean = 0.1)))
dat <- xts(dat[,-1], order.by=dat[,1])
ui <- fluidPage(
titlePanel("Shaded Regions using dygraphs and rCharts by Pork Chop"),
sidebarLayout(
sidebarPanel(
sliderInput("range_one", "Range One:",min = 100, max = 1000, value = c(200,300)),
sliderInput("range_two", "Range Two:",min = 100, max = 1000, value = c(500,600)),width=3),
mainPanel(
column(12,dygraphOutput("dygraph")),
column(12,showOutput("summary", "Highcharts"))
)
)
)
server <- function(input, output) {
output$dygraph <- renderDygraph({
dygraph(dat, main = "Sample Data") %>%
dyShading(from = index[input$range_one[1]], to = index[input$range_one[2]], color = "#FFE6E6") %>%
dyShading(from = index[input$range_two[1]], to = index[input$range_two[2]], color = "#CCEBD6")
})
output$summary <- renderChart2({
Selection1 <- dat[input$range_one[1]:input$range_one[2]]
Selection2 <- dat[input$range_two[1]:input$range_two[2]]
subset_data <- data.frame(merge(Selection1,Selection2))
a <- rCharts:::Highcharts$new()
a$chart(type = "column")
a$title(text = "Summary Stats")
a$yAxis(title = list(text = "Count"))
a$data(subset_data)
a$exporting(enabled=T)
a$set(width = 1200,height = "100%",slider = TRUE)
return(a)
})
}
shinyApp(ui, server)
I think I found a solution that is able to use interactive ggplot's in a shiny environment. The code looks like this:
library(shiny)
library(ggplot2)
ifna <- function(x, elseval = NA) ifelse(is.na(x) || is.null(x), elseval, x)
# two plots: as described in the question
ui <- fluidPage(
uiOutput("plotui"),
plotOutput("plot2")
)
server = function(input, output) {
set.seed(123)
dat <- data.frame(x = 1:1000,
val = cumsum(rnorm(1000, mean = 0.1)))
base <- 200:400 # Base Selection
# reactive expressions to get the values from the brushed area
selmin <- reactive(round(ifna(input$plot_brush$xmin, elseval = 700), 0))
selmax <- reactive(round(ifna(input$plot_brush$xmax, elseval = 900), 0))
# include the brush option: direction = "x" says that y values are fixed (min and max)
output$plotui <- renderUI({
plotOutput("plot", height = 300,
brush = brushOpts(id = "plot_brush", direction = "x",
fill = "blue", opacity = 0.5)
)
})
# render the first plot including brush
output$plot <- renderPlot({
ggplot() + geom_line(data = dat, aes(x = x, y = val)) +
geom_rect(aes(xmin = base[1], xmax = base[length(base)],
ymin = -Inf, ymax = Inf), alpha = 0.5, fill = "red") +
geom_rect(aes(xmin = 700, xmax = 900,
ymin = -Inf, ymax = Inf), alpha = 0.1, fill = "blue") +
ylab("Value") + xlab("t")
})
# render the second plot reactive to the brushed area
output$plot2 <- renderPlot({
# prepare the data
pdat <- rbind(data.frame(y = dat[dat$x %in% base, "val"],
type = "Base"),
data.frame(y = dat[dat$x %in% selmin():selmax(), "val"],
type = "Selection"))
ggplot(pdat, aes(x = y, fill = type)) +
geom_histogram(alpha = 0.5, position = "dodge") +
scale_fill_manual(name = "", values = c("red", "blue")) +
theme(legend.position = "bottom") + ylab("Frequency") + xlab("Value")
})
}
# run the app
shinyApp(ui, server)
Which gives something like this (the dark-blue box is interactive, as in you can push it around and the lower graph updates!
Picture of Shiny App