流行的关系数据库具有很强的确保一致性的能力。当我们插入或更新数据时，是通过
事务实现的。其中事务是对数据库操作的逻辑单位，事务操作有两种：提交（将数据库所
做的修改永久写入数据库）和回滚（将数据库所做的修改全部撤销，数据库还原到操作前
的状态）。如果一个事务操作失败了，我们可以撤销并回滚，以保证数据的一致性。
下面的例子简单模拟了一次数据累积过程（追加数据的过程），在这种过程中时常出现
错误。假设我们需要累积某些产品的数据，并将它存储到 data/products.sqlite 中。
每一次生成一块数据（几行数据），并将它追加到数据库的某张表上。然而，在每次迭代中，
该进程都有 20%的概率出错。
set.seed(123)
con <- dbConnect(SQLite( ), "data/products.sqlite")
chunk_size <- 10
for( i in 1:6 ){
cat("Processing chunk", i, "\n")
if(runif(1) <= 0.2) stop("Data error")
chunk <- data.frame(id = ((i - 1L) * chunk_size) : (i * chunk_size - 1L),
type = LETTERS[[i]],
score = rbinom(chunk_size, 10, (10 - i) /10),
stringsAsFactors = FALSE)
dbWriteTable(con, "products", chunk, append = i > 1, row.names = FALSE)
}
## Processing chunk 1
## Processing chunk 2
## Processing chunk 3
## Processing chunk 4
## Processing chunk 5
## Error in eval（expr, envir, enclos): Data error
这个累积过程在第 5 块数据处理时出错。我们计算一下表中的记录数：
dbGetQuery(con, "select COUNT(*) from products")
## COUNT(*)
## 1 40
dbDisconnect(con)
## [1] TRUE
此时，发现表中存储了一些记录。某些情形下，我们希望只有两种结果：要么正确存储所
有数据，要么不存入任何数据，这两种结果都保证了数据库的一致性。而如果只有一部分数据
被存储时，就会产生新的问题。为了确保对数据库的一系列变更能够作为一个整体，即要么全
部成功，要么全部失败。我们在写入任何数据前都调用 dbBegin( )，待所有变更完成后，
再调用 dbCommit( )，如果这个过程中出现错误，就调用 dbRollback( )。
接下来的代码是上一个例子的增强版。我们通过事务操作确保要么所有分块数据都被
正确写入数据库，要么不做任何变更。更确切地说，我们把数据写入过程放进 tryCatch 里。
在写入开始前，调用 dbBegin( ) 开始事务操作。接着，在 tryCatch 中，向数据库逐
块地写入数据。若一切顺利进行，再用 dbCommit( ) 提交事务。如果过程中出现任何错
误，error( ) 函数会捕获错误并产生警告，此时再调用 dbRollback( ) 回滚事务：
set.seed(123)
file.remove("data/products.sqlite")
## [1] TRUE
con <- dbConnect(SQLite( ), "data/products.sqlite")
chunk_size <- 10
dbBegin(con)
## [1] TRUE
fes <- tryCatch({
for( i in 1:6 ){
cat("Processing chunk", i, "\n")
if(runif(1) <= 0.2) stop("Data error")
chunk <- data.frame(id = ((i - 1L) * chunk_size) : (i * chunk_size - 1L),
type = LETTERS[[i]],
score = rbinom(chunk_size, 10, (10 - i) /10),
stringsAsFactors = FALSE)
dbWriteTable(con, "products", chunk,
append = i > 1, row.names = FALSE)
}
dbCommit(con)
},error = function(e){
warning("An error occurs: ", e, "\nRolling back", immediate. = TRUE)
dbRollback(con)
})
## Processing chunk 1
## Processing chunk 2
## Processing chunk 3
## Processing chunk 4
## Processing chunk 5
## Warning in value[[3L]](cond): An error occurs: Error in
doTryCatch(return(expr), name, parentenv, handler): Data error
##
## Rolling back
我们看到相同的错误又一次发生。但是，这次错误被捕获到了，事务操作取消，数据
库回滚。我们再一次计算表 products 中的记录条数进行验证：
dbGetQuery(con, "select COUNT(*) from products")
## Error in sqliteSendQuery(con, statement, bind.data): error in
statement:no such table: products
dbDisconnect(con)
## [1] TRUE
也许你会很惊讶，计数查询居然返回错误。为什么不返回 0 呢？如果我们仔细检查这
个例子，就会明白，在第一次调用 dbWriteTable( ) 时，它创建了一个新表，并在第一
块插入数据。换言之，创建表的操作也包括在事务中。所以在回滚时，表的创建也被撤销
了。由于名为 products 的表根本不存在，计数查询返回错误也就不奇怪了。如果创建表
在前，开始事务在后，那么撤销该事务后进行计数查询，其结果就与事务开始前表中的记
录条数一致了。
要求数据之间具有强一致性的另一个例子是账户转移。当我们将一笔资金从一个帐户
转移到另一个帐户时，必须确保系统从一个账户提取资金，同时向另一账户存入等额资金。
这两个变动要么同时发生，要么都失败，以保证一致性。针对这一类问题，利用关系型数
据的事务操作可以轻松实现。
我们定义一个函数用于创建一个虚拟银行的 SQLite 数据库。调用dbSendQuery( ) 发
送命令，创建 accounts 表（账户表）和 transactions 表（交易表）：
create_bank <- function(dbfile) {
if(file.exists(dbfile)) file.remove(dbfile)
con <- dbConnect(SQLite( ), dbfile)
dbSendQuery(con,
"create table accounts
(name text primarykey key, balance real)")
dbSendQuery(con,
"create table transactions
(time text, account_from text, account_to text, value real)")
con
}
这个 accounts 表具有 2 列：name 和 balance。transactions 表有 4 列：time、
account_from、account_to 和 value。第 1 张表存储了所有账户信息，第 2 张表存储
所有历史交易信息。
此外，我们定义另一个函数，用于创建带有账户名和初始余额的账户。这个函数
用 insert into 向 accounts 表写入新记录：
create_account <- function(con, name, balance){
dbSendQuery(con,
sprintf("insert into accounts (name, balance) values ('%s', %.2f)",
name, balance))
TRUE
}
我们用 sprintf( ) 产生之前的 SQL 语句。它适用于本地和个人用途，但对于网络应用
来说通常不够安全，因为黑客很容易通过局部表达式运行一些破坏性语句，进而操控整个数据库。
接着，我们定义一个转账函数，用于检查数据库中是否同时存在取款账户和收款账户。
它确保取款账户的余额足够完成转账请求。一旦转账有效，它会更新两个账户的余额，并
向数据库中添加一条交易记录：
transfer <- function(con, from, to, value){
get_account <- function(name){
account <- dbGetQuery(con,
sprintf("select * from accounts
where name = '%s' ", name))
if (nrow(account) == 0)
stop(sprintf("Account '%s' does nor exist", name))
account
}
account_from <- get_ _account(from)
account_to <- get_ _account(to)
if (account_from$balance < value) {
stop(sprintf("Insufficient money to transter from '%s' ", from))}
else {
dbSendQuery(con,
sprintf("update accounts set balance = %.2f
where name = '%s' ",
account_from$balance - value, from))
dbSendQuery(con,
sprintf("update accounts set balance = %.2f
where name = '%s' ",
account_to$balance + value, to))
dbSendQuery(con,
sprintf("insert into transactions (time, account_from,
account_to, value)
values ('%s', '%s', '%s', %.2f)",
format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
from, to, value))
}
TRUE
}
尽管已经考虑到取款账户余额不足的可能性，并对此进行事前检查，但是仍有其他原
因导致转账操作的风险。因此，我们实现一种 transfer( ) 的安全版本，利用事务操作
可以确保只要转账中出现任何错误，就能够撤销 transfer( ) 函数所做的一切更改。
safe_transfer <- function(con, ...) {
dbBegin(con)
tryCatch({
transfer(con, ...)
dbCommit(con)
}, error = function(e) {
message("An error occurs in the transaction. Rollback...")
dbRollback(con)
stop(e)
})
}
实际上，safe_transfer( ) 是 transfer( ) 的一个封装。safe_transfer( ) 仅
仅是将 transfer( ) 放进了 tryCatch( ) 的沙箱中。如果有错误发生，我们就调
用 doRollback( ) 以确保数据库的一致性。
在对这些函数进行测试前，我们还需要一个函数，用于查看给定账户的余额和成功完
成的交易信息。
get_balance <- function(con, name) {
res <- dbGetQuery(con,
sprintf("select balance from accounts
where name = '%s'", name))
res$balance
}
get_transactions <- function(con, from, to) {
dbGetQuery(con,
sprintf( "select * from transactions
where account_from = '%s' and account_to = '%s'",
from, to))
}
现在可以进行测试了。首先，调用 create_bank( ) 创建一个虚拟银行，它返回一
个指向数据库文件的 SQLite 连接。然后，我们创建两个账户，并赋予初始余额。
con <- create_ _bank("data/bank.sqlite")
create_ _account(con, "David", 5000)
## [1] TRUE
create_ _account(con, "Jenny", 6500)
## [1] TRUE
get_ _balance(con, "David")
## [1] 5000
get_ _balance(con, "Jenny")
## [1] 6500
接着，再用 safe_transfer( ) 从 David 的账户向 Jenny 的账户转账。
safe_ _transfer(con, "David", "Jenny", 1500)
## [1] TRUE
get_ _balance(con, "David")
## [1] 3500
get_ _balance(con, "Jenny")
## [1] 8000
转账成功，并且在保证一致性的前提下，两个账户的余额都被修改了。现在再做一次
转账。这一次，David 的账户余额不足，所以转账操作以失败告终：
safe_ _transfer(con, "David", "Jenny", 6500)
## An error occurs in the transaction. Rollback...
## Error in transfer(con, ...): Insufficient money to transter from 'David'
get_ _balance(con, "David")
## [1] 3500
get_ _balance(con, "Jenny")
## [1] 8000
函数返回错误信息，并对数据库进行回滚。两个账户的余额都没有变动。现在查询所
有成功的交易记录：
get_ _transactions(con, "David", "Jenny")
## time account_from account_to value
## 1 2017-03-05 08:58:59 David Jenny 1500
我们找到了第 1 次交易，但第 2 次交易失败了，所以没有出现在数据库中。最后，一
定要记得切断数据库连接：
dbDisconnect(con)
## [1] TRUE
