Let it shiny: Um sorteador (útil de verdade)
Dentre as muitas coisas que aprendi quando comecei a trabalhar com a Inteligência para produtos digitais é focar na resolução de um problema real do cliente final. É a dor a ser resolvida. Por mais óbvio que pareça, o processo de descobrir essa demanda e de ater-se a ela com foco no seu processo de desenvolvimento é super desafiador.
Vi que em diversas comunidades, inclusive na minha favorita, costumam existir (com a benção de patrocinadores) sorteios. E que nesses momentos tão esperados, é comum usar sorteadores que não tem o melhor fit com o problema. Muitas vezes os sorteios ideais querem excluir pessoas já sorteadas para dar chance de mais participantes ganharem algo de um modo incremental mas com alguns sorteios especiais que todes podem participar.
Adaptando a sabedoria popular: se a sua comunidade quiser um sorteio… Faça um sorteador (em R, claro!)
Se você quiser usar o sorteador que o Rladies Belo Horizonte vai adotar para os seus sorteios (dedos cruzados para que sejam muitos!) basta acessar: https://larissasayurifcs.shinyapps.io/rladiesBHsampler .
A solução descrita nesse post é a versão basicona do sorteador:
- Input: uma lista com os nomes das pessoas a serem sorteadas e o tamanho da amostra.
- Output: a lista de pessoas sorteadas sendo o sorteio aleatório simples sem reposição (cada vez que aperta-se o botão run um novo sorteio é feito excluindo os indivíduos amostrados anteiormente).
- Feito com o pacote shiny que permite interação do usuário e pacote dplyr para manipulação de dados.
- Sem os detalhes escritos em HTML.
Com os códigos descritos aqui fazemos o shiny app que permite um sorteio tipo esse:
- Suponha que você como organizador do sorteio tem uma lista de 300 participantes da comunidade, descritos em uma planilha (esses nomes eu tirei do pacote babynames):
- A ideia é que você copie a lista de nomes e cole no shiny app do sorteador, caixa a esquerda da tela:
- Suponha que são 05 premiações diferentes e que vamos começar com o sorteio de 05 camisetas do Rladies BH:
- Em seguida, sorteiam-se 04 canecas do Rladies BH (apenas para quem não ganhou a camiseta):
- Depois, sorteiam-se 03 ingressos para trilhas do TDC online (apenas para quem não ganhou a camiseta ou a caneca):
- Segue o sorteio de 02 ingressos para trilhas do She’s tech (apenas para quem não foi sorteado até esse momento):
- E existe um sorteio ultra especial: Um ingresso com passagem e hospedagem para o próximo rstudio::Conf. Nesse todos os participantes podem concorrer de modo que o sorteador é reiniciado:
Para permitir que o sorteador fosse usado pela maior quantidade de usuários diferentes possível tentei conceber a experiência de uso mais simples.
Como eu queria uma tela com as funcionalidades do R rodando “por trás” eu optei por usar o pacote shiny. Para os que não são familiariados com ele eu sugiro fortemente assistir os vídeos em: https://shiny.rstudio.com/tutorial/.
Comecei criando três scripts básicos de Shiny app (nomeados exatamente como ui.R, server.R e global.R e todos no mesmo diretório do projeto ):
- ui.R: destinado ao layout do app, para coletar dados que servem como input e como mostrar os objetos output para o usuário começando com:
ui <- fluidPage(
)- server.R: onde ficam os trechos de código destinados a manipulação de dados input para gerar os objetos output começando com:
server <- function(input, output){
}- global.R: script auxiliar que para o contexto desse sorteador, vai ter uma lista inicial de indivíduos a serem sorteados. Nas vezes que o usuário colar uma lista própria de indivíduos a serem sorteados o objeto lista desse script não será usado. Mas ainda assim ele será necessário para carregar o pacote dplyr:
library(dplyr)lista <- paste(c("Layla Comparin",
"Numiá Gomes",
"Ana Carolina Dias",
"Larissa Sayuri Santos",
"Numiá Comparin",
"Ana Carolina Comparin",
"Larissa Comparin",
"Layla Gomes",
"Ana Carolina Gomes",
"Larissa Sayuri Gomes",
"Layla Dias",
"Numiá Dias",
"Larissa Sayuri Dias",
"Layla Santos",
"Numiá Santos",
"Ana Carolina Santos"
), collapse = "\n")
A interface com o usuário (“as the top of the iceberg”)
Começando pela parte visível do app:
- No script ui.R eu dividi a tela em duas partes de mesmo tamanho.
A tela toda de um app shiny tem 12 como unidade de medida.
Logo, é como se eu tivesse criado duas colunas, cada uma com 06 unidades de medida.
Acrescentei a função wellPanel que cria um painel com borda e fundo cinza claro só para deixar mais bonitinho.
ui <- fluidPage(
column(width = 6,
wellPanel(
)
),
column(width = 6,
wellPanel(
)
)
)A metade à esquerda da tela foi pensada para que o usuário cole a lista de indivíduos para amostrar.
A metade à direita foi pensada para ter alguns botões de input na parte superior e a tabela com a relação dos indivíduos amostrados.
- No script ui.R vamos sub-dividir a tela da direita. Apesar de usar a função column estou criando linhas:
A 1ª e 3ª linhas terão toda a extensão horizontal da coluna a direita (width = 12) para receber o botão do tamanho amostral e a tabela com os indivíduos amostrados.
A 2ª linha ficará no meio da coluna direita, com dois botões: (01) que usa a função de amostragem sem reposição no indivíduos disponíveis para amostragem e (02) que reinicia o processo considerando todos os indivíduos como disponíveis para amostragem.
ui <- fluidPage(
column(width = 6,
wellPanel(
)
),
column(width = 6,
wellPanel(
column(width = 12,
# Sample size button
),
column(width = 4, offset = 4,
# Run or Restart button
),
column(width = 12,
# Table output
)
)
)
)Cola os nomes dos indivíduos e ‘printa’
- No script ui.R vamos colocar na coluna da esquerda uma caixa para receber texto como input usando a função textAreaInput.
- No script ui.R vamos colocar na coluna da direita uma tabela com o resultado das manipulações e instruções dadas no server.R usando a função tableOutput.
ui <- fluidPage(
column(width = 6,
wellPanel(
textAreaInput(inputId = "list",
label = "Enter your list",
height = "80vh",
value = lista)
)
),
column(width = 6,
wellPanel(
column(width = 12,
# Sample size button
),
column(width = 4, offset = 4,
# Run or Restart button
),
column(width = 12,
# Table output
tableOutput("sample")
)
)
)
)- No script server.R vou criar um objeto chamado dataInput que corresponderá à lista de nomes de indivíduos a serem amostrados associado a um id sequencial.
dataInput <- eventReactive(input$list, {
input_names <- input$list
input_names_split <- strsplit(input_names, "\n")
if(length(input_names_split) > 0){
df <- as.data.frame(x = input_names_split)
names(df) <- "name"
df <- df %>% mutate(id = seq(nrow(df))) %>%
select(id, name)
}
})Note que o objeto dataInput será atualizado a toda alteração feita em input$list. Em geral, shiny apps são concebidos de modo que as funcionalidades descritas em server.R são acionadas a toda e qualquer alterações de inputs (dizemos que são reativos, de reactive). A função eventReactive ‘isola’ a obtenção do dataInput para que dependa apenas das alterações feitas no input$list.
Incluí também uma condição lógica de modo que manipula-se o dado para chegar no tibble/data.frame inicial apenas se o usuário tiver colado uma lista de caracteres efetivamente (ou se estivermos usando o default do app, a lista de global.R).
- Também no script server.R vou criar o objeto que o usuário vai ver, o output$sample, obtido com a função renderTable. Para começar, ele vai retornar as primeiras linhas da tabela (função head()) com os indivíduos a serem amostrados.
output$sample <- renderTable({
data <- dataInput()
if(nrow(data) > 0) {
return(head(data))
} else {
return(NULL)
}
})Em resumo, o script server.R fica assim, por enquanto:
server <- function(input, output){
dataInput <- eventReactive(input$list, {
input_names <- input$list
input_names_split <- strsplit(input_names, "\n")
if(length(input_names_split) > 0){
df <- as.data.frame(x = input_names_split)
names(df) <- "name"
df <- df %>% mutate(id = seq(nrow(df))) %>%
select(id, name)
}
})
output$sample <- renderTable({
data <- dataInput()
if(nrow(data) > 0) {
return(head(data))
} else {
return(NULL)
}
})
}Clicando em Runapp vemos o app desse jeito:
Criando botões (tamanho da amostra e Run) e amostrando efetivamente
- No script ui.R vamos criar os inputs sample_size e run. Os nomes são auto-explicativos. Só vou reforçar que o shiny app a princípio é atualizado a cada alteração de qualquer um dos parâmetros input (input$list e input$sample_size). Como nos passos futuros a amostragem será sem reposição eu optei por criar o botão run que acionará o processo de amostragem. Usando o actionButton a ideia é que o server.R só será acionado com a intervenção explícita do usuário.
ui <- fluidPage(
column(width = 6,
wellPanel(
textAreaInput(inputId = "list",
label = "Enter your list",
height = "80vh",
value = lista)
)
),
column(width = 6,
wellPanel(
column(width = 12,
# Sample size button
numericInput(inputId = "sample_size",
label = "Sample size",
value = 3,
min = 1,
max = 1000000,
width = "33%")
),
column(width = 4, offset = 4,
# Run or Restart button
actionButton(inputId = "run",
label = "Run!",
icon("play-circle-o"))
),
column(width = 12,
# Table output
tableOutput("sample")
)
)
)
)Para fazer a amostragem propriamente dita vamos adicionar duas funções no script server.R: reactiveValues e observeEvent. Nesse post estamos construindo o shiny app juntes então pode parecer pouco intuitivo mas é o uso das duas funções (com eventReactive e renderTable já apresentadas) que flexibilizam o código para permitir a amostragem sem reposição.
Em linhas gerais vamos:
1. Criar um objeto no shiny para guardar os ids dos indivíduos amostrados com a função reactiveValues.
2. Quando apertarmos o botão run uma nova amostra será coletada (se possível) e o objeto que guarda os ids dos indivíduos amostrados será ATUALIZADO com a coleção mais recente de ids. Essa atualização acontece com a função observeEvent.
No começo do script server.R eu adicionei:
all_ids_sampled <- reactiveValues(ids = c())É como se eu estivesse criando um objeto global no shiny app chamado all_ids_sampled, com uma entrada chamada ids e inicializada com vazio.
Abaixo do chunk para leitura de dados (objeto dataInput) adicionei o chunk do observeEvent:
observeEvent(input$run, {
data <- dataInput()
ids_sampled <- sample(x = data$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- ids_sampled
})Note que:
1. esse é um chunk que será executado se o botão run for acionado.
2. observeEvent é uma função que não produz output, ou seja, não pode ser usada para atribuir uma quantidade a uma variável no shiny app.
3. Vamos usar o observeEvent para atualizar a lista com os ids amostrados, a última linha do chunk. Logo, no observeEvent estamos atualizando o objeto global do shiny app criado com a função reactiveValues no passo anterior.
Umas dicas do fundo do coração de quem apanhou para entender:
- Eu associo o observeEvent ao escopo local de uma função enquanto o eventReactive corresponderia a uma função no escopo global do shiny app.
- Quando é útil usar o observeEvent? Quando a atividade a ser feita é de atualização. Um uso comum dessa função pode ser no script ui.R quando um input está condicionado ao outro. Por exemplo: se o usuário precisa entrar com o estado e cidade de residência o app pode pedir primeiro o estado e dada a resposta do usuário apresentar apenas os municípios pertencentes ao estado reportado.
Ao atualizar o output final incluindo a relação de ids amostrados no chunk de outputTable o script server.R fica:
server <- function(input, output){
all_ids_sampled <- reactiveValues(ids = c())
dataInput <- eventReactive(input$list, {
input_names <- input$list
input_names_split <- strsplit(input_names, "\n")
if(length(input_names_split) > 0){
df <- as.data.frame(x = input_names_split)
names(df) <- "name"
df <- df %>% mutate(id = seq(nrow(df))) %>%
select(id, name)
}
})
observeEvent(input$run, {
data <- dataInput()
ids_sampled <- sample(x = data$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- ids_sampled
})
output$sample <- renderTable({
data <- dataInput()
sampled_ids <- all_ids_sampled[["ids"]]
if(length(sampled_ids) > 0) {
names_sampled <- data[sampled_ids, ]
return(names_sampled)
} else {
return(NULL)
}
})
}Execute o app nessa etapa! O meu tá do jeitinho abaixo, com um sorteio de tamanho 3.
Alterando o código para uma amostragem sem reposição
Até esse momento a amostragem toma os nomes dos invidíduos e o tamanho de amostra como input.
Queremos que as pessoas sorteadas para ganhar camisetas, por exemplo, saiam da lista dos indivíduos disponíveis para fazer um novo sorteio de canecas.
Basicamente nesse passo vamos trabalhar para incrementar o objeto all_ids_sampled. Essa é uma mudança no script server.R mais especificamente no chunk observeEvent, aquele que atualiza o objeto all_ids_sampled.
observeEvent(input$run, {
already_sampled <- all_ids_sampled[["ids"]]
if(is.null(already_sampled)){
available <- dataInput()
}else{
available <- dataInput() %>%
filter(!(id %in% already_sampled))
}
ids_sampled <- sample(x = available$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
})Note que:
1. No escopo local de observeEvent cria-se um objeto already_sampled que vai receber a lista de ids que já foram amostrados e, portanto, estão no objeto all_ids_sampled, output da função reactiveValues.
2. Criamos um objeto com os indivíduos disponíveis para serem amostrados, chamado de available, nas linhas do if/else. No contexto desse sorteador, already_sampled e available são conjuntos complementares.
3. A amostragem é feita com a função sample para o conjunto de ids do objeto available, com tamanho especificado pelo usuário e sem reposição.
4. Ao término do amostragem o objeto all_ids_sampled é atualizado de modo a receber o conjunto de ids que acabou de ser sorteado (ids_sampled).
E fica assim:
Note como a lista de pessoas sorteadas vai aumentando.
Mas temos um problema! Olha esse sorteio simplificado (10 nomes e tamanho 5) abaixo:
Com 10 pessoas é possível fazer dois sorteios de 05 pessoas sem reposição. Depois dos dois primeiros sorteios… Na ausência de pessoas disponíveis para mais um sorteio o shiny app “quebra” aparecendo sombreado para o usuário. Vamos criar caixas de diálogo para o usuário de modo a orientá-lo melhor.
Comunicando que o tamanho de amostra é maior que o número de pessoas disponíveis e/ou que todos foram sorteados
No script server.R, chunk observeEvent, vamos adicionar testes lógicos com relação a quantidade de ids disponíveis para sorteio (objeto available):
- Se NÃO há elementos disponíveis para amostragem (length(available$id) == 0)
Vamos usar as funções showModal e modalDialog para comunicar ao usuário que todas as pessoas cujos nomes foram colados na tela da esquerda já foram sorteadas (estão na tela da direita).
showModal(modalDialog(
title = "Stop!",
"There are no available elements to be sampled!",
footer = modalButton(label = "Ok! I'm done!"),
easyClose = TRUE
))2. Caso contrário (length(available$id) != 0):
2.1) Se o tamanho da amostra é MAIOR ou IGUAL que o número de pessoas disponíveis para sorteio (tem mais brinde que gente que ganhou nada)
Todas as pessoas disponíveis para sorteios serão obrigatoriamente sorteadas.
Na verdade, vai sobrar brinde! O que possivelmente implica o recomeço dos sorteios, com todo mundo apto a ser amostrado.
Parachamar a atenção do organizador para isso vamos usar as funções showModal e modalDialog para comunicar o ocorrido.
if(input$sample_size >= length(available$id)) {
ids_sampled <- available$id
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
showModal(modalDialog(
title = "Attention!",
"There were fewer elements than the desired sample size. You have sampled everyone.",
footer = modalButton(label = "Ok"),
easyClose = TRUE
))
}2.2) Caso contrário (tem mais gente pé frio do que brindes — vida real)
Nesse caso, o tamanho da amostra é MENOR que o número de pessoas disponíveis para sorteio. Ou seja, é o caso mais comum dos sorteios… sendo que o trecho de código não vai ter mensagem para o organizador:
ids_sampled <- sample(x = available$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)A essa altura o script server.R está beeem mais complexo:
server <- function(input, output){
all_ids_sampled <- reactiveValues(ids = c())
dataInput <- eventReactive(input$list, {
input_names <- input$list
input_names_split <- strsplit(input_names, "\n")
if(length(input_names_split) > 0){
df <- as.data.frame(x = input_names_split)
names(df) <- "name"
df <- df %>% mutate(id = seq(nrow(df))) %>%
select(id, name)
}
})
observeEvent(input$run, {
already_sampled <- all_ids_sampled[["ids"]]
if(is.null(already_sampled)){
available <- dataInput()
}else{
available <- dataInput() %>%
filter(!(id %in% already_sampled))
}
if(length(available$id) == 0){
showModal(modalDialog(
title = "Stop!",
"There are no available elements to be sampled!",
footer = modalButton(label = "Ok! I'm done!"),
easyClose = TRUE
))
}else{
if(input$sample_size >= length(available$id)) {
ids_sampled <- available$id
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
showModal(modalDialog(
title = "Attention!",
"There were fewer elements than the desired sample size. You have sampled everyone.",
footer = modalButton(label = "Ok"),
easyClose = TRUE
))
} else {
ids_sampled <- sample(x = available$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
}
}
})
output$sample <- renderTable({
data <- dataInput()
sampled_ids <- all_ids_sampled[["ids"]]
if(length(sampled_ids) > 0) {
names_sampled <- data[sampled_ids, ]
return(names_sampled)
} else {
return(NULL)
}
})
}Olha como essa nova implementação ficou, considerando que são 11 pessoas e amostra de tamanho 5 nos gifs abaixo.
Fazendo dois sorteios aleatórios, 10 das 11 pessoas iniciais foram sorteadas. Com atenção você notará que só falta a pessoa 8 na lista:
Seguindo com o sorteio (o gif compreende todas as etapas) note como no terceiro “Run!” aparece a mensagem (tela sombreada) que deixa claro para o usuário que a amostra basicamente retornou todo mundo que não tinha sido sorteado. No último frame podemos ver que a pessoa 08 aparece na lista de indivíduos sorteados (última linha).
Se a gente continuasse o sorteio acima clicando em Run mais uma vez apareceria, por fim a seguinte tela:
Adicionando um botão para recomeçar os sorteios
É possível que o organizador tenha interesse em recomeçar o sorteio. Vamos adicionar o botão restart, abaixo do botão run no script ui.R:
column(width = 4, offset = 4,
# Run or Restart button
actionButton(inputId = "run",
label = "Run!",
icon("play-circle-o")),
actionButton(inputId = "restart",
label = "Restart!",
icon("play-circle-o"))
)E, claro, atualizar o server.R adicionando um trecho de código com a função observeEvent de modo que o objeto all_ids_sampled é apagado/ reinicializado se o usuário aperta no botão restart (input$restart):
observeEvent(input$restart, {
all_ids_sampled[["ids"]] <- c()
})A essa altura o script ui.R está assim:
ui <- fluidPage(
column(width = 6,
wellPanel(
textAreaInput(inputId = "list",
label = "Enter your list",
height = "80vh",
value = lista)
)
),
column(width = 6,
wellPanel(
column(width = 12,
# Sample size button
numericInput(inputId = "sample_size",
label = "Sample size",
value = 5,
min = 1,
max = 1000000,
width = "33%")
),
column(width = 4, offset = 4,
# Run or Restart button
actionButton(inputId = "run",
label = "Run!",
icon("play-circle-o")),
actionButton(inputId = "restart",
label = "Restart!",
icon("play-circle-o"))
),
column(width = 12,
# Table output
tableOutput("sample")
)
)
)
)E o script server.R (grandão):
server <- function(input, output){
all_ids_sampled <- reactiveValues(ids = c())
dataInput <- eventReactive(input$list, {
input_names <- input$list
input_names_split <- strsplit(input_names, "\n")
if(length(input_names_split) > 0){
df <- as.data.frame(x = input_names_split)
names(df) <- "name"
df <- df %>% mutate(id = seq(nrow(df))) %>%
select(id, name)
}
})
observeEvent(input$run, {
already_sampled <- all_ids_sampled[["ids"]]
if(is.null(already_sampled)){
available <- dataInput()
}else{
available <- dataInput() %>%
filter(!(id %in% already_sampled))
}
if(length(available$id) == 0){
showModal(modalDialog(
title = "Stop!",
"There are no available elements to be sampled!",
footer = modalButton(label = "Ok! I'm done!"),
easyClose = TRUE
))
}else{
if(input$sample_size >= length(available$id)) {
ids_sampled <- available$id
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
showModal(modalDialog(
title = "Attention!",
"There were fewer elements than the desired sample size. You have sampled everyone.",
footer = modalButton(label = "Ok"),
easyClose = TRUE
))
} else {
ids_sampled <- sample(x = available$id,
size = input$sample_size,
replace = FALSE)
all_ids_sampled[["ids"]] <- c(all_ids_sampled[["ids"]], ids_sampled)
}
}
})
observeEvent(input$restart, {
all_ids_sampled[["ids"]] <- c()
})
output$sample <- renderTable({
data <- dataInput()
sampled_ids <- all_ids_sampled[["ids"]]
if(length(sampled_ids) > 0) {
names_sampled <- data[sampled_ids, ]
return(names_sampled)
} else {
return(NULL)
}
})
}Tadam! Chegamos então em um shiny app que faz a seguinte sequência de sorteios:
Como eu disse lá no começo essa é a versão basicona, sem os códigos HTML que deixam a interface linde. Os scripts ui.R, server.R, global. R e a base babynames.csv do app descrito nesse post estão nesse repositório.
Perfeito é impossível
Mesmo a versão com ajustes em HTML pode e deve passar por melhorias tipo:
- permitir que o usuário do shiny app nomeie as etapas do sorteio deixando claro, por exemplo, que as primeiras cinco linhas da tabela descrevem os ganhadores das camisetas no exemplo do começo do post.
- permitir que o usuário do shiny app (o organizador do sorteio) faça download de uma planilha final com o nome das pessoas sorteadas, seguida da expressão que identifica o seu prêmio.
- ajustar a função sampler para que amostre o mínimo de 1 elemento e o máximo de elementos como sendo o número de nomes distintos colados na tela da esquerda.
- permitir que o usuário do shiny app (o organizador do sorteio) especifique a semente para o sorteio aleatório.
E você? Sugere alguma funcionalidade para tornar esse shiny app ainda mais útil? Tem alguma coisa do app https://larissasayurifcs.shinyapps.io/rladiesBHsampler que não te parece intuitivo ou bem explicado? Sugestões e comentários são muito bem-vindos!!!
Esse foi um dos projetos pessoais mais desafiadores que eu já peguei. Eu ainda sou imatura em programar um shiny app por exigir a compreensão clara dos 03 scripts ao mesmo tempo. Mas certamente foi o projeto que eu mais aprendi recentemente. Sobretudo na tarefa de escrever esse post, porque me fazer colocar definições e raciocínios nas minhas próprias palavras costuma ser a melhor forma de me fazer aprender.
Referências
Para esse post foram usados os seguintes pacotes:
- babynames:
Hadley Wickham (2019). babynames: US Baby Names 1880–2017. R package
version 1.0.0. https://CRAN.R-project.org/package=babynames - dplyr:
Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2020).
dplyr: A Grammar of Data Manipulation. R package version 1.0.0.
https://CRAN.R-project.org/package=dplyr - shiny:
Winston Chang, Joe Cheng, JJ Allaire, Yihui Xie and Jonathan McPherson
(2020). shiny: Web Application Framework for R. R package version 1.5.0.
https://CRAN.R-project.org/package=shiny
E como não poderia faltar:
- O shiny app está disponível na plataforma self-service https://www.shinyapps.io/, específica para aplicações do shiny.
