Merhaba Arkadaşlar,
Bu yazımda, R shiny paketi ile css,javascript,R komutları kullanılarak reactive bir raporlama arayüzü nasıl yapıldığını gösteren R kodlarımı paylaştım umarım sizlere faydalı olur. Raporlama ekranından görüntülere aşağıdaki gibidir.
R kodları
ui.R----
library(shiny)
library(shinydashboard)
library(leaflet)
shinyUI(
dashboardPage(
dashboardHeader( title=textOutput("title"),titleWidth = 300,
tags$li(class = "dropdown",
tags$a(href="https://www.r-project.org", target="_blank",
tags$img(height = "20px", alt="SBM Logo", src="r.png")
))
),
dashboardSidebar(uiOutput("side"),uiOutput('Side_Logout'), width = 300),
dashboardBody(
tags$head(tags$style(HTML('
/* logo */
.skin-blue .main-header .logo {
background-color: #088da5;
}
/* logo when hovered */
.skin-blue .main-header .logo:hover {
background-color: #9cd1db;
}
/* navbar (rest of the header) */
.skin-blue .main-header .navbar {
background-color: #39a3b7
;
}
/* main sidebar */
.skin-blue .main-sidebar {
background-color: #39a3b7
}
/* active selected tab in the sidebarmenu */
.skin-blue .main-sidebar .sidebar .sidebar-menu .active a{
background-color: RGB(8,141,168);
color: #ffffff;
}
/* other links in the sidebarmenu */
.skin-blue .main-sidebar .sidebar .sidebar-menu a{
background-color: #f9f9f9;
color: #000000;
border: 0.9px solid #20b2aa;
}
/* other links in the sidebarmenu when hovered */
.skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{
background-color: RGB(8,141,168);
color: #ffffff;
}
/* toggle button when hovered */
.skin-blue .main-header .navbar .sidebar-toggle:hover{
background-color: #9cd1db;
color: #ffffff;
}
'))),
uiOutput("page")
)
)
)
Server.R
---
library(shiny)
library(shinydashboard)
library(shinyBS)
library(DT)
library(leaflet)
source("user.R")
source("admin.R")
my_username <- c("test","admin")
my_password <- c("test","123")
get_role=function(user){
if(user=="test") {
return("TEST")
}else{
return("ADMIN")
}
}
get_ui=function(role){
itog=list()
if(role=="TEST"){
itog$title=test_title
itog$system=test_system
itog$main=test_main
itog$side=test_side
return(itog)
}else{
itog$title=admin_title
itog$system=admin_system
itog$main=admin_main
itog$side=admin_side
return(itog)
}
}
shinyServer(function(input, output,session) {
USER <- reactiveValues(Logged = FALSE,role=NULL)
data <- reactive({
file2 <- input$file1
if(is.null(file2)){return()}
read.csv(file=file2$datapath,header=TRUE,sep=input$sep,stringsAsFactors =FALSE)
})
output$wykres <- renderPlot({
x <- data()[, input$xcol]
y <- data()[, input$ycol]
z <- data()[, input$zcol]
req(as.numeric(x))
req(as.numeric(y))
plot(x,y,data=data())
})
output$summary <- renderPrint({
inFile <- input$file1
if (is.null(inFile))
return(NULL)
summary( read.csv(inFile$datapath, header=TRUE,sep=input$sep))
})
observe({
inFile<-input$file1
print(inFile)
if(is.null(inFile))
return(NULL)
dt = read.csv(inFile$datapath, sep=input$sep)
nums <- sapply(dt, is.numeric)
items=names(nums[nums])
names(items)=items
## Decide later what to do with the data, here we just fill
updateSelectInput(session, "xcol", choices = items)
updateSelectInput(session, "ycol", choices = items,selected = names(dt)[2])
updateSelectInput(session, "zcol", choices = names(dt))
})
output$contents <- DT::renderDataTable({
if(is.null(data())){
return(NULL)
}
DT::datatable(data(),extensions = 'FixedColumns',class = 'cell-border stripe table-bordered',style = 'bootstrap',
filter = list(position = "top", clear = TRUE),
options = list(
scrollX = TRUE,
autoWidth = TRUE,
#fixedColumns = list(leftColumns = 2, rightColumns = 1),
columnDefs = list(list(width = "140px", targets = "_all"))
),
rownames = FALSE,
selection = "none")
})
observe({
if (USER$Logged == FALSE) {
if (!is.null(input$Login)) {
if (input$Login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
Id.username <- which(my_username == Username)
Id.password <- which(my_password == Password)
if (length(Id.username) > 0 & length(Id.password) > 0) {
if (Id.username == Id.password) {
USER$Logged <- TRUE
USER$role=get_role(Username)
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$title <- renderText({
"R Web Application"
})
output$side <- renderUI({
div(id = "login",
wellPanel(textInput("userName", tags$span(style="color:RGB(54,127,169)", "Username:")),
tags$style(type="text/css", "#userName {text-align:center;}"),
passwordInput("passwd", tags$span(style="color:RGB(54,127,169)", "Password:")),
tags$style(type="text/css", "#passwd {text-align:center;}"),
br(),
fluidRow(
column(4,
actionButton("Login", tags$span(style="color:RGB(54,127,169)", "Login:"))
),
column(8,
div(img(src="r.png",width=40, heigth=3),align = "right")
)
))
)
})
output$page <- renderUI({
div(id="log1",img(src="data.png",width=700),align = "center")
})
}
if (USER$Logged == TRUE) {
itog=get_ui(USER$role)
output$title<- renderText({
itog$title
})
output$system<- renderUI({
itog$system
})
output$side <- renderUI({
itog$side
})
output$page <- renderUI({
itog$main
})
}
})
})
User.R
--
test_title="Decison Support System"
test_system<-list(
)
test_side=list(
sidebarMenu(id = "tabs",
menuItem("File Upload", icon = icon("upload"),
div(id="rad",
fileInput('file1', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
))
),
menuItem("Show The Seperators", icon = icon("drupal"), tabName = "dashboard",
div(id="rad",radioButtons('sep', 'Separator',
c(Comma=',',
Semicolon=';',
Tab='\t'),
','))),
menuItem("Show The Variables", icon = icon("codepen"), tabName = "widgets",
div(id="rad",selectInput('xcol', 'X Variable',""),
selectInput('ycol', 'Y Variable',""),
selectInput('zcol', 'Z Variable',""))
),
tags$style(type="text/css", "#rad {background-color: #ffffff;color: #000000;
}")
)
)
test_main=list(
navbarPage(title=div(icon("jsfiddle"),"Business Intelligence"),
tabPanel("Dashboard", icon = icon("dashboard")),
tabPanel("Data", icon = icon("database"), DT::dataTableOutput('contents')),
tabPanel("Grafik",icon = icon("line-chart"),
box(
title = "Histogram", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("wykres", height = 250)
)),
tabPanel("Summary",verbatimTextOutput("summary"))
)
,
div(id="back",tags$b("Development by Şükrü ERGÜNTOP")),
tags$style(type="text/css", "#back {position:absolute;bottom:0;color:#088da5;max-width: 100%; width: 100%;}")
)
Admin.R
--
admin_title="Decison Support System"
admin_side=list(sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
))
admin_main=list(
tabItems(
tabItem(tabName = "dashboard", list(h1("1234"),h2("234"))),
tabItem(tabName = "widgets", list(fluidRow(column(6,numericInput("inputtest", "test", value = 0),column(6,actionButton(inputId ="test1",label ="go")))))
)
))
