i have a problem using the gtrendsR package. When creating an example Shiny APP I always get the error:
Error in gtrends: unused arguments (start_date = start_date(), end_date = end_date())
The start and end date no longer exist in the current package. Currently, start and end times only need to be specified as follows:
Time span between two dates (ex.: "2010-01-01 2010-04-03")
How can I change the function?
Many thanks for your help.
The complete code looks like this:
server.R:
# Load libraries ====
if(!require(shiny)){
install.packages('shiny')
}
if(!require(gtrendsR)){
install.packages('gtrendsR')
}
if(!require(reshape2)){
install.packages('reshape2')
}
if(!require(ggplot2)){
install.packages('ggplot2')
}
library(shiny)
library(gtrendsR)
library(reshape2)
library(ggplot2)
data(countries)
# Start shiny application
shinyServer(function(input, output) {
out <- reactive({
if(length(input$terms)>0){
unlist(strsplit(input$terms,","))
}
})
start_date<-reactive({
if(input$period=="2004-present"){as.Date("2004-01-01")}
else if (input$period=="Past90Days"){as.Date(Sys.time())-90}
else if (input$period=="Past12Months"){
m=as.POSIXlt(as.Date(Sys.time()))
m$year=m$year-1
m}
else if (input$period=="2011"){as.Date("2011-01-01")}
else if (input$period=="2012"){as.Date("2012-01-01")}
else if (input$period=="2013"){as.Date("2013-01-01")}
else if (input$period=="2014"){as.Date("2014-01-01")}
else if (input$period=="2015"){as.Date("2015-01-01")}
})
end_date<-reactive({
if(input$period %in% c("2004-present",
"Past90Days","Past12Months"))
{
as.Date(Sys.time())}
else if (input$period=="2011"){as.Date("2011-12-31")}
else if (input$period=="2012"){as.Date("2012-12-31")}
else if (input$period=="2013"){as.Date("2013-12-31")}
else if (input$period=="2014"){as.Date("2014-12-31")}
else if (input$period=="2015"){as.Date(Sys.time())}
})
geo<-reactive({
if(input$geography=="Worldwide"){""}
else{
countries$CODE[countries$COUNTRY==input$geography]
}
})
data<-reactive({
if(length(out()>0))
{
out2<-gtrends(query=out(),start_date=start_date(),end_date=end_date(),geo=geo())
}
})
output$myplot <- renderPlot({
if(length(out()>0)){
z=data()
trend=z$trend
if("end"%in%names(trend)==T)
{
trend=select(trend,-end)}
trend <- melt(trend, id='start')
ggplot(trend, aes(start,value, color=variable)) + geom_line()+ggtitle("Interest over time")+
ylab("Relative Trend")+
theme(plot.title = element_text(size = 18,colour="black"))+
xlab('')+theme(axis.title.y = element_text(colour="#00007A",size=14,angle=90,hjust=.5,vjust=1),
axis.text.y = element_text(colour="darkred",size=14,angle=0,hjust=1,vjust=0),
axis.text.x = element_text(colour="darkred",size=14,angle=0,hjust=1,vjust=0))+
theme(legend.title = element_text(colour="black", size=15,
face="bold"))+
theme(legend.text = element_text(colour="blue", size=14,
face="bold"))
}
})
corr<-reactive({
if(input$corr==T & length(out()>1)){
z=data()
trend=z$trend
trend=trend[,3:ncol(trend)]
cor(trend)
}
})
output$myplot3 <- renderPlot({
if(length(corr()>0)){
data=corr()
qplot(x=Var1, y=Var2, data=melt(cor(data)), fill=value, geom="tile")+
ggtitle('Correlation Matrix')+theme(axis.title.y =element_blank(),axis.title.x =element_blank(),
axis.text.y = element_text(colour="darkred",size=14,angle=0,hjust=1,vjust=0),
axis.text.x = element_text(colour="darkred",size=14,angle=0,hjust=1,vjust=0))+
theme(legend.title=element_blank())+
theme(legend.text = element_text(colour="black", size=14))+scale_fill_gradient2(limits=c(-1, 1),low="skyblue", high="blue")+
theme(plot.title = element_text(size = 20,colour="black"))
}
})
output$myplot2 <- renderPlot({
if(length(out()>0)){
data=data()
z=data$searches
rr=data$regions
for (i in 1:length(z)){
n=z[i]
n=as.data.frame(n)
names(n)=c("searches","hits")
n$searches <- factor(n$searches, levels = n$searches[order(n$hits,decreasing =T)])
colors=c("orange","skyblue","#999966")
col=sample(c(1,2,3),1,replace=T)
x11()
print(ggplot(n, aes(searches,hits))+
geom_bar(stat='identity',fill=colors[col],color='black')+
ggtitle(data$headers[2+2*length(z)+i])+ylab('Hits')+
theme(plot.title = element_text(size = 18,colour="blue"))+
theme(axis.title.x=element_blank(),axis.title.y = element_text(colour="blue",size=14),axis.text.x = element_text(colour="grey20",size=14,angle=60,hjust=.5,vjust=.5,face="plain"))
)
if(geo()=='')
{
x11()
regions = as.data.frame(rr)[c(1,i+1)]
names(regions)=c('region','hits')
regions$region[regions$region=="United States"] = "USA"
world_map = map_data("world")
world_map =merge(world_map, regions, by="region",all.x = TRUE)
world_map = world_map[order(world_map$group, world_map$order),]
g=ggplot(world_map, aes(x=long, y=lat, group=group))+
geom_polygon(aes(fill=hits), color="gray70")
print(g+theme(axis.text.y = element_blank(),
axis.text.x = element_blank(),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())+
scale_fill_gradient(low = "skyblue", high = "blue", guide = "colorbar",na.value="white")+ggtitle(data$headers[2+2*length(z)+i])+ylab('Hits')+
theme(legend.key.size = unit(1, "cm"),
legend.title = element_text(size = 12, colour = "blue"),
legend.title.align=0.3,legend.text = element_text(size = 10))+
theme(panel.border = element_rect(colour = "gray70", fill=NA, size=0.5))
)
}
}
}
})
})
And ui.R:
library(shiny)
library(shinydashboard)
dashboardPage(
dashboardHeader(title="By Fish"),
dashboardSidebar(
br(),
h6(" Search Term(s)",style="text-align:center;color:#FFA319;font-size:150%"),
helpText("Give one or more terms that you want R to retrieve data from the Google Trends API.
Use comma to separate terms", style="text-align:center"),
textInput('terms',''),
selectInput("geography",
label = tags$h4(strong(em("Geography")),style="text-align:center;color:#FFA319;font-size:150%"),
choices = c("Worldwide"),
selected = "Worldwide"),
selectInput("period",
label = tags$h4(strong(em("Time Period")),style="text-align:center;color:#FFA319;font-size:150%"),
choices = c("2004-present",
"Past30Days",
"Past90Days",
"Past12Months",
"2011",
"2012",
"2013",
"2014",
"2015"
),
selected = "2004-present"),
checkboxInput("corr",
label = strong("Correlation",style="text-align:center;color:#FFA319;font-size:150%")),
br(),
tags$h1(submitButton("Update!"),style="text-align:center"),
helpText("To get results, click the 'Update!' button",style="text-align:center"),
br(),
br(),
br(),
br(),
br(),
br()
),
#####
## Main Panel
#### help ====
dashboardBody(
fluidRow(
br(),
h5(em(strong("Google Trends Analytics", style="color:darkblue;font-size:210%")),align = "center"),
plotOutput("myplot"),
br(),
plotOutput("myplot3"),
plotOutput("myplot2")
)
))
The answer to your question is you are not using gtrends() in the right way probably the code was written for an older version of the package.
Please change your code like this.
out2<- gtrends(keyword = out(),
time = paste0(start_date()," ",end_date()),
geo=geo())
Please note even after that your code isn't running successfully because again the way the function result is handled in your code is different from what it actually returns so those need to be fixed.
Related
I am trying to show a plot chart after the button is clicked, which means the chart will only show up when the button is clicked, but the chart is just not showing up... any clue with this? Here is the code:
shinyApp(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Show Chart")
),
mainPanel(
plotOutput("bar")
)
)
),
server = function(input, output) {
observeEvent(input$button, {
category <- c('task1', 'task2', 'task2','task1','task1')
start_min <- c(0, 0, 16, 45, 40)
stop_min <- c(14.9,18.8,17.5,65.5, 70)
group <- c('A', 'B', 'A', 'A', 'B')
data <- data.frame(category,start_min,stop_min,group)
task_bars <- ggplot(data, mapping=aes(ymin=0, ymax=1,
xmin=start_min, xmax=stop_min,
fill=as.factor(category),
text=paste("Task:", str_wrap(string = category, width = 70,),
"<br>Start: ", format(start_min, digits=1), "min",
"<br>Stop: ", format(stop_min, digits=1), "min")
)) +
geom_rect(alpha=0.8) +
theme_minimal()+
theme(
axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
scale_fill_discrete(breaks=data$category)
task_bars <- plotly::ggplotly(task_bars, tooltip="text", width = 970, height = 120) %>%
plotly::config(displayModeBar = TRUE) %>%
plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
print(task_bars)
output$bar <- renderPlotly(task_bars)
})
}
)
You need to move the output$bar outside of the observeEvent. I created a reactiveValues object for your plot. The observeEvent creates the plot and then it will be displayed in the output.
You also had plotOutput in ui instead of plotlyOutput in ui.
library(shiny)
library(ggplot2)
library(plotly)
task_bars <- reactiveValues(plot = NULL)
shinyApp(
ui = fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("button", "Show Chart")
),
mainPanel(
plotlyOutput("bar")
)
)
),
server = function(input, output) {
observeEvent(input$button, {
category <- c('task1', 'task2', 'task2','task1','task1')
start_min <- c(0, 0, 16, 45, 40)
stop_min <- c(14.9,18.8,17.5,65.5, 70)
group <- c('A', 'B', 'A', 'A', 'B')
data <- data.frame(category,start_min,stop_min,group)
task_bars$plot <- ggplot(data, mapping=aes(ymin=0, ymax=1,
xmin=start_min, xmax=stop_min,
fill=as.factor(category)
)) +
geom_rect(alpha=0.8) +
theme_minimal()+
theme(
axis.title.x=element_text(color="white"), axis.text.x=element_text(color="white"),
axis.text.y=element_blank(), axis.ticks.y=element_blank(),
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(), panel.background = element_blank()) +
scale_fill_discrete(breaks=data$category)
})
output$bar <- renderPlotly({
if(input$button == 0){
return()
} else {
print(plotly::ggplotly(task_bars$plot, tooltip="text", width = 970, height = 120) %>%
plotly::config(displayModeBar = TRUE) %>%
plotly::layout(plot_bgcolor='black', paper_bgcolor='black', margin = list(b=30, l=0, r=10, t=30))
)
}
})
}
)
I have tried to customise my choropleth map tooltips in R shiny app, which doesn't work. I tried both paste0 and paste, and it does not work either.
Here is my code:
ui <- fixedPage(
titlePanel("Map"),
fixedRow(
column(5
),
),
column(
12,
plotlyOutput('map',
width = 1000,
height = 1000)
)
)
server <- function(input, output) {
output$map = renderPlotly({
map<- country_choropleth(AADS_map,
num_colors=8,
text = paste0("value:", value)
)+
scale_fill_brewer(palette="RdPu") +
theme(plot.title = element_text (h = 0.5, size = 18),
legend.title = element_text(size = 10),
legend.text = element_text(size = 12)
) +
labs(fill = "Number of Accident",
title = "The distribution of accidents in countries from 1981 to 2019")
map <- ggplotly(map,
tooltip = c("text"))
})}
I have my shiny app in AWS ubuntu server attached with mysql database, my app doesnot work sometimes when number of database connection exceeded(16 new connections). I tried several ways from various sources in internet but not able to get the required solution.
Furthure i am also getting warning you have leaked pool object . I am attaching the sample code.
library("shiny")
library("shinydashboard")
library("pool")
library(ggplot2)
library("DBI")
library(plotly)
pool <- dbPool(drv = RMySQL::MySQL(),dbname = "db",host = "database.cw5east-2.rds.amazonaws.com",username = "host",password = "host", port = 3306)
mychoices = dbGetQuery(pool,"select available_scenario from scenario_name;")
ui <- (fluidPage(
titlePanel("Demonstration of renderUI in shiny - Dymanically creating the tabs based on user inputs"),
sidebarLayout(
sidebarPanel(
selectInput(inputId = 'n', "available scenarios", choices = mychoices, multiple = TRUE),
verbatimTextOutput("selected")
),
mainPanel(
plotOutput('Cost'),
uiOutput('tabs')
)
)
))
server <- (function(input,output,session){
output$tabs = renderUI({
par(mfrow = c(2, 2))
if(!is.null(input$n)){
x <- input$n
y <- length(x)
z <- dbGetQuery(pool,paste0("select scenario_key from scenario_name where available_scenario = '",x[y],"'"))
frame <- dbGetQuery(pool,paste0("select x,price from plot1 where scenario_key ='",z,"'"))
frame1 <- dbGetQuery(pool,paste0("select obj,runs from plot2 where scenario_key ='",z,"'"))
frame2 <- dbGetQuery(pool,paste0("select V1,V2,V3 from tableee where scenario_key ='",z,"'"))
runs <- dbGetQuery(pool,paste0(" select count(*) from plot2 where scenario_key ='",z,"'"))
b<-dbGetQuery(pool, paste0("select scenario_key from scenario_name where available_scenario = '",input$n,"'"))
Tabs <- lapply(paste("Scenario name:", input$n, sep=" "), tabPanel,
renderPlotly({
ggplot(frame, aes(x=x,y=price,fill=price)) + # basic graphical object
geom_col(width = 0.3)+
#geom_bar(position = 'dodge',stat = "identity")+ # first layer
xlab(NULL)+ylab("Price in USD")+
geom_text(aes(label=price),size=5,position=position_dodge(width=0.9), vjust=-0.25)+
theme_minimal()+
theme(axis.text = element_text(size = 12),
axis.title = element_text(size=16),
axis.text.y =element_text(angle = 90,hjust = 1))
}),
renderPlotly({
ggplot(frame1,aes(x=runs,y=obj))+
geom_col(width=0.3,fill='orangered')+
geom_hline(aes(yintercept=mean(obj,na.rm = T),color="Mean"),linetype='dashed',size=1)+
scale_color_manual(values = "blue")+
labs(x= 'Day Number',y='Reveneue in USD',color=NULL)+
theme_minimal()+theme(axis.text = element_text(size = 12),
axis.title = element_text(size=16),
axis.text.y= element_text(angle = 90,hjust = 1) )
}),
DT::renderDataTable({
frame2
},colnames=c('Day','Total Wt(kg)','Total Pcs','Revenue($)')
)
)
do.call(tabsetPanel, Tabs)}
})
})
shinyApp(ui, server)
I am creating a table using renderTable and a plot (plotly) to be placed in ShinyDashboard. There is a whitespace that surrounds the table data that I am trying to get rid off. However, there is no whitespace around the plot.
How do I remove the whitespace that surround the table i have added to my shiny dashboard.
How do I align the header of the table "Recruitment" to the center?
I know there are some HTML solutions, but I am not familiar with those codes and will be glad if someone can explain.
Here are my codes:
Server codes
output$recruit_stats <- renderTable(recruit_stats, bordered = TRUE, colnames = TRUE)
output$Recruitment_bar_plot <- renderPlotly({
Recruitment_bar<-Recruitment_bar[(Recruitment_bar$hospital!="H"),];
R01 <- ggplot()+
geom_bar(data=Recruitment_bar,aes(x=hospital,y=count),stat = "identity", fill="navyblue")+
ylim(0,1200) +
geom_text(data=Recruitment_bar,aes(x=hospital,y=count*1.05,label=paste(count)),size=2.5, vjust=-1.0) +
theme(panel.background = element_blank(),
axis.text = element_text(size = 7),
axis.title = element_text(size=7),
axis.line = element_line(colour = "black", size = 0.5, linetype = "solid"),
plot.title = element_text(size=8, face="bold", hjust=0.5),
legend.position = "none", legend.text = element_text(size=6)) +
labs(fill="") + guides(fill = guide_legend(reverse=TRUE))+
ylab("No. Recruited") + ggtitle("No. of Patients Recruited (Jan 2017 to June 2018)")
ggplotly(R01, tooltip=c("count"));
})
UI codes
Recruitment<-tabItem(
tabName = "Recruitment",
fluidRow(
box(
box(title = "Recruitment",
status = "primary",
solidHeader = TRUE,column(12,tableOutput("recruit_stats"), align="c"),
width=8,
collapsed=TRUE)
),
box(
plotlyOutput("Recruitment_bar_plot", height = 400),
width=5,
status = "primary",
solidHeader = TRUE
)
)
)
I would drop boxes and try grid by columns. For table have a look at DT tutorials.
library(shiny)
library(shinydashboard)
dat5 <- c(rep("Female", 3376), rep("Male", 2180))
app <- shinyApp(
ui <- shinyUI(
dashboardPage(dashboardHeader(title = "PSM"),
dashboardSidebar(),
dashboardBody(
tabItem(
tabName = "Recruitment",
fluidRow(
column(width=6,
DT::dataTableOutput("recruit_stats")),
column(width=6,
plotOutput("pie_chart", height = 400))
)
)
))
),
server <- shinyServer(function(input,output){
output$pie_chart <- renderPlot({
df <- table(dat5)
cols <- rainbow(length(df))
barplot(df, col = cols)
})
output$recruit_stats <- DT::renderDataTable({
DT::datatable(as.data.frame(dat5), options = list(paging=TRUE, searching= TRUE ))
})
})
)
runApp(app)
I am trying to create a dynamic plot in R Shiny but the plot does not show in the Dashboard.
I have the following test data which I will upload in the shiny app:
Region.1=c( 375.00,375.00,370.00,350.00,350.00,305.00,300.00,250.00,245.00,240.00,235.00,225.00,215.00,200.00,100.00,100.00,100.00,100.00,100.00,100.00)
Region.2 =c(0.00,0.00,0.00,0.00,0.00,200.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,20.00,500.00,235.00,0.00)
Region.3 =c(100000.00,76000.00,60000.00,50000.00,50000.00,30000.00,30000.00,26000.00,19000.00,11000.00,10000.00,8000.00,7000.00,5000.00,4070.00,4000.00,3660.00,2585.00,2550.00,250.00)
Type=c("B","F","F","B","B","A","A","F","F","B","A","B","F","B","F","F","A","A","F","B")
data <- data.frame("Region.1"=Region.1, "Region.2"=Region.2, "Region.3"=Region.3, "Type"=Type)
My Script for Shiny looks like this (simplified code)
server.R
function(input, output,session) {
myData <- reactive({
req(input$file)
inFile <- input$file
if(is.null(inFile)){return(NULL)}
read.csv(inFile$datapath, header = TRUE, sep = input$sep,
quote = '""')
})
df<-reactive({
df<-myData()
dfType <- df[ , grepl( "Type" , names( df ) ) ]
dfRegion<-df[ , grepl( "Region" , names( df ) ) ]
df4<-cbind(dfType, dfRegion)
colnames(df4)[which(names(df4) == "dfType")] <- "Type"
colnames(df4)[which(names(df4) == "dfRegion")] <- "Region"
df4[df4==""] <- NA
df4 <- na.omit(df4)
return(df4)
})
df.datasets <- reactive({
df<-df()
df<- melt(df,id.vars=c("Type"),
measure.vars=c("Region.1", "Region.2", "Region.3"))
test<-aggregate(df$value, by=list(Region=df$variable, Type=df$Type), FUN=sum)
test<-test %>% group_by(Region) %>% transmute(Type, percent = (x/sum(x))*100)
test$percent<-round(test$percent, digits = 0)
test[test==0] <- NA
test<-test[complete.cases(test),]
})
output$plot1<-renderPlot({
blank_theme <- theme_minimal()+
theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.border = element_blank(),
panel.grid=element_blank(),
axis.ticks = element_blank(),
plot.title=element_text(size=14, face="bold")
)
test<-df.datasets()
levels(test$"Region")[levels(test$"Region") %in% c("Region.1")] <- "Region 1"
levels(test$"Region")[levels(test$"Region") %in% c("Region.2")] <- "Region 2"
levels(test$"Region")[levels(test$"Region") %in% c("Region.3")] <- "Region 3"
levels(test$"Region")[levels(test$"Region") %in% c("Region.4")] <- "Region 4"
p<-ggplot(test,
aes(x =" ", y = percent, fill = Type))+
geom_bar(width = 1, stat = "identity",position="fill", color="grey35")+
coord_polar("y")+
facet_grid(.~Region)+
geom_text(aes( label= paste(percent, "%")) ,
position=position_fill(0.5), size=4.5)+
theme(axis.text.x=element_blank(),
strip.text.x = element_text(size=15, color="black", face="bold"),
strip.text.y = element_text(size=15, color="black", face="bold"),
legend.text = element_text(size=15),
legend.title = element_text(size=15, face="bold"),
plot.title = element_text(hjust = 0.5, size = 25),
axis.text=element_text(size=10))
})
}
my ui.R
myData <- NULL
sidebar <- dashboardSidebar(
sidebarMenu(
fileInput('file', 'Upload File (.csv | .txt)',
accept=c('text/csv',
'text/comma-separated-values,text/plain',
'.csv')),
radioButtons('sep', 'File Type',
c(CSV=';',
Text='\t'))
#actionButton("goButton", " Legenda", icon = icon("play-circle"))
)
)
dashboardPage(
dashboardHeader(title = "Overview"),
sidebar,
dashboardBody(tags$style("image {max-width: 100%; width: 100%; height: auto}"),
fluidRow(
tabBox(
title = " ",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1",
height = "1200px", width = "1000px"
,
tabPanel( "Plots",
column(12,
plotOutput("plot1"))
)
)
)))
I tried to strip down my code to detect the error but I can't find it. When I run the code outside of Shiny, the plot does show like it suppose to:
I Also don't get any error message. So I think that the plot is working but somehow it doesn't show. I tried modifying the size of the column but that didn't work..
I would like a result like this:
Anybody got an idea? I would really appreciate it, thank you :)
It looks like you assigned the plot to p then never called p in the renderPlot block, what happens if you just add p at the end of the block?