CODEWITHSUNDEEP
rdatatableshiny
Tim
Tim

Reputation: 7474

Shiny/Datatable: leave row on fixed position while sorting

I have a simple datatable table in Shiny report, say

renderDataTable(mtcars)

is it possible to make one of the rows (e.g. the Volvo 142E) have fixed position (always stay on the bottom), i.e. not to move while sorting the table using the up/down arrows, no matter by what column we sort? I assume that the row is uniquely identifiable, so there is no problem with pointing the row that should stay fixed.

Upvotes: 0

Views: 1137

Answers (1)

lloyd
lloyd

Reputation: 11

    # 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

Upvotes: 1

Related Questions