林嶔 (Lin, Chin)
Lesson 15 圖形化互動App
– ui.R
library(shiny)
fluidPage(
fluidRow(
column(width = 4,
plotOutput("plot1", height = 350,
click = "plot_click",
dblclick = dblclickOpts(id = "plot_dblclick"),
hover = hoverOpts(id = "plot_hover"),
brush = brushOpts(id = "plot_brush")
)
)
),
fluidRow(
column(width = 3,
verbatimTextOutput("click_info")
),
column(width = 3,
verbatimTextOutput("dblclick_info")
),
column(width = 3,
verbatimTextOutput("hover_info")
),
column(width = 3,
verbatimTextOutput("brush_info")
)
)
)
– server.R
library(shiny)
data(cars)
dat = cars
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
plot(dat)
})
output$click_info <- renderPrint({
cat("input$plot_click:\n")
str(input$plot_click)
})
output$hover_info <- renderPrint({
cat("input$plot_hover:\n")
str(input$plot_hover)
})
output$dblclick_info <- renderPrint({
cat("input$plot_dblclick:\n")
str(input$plot_dblclick)
})
output$brush_info <- renderPrint({
cat("input$plot_brush:\n")
str(input$plot_brush)
})
})
– 這邊需要用到兩個新函數:reactiveValues()、observe()和observeEvent()
library(shiny)
fluidPage(
fluidRow(
column(width = 4,
plotOutput("plot1", height = 400,
brush = brushOpts(id = "plot1_brush", resetOnNew = TRUE))
),
column(width = 4,
plotOutput("plot2", height = 400)
),
column(width = 4,
plotOutput("plot3", height = 400,
dblclick = "plot3_dblclick",
brush = brushOpts(id = "plot3_brush", resetOnNew = TRUE))
)
)
)
library(shiny)
data(cars)
dat = cars
shinyServer(function(input, output) {
ranges1 = reactiveValues(x = NULL, y = NULL)
observe({
brush1 = input$plot1_brush
if (!is.null(brush1)) {
ranges1$x = c(brush1$xmin, brush1$xmax)
ranges1$y = c(brush1$ymin, brush1$ymax)
} else {
ranges1$x = NULL
ranges1$y = NULL
}
})
output$plot1 <- renderPlot({
plot(dat)
})
output$plot2 <- renderPlot({
plot(dat, xlim = ranges1$x, ylim = ranges1$y)
})
ranges2 <- reactiveValues(x = NULL, y = NULL)
output$plot3 <- renderPlot({
plot(dat, xlim = ranges2$x, ylim = ranges2$y)
})
observeEvent(input$plot3_dblclick, {
brush2 <- input$plot3_brush
if (!is.null(brush2)) {
ranges2$x <- c(brush2$xmin, brush2$xmax)
ranges2$y <- c(brush2$ymin, brush2$ymax)
} else {
ranges2$x <- NULL
ranges2$y <- NULL
}
})
})
假設你未來想要做人工智慧研究,我們在教會電腦之前自己必須先做一次給他看。
目前我們的任務是,請你找出圖片中的人類位置在哪,請到這裡下載範例檔案
– 我們先看看裡面的一個文字檔案,而這個檔案描述的是5張圖的人類位置在哪:
## obj_name col_left col_right row_bot row_top prob img_id
## 1 person 0.60728125 0.7782344 0.8139110 0.1637471 1 1
## 2 person 0.00000000 0.0971250 0.7015925 0.6154801 1 1
## 3 person 0.50981250 0.6211250 0.8687150 0.4078505 1 2
## 4 person 0.01529687 0.2058281 0.9194159 0.3903271 1 2
## 5 person 0.79756250 0.9907812 0.9042757 0.4001636 1 2
## 6 person 0.32854688 0.6720156 0.8738333 0.2985208 1 3
## 7 person 0.88721875 0.9362500 0.7515368 0.5911255 1 4
## 8 person 0.39248437 0.4289219 0.3639394 0.2303463 1 4
## 9 person 0.47934375 0.4961250 0.6005000 0.5788542 1 5
## 10 person 0.76668750 0.7721250 0.5681875 0.5610833 1 5
library(jpeg)
library(imager)
Show_img = function (img, box_info = NULL, col_bbox = '#FFFFFF00', col_label = '#FF0000FF') {
par(mar = rep(0, 4))
plot(NA, xlim = c(0, 1), ylim = c(1, 0), xaxt = "n", yaxt = "n", bty = "n")
img = (img - min(img))/(max(img) - min(img))
img = as.raster(img)
rasterImage(img, 0, 1, 1, 0, interpolate=FALSE)
if (!is.null(box_info)) {
if (nrow(box_info) > 0) {
for (i in 1:nrow(box_info)) {
size = max(box_info[i,3] - box_info[i,2], 0.2)
rect(xleft = box_info[i,2], xright = box_info[i,2] + 0.06*sqrt(size)*nchar(box_info[i,1]),
ybottom = box_info[i,5] + 0.08*sqrt(size), ytop = box_info[i,5],
col = col_label, border = col_label, lwd = 0)
text(x = box_info[i,2] + 0.03*sqrt(size) * nchar(box_info[i,1]),
y = box_info[i,5] + 0.04*sqrt(size),
labels = box_info[i,1],
col = 'white', cex = 1.5*sqrt(size), font = 2)
rect(xleft = box_info[i,2], xright = box_info[i,3],
ybottom = box_info[i,4], ytop = box_info[i,5],
col = col_bbox, border = col_label, lwd = 5*sqrt(size))
}
}
}
}
讓使用者能夠自己上傳一張圖片上去
框出物件的位置在哪,並選擇框選的物件為何(目前只有人類供選擇)
按下按鍵後紀錄框的位置
將資訊記錄在資料表內,而img_id設定為圖像的檔名
如果使用者覺得框錯了,可以把它刪除
使用者最終能下載該資料表
library(shiny)
library(DT)
library(jpeg)
library(imager)
fluidPage(
fluidRow(
column(width = 4,
fileInput("files", label = h4("Upload your jpeg image:"), multiple = FALSE, accept = "image/jpeg"),
br(),
radioButtons("obj", label = h4("Please select a object name:"), c("person" = "person")),
br(),
downloadButton("download", label = "Download file", class = NULL)
),
column(width = 7,
plotOutput("plot", height = 416, width = 416,
dblclick = "plot_dblclick",
brush = brushOpts(id = "plot_brush", resetOnNew = TRUE)),
br(),
actionButton("delete", strong("Delete selected box!"), icon("list-alt")),
br(),
br(),
DT::dataTableOutput('table')
)
)
)
library(shiny)
library(DT)
library(jpeg)
library(imager)
Show_img = function (img, box_info = NULL, col_bbox = '#FFFFFF00', col_label = '#FF0000FF') {
par(mar = rep(0, 4))
plot(NA, xlim = c(0, 1), ylim = c(1, 0), xaxt = "n", yaxt = "n", bty = "n")
img = (img - min(img))/(max(img) - min(img))
img = as.raster(img)
rasterImage(img, 0, 1, 1, 0, interpolate=FALSE)
if (!is.null(box_info)) {
if (nrow(box_info) > 0) {
for (i in 1:nrow(box_info)) {
size = max(box_info[i,3] - box_info[i,2], 0.2)
rect(xleft = box_info[i,2], xright = box_info[i,2] + 0.06*sqrt(size)*nchar(box_info[i,1]),
ybottom = box_info[i,5] + 0.08*sqrt(size), ytop = box_info[i,5],
col = col_label, border = col_label, lwd = 0)
text(x = box_info[i,2] + 0.03*sqrt(size) * nchar(box_info[i,1]),
y = box_info[i,5] + 0.04*sqrt(size),
labels = box_info[i,1],
col = 'white', cex = 1.5*sqrt(size), font = 2)
rect(xleft = box_info[i,2], xright = box_info[i,3],
ybottom = box_info[i,4], ytop = box_info[i,5],
col = col_bbox, border = col_label, lwd = 5*sqrt(size))
}
}
}
}
shinyServer(function(input, output) {
IMAGE = reactive({
if (is.null(input$files)) {return()} else {
img = readJPEG(input$files$datapath)
return(img)
}
})
MY_TABLE = reactiveValues(table = NULL)
output$plot = renderPlot({
img = IMAGE()
if (!is.null(input$files$name)) {
box_info = MY_TABLE$table
box_info = box_info[box_info[,"img_id"] == input$files$name,]
} else {
box_info = NULL
}
if (is.null(img)) {return()} else {
Show_img(img = img, box_info = box_info)
}
})
observeEvent(input$plot_dblclick, {
brush = input$plot_brush
if (!is.null(brush) & !is.null(input$files$name)) {
new_table = data.frame(obj_name = input$obj,
col_left = brush$xmin,
col_right = brush$xmax,
row_bot = brush$ymax,
row_top = brush$ymin,
prob = 1,
img_id = input$files$name,
stringsAsFactors = FALSE)
MY_TABLE$table = rbind(MY_TABLE$table, new_table)
}
})
observeEvent(input$delete, {
selection = as.numeric(input$table_rows_selected)
if (length(selection)!=0) {
MY_TABLE$table = MY_TABLE$table[-selection,]
}
})
output$table = DT::renderDataTable({
dat = MY_TABLE$table
if (is.null(dat)) {return()} else {
dat[,2] = round(dat[,2], 3)
dat[,3] = round(dat[,3], 3)
dat[,4] = round(dat[,4], 3)
dat[,5] = round(dat[,5], 3)
Result = DT::datatable(dat)
return(Result)
}
})
output$download = downloadHandler(
filename = function() {'label.csv'},
content = function(con) {
dat = MY_TABLE$table
if (is.null(dat)) {return()} else {
write.csv(dat, con, row.names = FALSE)
}
}
)
})
– 你應該有注意到你的App是沒有辦法用帳號密碼保護的,而要做這件事情確實是有難度,畢竟我們似乎是沒有學過兩個頁面的切換功能,那讓我們再google看看吧:
– 其中的第三個討論串:Starting Shiny app after password input就是在講這件事情
rm(list = ls())
library(shiny)
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){tagList(tabPanel("Test"))}
ui = (htmlOutput("page"))
server = (function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
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
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
})
}
})
})
#runApp(list(ui = ui, server = server))
– global.R
library(shiny)
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){tagList(tabPanel("Test"))}
– ui.R
library(shiny)
function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
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
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
})
}
})
}
– global.R
library(shiny)
Logged = FALSE;
my_username <- "test"
my_password <- "test"
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){tagList(tabPanel("Test",
sliderInput("obs", "Number of observations:", min = 0, max = 1000, value = 500),
plotOutput("distPlot")))}
– ui.R
library(shiny)
function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
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
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
})
output$distPlot = renderPlot({
# generate an rnorm distribution and plot it
dist = rnorm(input$obs)
hist(dist)
})
}
})
}
– 請你設計兩個頁面的程序,讓使用者在使用標註系統之前需要輸入帳號密碼!
library(shiny)
library(DT)
library(jpeg)
library(imager)
Logged = FALSE;
my_username <- "test"
my_password <- "test"
Show_img = function (img, box_info = NULL, col_bbox = '#FFFFFF00', col_label = '#FF0000FF') {
par(mar = rep(0, 4))
plot(NA, xlim = c(0, 1), ylim = c(1, 0), xaxt = "n", yaxt = "n", bty = "n")
img = (img - min(img))/(max(img) - min(img))
img = as.raster(img)
rasterImage(img, 0, 1, 1, 0, interpolate=FALSE)
if (!is.null(box_info)) {
if (nrow(box_info) > 0) {
for (i in 1:nrow(box_info)) {
size = max(box_info[i,3] - box_info[i,2], 0.2)
rect(xleft = box_info[i,2], xright = box_info[i,2] + 0.06*sqrt(size)*nchar(box_info[i,1]),
ybottom = box_info[i,5] + 0.08*sqrt(size), ytop = box_info[i,5],
col = col_label, border = col_label, lwd = 0)
text(x = box_info[i,2] + 0.03*sqrt(size) * nchar(box_info[i,1]),
y = box_info[i,5] + 0.04*sqrt(size),
labels = box_info[i,1],
col = 'white', cex = 1.5*sqrt(size), font = 2)
rect(xleft = box_info[i,2], xright = box_info[i,3],
ybottom = box_info[i,4], ytop = box_info[i,5],
col = col_bbox, border = col_label, lwd = 5*sqrt(size))
}
}
}
}
ui1 <- function(){
tagList(
div(id = "login",
wellPanel(textInput("userName", "Username"),
passwordInput("passwd", "Password"),
br(),actionButton("Login", "Log in"))),
tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
)}
ui2 <- function(){tagList(tabPanel("Main page",
fluidRow(
column(width = 4,
fileInput("files", label = h4("Upload your jpeg image:"), multiple = FALSE, accept = "image/jpeg"),
br(),
radioButtons("obj", label = h4("Please select a object name:"), c("person" = "person")),
br(),
downloadButton("download", label = "Download file", class = NULL)
),
column(width = 7,
plotOutput("plot", height = 416, width = 416,
dblclick = "plot_dblclick",
brush = brushOpts(id = "plot_brush", resetOnNew = TRUE)),
br(),
actionButton("delete", strong("Delete selected box!"), icon("list-alt")),
br(),
br(),
DT::dataTableOutput('table')
)
)))}
library(shiny)
library(DT)
library(jpeg)
library(imager)
function(input, output,session) {
USER <- reactiveValues(Logged = Logged)
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
}
}
}
}
}
})
observe({
if (USER$Logged == FALSE) {
output$page <- renderUI({
div(class="outer",do.call(bootstrapPage,c("",ui1())))
})
}
if (USER$Logged == TRUE)
{
output$page <- renderUI({
div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
})
IMAGE = reactive({
if (is.null(input$files)) {return()} else {
img = readJPEG(input$files$datapath)
return(img)
}
})
MY_TABLE = reactiveValues(table = NULL)
output$plot = renderPlot({
img = IMAGE()
if (!is.null(input$files$name)) {
box_info = MY_TABLE$table
box_info = box_info[box_info[,"img_id"] == input$files$name,]
} else {
box_info = NULL
}
if (is.null(img)) {return()} else {
Show_img(img = img, box_info = box_info)
}
})
observeEvent(input$plot_dblclick, {
brush = input$plot_brush
if (!is.null(brush) & !is.null(input$files$name)) {
new_table = data.frame(obj_name = input$obj,
col_left = brush$xmin,
col_right = brush$xmax,
row_bot = brush$ymax,
row_top = brush$ymin,
prob = 1,
img_id = input$files$name,
stringsAsFactors = FALSE)
MY_TABLE$table = rbind(MY_TABLE$table, new_table)
}
})
observeEvent(input$delete, {
selection = as.numeric(input$table_rows_selected)
if (length(selection)!=0) {
MY_TABLE$table = MY_TABLE$table[-selection,]
}
})
output$table = DT::renderDataTable({
dat = MY_TABLE$table
if (is.null(dat)) {return()} else {
dat[,2] = round(dat[,2], 3)
dat[,3] = round(dat[,3], 3)
dat[,4] = round(dat[,4], 3)
dat[,5] = round(dat[,5], 3)
Result = DT::datatable(dat)
return(Result)
}
})
output$download = downloadHandler(
filename = function() {'label.csv'},
content = function(con) {
dat = MY_TABLE$table
if (is.null(dat)) {return()} else {
write.csv(dat, con, row.names = FALSE)
}
}
)
}
})
}
– 大家可以在googleVis examples找到一些例子
– 請複製貼上以下範例在Rstudio中
– 請至這裡下載範例資料
## eGFR Disease Survival.time Death Diabetes Cancer SBP DBP
## 1 34.65379 1 0.4771037 0 0 1 121.2353 121.3079
## 2 37.21183 1 3.0704424 0 1 1 122.2000 122.6283
## 3 32.60074 1 0.2607117 1 0 0 118.9136 121.7621
## 4 29.68481 1 NA NA 0 0 118.2212 112.7043
## 5 28.35726 0 0.1681673 1 0 0 116.7469 115.7705
## 6 33.95012 1 1.2238556 0 0 0 119.9936 116.3872
## Education Income
## 1 2 0
## 2 2 0
## 3 0 0
## 4 1 0
## 5 0 0
## 6 1 0
– 圓餅圖
TAB = table(dat$Income)
TAB = data.frame(TAB)
colnames(TAB) = c("Income", "Freq")
TAB[,1] = c("Low income", "Middle-class", "Wealthy")
Pie = gvisPieChart(TAB)
plot(Pie)
– 長條圖
m1.0 = mean(dat[dat[,"Income"] == 0,]$SBP, na.rm = TRUE)
m1.1 = mean(dat[dat[,"Income"] == 1,]$SBP, na.rm = TRUE)
m1.2 = mean(dat[dat[,"Income"] == 2,]$SBP, na.rm = TRUE)
m2.0 = mean(dat[dat[,"Income"] == 0,]$eGFR, na.rm = TRUE)
m2.1 = mean(dat[dat[,"Income"] == 1,]$eGFR, na.rm = TRUE)
m2.2 = mean(dat[dat[,"Income"] == 2,]$eGFR, na.rm = TRUE)
DF = data.frame(Income = c("Low income", "Middle-class", "Wealthy"),
SBP = c(m1.0, m1.1, m1.2),
eGFR = c(m2.0, m2.1, m2.2))
Column = gvisColumnChart(DF)
plot(Column)
newdat = dat[,c("eGFR", "SBP")]
SC2 = gvisScatterChart(newdat,
options=list(
title = "eGFR vs SBP",
legend = "none",
colors="['#ff0000']",
pointSize = 2,
explorer="{actions: ['dragToZoom',
'rightClickToReset'],
maxZoomIn:0.05}"
))
plot(SC2)
– ui.R
– server.R
– 請在這裡下載練習用檔案
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Linear regression for two continuous variables."),
sidebarPanel(
fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
helpText("Note: you only can upload the .txt file."),
uiOutput("choose_columns1"), #這裡是關鍵
uiOutput("choose_columns2"), #這裡是關鍵
radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "red", "Blue" = "blue", "Green" = "green"))
),
mainPanel(
verbatimTextOutput("summary"),
plotOutput("plot",width = "500px", height = "500px")
)
))
library(shiny)
shinyServer(function(input, output) {
DATA <- reactive({
if (is.null(input$files)) {return()} else {
dat <- read.table(input$files$datapath,header=T)
return(dat)
}
})
output$choose_columns1 <- renderUI({ #這裡是關鍵
dat = DATA()
if (is.null(dat)) {return()} else {
colnames <- colnames(dat)
selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
}
})
output$choose_columns2 <- renderUI({ #這裡是關鍵
dat = DATA()
if (is.null(dat)|is.null(input$Y)) {return()} else {
colnames <- colnames(dat)
selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
}
})
output$summary <- renderPrint({
dat = DATA()
if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
X <- dat[,input$X] #這裡是關鍵
Y <- dat[,input$Y] #這裡是關鍵
Result=cor.test(X,Y,method=input$method)
return(Result)
}
})
output$plot <- renderPlot({
dat = DATA()
if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
X <- dat[,input$X] #這裡是關鍵
Y <- dat[,input$Y] #這裡是關鍵
plot(X,Y,pch=19,col=input$Color)
abline(lm(Y~X),col="black")
}
})
})
library(shiny)
library(googleVis)
shinyUI(pageWithSidebar(
headerPanel("Linear regression for two continuous variables."),
sidebarPanel(
fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
helpText("Note: you only can upload the .txt file."),
uiOutput("choose_columns1"), #這裡是關鍵
uiOutput("choose_columns2"), #這裡是關鍵
radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "#ff0000", "Blue" = "#0000ff", "Green" = "#00ff00"))
),
mainPanel(
verbatimTextOutput("summary"),
htmlOutput("plot")
)
))
library(shiny)
library(googleVis)
shinyServer(function(input, output) {
DATA <- reactive({
if (is.null(input$files)) {return()} else {
dat <- read.table(input$files$datapath,header=T)
return(dat)
}
})
output$choose_columns1 <- renderUI({ #這裡是關鍵
dat = DATA()
if (is.null(dat)) {return()} else {
colnames <- colnames(dat)
selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
}
})
output$choose_columns2 <- renderUI({ #這裡是關鍵
dat = DATA()
if (is.null(dat)|is.null(input$Y)) {return()} else {
colnames <- colnames(dat)
selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
}
})
output$summary <- renderPrint({
dat = DATA()
if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
X <- dat[,input$X] #這裡是關鍵
Y <- dat[,input$Y] #這裡是關鍵
Result=cor.test(X,Y,method=input$method)
return(Result)
}
})
output$plot <- renderGvis({
dat = DATA()
if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
X <- dat[,input$X] #這裡是關鍵
Y <- dat[,input$Y] #這裡是關鍵
newdat = data.frame(X = X, Y = Y)
SC2 = gvisScatterChart(newdat,
options=list(
legend = "none",
colors=paste0("['", input$Color, "']"),
pointSize = 2,
explorer="{actions: ['dragToZoom',
'rightClickToReset'],
maxZoomIn:0.05}"
))
SC2
}
})
})
– 現在我們的網頁功能越來越多,也越來越漂亮了。