Create a Shiny Application to Collect Subscribers

Create a Shiny Application to Collect Subscribers

Recently, my interest in shiny is very strong. These two days, I try to build a shiny application to collect subscribers. Actually, it a very simple applications, but I spends a lot of time on UI design and submit action. Unfortunately, I failed to add submit action. According to my original imagine, after you input name and email address, click , then this application should return you a message to alert your submit action is successful.

emmm… In fact, I add this feature to this application, but it doesn’t work, I think maybe there are some conflicts between shiny and shinybulma. If that case, forget it, just use it! To make sure you make a successful submit, you can click the submit button more than one times, generally, two times are enough.

Subsribe: Painter’s Alert

Next, I will illustrate how to write this shiny application.

UI Design

shinybulma is a very beautiful shiny framework, which I have already used many times in shiny applications’ development.

First, load shiny and shinybulma packages:

app.R
1
2
library(shiny)
library(shinybulma)

Then source a R script, which contains some functions that can exchange data between R and MySQL. I have already demonstrated how to do it in last tweets.

database.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
library(RMySQL)
library(tibble)
# Initialization
# con = dbConnect(RMySQL::MySQL(), dbname = 'email', username = 'root', password = '12345678', host = 'localhost', port = 3306)
# df = tribble(
# ~name, ~email,
# "czxa", "[email protected]"
# )
# df
# dbRemoveTable(con, "emaillist")
# # if error happends, excute `set persist local_infile = 1` in MySQL.
# dbWriteTable(con, "emaillist", df, append = TRUE, row.names = FALSE)
# # Close connection
# dbDisconnect(con)

options(mysql = list(
"host" = "localhost",
"port" = 3306,
"user" = "root",
"password" = "12345678"
))
databaseName <- "email"
table <- "emaillist"

saveData <- function(data) {
# Connect to the database
db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host,
port = options()$mysql$port, user = options()$mysql$user,
password = options()$mysql$password)
# Construct the update query by looping over the data fields
query <- sprintf(
"INSERT INTO %s (%s) VALUES ('%s')",
table,
paste(names(data), collapse = ", "),
paste(data, collapse = "', '")
)
# Submit the update query and disconnect
dbGetQuery(db, query)
dbDisconnect(db)
}

loadData <- function() {
# Connect to the database
db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host,
port = options()$mysql$port, user = options()$mysql$user,
password = options()$mysql$password)
# Construct the fetching query
query <- sprintf("SELECT * FROM %s", table)
# Submit the fetch query and disconnect
data <- dbGetQuery(db, query)
dbDisconnect(db)
data
}
app.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
source("database.R")

ui <- bulmaPage(
tags$head(tags$script(src = "message-handler.js")),
bulmaHero(
fullheight = T,
color = "primary",
bulmaHeroBody(
bulmaContainer(
bulmaTitle("Painter's Alert"),
bulmaSubtitle("Get email alerts when my blog gets updated"),
bulmaTileAncestor(
bulmaTileParent(
bulmaTileChild(
HTML('
<div class="control has-icons-left has-icons-right">
<input id = "name" class="input is-medium" type="email" placeholder="What can I call you?" value>
<span class="icon is-left">
<i class="fa fa-user"></i>
</span>
<span class="icon is-right">
<i class="fa fa-check"></i>
</span>
</div>'),
br(),
HTML('
<div class="control has-icons-left has-icons-right">
<input id = "email" class="input is-medium" type="email" placeholder="Please insert your email here:" value>
<span class="icon is-left">
<i class="fa fa-envelope"></i>
</span>
<span class="icon is-right">
<i class="fa fa-check"></i>
</span>
</div>'),
br(),
bulmaActionButton(inputId = "submit", label = "Submit", color = "success"),
color = "light"
)
)
)
)
)
)
)

message-handler.js is the file used to add the reminder function. But I don’t know why it doesn’t work… May be I will fix it in the near future.

message-handler.js
1
2
3
4
5
6
7
8
// This recieves messages of type "testmessage" from the server.
// See http://shiny.rstudio.com/gallery/server-to-client-custom-messages.html
// for details
Shiny.addCustomMessageHandler("testmessage",
function(message) {
alert(JSON.stringify(message));
}
);

Server

app.R
1
2
3
4
5
6
7
8
9
10
11
server <- function(input, output, session) {
observeEvent(input$submit, {
session$sendCustomMessage(
type = 'testmessage',
message = 'Thank you for subscribing!')
saveData(tibble(name = input$name, email = input$email))
})
}

# Run the application
shinyApp(ui = ui, server = server)

There is a bulmaActionButton defined in UI part. It defines a event, which means the action defined in observeEvent() will only respond after you click the submit button.

Write Email in R

This applications can only collect subscriber’s name and email address. It can’t send email automatically. A common way to do this is to write another program. But I don’t think it’s a good idea, since it may cause unnecessary interruptions to subcribers. So I will just write email handly, but that not means I will log in my email account and send emails to every subscribers one by one. This job can be done in a very efficient way.

blastula package provides a very simple way to send email in R:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
# devtools::install_github('rich-iannone/blastula')
# brew install openssl
library(magrittr)
library(blastula)
# current time:
(current_date_time <- add_readable_time())

# Contents
email_object <- compose_email(
body = "
## Hiya! Thank you for subscribing to my personal website.

I promise not to disturb you, write weekly and only relevant information about my blog's update.

<div align='center'><img src='https://images.unsplash.com/photo-1567538096601-b3177180fa5d?ixlib=rb-1.2.1&ixid=eyJhcHBfaWQiOjEyMDd9&auto=format&fit=crop&w=800&q=60' width = '500px'/></div>

I hope you enjoy these posts. Feel free to message me with any questions, concerns or ideas; or just let me know you like what I'm up to!

If you have changed your mind, you can just reply me a email to let me konw, then I will remove your email from my list.

Peace out,

{sender}",

footer = "Brought to you by Zhenxing Cheng on {current_date_time}",

sender = "Zhenxing Cheng"
)

# preview
email_object

# create a credential
blastula::create_smtp_creds_file(
file = "~/.e_creds",
user = "[email protected]",
host = "smtp.sina.com",
port = 465,
use_ssl = TRUE
)

# send email
email_object %>%
smtp_send(
from = "[email protected]",
to = "[email protected]",
subject = "Thank you for subscribing!",
credentials = creds_file(file = "~/.e_creds")
)

Here is what this email looks like:

unsplash-logozhao chen

# MySQL, R, Shiny

Comments

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×