闪亮的应用程序与Plotly图

时间:2016-02-23 14:53:24

标签: r shiny plotly

我是新手,有光泽和情节!

我正在尝试使用plotly for graph开发一个Shiny应用程序。

My App文件夹如下所示:

  • www - > plotlyGraphwidget.js
  • global.R
  • plotlyGraphwidget.R
  • ui.R
  • server.R

plotlyGraphwidget.js有我从剧情博客得到的javascript。

global.R拥有用户名和apikey,我是通过在plotly上注册获得的。

plotlyGraphwidget.R具有ui.R和server.R

之间的接口函数

ui.R具有ui元素定义。

server.R具有数据操作和renderGraph功能。

在renferGraph中,我使用以下方法绘制情节:

  • 使用ggplot2,然后使用gg2list()
  • 将其转换为plotly
  • 直接使用ggplotly()

我能够获得情节图,但图表没有在应用程序中填充。

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的概念和病房后的列表。

任何帮助都将不胜感激!!

0 个答案:

没有答案