Shiny : variable height of renderplot - r

I would like to take the height of my plot reactive because sometimes I have to draw just one graph and sometimes two or three graphs. Here my code :
output$myplot<-renderPlot({
plot_to_draw <- data[data$code==input$code,"River_name"]
plot(plot_to_draw)
number_of_plot <- length(plot_to_draw)
},height = 500*number_of_plot)
But shiny reads the height of the plot just one time so that it's not reactive.
Thank you for your answers !

I finally figuerd out a solution ;
server.R
output$myplot<-renderPlot({
plot_to_draw <- data[data$code==input$code,"River_name"]
plot(plot_to_draw)
number_of_plot <- length(plot_to_draw)
},height = function(){500*number_of_plot})
ui.R
plotOutput(outputId="myplot",height = "auto")

This is the solution that I finally got, after drudging with my app and thanks to all persons in this thread for your kind suggestions. Please don't mind the name of the variables.
In the server part:
#I had to transform my imput into a data.frame, otherwise sqldf didn't work.
country12<- reactive({as.data.frame(matrix(c(input$sel_country121),1,1))})
question12<-reactive({
country121 <- country12()
sqldf("SELECT dp.Year, dp.Type_of_Product COUNT (*) as num_products12 FROM dataPanelV5 dp, country121 p WHERE dp.Country_name = p.V1 GROUP BY dp.Year, dp.Type_of_Product")})
#I use this function to calculate the number of different types of products resulting from the query, using unique() and calculating its length, as that number is the number of facets.
n_facets12<-function(){
question121<- question12()
return (500*length(unique(question121$Type_of_Product)))}
output$barplot12 <- renderPlot({
question121<-question12()
ggplot(question121,aes(x=factor(Year),y=num_products12,fill=Type_of_Product)) + geom_bar(stat="identity") + facet_grid(Type_of_Product ~ .,scales = "free_y") +
geom_text(aes(label=num_products12), vjust=-0.2, colour="black") + scale_x_discrete(breaks=question121$Year,labels=as.character(question121$Year),position = "top") + theme(legend.position="top",axis.title.y=element_blank(),axis.text.y = element_blank(),panel.grid.major.y = element_blank(),panel.grid.minor.y = element_blank()) + labs(fill="Type_of_Product", x="Year")
},height = n_facets12)
#And it works!!

Related

I can't get my plots to a single grid please help correct my code

I have 11 plots and used a looping function to plot them see my code below. However, I can't get them to fit in just 1 page or less. The plots are actually too big. I am using R software and writing my work in RMarkdown. I have spent almost an entire week trying to resolve this.
group_by(Firm_category) %>%
doo(
~ggboxplot(
data =., x = "Means.type", y = "means",
fill ="grey", palette = "npg", legend = "none",
ggtheme = theme_pubr()
),
result = "plots"
)
graph3
# Add statistical tests to each corresponding plot
Firm_category <- graph3$Firm_category
xx <- for(i in 1:length(Firm_category)){
graph3.i <- graph3$plots[[i]] +
labs(title = Firm_category[i]) +
stat_pvalue_manual(stat.test[i, ], label = "p.adj.signif")
print(graph3.i)
}
#output3.long data sample below as comments
#Firm_category billmonth Means.type means
#Agric 1 Before 38.4444
#Agric 1 After 51.9
Complete data is on my github: https://github.com/Fridahnyakundi/Descriptives-in-R/blob/master/Output3.csv
This code prints all the graphs but in like 4 pages. I want to group them into a grid. I have tried to add all these codes below just before my last curly bracket and none is working, please help me out.
library(cowplot)
print(plot_grid(plotlist = graph3.i[1:11], nrow = 4, ncol = 3))
library(ggpubr)
print(ggarrange(graph3.i[1:11], nrow = 4, ncol = 3))
I tried the gridExtra command as well (they all seem to do the same thing). I am the one with a mistake and I guess it has to do with my list. I read a lot of similar work here, some suggested
dev.new()
dev.off()
I still didn't get what they do. But adding either of them caused my code to stop.
I tried defining my 'for' loop function say call it 'XX', then later call it to make a list of graph but it returned NULL output.
I have tried defining an empty list (as I read in some answers here) then counting them to make a list that can be printed but I got so many errors.
I have done this for almost 3 days and will appreciate your help in resolving this.
Thanks!
I tried to complete your code ... and this works (but I don't have your 'stat.test' object). Basically, I added a graph3.i <- list() and replaced graph3.i in the loop ..
Is it what you wanted to do ?
library(magrittr)
library(dplyr)
library(rstatix)
library(ggplot2)
library(ggpubr)
data <- read.csv(url('http://raw.githubusercontent.com/Fridahnyakundi/Descriptives-in-R/master/Output3.csv'))
graph3 <- data %>% group_by(Firm_category) %>%
doo(
~ggboxplot(
data =., x = "Means.type", y = "means",
fill ="grey", palette = "npg", legend = "none",
ggtheme = theme_pubr()
),
result = "plots"
)
graph3
# Add statistical tests to each corresponding plot
graph3.i <- list()
Firm_category <- graph3$Firm_category
xx <- for(i in 1:length(Firm_category)){
graph3.i[[i]] <- graph3$plots[[i]] +
labs(title = Firm_category[i]) # +
# stat_pvalue_manual(stat.test[i, ], label = "p.adj.signif")
print(graph3.i)
}
library(cowplot)
print(plot_grid(plotlist = graph3.i[1:11], nrow = 4, ncol = 3))

Plotting a tree - collapsing a vector of nodes

I am trying to plot a large tree using ggtree, but, due to its size, I would like to collapse multiple nodes. I am following a tutorial , but it collapses the nodes one at the time, and this is not an option in my case.
Here is my code:
library(ggtree)
library(ape)
library(ggplot2)
library(colorspace)
library(Biostrings)
library(phytools)
library(treeio)
library(dplyr)
library(readr)
library(tidyr)
library(reshape2)
tempnwk<- "((('clade01_1':1.35E-4,('clade01_2':1.0E-6,'clade01_3':1.0E-6):3.3E-5):3.3E-5,('clade02_1':2.7E-4,'clade02_2':3.3E-5):3.3E-5):1.0E-6,'clade03_1':1.0E-6);"
testTree0 <- read.tree(text = tempnwk)
#
testcollapse0<- ggtree(testTree0)
#Now, this works:
#
testcollapse0b<- testcollapse0 %>% collapse(node = 10) +
geom_point2(aes(subset=(node==10)),
shape=21, size=5, fill='green')
testcollapse0b<- collapse(testcollapse0b, node = 11) +
geom_point2(aes(subset=(node==11)),
shape=21, size=5, fill='red')
testcollapse0b ####This works
#
#
##############THis does not:
nodes2go<- c(10, 11)
myTestCols<- c('green', 'red')
testcollapse1<- testcollapse0
for(i in 1:2) {
testcollapse1<- collapse(
testcollapse1, node = nodes2go[i]) +
geom_point2(
aes(subset=(node==i)), shape=23,
size=7, fill=myTestCols[i])
}
rm(i)
#
testcollapse1 + geom_text(aes(label=label))
#
#Error in FUN(X[[i]], ...) : object 'i' not found
I need some help, I am not sure how to fix it. I had a look at drop.tip, but I am not sure that is what I want, since I still want a colored dot where the collapsed node is.
I am looking forward to your feedback, thank you for your kind attention.
Well,
While waiting for a sane way to do it, quick and dirty will do the job:
myTestCols2<- c("'green'", "'red'")
testcollapse2<- testcollapse0
teststring0<- "testcollapse2<- collapse(testcollapse2, node=NODE) + geom_point2(aes(subset=(node==NODE)), shape=23, size=7, fill=COLOR);"
testString2<- character()
for(i in 1:2) {
indString<- gsub(
pattern = "NODE",replacement = nodes2go[i],
x = teststring0)
indString<- gsub(
pattern = "COLOR", replacement = myTestCols2[i],
x = indString)
testString2<- c(testString2, indString)
}
rm(i, indString)
#
#Run the command
eval(parse(text = testString2))
##And now plot:
testcollapse2
And yes, I am aware that there must be a better way to do it 🙄

Listing All Variables (Column Names) in R Shiny's checkboxGroupInput

I'm writing an R shiny application. I'm facing much trouble, particularly the checkboxGroupInput function. I'm hoping that I will be able to create a dynamic list that will automatically list down all columns except the first column, source_file$Date of a dataset named source_file, and I'm not entirely sure on it. Would greatly appreciate any help you can provide!
Sample dataset of source_file would look something like this:
Date
Index 1
Index 2
Index 3
Index 4
Index 5
2016-01-01
+5%
-2%
+5%
+10%
+12%
2016-01-08
+3%
+13%
-8%
-3%
+10%
2016-01-15
+2%
+11%
-3%
+4%
-15%
The end goal is that I hope the checkboxGroupInput function will be able to automatically read all columns starting from the second column (ignore Date). In this case, the check box would load up 5 options, Index 1 to Index 5. It should be replicable such that it can load any number of indexes depending on the data specified. I tried hard-coding each individual index in but it's definitely counter-intuitive and so frustrating to do.
tabPanel("Target Volatility Portfolio",
sidebarPanel(
tags$h3("Find an optimised portfolio to achieve maximum return for a given level of risk/volatility"),
tags$h4("Input:"),
checkboxGroupInput("portfolio_selection",
"Select Number of Indexes for Portfolio",
choices = list(#####please send help here#####)
Edits: Would appreciate if you could help me fix this.
I want to reference the output that comes from the checkbox into my global.R in this format. Basically, I want to use the selected variables to plot a graph. A selection of 2 variables will result in a graph plotting a graph related to the 2 variables, whereas a selection of 10 variables will create a plot involving all 10 variables. (I'm basically plotting the efficient market frontier of x number of stocks where x is the number of variables selected. Its a little hard to explain but I hope attaching the code can provide you some insight) The hashed line is what I need help fixing. Thank you!
plot_emf = function(n_points, target_vol, portfolio_selection)
{
first <- portfolio_selection[1]
last <- portfolio_selection[length(portfolio_selection)]
#######asset_returns = source_file[first:last]########
# Extract necessary parameters
n_assets = ncol(asset_returns)
n_obs = nrow(asset_returns)
n_years = n_obs / 52
# Initialize containers for holding return and vol simulations
return_vector = c()
vol_vector = c()
sharpe_vector = c()
for (i in 1:n_points)
{
# Generate random weights for n assets from uniform(0,1)
asset_weights = runif(n_assets, min = 0, max = 1)
normalization_ratio = sum(asset_weights)
# Asset weights need to add up to 100%
asset_weights = asset_weights / normalization_ratio
# print(asset_weights)
# print(asset_returns)
# Generate the portfolio return vector using these weights
random_portfolio_returns = emf_portfolio_returns(
asset_weights,
asset_returns)
# print(random_portfolio_returns)
# plot_returns_histogram(random_portfolio_returns$portfolio_returns)
cumulative_return = calculate_cumulative_return(random_portfolio_returns$portfolio_returns)
annualized_return = 100*((1 + cumulative_return/100)^(1/n_years) - 1)
annualized_vol = sd(random_portfolio_returns$portfolio_returns)*(52^0.5)
sharpe = annualized_return / annualized_vol
return_vector = append(return_vector, annualized_return)
vol_vector = append(vol_vector, annualized_vol)
sharpe_vector = append(sharpe_vector, sharpe)
#print(paste("Asset weights:",asset_weights))
#print(paste("Anualized return:",annualized_return))
#print(paste("Annualized vol:",annualized_vol))
}
g = ggplot(data = data.frame(vol_vector, return_vector, sharpe_vector),
aes(x = vol_vector, y = return_vector, color = sharpe_vector)) +
scale_color_gradient(low = "red", high = "blue", name = "Sharpe Ratio\n(Return/Risk)") +
ggtitle("Efficient Market Frontier") +
xlab("Annualized Vol (%)") +
ylab("Annualized Return (%)") +
theme(plot.title = element_text(hjust=0.5)) + geom_vline(xintercept=target_vol) +
geom_point()
print(g)
}
You can try something like the following which uses colnames() to extract the new choices, and then updates the checkboxGroupInput with updateCheckboxGroupInput():
server <- function(input, output, session) {
# Read the data once per session - this step might be better to
# put in a `global.R` file
source_file <- read.csv("source_file.csv")
# Column names we want to show - all except `Date`
opts <- setdiff(colnames(source_file), "Date")
# Update your checkboxGroupInput:
updateCheckboxGroupInput(
session, "portfolio_selection", choices = opts
)
# Rest of app after this point --------------------------------------
}

How to use a custom-defined function to change a text label in geom_text()

I have some data, and I want to use some variables from stat_count() to label a bar plot.
This is what I want to do:
library(ggplot2)
library(scales)
percent_and_count <- function(pct, cnt){
paste0(percent(pct), ' (', cnt, ')')
}
ggplot(aes(x=Type)) +
stat_count(aes(y=(..prop))) +
geom_text(aes(y=(..prop..), label=percent_and_count(..prop.., ..count))),
stat='count')
However, I get this error, since it can't find the function in what I assume is either some base packages or the data frame:
Error in eval(expr, envir, enclos) : could not find function "percent_and_count"
I get this error if I do percent(..prop..) as well, although it is fine with scales::percent(..prop..). I did not load my function from a package.
If all else fails, I can do
geom_text(aes(y=(..prop..), label=utils::getAnywhere('percent_and_count')$objs[[1]]((..prop..),(..count..))))
But this seems needlessly roundabout for what should be a stupidly simple task.
You can use bquote and aes_:
# Sample data
set.seed(2017);
df <- data.frame(
Type = sample(6, 100, replace = T)
);
library(ggplot2);
library(scales);
# Your custom function
percent_and_count <- function(pct, cnt){
paste0(percent(pct), ' (', cnt, ')')
}
ggplot(df, aes(x = Type)) +
stat_count(aes(y = ..prop..)) +
geom_text(
stat = "count",
aes_(
y = ~(..prop..),
label = bquote(.(percent_and_count)((..prop..), (..count..)))))
Explanation: bquote(.(percent_and_count)(...)) ensures that percent_and_count is found (as terms .(...) are evaluated in the parent environment). We then use aes_ to ensure that quoted expressions (either with ~ or bquote) are properly evaluated.
Still not pretty, but probably more straighforward than using utils::getAnywhere.

GTrendsR + ggplot2?

I want to generate a plot of interest over time using GTrendsR and ggplot2
The plot I want (generated with google trends) is this:
Any help will be much appreciated.
Thanks!
This is the best I was able to get:
library(ggplot2)
library(devtools)
library(GTrendsR)
usr = "my.email"
psw = "my.password"
ch = gConnect(usr, psw)
location = "all"
query = "MOOCs"
MOOCs_trends = gTrends(ch, geo = location, query = query)
MOOCs<-MOOCs_trends[[1]]
MOOCs$moocs<-as.numeric(as.character(MOOCs$moocs))
MOOCs$Week <- as.character(MOOCs$Week)
MOOCs$start <- as.Date(MOOCs$Week)
ggplot(MOOCs[MOOCs$moocs!=0,], aes(start, moocs)) +
geom_line(colour = "blue") +
ylab("Trends") + xlab("") + theme_bw()
I think that to match the graph generated by google I would need to aggregate the data to months instead of weeks... not sure how to do that yet
The object returned by gtrendsR is a list, of which the trend element in a data.frame that you would want to plot.
usr = "my.email"
psw = "my.password"
gconnect(usr, psw)
MOOCs_trends = gtrends('MOOCs')
MOOCsDF <- MOOCs_trends$trend
ggplot(data = MOOCsDF) + geom_line(aes(x=start, y=moocs))
This gives:
Now if you want to aggregate by month, I would suggest using the floor_date function from the lubridate package, in combination with dplyr (note that I am using the chain operator %>% which dplyr re-exports from the magrittr package).
usr = "my.email"
psw = "my.password"
gconnect(usr, psw)
MOOCs_trends = gtrends('MOOCs')
MOOCsDF <- MOOCs_trends
MOOCsDF$start <- floor_date(MOOCsDF$start, unit = 'month')
MOOCsDF %>%
group_by(start) %>%
summarise(moocs = sum(moocs)) %>%
ggplot() + geom_line(aes(x=start, y=moocs))
This gives:
Note 1: The query MOOCs was changed to moocs, by gtrendsR, this is reflected in the y variable that you're plotting.
Note 2: some of the cases of functions have changed (e.g. gtrendsR not GTrendsR), I am using current versions.
This will get you most of the way there. The plot doesn't look quite right, but that's more of a function of the data being a bit different. Here's the necessary conversions to numeric and to dates.
MOOCs<-MOOCs_trends[[1]]
library(ggplot2)
library(plyr)
## Convert to string
MOOCs$Week <- as.character(MOOCs$Week)
MOOCs$moocs <- as.numeric(MOOCs$moocs)
# split the string
MOOCs$start <- unlist(llply(strsplit(MOOCs$Week," - "), function(x) return(x[2])))
MOOCs$start <- as.POSIXlt(MOOCs$start)
ggplot(MOOCs,aes(x=start,y=moocs))+geom_point()+geom_path()
Google might do some smoothing, but this will plot the data you have.

Resources