Изменять переменные в таблицах базы данных напрямую с помощью dplyr - PullRequest
Новая
       48

Изменять переменные в таблицах базы данных напрямую с помощью dplyr

0 голосов
/ 08 июня 2018

Вот данные mtcars в файле базы данных MonetDBLite. 

library(MonetDBLite)
library(tidyverse)
library(DBI)

dbdir <- getwd()
con <- dbConnect(MonetDBLite::MonetDBLite(), dbdir)

dbWriteTable(conn = con, name = "mtcars_1", value = mtcars)

data_mt <- con %>% tbl("mtcars_1")

Я хочу использовать dplyr mutate для создания новых переменных и добавления (фиксации!) К таблице базы данных?Что-то вроде 

data_mt %>% select(mpg, cyl) %>% mutate(var = mpg/cyl) %>% dbCommit(con)

Нужный результат должен быть таким же, когда мы делаем: 

dbSendQuery(con, "ALTER TABLE mtcars_1 ADD COLUMN var DOUBLE PRECISION")
dbSendQuery(con, "UPDATE mtcars_1 SET var=mpg/cyl")

Как это сделать?

1 Ответ

0 голосов
/ 17 июня 2018

Вот пара функций, create и update.tbl_lazy.

Они соответственно реализуют CREATE TABLE, что было просто, и пару ALTER TABLE / UPDATE, которая намного меньше:

СОЗДАТЬ 

create <- function(data,name){
  DBI::dbSendQuery(data$src$con,
                   paste("CREATE TABLE", name,"AS", dbplyr::sql_render(data)))
  dplyr::tbl(data$src$con,name)
}

пример: 

library(dbplyr)
library(DBI)
con <- DBI::dbConnect(RSQLite::SQLite(), path = ":memory:")
copy_to(con, head(iris,3),"iris")

tbl(con,"iris") %>% mutate(Sepal.Area= Sepal.Length * Sepal.Width) %>% create("iris_2")

# # Source:   table<iris_2> [?? x 6]
# # Database: sqlite 3.22.0 []
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species Sepal.Area
#          <dbl>       <dbl>        <dbl>       <dbl> <chr>        <dbl>
# 1          5.1         3.5          1.4         0.2 setosa        17.8
# 2          4.9         3            1.4         0.2 setosa        14.7
# 3          4.7         3.2          1.3         0.2 setosa        15.0

ОБНОВЛЕНИЕ 

update.tbl_lazy <- function(.data,...,new_type="DOUBLE PRECISION"){
  quos <- rlang::quos(...)
  dots <- rlang::exprs_auto_name(quos, printer = tidy_text)

  # extract key parameters from query
  sql <- dbplyr::sql_render(.data)
  con  <- .data$src$con
  table_name <-gsub(".*?(FROM (`|\")(.+?)(`|\")).*","\\3",sql)
  if(grepl("\nWHERE ",sql)) where <-  regmatches(sql, regexpr("WHERE .*",sql))
  else where <- ""
  new_cols <- setdiff(names(dots),colnames(.data))

  # Add empty columns to base table
  if(length(new_cols)){
    alter_queries <- paste("ALTER TABLE",table_name,"ADD COLUMN",new_cols,new_type)
    purrr::walk(alter_queries, ~{
      rs <- DBI::dbSendStatement(con, .)
      DBI::dbClearResult(rs)})}

  # translate unevaluated dot arguments to SQL instructions as character
  translations  <- purrr::map_chr(dots, ~ translate_sql(!!! .))
  # messy hack to make translations work
  translations <- gsub("OVER \\(\\)","",translations) 

  # 2 possibilities: called group_by or (called filter or called nothing)
  if(identical(.data$ops$name,"group_by")){
    # ERROR if `filter` and `group_by` both used
    if(where != "") stop("Using both `filter` and `group by` is not supported")

    # Build aggregated table
    gb_cols   <- paste0('"',.data$ops$dots,'"',collapse=", ")
    gb_query0 <- paste(translations,"AS", names(dots),collapse=", ")
    gb_query  <- paste("CREATE TABLE TEMP_GB_TABLE AS SELECT",
                       gb_cols,", ",gb_query0,
                       "FROM", table_name,"GROUP BY", gb_cols)
    rs <- DBI::dbSendStatement(con, gb_query)
    DBI::dbClearResult(rs)

    # Delete temp table on exit
    on.exit({
      rs <- DBI::dbSendStatement(con,"DROP TABLE TEMP_GB_TABLE")
      DBI::dbClearResult(rs)
    })

    # Build update query
    gb_on <- paste0(table_name,'."',.data$ops$dots,'" = TEMP_GB_TABLE."', .data$ops$dots,'"',collapse=" AND ")
    update_query0 <- paste0(names(dots)," = (SELECT ", names(dots), " FROM TEMP_GB_TABLE WHERE ",gb_on,")",
                            collapse=", ")
    update_query <- paste("UPDATE", table_name, "SET", update_query0)
    rs <- DBI::dbSendStatement(con, update_query)
    DBI::dbClearResult(rs)

  } else {

    # Build update query in case of no group_by and optional where
    update_query0 <- paste(names(dots),'=',translations,collapse=", ")
    update_query  <- paste("UPDATE", table_name,"SET", update_query0,where)
    rs <- DBI::dbSendStatement(con, update_query)
    DBI::dbClearResult(rs)
  }
  tbl(con,table_name)
}

пример 1 , определить 2 новых числовых столбца: 

tbl(con,"iris") %>% update(x=pmax(Sepal.Length,Sepal.Width),
                           y=pmin(Sepal.Length,Sepal.Width))

# # Source:   table<iris> [?? x 7]
# # Database: sqlite 3.22.0 []
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species     x     y
#          <dbl>       <dbl>        <dbl>       <dbl> <chr>   <dbl> <dbl>
# 1          5.1         3.5          1.4         0.2 setosa    5.1   3.5
# 2          4.9         3            1.4         0.2 setosa    4.9   3  
# 3          4.7         3.2          1.3         0.2 setosa    4.7   3.2

пример 2 , изменить существующий столбец, создать 2 новых столбца разных типов: 

tbl(con,"iris") %>%
  update(x= Sepal.Length*Sepal.Width,
         z= 2*y,
         a= Species %||% Species,               
         new_type = c("DOUBLE","VARCHAR(255)"))

# # Source:   table<iris> [?? x 9]
# # Database: sqlite 3.22.0 []
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species     x     y     z a           
#          <dbl>       <dbl>        <dbl>       <dbl> <chr>   <dbl> <dbl> <dbl> <chr>       
# 1          5.1         3.5          1.4         0.2 setosa   17.8   3.5   7   setosasetosa
# 2          4.9         3            1.4         0.2 setosa   14.7   3     6   setosasetosa
# 3          4.7         3.2          1.3         0.2 setosa   15.0   3.2   6.4 setosasetosa

пример 3 , где обновление: 

tbl(con,"iris") %>% filter(Sepal.Width > 3) %>% update(a="foo")

# # Source:   table<iris> [?? x 9]
# # Database: sqlite 3.22.0 []
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species     x     y     z a           
#          <dbl>       <dbl>        <dbl>       <dbl> <chr>   <dbl> <dbl> <dbl> <chr>       
# 1          5.1         3.5          1.4         0.2 setosa   17.8   3.5   7   foo         
# 2          4.9         3            1.4         0.2 setosa   14.7   3     6   setosasetosa
# 3          4.7         3.2          1.3         0.2 setosa   15.0   3.2   6.4 foo

пример 4 : обновление по группе 

tbl(con,"iris") %>%
  group_by(Species, Petal.Width) %>%
  update(new_col1 = sum(Sepal.Width,na.rm=TRUE), # using a R function
         new_col2 = MAX(Sepal.Length))           # using native SQL

# # Source:   SQL [?? x 11]
# # Database: sqlite 3.22.0 []
#   Sepal.Length Sepal.Width Petal.Length Petal.Width Species        x     y     z a            new_col1 new_col2
#          <dbl>       <dbl>        <dbl>       <dbl> <chr>      <dbl> <dbl> <dbl> <chr>           <dbl>    <dbl>
# 1          5.1         3.5          1.4         0.2 setosa         1     2   7   foo               6.5      5.1
# 2          4.9         3            1.4         0.2 setosa         1     2   6   setosasetosa      6.5      5.1
# 3          7           3.2          4.7         1.4 versicolor     1     2   6.4 foo               3.2      7

ОБЩИЕ СВЕДЕНИЯЗАМЕЧАНИЯ

  • В коде используются dbplyr::translate_sql, поэтому мы можем использовать функции R или родные, как в старых добрых вызовах mutate.

  • update можно использовать только после одного filter вызова ИЛИ одного group_by вызова ИЛИ нуля каждого, всего остального, и вы получите ошибку или неожиданные результаты.

  • Реализация group_by ОЧЕНЬ хакерская, поэтому нет места для определения столбцов на лету или группировки по операции, придерживайтесь основ.

  • update и create оба возвращают tbl(con, table_name), что означает, что вы можете связать столько вызовов create или update, сколько пожелаете, с соответствующим количеством group_by и filter между ними.На самом деле все мои 4 примера можно объединить в цепочку.

  • Чтобы забить гвоздь, create не страдает от тех же ограничений, вы можете получить столько же удовольствия, сколько и 1079 *.желательно перед вызовом.

  • Я не реализовал определение типа, поэтому мне был нужен параметр new_type, он перерабатывается в вызове paste определения alter_queries вмой код, так что это может быть одно значение или вектор.

Один из способов решить эту проблему - извлечь переменные из переменной translations, найти их типы в dbGetQuery(con,"PRAGMA table_info(iris)").Тогда нам нужны правила приведения между всеми существующими типами, и мы настроены.Но поскольку разные СУБД имеют разные типы, я не могу придумать общий способ сделать это, и я не знаю MonetDBLite.

...