I am trying to create a shiny app to get the data into a PostgreSQL database. And generate reports thereafter.
Can I create something like this layout in shiny?
any suggestion is helpful. Please let me know.
Hey @Anantadinath,
This use case of yours can easily be solved using Shiny. For building a similar UI, you can use the shinydashboard library, all your database logic, Postgre in your case, go inside the server function.
Also, go through this doc to learn more about R PostgreSQL connectivity
And this guide will help you deploy your own R server and run all of the above
Do update the post with your learnings while you're at it.
2 Likes
Thanks for your reply But I am looking for a way to dynamically edit the row from the table.
Like I have mentioned in the picture. I want to give the user a way to edit the table. I have no clue how can somebody do it.
Though you may be more interested in rhandsontable + shiny, which gives you directly editable tables. Run the following example to see what I mean (code here):
shiny::runGitHub("rhandsontable", "jrowen", subdir="inst/examples/rhandsontable_dash")
Here's the intro to rhandsontable.
2 Likes
how did you find this wonderful library? This is not mentioned anywhere on Net unless you know the name precisely.
Thanks @barbara
This is almost exactly what I need. I will look into it more and If I face any issues I will let you know. Thanks a LOT for telling me about this package.
For future reader: In my case I don't know why rhandsontable not working properly using shiny::runGitHub("rhandsontable", "jrowen", subdir="inst/examples/rhandsontable_dash") or even at shinyapps.io on the 1st day of the month.
Alternatively, you can check this great post https://antoineguillot.wordpress.com/2017/03/01/three-r-shiny-tricks-to-make-your-shiny-app-shines-33-buttons-to-delete-edit-and-compare-datatable-rows/
1 Like
Thanks for the reply @abubaker This is exactly what I need. You hit right on the mark. I read the entire page but I still do not understand the JS side of the code so It will be very hard for me to create it on my own. I mean to rebuild an application where my data comes directly from a SQL database and then commit changes would still be very hard for me. Considering everything was just adding JS into shiny ( which I do not yet understand).
But Thanks a Lot again. I see a HOPE now.
Dear @Anantadinath I'm so happy that some one find my post useful Loool.
I'm also a statistician so I don't have a JS or HTML background, but here is my very poor solution to my problem, I hope it may be helpful for you in some way. Regarding JS I would like to suggest this tutorial.
library(shiny)
library(shinyjs)
library(DT)
library(data.table)
library(DBI)
library(pool)
#Database
pool <- dbPool(drv =RSQLite::SQLite(),dbname="")
onStop(function() {
poolClose(pool)
})
dbGetQuery(pool,"CREATE TABLE customer(customer_first TEXT, customer_last TEXT, gender TEXT,dob TEXT);")
dbGetQuery(pool, 'INSERT INTO customer (customer_first, customer_last, gender, dob)
VALUES ("Amit","Kumar","male","1988-01-01");')
dbGetQuery(pool, 'INSERT INTO customer (customer_first, customer_last, gender, dob)
VALUES ("Bhatia","Krouz","male","1975-01-01");')
#SQLlite create and use rowid as default auto_increament id
#Example
#dbGetQuery(pool, 'SELECT * FROM customer where rowid=1')
#dbGetQuery(pool, 'SELECT rowid FROM customer where customer_last="Kumar"')
#App
shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
conditionalPanel(
condition="input.conditionedPanels == 0",helpText("This is About")),
conditionalPanel(
condition="input.conditionedPanels == 1",
textInput("customer_first", "First Name", ""),
textInput("customer_last", "Last Name", ""),
selectInput(inputId="gender" ,"1. Gender" , choices=c("Male"=0,"Female"=1) , selected =0, selectize=FALSE ) ,
dateInput("dob","Date of birth:",value="1980-01-01",format="yyyy-mm-dd"),
actionButton("submit", "Create")
),
conditionalPanel(
condition="input.conditionedPanels == 2",
div(id="abu",
textInput("customer_first_s", "First Name", ""),
textInput("customer_last_s", "Last Name", ""),
dateInput("dob_s","Date:",value = "",format = "yyyy-mm-dd")),
actionButton("search", "Search"))
), #sidebarPanel
mainPanel(tabsetPanel(id="conditionedPanels",
tabPanel("About",value=0,h3("About the application")),
navbarMenu("CRM",
tabPanel("New Customer", value=1,br(),br(),p("Please save the customer ID for future reference. In case customer id has been lost then please use the customer patient panel for search.")),
tabPanel("Existing Customer",value=2,DT::dataTableOutput("res"))
) #navbarMenu
) #tabSetPanel
,
tags$script("$(document).on('click', '#res button', function () {
Shiny.onInputChange('lastClickId',this.id);
Shiny.onInputChange('lastClick', Math.random())
});")) #mainPanel
)), #ui
server = function(input, output, session) {
observeEvent(input$submit, {
tryCatch(
poolWithTransaction(pool, function (conn) {
dbExecute(conn,paste0("INSERT INTO customer (customer_first, customer_last, gender, dob) values ","('",input$customer_first,"','",input$customer_last,"',",input$gender,",'",input$dob,"')", ";"))
id <- dbGetQuery(conn, "select last_insert_rowid();")[1,1]
showModal(modalDialog(
title = "Record created successfully",
span('New customer record was created with ID:',strong(em(id)))
))
}),
error = function(e){
showModal(modalDialog(
title = "Create new record not successful",
tags$i("Please enter valid values and try again"),br(),br(),
tags$b("Error:"),br(),
tags$code(e$message)
))
})
reset("customer_first");reset("customer_last") #reset from shinyjs
})
select_dat <- eventReactive(input$search,
dbGetQuery(pool,paste0("select rowid AS 'Customer ID', customer_first AS 'First name' , customer_last 'Last name', dob AS DOB from customer where customer_first like","'%",ifelse(input$customer_first_s=="","^",input$customer_first_s),"%'"," OR customer_last like","'%",ifelse(input$customer_last_s=="","^",input$customer_last_s),"%'"," OR dob like","'",input$dob_s,"'",";"))
)
values = reactiveValues(data=NULL)
observe({
input$search
values$data <- select_dat()
})
output$res <- DT::renderDataTable({
req(values$data)
DT <- values$data
if(nrow(DT)>=1){
DT[["Actions"]]<-
paste0('
<div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary delete" id=delete_',1:nrow(DT),'>Delete</button>
<button type="button" class="btn btn-secondary modify"id=modify_',1:nrow(DT),'>Modify</button>
</div>
')} else {return(DT)}
datatable(DT,escape=F,selection="none",options = list(columnDefs = list(list(className = 'dt-center',targets=1:5))))})
output$row_modif<-renderDataTable({
selected_row=as.numeric(gsub("modify_","",input$lastClickId))
#start from 2nd coulmn Because I don't want user has access to the ID
old_row= values$data[selected_row,2:4]
row_change=list()
for (i in colnames(old_row))
{
if (is.numeric(old_row[[i]]))
{
row_change[[i]]<-paste0('<input class="new_input" type="number" id=new_',i,'><br>')
}
else
row_change[[i]]<-paste0('<input class="new_input" type="text" id=new_',i,'><br>')
}
row_change=as.data.table(row_change)
setnames(row_change,colnames(old_row))
DT=rbind(old_row,row_change)
rownames(DT)<-c("Current values","New values")
DT
},escape=F,options=list(dom='t',ordering=F),selection="none")
##Managing in row deletion
modal_modify<-modalDialog(
fluidPage(
h3(strong("Record modification"),align="center"),
hr(),
dataTableOutput('row_modif'),
actionButton("save_changes","Save changes"),
tags$script(HTML("$(document).on('click', '#save_changes', function () {
var list_value=[]
for (i = 0; i < $( '.new_input' ).length; i++)
{
list_value.push($( '.new_input' )[i].value)
}
Shiny.onInputChange('newValue', list_value)
});"))
),size="l")
observeEvent(input$newValue,{
newValue=lapply(input$newValue, function(col) {
if (suppressWarnings(all(!is.na(as.numeric(as.character(col)))))) {
as.numeric(as.character(col))
} else {
col
}
})
DF=data.frame(lapply(newValue, function(x) t(data.frame(x))))
id_row <- values$data[as.numeric(gsub("modify_","",input$lastClickId)),1]
query <- sqlInterpolate(pool,"update customer set customer_first=?f,customer_last=?l,dob=?d where rowid=?id;",f=as.character(DF[1,1]),l=as.character(DF[1,2]),d=as.character(DF[1,3]),id=id_row)
if(!isTruthy(tryCatch(dbGetQuery(pool,query), error=function(e) NA))){
showModal(
modalDialog(
title = "Unvalid Modification",
"Please enter non null values", easyClose = TRUE, footer = NULL
)
)
return()
}
dbGetQuery(pool,query)
values$data[as.numeric(gsub("modify_","",input$lastClickId)),2:4]<- c(as.character(DF[1,1]),as.character(DF[1,2]),as.character(DF[1,3]))
})
observeEvent(input$lastClick,
{
if (input$lastClickId%like%"delete")
{
row_to_del=as.numeric(gsub("delete_","",input$lastClickId))
query <- sqlInterpolate(pool,"delete from customer where rowid=?id;",id=values$data[row_to_del,1])
if(!isTruthy(tryCatch(dbGetQuery(pool,query), error=function(e) NA))){
showModal(
modalDialog(
title = "Unvalid Deletion",
"Delete customer record who has sales record is prohibited", easyClose = TRUE, footer = NULL
)
)
return()
}
dbGetQuery(pool,query)
values$data=values$data[-row_to_del,]
}
else if (input$lastClickId%like%"modify")
{
showModal(modal_modify)
}
}
)
}
)
6 Likes
WOw it worked like magic exactly what I needed. Thanks a lot buddy you are great.
I would highly appericate if package DT ( @yihui ) can implement this feature as a function. I will try to ask help from them. But for the mean time I would learn it for sure.
Thanks for such a wonderful reply.
This got me going like 
1 Like
https://rstudio.cloud/project/19560
perfectly functioning ShinyApp with CRUD application. However some parts are written in JavaScript. but It's good enough to use.
2 Likes
(post withdrawn by author, will be automatically deleted in 24 hours unless flagged)