используйте реактивный набор данных в блестящем R и нарисуйте график - PullRequest
Новая
       6

используйте реактивный набор данных в блестящем R и нарисуйте график

0 голосов
/ 22 января 2019

Я хочу нарисовать график, используя блестящий R, когда я выбираю элементы из selectInput. Проблема заключается в выборе элементов из выбора ввода, я пробовал plot (mydata $ input $ getCol1, mydata $ input $ getCol2], тип= "l", col = "blue"), но я получил еще одну ошибку, которая говорит о необходимости конечных значений 'xlim'.Я также проверил NA там, где в моем наборе данных нет Na.

Мой код UI.R выглядит следующим образом 

library(shiny)
library(shinydashboard)
library(DT)
library(ggplot2)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title="Engagement and Passionate",titleWidth = 350),

# Sidebar ######################################
dashboardSidebar(
width = 150,
sidebarMenu(id = "mysidebar",
            menuItem("Engagement", 
                     menuSubItem("Bittorent", tabName = 
"subItemOne"),
                     menuSubItem("Twitter", tabName = "subItemTwo"),
                     menuSubItem("Tumblr", tabName = 
 "subItemThree"),
                     menuSubItem("Youtube", tabName = 
 "subItemFour"),
                    menuSubItem("Dailymotion", tabName = 
 "subItemFive")),
            menuItem("Charts",
                     menuSubItem("AP", tabName = "APC"),
                     menuSubItem("Anp", tabName = "ANPC"))
)),
  # Body #######################################


 dashboardBody(
 fluidRow(box(width = 3,h2("Upload file"),fileInput("file2", "Choose 
  CSV File",
                                                    accept = NULL)),
         box(width=8,h2("Raw Data"),DT::dataTableOutput("pltable")
         )
    ),
   tabItems(
   tabItem(tabName = "subItemOne",
         h2("Bittorent Insight"),
         box(title="select the variable",width=3 
 ,uiOutput("getCol1"),uiOutput("getCol2"),status = 
 "warning",solidheader=TRUE),
         plotOutput("graph"))
  ,

  tabItem(tabName = "subItemTwo",
          h2("Twitter Insight")
  ),

  tabItem(tabName = "subItemThree",
          h2("Tumblr Insight")
  ),

  tabItem(tabName = "subItemFour",
          h2("Youtube Insigth")
  ),
  tabItem(tabName = "subItemFive",
          h2("Daily motion Insigth")
  ))))

Server.R 

  options(shiny.maxRequestSize=30*1024^2)
  server <- function(input, output) { 

  #Function to read table 
  rawdata <<- reactive({
  file1 <- input$file2
if(is.null(file1)){return()}
read.csv(file=file1$datapath,1,stringsAsFactors=FALSE)
 })
 output$getCol1<-renderUI({
 selectInput("Variable1","Choose 
 Option:",as.list(colnames(rawdata())))
  })
  output$getCol2<-renderUI({
selectInput("Variable2","Choose 
 Option:",as.list(colnames(rawdata())))
})
 #raw Datatable for platform

   output$pltable<-DT::renderDataTable({
  if(is.null(rawdata)){return()}
  DT::datatable(rawdata(),
 extensions="Responsive",options=list(pageLength=3),class='cell- 
  border strip',selection='single')
  })
  #access rawdata 
 output$graph <- renderPlot({
 mydata <- as.data.frame(rawdata())
 # p <- ggplot(mydata, 


 aes(mydata$input$getCol1,mydata$input$getCol2,
color=factor(mydata[3]))) + geom_point()
#ggplotly(p)
plot(x=mydata[input$getCol1],
y=mydata[input$getCol2],type="l",col="blue")
#plot(mydata[2])
 })

 }

Ошибкая получил следующее: только один столбец в аргументе для «пар». Я также попробовал следующий код: 

output$graph <- renderPlot({
    mydata <- as.data.frame(rawdata())
    ggplot(mydata, aes_string(x = input$getCol1, y = input$getCol2))

     })

, он не показывает ни одной линии на графике, но также не показывает никакой ошибки.Не могли бы вы, пожалуйста, дайте мне знать, что это за проблема.

1 Ответ

0 голосов
/ 22 января 2019

Вам нужно вызвать id входного выбора, который является Variable1 и Variable2, вместо вызова getCol1 и getCol2. Попробуйте это: 

output$graph <- renderPlot({
   df<- rawdata()
   plot(df[,input$Variable1],df[,input$Variable2])

 })

Или вы можете попробовать следующий код: 

ggplot(df, aes_string(input$Variable1,input$Variable2))+geom_point(colour=‘blue’)
...