从SQL Server导入数据到闪亮的应用程序

Question

我使用RODBC从R中的SQL Server处理数据，在获得我的结果后，我创建了ShinyApp来部署我的结果但是我想直接从我的SQL查询中获取数据而不将我的结果导出到Excel然后将其导入闪亮，怎么能我这样做？

Test <- odbcDriverConnect("driver={SQL Server};server=localhost;database=Fakahany;trusted_connection=true")
Orders<- sqlQuery(Test,"
SELECT
  WHWorkOrderHeaderId
, OtherLangDescription
FROM   Warehouse.WHWorkOrderDetails 
   INNER JOIN Warehouse.WHWorkOrderHeader AS WHH
      ON Warehouse.WHWorkOrderDetails.WHWorkOrderHeaderId = WHH.ID 
  INNER JOIN Warehouse.StockItems 
     ON Warehouse.WHWorkOrderDetails.StockItemId = Warehouse.StockItems.Id 
WHERE Type = 'IO'
ORDER BY OtherLangDescription ASC")
#Creating the correlations 
Orders$OtherLangDescription <- as.factor(Orders$OtherLangDescription)
orderList <- unique(Orders$OtherLangDescription) 
ListId <- lapply(orderList, function(x) subset(Orders, OtherLangDescription == x)$WHWorkOrderHeaderId) 
Initial_Tab <- lapply(ListId, function(x) subset(Orders, WHWorkOrderHeaderId %in% x)$OtherLangDescription) 
Correlation_Tab <- mapply(function(Product, ID) table(Product)/length(ID),
                        Initial_Tab, ListId) 
colnames(Correlation_Tab) <- orderList
cor_per<- round(Correlation_Tab*100,2)
DF<-data.frame(row=rownames(cor_per)[row(cor_per)], col=colnames(cor_per)[col(cor_per)], corr=c(cor_per))

这是我的应用代码：

#loading Packages 
library(RODBC)
library(shiny)
library(rsconnect)
ui <- fluidPage(
  titlePanel("Item Correlation"),
  sidebarPanel(
    selectInput("Item2","Select Item",choices= DF$FirstItem),
    h6("Powerd By:"),
    img(src='edrak.png',height='50px',width='110px')
   # ,selectInput("Item","SelectItem",choices= DF$col)
  ),
  mainPanel(
    tableOutput("Itemcorr")
  )
)
server <- function(input,output){
  output$Itemcorr <- renderTable({
    subset(DF, DF$FirstItem == input$Item2)
  })
}

shinyApp(ui, server)

Answer 1

这应该做你想要的。

library(RODBCext)
library(shiny)

ui <- shinyUI(

  pageWithSidebar(

    headerPanel("Hide Side Bar example"),
    sidebarPanel(
      textInput("CATEGORY", "Enter CATEGORY below"),
      submitButton(text="Submit")
    ),
    mainPanel(
      tabsetPanel(
        tabPanel("Data", tableOutput("tbTable"))
      )

    )
  )
)

server <- function(input, output, session)    
{ # NOTE THE BRACE HERE
  myData <- reactive({
    req(input$CATEGORY)

    #connect to database 
    dbhandle = odbcDriverConnect('driver={SQL Server};server=Server_Name;database=Database_Name;trusted_connection=true')

    #build query
    query = "SELECT * FROM [Your_Table] where [CATEGORY] = ?"

    #store results
    res <- sqlExecute(channel = dbhandle, 
                      query = query,
                      data = list(input$CATEGORY),
                      fetch = TRUE,
                      stringsAsFactors = FALSE) 

    #close the connection
    odbcClose(dbhandle)
    #return results
    res
  })

  output$tbTable <- 
    renderTable(myData())

} # AND NOTE THE CLOSING BRACE HERE

shinyApp(ui = ui, server = server)

您可能也想考虑这一点。

library(shiny)
library(RODBCext)

shinyApp(
  ui = 
    shinyUI(
      fluidPage(
        uiOutput("select_category"),
        tableOutput("display_data")
      #   plotOutput("plot_data")
      )
    ),

  # server needs the function; looks ok
  server = shinyServer(function(input, output, session)
    {
    # A reactive object to get the query. This lets you use
    # the data in multiple locations (plots, tables, etc) without
    # having to perform the query in each output slot.
    QueriedData <- reactive({
        req(input$showDrop)
        ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
        showList <- sqlExecute(ch, "SELECT * FROM [Your_Table] WHERE Category = ?",
                               data = list(Category = input$showDrop),
                               fetch = TRUE,
                               stringsAsFactors = FALSE)
        odbcClose(ch)
        showList
      })

    # The select input control.  These can be managed dynamically 
    # from the server, and then the control send back to the UI
    # using `renderUI`
     output$select_category <- renderUI({
         ch <- odbcDriverConnect("driver={SQL Server};server=Server_Name;database=DATABASE_NAME;trusted_connection=true")
         showList <- sqlExecute(ch, "Select Distinct Category From [Your_Table] Order by Category", 
                                fetch = TRUE,
                                stringsAsFactors = FALSE)
         odbcClose(ch)
         selectInput(inputId = "showDrop",
                     label = "Select Asset",
                     showList$Category)
       })

    # Display the data in a table
    output$display_data <- renderTable({
        QueriedData()
      })

    # Display a plot
    # output$plot_data <- 
    #  renderPlot({
    #    plot(QueriedData()) # fill in the plot code you want to use.
    #  })

  })
)