Question

我在Shiny报告中有一个简单的数据表表，比如说

Protected Sub cbTekening_Callback(source As Object, e As DevExpress.Web.CallbackEventArgs) Handles cbTekening.Callback
    Dim document As New iTextSharp.text.Document()
    Dim intTekID As Integer

    Try

        Dim fieldValues As List(Of Object) = gridTekeningen.GetSelectedFieldValues(New String() {"TekeningID"})

        For Each item As Object In fieldValues
            Using ms As MemoryStream = New MemoryStream()
                intTekID = item

                Dim pdfr = New PdfReader(GetPDFFromDatabase(intTekID).ToArray())

                Dim pdfs As New iTextSharp.text.pdf.PdfStamper(pdfr, ms)

                Dim image__1 As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(New System.Uri(Session("ORG_Website") & Session("ORG_Tekeninglogo")))
                Dim image__2 As iTextSharp.text.Image = iTextSharp.text.Image.GetInstance(New System.Uri(Session("ORG_Website") & "Images/contactid_" & Session("ContactID") & ".png"))
                Dim rect As Rectangle

                Dim PageCount As Integer = pdfr.NumberOfPages
                Dim content As iTextSharp.text.pdf.PdfContentByte
                For x = 1 To PageCount
                    rect = pdfr.GetPageSize(x)
                    content = pdfs.GetOverContent(x)

                    image__1.SetAbsolutePosition(50.0F, 50.0F)
                    image__1.ScalePercent(30.0F, 30.0F)
                    image__2.SetAbsolutePosition(100.0F, 100.0F)
                    image__2.ScalePercent(30.0F, 30.0F)
                    Content.AddImage(image__1)
                    Content.AddImage(image__2)
                    Dim layer As New PdfLayer("Goedkeurlaag" & x.ToString, pdfs.Writer)
                    'Tell the cb that the next commands should be "bound" to this new layer
                    Content.BeginLayer(layer)
                    Content.SetFontAndSize(BaseFont.CreateFont(BaseFont.HELVETICA, BaseFont.CP1252, BaseFont.NOT_EMBEDDED), 20)

                    Dim strWatermerkText1 As String = Session("ORG_Tekeningtekst")
                    Dim strWatermerkText2 As String = Format(Now, "dd-MM-yyyy")
                    Dim strWatermerkText3 As String = Session("VolNaam")

                    Content.SetColorFill(BaseColor.RED)
                    Content.BeginText()
                    Content.ShowTextAligned(PdfContentByte.ALIGN_LEFT, strWatermerkText3, 60, 160, 0.0F)
                    Content.ShowTextAligned(PdfContentByte.ALIGN_LEFT, strWatermerkText2, 60, 185, 0.0F)
                    Content.ShowTextAligned(PdfContentByte.ALIGN_LEFT, strWatermerkText1, 60, 210, 0.0F)
                    Content.EndText()

                    '// Close the layer
                    Content.EndLayer()                
                Next

                pdfs.Close()
                StoreToDatabase(ms, intTekID)

            End Using
        Next item

        imgPubliceerTekening.ClientVisible = False
        gridTekeningen.DataBind()

    Catch ex As Exception

    End Try
End Sub

是否可以使其中一行（例如renderDataTable(mtcars)）具有固定位置（始终保持在底部），即在使用向上/向下箭头对表格进行排序时不移动，无论如何我们排序的列是什么？我假设该行是唯一可识别的，因此指向应该保持固定的行没有问题。

Answer 1

    # this pgm will hopefully download time-series data from yahoo.finance
   # from a table listing the sp500 you will select 3 rows
   # one row designated by the setResponse button is the response variable to be predicted
   # in a regression
   # the next two rows will determine the explanatory vars  and is set by
   # the user pressing the selEVars button      

                                  #   server.R
   library(shiny)
   library(googlesheets)
   library(DT)
   # the google sheet is a great way to store data
   sheet <- gs_title( 'tickerSymbols' )
   sp500 = gs_read_csv(sheet)   # it's a google sheet

   shinyServer(   function(input, output, session ) {

   # define sp500 symbol table for stock history lookup
   output$sp500Table = DT::renderDataTable( sp500 , escape=T )

    rsIndex = eventReactive( input$setResponse, {
    if( length( input$sp500Table_cell_clicked$row ) > 0 ) {
         setResponse = input$sp500Table_cell_clicked$row  
         return( setResponse )
        } # end if
    }  # end code chunk
   )   # end obs evt fun
    # this sets the expl. vars  set in ui.R
   eVarIndex= eventReactive( input$selEVars, {
   if( length( input$sp500Table_rows_selected ) >= 2 ) {
   selEVars = input$sp500Table_rows_selected 
   return( selEVars[2:3] )
   }  # end if
   }  # end code chunk for obs evt
   )   # obs evt fun
  # here is the probable location of problem
  # this data.frame does not show up unless i select 4 rows!
  observeEvent( input$sp500Table_rows_selected ,  {
   if( length(eVarIndex() ) >= 2  && length( rsIndex())>=1 ) {
        rs=c( rsIndex(), eVarIndex() )
    cc = c( 'response', 'expl. var. 1', 'expl. var. 2' )   
    sel.df =  data.frame( description=cc, sp500[ rs ,  ] )
    output$tabO = renderTable( sel.df  )
    } # endif
    }  # end chunk

      }  # end server chunk fun
    )   # end shinyserver fun

      # the ui follows
      #  ui.R

   library(shiny)
   library(shinyBS)

   shinyUI(

   fluidPage(
   tags$style(type='text/css', ".shiny-table { color: blue; font-weight:       
   bold;  font-size: 10px; line-height: 12px;}")
   ,  # ,

    bsCollapsePanel(  
         h5("Select a response and 2 explanatory variables") 
  , # ,
     # i hope the labels are self explanatory as to the objective
     actionButton( inputId = 'setResponse', label = 'set response variable'        
      )
   ,  # ,
     actionButton( inputId = 'selEVars', label = 'select 2 explantory 
                    variables' )
      ,  # ,
         actionButton( input='bldModel', label='build predictive model' )
        ,  # , 
    h6( 'selected variables for model construction' )
  ,  # ,    # and the problem table appears here!
    tableOutput( outputId='tabO' )
    ,  # ,
    br()
    , # ,
         DT::dataTableOutput( "sp500Table" ) 

      )  # end panel
     )    # end page

   )  # end UI

闪亮/数据表：排序时将行留在固定位置

1 个答案: