I am new to shiny and plotly!
I am trying to develop a Shiny app using plotly for graph.
My App folder looks like:
- www -> plotlyGraphwidget.js
- global.R
- plotlyGraphwidget.R
- ui.R
- server.R
plotlyGraphwidget.js has the javascript i got from the plotly blogs.
global.R is having the username and apikey, i got from registering on plotly.
plotlyGraphwidget.R has the interface function between ui.R and server.R
ui.R has the ui elements definition.
server.R has the data manpulation and the renderGraph functionality.
In renferGraph, I am using following approaches for ploting plotly:
- using ggplot2 and then converting it into plotly using gg2list()
- directly using ggplotly()
I am able to get the plotly graph but the graph is not getting populated on the app.
ui.R
shinyUI(navbarPage("Hello",
tabPanel("ABC",
shinyUI(fluidPage(
# Application title
titlePanel("ABC1"),
# Sidebar with a input for the number of bins
helpText("Help me"),
helpText("Help Me"),
fluidRow(
column(6,uiOutput("Box10")),
column(6,uiOutput("Box1")),
column(6,uiOutput("Box2")),
column(6,uiOutput("Box3")),
column(6,uiOutput("Box4"))
),
mainPanel(
graphOutput('trendPlot')
)
)
))
))
server.R
library(ggplot2);
library(shiny);
library(reshape2);
##Read data##
test=read.csv("data.csv",header = TRUE);
test$Price=as.numeric(as.character(test$Price));
if (nrow(test[is.na(test$Price)==TRUE,])>0) {
test[is.na(test$Price)==TRUE,]$Price=0;
};
if (nrow(test[test$Price <0,])>0) {
test[test$Price <0,]$Price = 0;
};
names(test)[1]="Territory_1";
test1=test[test$Territory_1=='National',];
territory_list=unique(test$Territory_1);
territory_list=territory_list[territory_list!='National'];
combinations=test[1,];
combinations=combinations[-1,];
if (length(territory_list)!=0) {
for (i in 1:length(territory_list))
{
territory=territory_list[i];
tmp=test[test$Territory_1==territory,];
tmp=rbind(tmp,test1);
Seller=unique(tmp$Seller);
sample=unique(tmp[,c("Territory_1","Category","Sub_category","flag","price_point","IA_Category","Date")]);
sample$a=1;
Seller=as.data.frame(Seller);
Seller$a=1;
sample=merge(x = sample,y = Seller,by.x="a",by.y="a",all=TRUE);
sample=sample[,-1];
rm(Seller);
sample=merge(x = sample,y=tmp,
by.x = c("Category","Sub_category","flag","price_point","IA_Category","Seller","Territory_1","Date"),
by.y = c("Category","Sub_category","flag","price_point","IA_Category","Seller","Territory_1","Date"),
all.x=TRUE);
sample[is.na(sample$Price)==TRUE,]$Price=0.0;
sample=sample[,c("Territory_1","Category","Sub_category","flag","price_point","Seller","Price","Date","IA_Category")];
combinations=rbind(combinations,sample);
rm(sample,tmp,territory);
};
rm(i,territory_list,test,test1);
test= combinations;
rm(combinations);
} else if (length(territory_list)==0) {
tmp=test;
Seller=unique(tmp$Seller);
sample=unique(tmp[,c("Territory_1","Category","Sub_category","flag","price_point","IA_Category","Date")]);
sample$a=1;
Seller=as.data.frame(Seller);
Seller$a=1;
sample=merge(x = sample,y = Seller,by.x="a",by.y="a",all=TRUE);
sample=sample[,-1];
rm(Seller);
sample=merge(x = sample,y=tmp,
by.x = c("Category","Sub_category","flag","price_point","IA_Category","Seller","Territory_1","Date"),
by.y = c("Category","Sub_category","flag","price_point","IA_Category","Seller","Territory_1","Date"),
all.x=TRUE);
sample[is.na(sample$Price)==TRUE,]$Price=0.0;
sample=sample[,c("Territory_1","Category","Sub_category","flag","price_point","Seller","Price","Date","IA_Category")];
test=sample;
rm(sample,tmp);
rm(combinations,test1,territory_list);
};
test$Date=as.character(test$Date);
test$Date=as.Date(test$Date,"%d-%m-%Y");
test$price_point=as.character(test$price_point);
test$Territory_1=as.character(test$Territory_1);
test$Category=as.character(test$Category);
test$Sub_category=as.character(test$Sub_category);
test$IA_Category=as.character(test$IA_Category);
test$Price=as.numeric(test$Price);
test11=test[test$Territory_1=="National",];
test12=test[test$Territory_1!="National",];
test1 = (dcast(test,Category+IA_Category+flag+price_point+Date ~ Seller,value.var="Price",sum));
test2 = (test1[,c(6,7,9)]);
test2[test2==0]<-NA;
Median = apply(test2,1,median,na.rm=TRUE);
Median = as.data.frame(Median)
test2[is.na(test2)]=0;
test2$Competitors<-(rowSums(test2>0))
Median=cbind(Median,test2$Competitors)
test2 = cbind(test1,Median)
test2$Diff=(test2$Staples-test2$Median)/(test2$Median)
test2$Diff=100*test2$Diff
names(test2)[11]="Count_competitors"
test2$Count_competitors=as.numeric(test2$Count_competitors)
if (nrow(test12)==0) {
test12=test11
};
## Template for server.R script for Plotly/Shiny apps
shinyServer(function(input, output, session) {
output$Box10 = renderUI(selectInput("Territory_1","Select Territory",c(unique(test12[order(test12$Territory_1),]$Territory_1))))
output$Box1 = renderUI(selectInput("Category","Select Product Category",c(unique(test[which(test$Territory_1 == input$Territory_1),]$Category))))
output$Box2 = renderUI(selectInput("IA_Category","Select Product Sub Category",c(unique(test[which(test$Category == input$Category),]$IA_Category))))
output$Box3 = renderUI(radioButtons("flag","Select Actual/Discounted Price",c("Actual","Discounted")))
output$Box4 = renderUI(dateInput("date","Select Date"))
## Subsetting data##
subdata101 =reactive(test12[which(test12$Territory_1 == input$Territory_1),]);
subdata102=reactive(unique(rbind(test11,subdata101())));
subdata1 = reactive(subdata102()[which(subdata102()$Category == input$Category),])
subdata2 = reactive(subdata1()[which(subdata1()$IA_Category == input$IA_Category),])
subdata3 = reactive(subdata2()[which(subdata2()$flag == input$flag),])
subdata4 = reactive(subdata3()[which(subdata3()$Date == input$date),])
subdata5 = reactive(price_change[which(price_change$date == input$date),])
subdata6 = reactive(subdata5()[,-9])
subdata7 = reactive(discount_change[which(discount_change$date == input$date),])
subdata8 = reactive(subdata7()[,-11])
output$Box5 = renderUI(selectInput("Category1","Select Product Category",c(unique(test2$Category))))
output$Box6 = renderUI(
if (is.null(input$Category) || input$Category == "pick one"){return()
}else selectInput("price_point1",
"Select Quantity",
c(unique(as.character(sort(as.numeric(test2$price_point[which(test2$Category == input$Category1)]),decreasing = FALSE)))))
)
#unique(as.character(sort(as.numeric(test2$price_point[which(test2$Category == input$Category)]),decreasing = FALSE)))
output$Box7 = renderUI(radioButtons("flag1","Select Actual/Discounted Price",c("Actual","Discounted")))
output$Box8 = renderUI(dateInput("Date1","Select Date"))
subdata9 = reactive(test2[which(test2$Category == input$Category1),])
subdata10 = reactive(subdata9()[which(subdata9()$price_point == input$price_point1),])
subdata11 = reactive(subdata10()[which(subdata10()$flag == input$flag1),])
subdata12 = reactive(subdata11()[which(subdata11()$Date == input$Date1),])
## ADD DATA
#YOUR_DATA<- call_your_data_file
output$trendPlot <- renderGraph({
xaxislimits=as.character(sort(unique(as.numeric(test$price_point)),decreasing = FALSE))
p <- ggplot(data=test, aes(x=price_point, y=Price, fill=Seller)) +
geom_bar(stat="identity",position=position_dodge(),colour="black")
+
theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),legend.position="bottom")+
scale_x_discrete(name="Number of Units Sold",limit=xaxislimits)+
scale_y_continuous(name="Selling Price")
#
#}, width = 1200
## Create your ggplot
#YOUR_PLOT <- ggplot(YOUR_DATA, YOUR_GGPLOT_SPECIFICATIONS)
## You can edit your graph with ggplot syntax here!
## This function rewrites the ggplot figure in Plotly syntax
## and returns data information (gg$data) and layout information (gg$layout)
#gg<- gg2list(YOUR_PLOT)
gg<- gg2list(p)
# ggplotly(p)
# # start comment
# data <- list()
# for(i in 1:(length(gg)-1)){data[[i]]<-gg[[i]]}
#
# layout <- gg$kwargs$layout
# # layout <- gg$layout
# # Remove the existing annotations (the legend label)
# layout$annotations <- NULL
#
# # place legend to the right of the plot
# layout$legend$x <- 100
# layout$legend$y <- 1
# return(list(
# list(
# id="trendPlot",
# task="newPlot",
# data=data,
# layout=layout
# )
# ))
## You can edit your graph with Plotly syntax here!
# This sends message up to the browser client, which will get fed through to
# Plotly's javascript graphing library embedded inside the graph
# return(list(
# list(
# id="trendPlot",
# task="newPlot",
# data=gg$data,
# layout=gg$layout
# )
# ))
#
# # 3rd type of code
#
# # Use Plotly syntax to further edit the plot:
# gg$layout$annotations <- NULL # Remove the existing annotations (the legend label)
# gg$layout$annotations <- list()
#
# # Add colored text annotations next to the end of each line
# # More about plotly annotations: https://plot.ly/r/reference/#annotation
# # Each key that we update is documented in that link above.
# for(i in 1:(length(gg$data))){ # data is a list of the lines in the graph
# gg$layout$annotations[[i]] <- list(
# text = gg$data[[i]]$name, # The text label of the annotation, e.g. "Canada"
# font = list(color = gg$data[[i]]$line$color), # Match the font color to the line color
# showarrow = FALSE, # Don't show the annotation arrow
# y = gg$data[[i]]$y[[length(gg$data[[i]]$y)]], # set the y position of the annotation to the last point of the line
# yref = "y1", # the "y" coordinates above are with respect to the yaxis
# x = 1, # set the x position of the graph to the right hand side of the graph
# xref = "paper", # the x coordinates are with respect to the "paper", where 1 means the right hand side of the graph and 0 means the left hand side
# xanchor = "left" # position the x coordinate with respect to the left of the text
# );
# }
#
# gg$layout$showlegend <- FALSE # remove the legend
# gg$layout$margin$r <- 170 # increase the size of the right margin to accommodate more room for the annotation labels
#
# # Send this message up to the browser client, which will get fed through to
# # Plotly's javascript graphing library embedded inside the graph
# return(list(
# list(
# id="trendPlot",
# task="newPlot",
# data=gg$data,
# layout=gg$layout
# )
# ))
# 4th try
g = ggplotly(p)
print(g)
})
})
I am not able to understand the concept of gg2list and the list after wards.
Any help would be appreciated!!