From 22666b395b10981346f982065e69e2570888afad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?U=C4=9Fur=20Dar?= <37039994+ugurdar@users.noreply.github.com> Date: Tue, 20 Dec 2022 20:55:05 +0300 Subject: [PATCH] Add files via upload --- app/app-1.R | 20 ++ app/app-2.R | 113 +++++++++++ app/app-3.R | 76 ++++++++ app/app-4.R | 40 ++++ app/app-5.R | 78 ++++++++ app/app-6.R | 54 ++++++ app/app-7.R | 227 +++++++++++++++++++++++ app/app-8.R | 29 +++ app/app.Rproj | 13 ++ deploy/deploy.Rproj | 13 ++ deploy/server.R | 28 +++ deploy/ui.R | 33 ++++ sunum.html | 443 ++++++++++++++++++++++++++++++++++++++++++++ 13 files changed, 1167 insertions(+) create mode 100644 app/app-1.R create mode 100644 app/app-2.R create mode 100644 app/app-3.R create mode 100644 app/app-4.R create mode 100644 app/app-5.R create mode 100644 app/app-6.R create mode 100644 app/app-7.R create mode 100644 app/app-8.R create mode 100644 app/app.Rproj create mode 100644 deploy/deploy.Rproj create mode 100644 deploy/server.R create mode 100644 deploy/ui.R create mode 100644 sunum.html diff --git a/app/app-1.R b/app/app-1.R new file mode 100644 index 0000000..4dd53db --- /dev/null +++ b/app/app-1.R @@ -0,0 +1,20 @@ +library(shiny) + +# UI fonksiyonu +ui <- fluidPage( + textOutput("text") +) + +# Server fonksiyonu +server <- function(input, output) { + + output$text <- renderText({ + paste("cikti-1") + }) + + +} + +# Uygulamanin calistirilmasi: +# Run App butonu bu fonksiyon varsa görünür. +shinyApp(ui = ui, server = server) diff --git a/app/app-2.R b/app/app-2.R new file mode 100644 index 0000000..8494796 --- /dev/null +++ b/app/app-2.R @@ -0,0 +1,113 @@ +library(shiny) +# widgets'lara asagidaki linkten ulasilabilir. +# https://shiny.rstudio.com/gallery/widget-gallery.html + +# Render fonksiyonu: +# Ciktinin hangi girdileri kullandigini otomatik olarak izleyen ozel bir +# reaktif baglam kurar + +# R kodudunun ciktisini bir web sayfasinda goruntulemek icin HTML'e donusturur. + +# UI +ui <- fluidPage( + # 1 - checkbox + # checkbox fonksiyonunda parametreler + # id, label (checkbox'da ne yazacagi), value TRUE ya da FALSE + # checkboxInput("b", label = "secenek A-1", value = FALSE), + # textOutput("text_checkb") + + # # 2 - checkbox group + # checkboxlar birden fazla secenegi de barindirabilir. + # checkboxGroupInput("check_grup", label = h2("Checkbox"), + # choices = list("secenek 1" = 1, "secenek 2" = 2, "secenek 3" = "a"), + # selected = c("a")), + # textOutput("text_checkb_grup") + # + # # 3 - radiobuttons + # # Farkli secenekler icerisinden tek secenek sectirilmek istendiginde kullanilabilir + # radioButtons("radio", label = h3("Radiobuttons"), + # choices = list("Secenek 1" = 1, "Secenek 2" = 2, "Secenek 3" = 3), + # selected = 1), + # textOutput("text_radio") + # + # # 4 - numericinput + # numericInput("numeric", label = h3("Numeric girdi"), value = 5, min=3, max=7, step = 2), + # textOutput("text_numeric") + # + # # 5 - textinput + # textInput("text_girdi", label = h3("Text girdi"), value = "Text giriniz"), + # textOutput("text_girdi"), + # + # 6 - select box + # selectInput("selectbox", label = h3("Select box"), + # choices = unique(mtcars$cyl), + # selected = 1), + # textOutput('text_selectbox') + # SelectInput icerisinde birden fazla secim yapilabilir bunun + # icin multiple=TRUE olarak degistirilmelidir. + # selectInput( + # "selectbox_multi", "Select mtcars cyl", unique(mtcars$cyl), + # multiple = TRUE + # ) + # + # # 7 - slider + # sliderInput("slider", label = h3("Slider"), min = 0, + # max = 100, value = 50), + # textOutput('text_slider'), + # # + # # # 8 - slider range + # sliderInput("slider_range", label = h3("Slider Range"), min = 0, + # max = 100, value = c(40, 60)), + # textOutput('text_slider_range') + # + # # 9- action button + actionButton("action", label = "Action"), + # # req(input$action) ile ciktilar kontrol edilebilir. + + # 10- fluidRow fonksiyonu ile layout ayarlama. + fluidRow( + column(6, + sliderInput("slider", label = h3("Slider"), min = 0, + max = 100, value = 50, width = '70%')), + column(6, + sliderInput("slider_range", label = h3("Slider Range"), min = 0, + max = 100, value = c(40, 60))) + ) + ) + +# Server fonksiyonu +server <- function(input, output) { + # 1 - checkbox + # output$text_checkb <- renderText({ + # input$checkbox + # }) + # 2 - checkbox group + output$text_checkb_grup <- renderText({ + input$check_grup + }) + # # 3 - radiobuttons + output$text_radio <- renderText({ + input$radio + }) + # # 4 - numericinput + output$text_numeric <- renderText({ + input$numeric + }) + # # 5 - numericinput + output$text_girdi <- renderText({ + input$text_girdi + }) + # # 6 - selectbox + output$text_slider <- renderText({ + input$slider + }) + # # 7 - slider + output$text_slider_range <- renderText({ + input$slider_range + }) + +} + +# Uygulamanin calistirilmasi +# Run App butonu bu fonksiyon varsa eklenir +shinyApp(ui = ui, server = server) diff --git a/app/app-3.R b/app/app-3.R new file mode 100644 index 0000000..1182296 --- /dev/null +++ b/app/app-3.R @@ -0,0 +1,76 @@ +library(shiny) +library(ggplot2) + +# grafigi cizdirmek icin +freqpoly <- function(x1, x2, binwidth = 0.1, xlim = c(-3, 3)) { + df <- data.frame( + x = c(x1, x2), + g = c(rep("x1", length(x1)), rep("x2", length(x2))) + ) + + ggplot(df, aes(x, colour = g)) + + geom_freqpoly(binwidth = binwidth, size = 1) + + coord_cartesian(xlim = xlim) +} + +# t testi sonucundan guven araliklari ve p value'yu almak icin +t_test <- function(x1, x2) { + test <- t.test(x1, x2) + sprintf( + "p value: %0.3f\n Guven araligi:[%0.2f, %0.2f]", + test$p.value, test$conf.int[1], test$conf.int[2] + ) +} +# UI fonksiyonu +ui <- fluidPage( + fluidRow( + column(4, + "Distribution 1", + numericInput("n1", label = "n", value = 1000, min = 1), + numericInput("mean1", label = "mu", value = 0, step = 0.1), + numericInput("sd1", label = "sigma", value = 0.5, min = 0.1, step = 0.1) + ), + column(4, + "Distribution 2", + numericInput("n2", label = "n", value = 1000, min = 1), + numericInput("mean2", label = "mu", value = 0, step = 0.1), + numericInput("sd2", label = "sigma", value = 0.5, min = 0.1, step = 0.1) + ), + column(4, + "Frequency polygon", + numericInput("binwidth", label = "Bin width", value = 0.1, step = 0.1), + sliderInput("range", label = "range", value = c(-3, 3), min = -5, max = 5) + ) + ), + fluidRow( + column(9, plotOutput("hist")), + column(3, verbatimTextOutput("ttest")) + ), + actionButton("action", label = "Cizdir") + +) + +# Server fonksiyonu +server <- function(input, output, session) { + output$hist <- renderPlot({ + req(input$action) + x1 <- rnorm(input$n1, input$mean1, input$sd1) + x2 <- rnorm(input$n2, input$mean2, input$sd2) + + freqpoly(x1, x2, binwidth = input$binwidth, xlim = input$range) + }, res = 96) + cat(1) + + output$ttest <- renderText({ + # req(input$action) + + x1 <- rnorm(input$n1, input$mean1, input$sd1) + x2 <- rnorm(input$n2, input$mean2, input$sd2) + + t_test(x1, x2) + }) +} + +# Uygulamanin calistirilmasi +# Run App butonu bu fonksiyon varsa eklenir +shinyApp(ui = ui, server = server) diff --git a/app/app-4.R b/app/app-4.R new file mode 100644 index 0000000..dbeafd1 --- /dev/null +++ b/app/app-4.R @@ -0,0 +1,40 @@ +# Reaktif +# Reaktif programlamannin ana fikri, bir girdi degistiginde ilgili tum ciktilarin +# otomatik olarak guncellenmesi mantigina dayanir. +# eventReactive(),reactive(),observe(),observeEvent() + +library(shiny) +library(ggplot2) +library(dplyr) + +# Ornek veri seti. +dt <- data.frame(x=runif(1000), y=runif(1000)) + +ui <- fluidPage( + numericInput("y_ekseni", label=NULL, value=1, min=1), + actionButton("ciz","Cizdir"), + + plotOutput("graph") +) + +server <- function(input,output){ + plot_reactive <- reactive({ + plot <- ggplot(dt, aes(x,y)) + + geom_point() + + scale_y_continuous(limits = function(x){ + c(min(x), input$y_ekseni) + }) + + + return(plot) + }) + + output$graph <- renderPlot({ + plot_reactive() + }) %>% + # Cizdir'e cizdirir. Bu eklenmez ise ilk cizdir'e basildiktan sonra + # her bir numericInput degistiginde grafik de otomatik olarak degisir. + bindEvent(input$ciz) +} + +shinyApp(ui=ui, server=server) diff --git a/app/app-5.R b/app/app-5.R new file mode 100644 index 0000000..eaa6d1e --- /dev/null +++ b/app/app-5.R @@ -0,0 +1,78 @@ +# Basit dogrusal regresyon ornegi +library(shiny) +ui <- fluidPage( + # En uste baslik yazar + titlePanel("Basit Dogrusal Regresyon Analizi"), + # Sol tarafa sidebar ekler + sidebarLayout( + # siderbarPanel ve mainPanelden olusur + # siderbarPanel ekler + sidebarPanel( + selectInput("bagimli_deg", label = h3("Bagimli degisken"), + choices =names(swiss), selected = 1), + + selectInput("bagimsiz_deg", label = h3("Bagimsiz degisken"), + choices =names(swiss), selected = 1) + + ), + # mainPanel ekler + mainPanel( + # tabset ekler + tabsetPanel(type = "tabs", + # 1.panel scatterplot + tabPanel("Scatterplot", plotOutput("scatterplot")), + # 2.panel dagilimlar + tabPanel("Dagilimlar", + fluidRow( + column(6, plotOutput("dagilim1")), + column(6, plotOutput("dagilim2"))) + ), + # 3.panel model ozeti + tabPanel("Model Ozeti", verbatimTextOutput("summary")), # Regresyon ciktisi + tabPanel("Veri", DT::dataTableOutput('tbl')) # datatable olarak data ciktisi + + ) + ) + )) + +# SERVER +server <- function(input, output) { + + # Regressyon ciktisi + output$summary <- renderPrint({ + fit <- lm(swiss[,input$bagimli_deg] ~ swiss[,input$bagimsiz_deg]) + names(fit$coefficients) <- c("Intercept", input$bagimsiz_deg) + summary(fit) + }) + + # Datatable + output$tbl = DT::renderDataTable({ + DT::datatable(swiss, options = list(lengthChange = FALSE)) + }) + + + # Scatterplot + output$scatterplot <- renderPlot({ + # scatter plot cizilmesi + plot(swiss[,input$bagimsiz_deg], swiss[,input$bagimli_deg], main="Scatterplot", + xlab=input$bagimsiz_deg, ylab=input$bagimli_deg, pch=19) + # regresyon dogrusunun eklenmesi + abline(lm(swiss[,input$bagimli_deg] ~ swiss[,input$bagimsiz_deg]), col="red") + # lowess fonksiyonu snooth line grafigi cizilmesini saglar + lines(lowess(swiss[,input$bagimsiz_deg],swiss[,input$bagimli_deg]), col="blue") + }, height=400) + + + # Histogram-1 + output$dagilim1 <- renderPlot({ + hist(swiss[,input$bagimli_deg], main="", xlab=input$bagimli_deg) + }, height=300, width=300) + + # Histogram-1 + output$dagilim2 <- renderPlot({ + hist(swiss[,input$bagimsiz_deg], main="", xlab=input$bagimsiz_deg) + }, height=300, width=300) + +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/app/app-6.R b/app/app-6.R new file mode 100644 index 0000000..cb1cd11 --- /dev/null +++ b/app/app-6.R @@ -0,0 +1,54 @@ +# Stock price ornegi +library(shiny) +library(dplyr) +library(quantmod) +library(highcharter) +library(DT) + + +ui <- fluidPage( + titlePanel("Stock Grafigi"), + + sidebarLayout( + sidebarPanel( + helpText("Lutfen sembol giriniz."), + textInput("symb", "Sembol", "SPY"), + + dateRangeInput("dates", + "Tarih araligi", + start = "2013-01-01", + end = as.character(Sys.Date())), + actionButton("ciz","Grafik"), + actionButton("tablo","Tablo"), + ), + mainPanel( + highchartOutput("plot"), + dataTableOutput("tablo") + + ) + ) +) + +server <- function(input, output) { + + dataInput <- reactive({ + getSymbols(input$symb, src = "yahoo", + from = input$dates[1], + to = input$dates[2], + auto.assign = FALSE) + }) + + output$plot <- renderHighchart({ + hchart(dataInput(), type = "ohlc") |> + hc_title(text = paste(input$symb,"-","Acilis Kapanis")) + }) %>% + bindEvent(input$ciz) + + output$tablo <- renderDataTable({ + datatable(dataInput()) + }) %>% + bindEvent(input$tablo) + +} + +shinyApp(ui, server) diff --git a/app/app-7.R b/app/app-7.R new file mode 100644 index 0000000..5443e10 --- /dev/null +++ b/app/app-7.R @@ -0,0 +1,227 @@ +library(shiny) +library(shinydashboard) +################################################################# +## App 1 ## +################################################################# +ui <- dashboardPage( + dashboardHeader(), + dashboardSidebar(), + dashboardBody() +) + +server <- function(input, output) { } + +shinyApp(ui, server) + + +################################################################# +## App 2 ## +################################################################# +ui <- dashboardPage( + dashboardHeader(title = "Dashboard basligi"), + dashboardSidebar(), + dashboardBody( + # Box fonksiyonu sat??r(fluidRow) ya sutun(column) icerisinde kullanilmali. + fluidRow( + box(plotOutput("plot1", height = 250)), + + box( + title = "Slider Input", + sliderInput("slider", "Gozlem sayisi:", 1, 100, 50) + ) + ) + ) +) + +server <- function(input, output) { + set.seed(122) + histdata <- rnorm(500) + + output$plot1 <- renderPlot({ + data <- histdata[seq_len(input$slider)] + hist(data) + }) +} + +shinyApp(ui, server) + + +################################################################# +## App 3 ## +################################################################# + +sidebar <- dashboardSidebar( + sidebarSearchForm(label = "Search...", "searchText", "searchButton"), + sliderInput("slider", "Slider:", 1, 20, 5), + textInput("text", "Text input:"), + dateRangeInput("daterange", "Date Range:") +) + +ui <- dashboardPage( + dashboardHeader(title = "Sidebar inputs"), + sidebar, + dashboardBody() +) + +server <- function(input, output) { } + +shinyApp(ui, server) + +################################################################# +## App 4 ## +################################################################# +ui <- dashboardPage( + dashboardHeader(title = "Info boxes"), + dashboardSidebar(), + dashboardBody( + # infoBoxes with fill=FALSE + fluidRow( + # A static infoBox + infoBox("New Orders", 10 * 2, icon = icon("credit-card")), + # Dynamic infoBoxes + infoBoxOutput("progressBox"), + infoBoxOutput("approvalBox") + ), + + # infoBoxes with fill=TRUE + fluidRow( + infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE), + infoBoxOutput("progressBox2"), + infoBoxOutput("approvalBox2") + ), + + fluidRow( + # Clicking this will increment the progress amount + box(width = 4, actionButton("count", "Increment progress")) + ) + ) +) + +server <- function(input, output) { + output$progressBox <- renderInfoBox({ + infoBox( + "Progress", paste0(25 + input$count, "%"), icon = icon("list"), + color = "purple" + ) + }) + output$approvalBox <- renderInfoBox({ + infoBox( + "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"), + color = "yellow" + ) + }) + + # Same as above, but with fill=TRUE + output$progressBox2 <- renderInfoBox({ + infoBox( + "Progress", paste0(25 + input$count, "%"), icon = icon("list"), + color = "purple", fill = TRUE + ) + }) + output$approvalBox2 <- renderInfoBox({ + infoBox( + "Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"), + color = "yellow", fill = TRUE + ) + }) +} + +shinyApp(ui, server) + +################################################################# +## App 5 ## +################################################################# +body <- dashboardBody( + fluidRow( + box( + title = "Box title", + status = "primary", + plotOutput("plot1", height = 240) + ), + box( + status = "warning", + plotOutput("plot2", height = 240) + ) + ), + + fluidRow( + column(width = 4, + box( + title = "Title 1", solidHeader = TRUE, status = "primary", + width = NULL, + sliderInput("orders", "Orders", min = 1, max = 500, value = 120), + radioButtons("fill", "Fill", inline = TRUE, + c(None = "none", Blue = "blue", Black = "black", red = "red") + ) + ), + box( + width = NULL, + background = "black", + "A box with a solid black background" + ) + ), + column(width = 4, + box( + title = "Title 2", + solidHeader = TRUE, + width = NULL, + p("Box content here") + ), + box( + title = "Title 5", + width = NULL, + background = "light-blue", + "A box with a solid light-blue background" + ) + ), + column(width = 4, + box( + title = "Title 3", + solidHeader = TRUE, status = "warning", + width = NULL, + selectInput("spread", "Spread", + choices = c("0%" = 0, "20%" = 20, "40%" = 40, "60%" = 60, "80%" = 80, "100%" = 100), + selected = "60" + ) + ), + box( + title = "Title 6", + width = NULL, + background = "maroon", + "A box with a solid maroon background" + ) + ) + ) +) + +ui <- dashboardPage( + dashboardHeader(title = "Mixed layout"), + dashboardSidebar(), + body +) + +server <- function(input, output) { + + set.seed(122) + histdata <- rnorm(500) + + output$plot1 <- renderPlot({ + if (is.null(input$orders) || is.null(input$fill)) + return() + + data <- histdata[seq(1, input$orders)] + color <- input$fill + if (color == "none") + color <- NULL + hist(data, col = color) + }) + + output$plot2 <- renderPlot({ + spread <- as.numeric(input$spread) / 100 + x <- rnorm(1000) + y <- x + rnorm(1000) * spread + plot(x, y, pch = ".", col = "blue") + }) +} + +shinyApp(ui, server) \ No newline at end of file diff --git a/app/app-8.R b/app/app-8.R new file mode 100644 index 0000000..03f38c7 --- /dev/null +++ b/app/app-8.R @@ -0,0 +1,29 @@ +sidebar <- dashboardSidebar( + sidebarMenu( + menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")), + menuItem("Widgets", icon = icon("th"), tabName = "widgets", + badgeLabel = "new", badgeColor = "green") + ) +) + +body <- dashboardBody( + tabItems( + tabItem(tabName = "dashboard", + h2("Dashboard tab content"), + ), + tabItem(tabName = "widgets", + ) + ) +) + +ui <- dashboardPage( + dashboardHeader(title = "Simple tabs"), + sidebar, + body +) + +server <- function(input, output) { + + } + +shinyApp(ui, server) \ No newline at end of file diff --git a/app/app.Rproj b/app/app.Rproj new file mode 100644 index 0000000..f5c783e --- /dev/null +++ b/app/app.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: ISO-8859-1 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/deploy/deploy.Rproj b/deploy/deploy.Rproj new file mode 100644 index 0000000..f5c783e --- /dev/null +++ b/deploy/deploy.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: ISO-8859-1 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/deploy/server.R b/deploy/server.R new file mode 100644 index 0000000..41dc93f --- /dev/null +++ b/deploy/server.R @@ -0,0 +1,28 @@ +# +# This is the server logic of a Shiny web application. You can run the +# application by clicking 'Run App' above. +# +# Find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com/ +# + +library(shiny) + +# Define server logic required to draw a histogram +shinyServer(function(input, output) { + + output$distPlot <- renderPlot({ + + # generate bins based on input$bins from ui.R + x <- faithful[, 2] + bins <- seq(min(x), max(x), length.out = input$bins + 1) + + # draw the histogram with the specified number of bins + hist(x, breaks = bins, col = 'darkgray', border = 'white', + xlab = 'Waiting time to next eruption (in mins)', + main = 'Histogram of waiting times') + + }) + +}) diff --git a/deploy/ui.R b/deploy/ui.R new file mode 100644 index 0000000..5dd98cf --- /dev/null +++ b/deploy/ui.R @@ -0,0 +1,33 @@ +# +# This is the user-interface definition of a Shiny web application. You can +# run the application by clicking 'Run App' above. +# +# Find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com/ +# + +library(shiny) + +# Define UI for application that draws a histogram +shinyUI(fluidPage( + + # Application title + titlePanel("Old Faithful Geyser Data"), + + # Sidebar with a slider input for number of bins + sidebarLayout( + sidebarPanel( + sliderInput("bins", + "Number of bins:", + min = 1, + max = 50, + value = 30) + ), + + # Show a plot of the generated distribution + mainPanel( + plotOutput("distPlot") + ) + ) +)) diff --git a/sunum.html b/sunum.html new file mode 100644 index 0000000..366106e --- /dev/null +++ b/sunum.html @@ -0,0 +1,443 @@ + + + + + + + + + + + + + + + +Shiny ile Arayüz Tasarımı + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

İçerik

+ +
+
+

Shiny nedir?

+

Shiny, interaktif web uygulamalarını R ile oluşturmayı sağlayan bir R +paketidir(Python’da da mevcut).

+

Shiny uygulamarı htmlwidgets’lar, CSS ve JavaScript ile daha fazla +genişletilebilir.

+

Shiny paketini kullanırken herhangi bir HTML, CSS, JavaScript kodu +yazmak zorunlu değildir ancak gelişmiş uygulamalar yapmak için bunları +kullanmak gerekebilir.

+
+
+

Nereden nasıl başlamalı?

+

POSIT’in sunduğu +eğitimler

+

widgets’lar

+
+
+

Shiny örnekleri

+

Shiny Gallery

+
+
+

Yararlı linkler

+

Advanced Shiny - +tips&tricks

+

Shiny +Extension

+
+ + + + +
+ + + + + + + + + + + + + + +