我是新手,有光泽和情节!
我正在尝试使用plotly for graph开发一个Shiny应用程序。
My App文件夹如下所示:
plotlyGraphwidget.js有我从剧情博客得到的javascript。
global.R拥有用户名和apikey,我是通过在plotly上注册获得的。
plotlyGraphwidget.R具有ui.R和server.R
之间的接口函数ui.R具有ui元素定义。
server.R具有数据操作和renderGraph功能。
在renferGraph中,我使用以下方法绘制情节:
我能够获得情节图,但图表没有在应用程序中填充。
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)
})
})
我无法理解gg2list的概念和病房后的列表。
任何帮助都将不胜感激!!