9.3.2 Rでのスクリプトの管理

Embedded R Execution関数で、OML4Rスクリプト・リポジトリにスクリプトとして格納されているR関数をコールできます。このトピックで説明するR関数を使用すると、スクリプトを作成および管理できます。

Embedded R Execution関数はFUN.NAME引数を取ることができ、これには、OML4Rスクリプト・リポジトリ内のスクリプトの名前を指定します。Rスクリプト・リポジトリ内のスクリプトは、Embedded R Execution用のSQL APIで使用することもできます。

スクリプトを管理するためのR関数は次のとおりです。

  • ore.grant

  • ore.revoke

  • ore.scriptCreate

  • ore.scriptList

  • ore.scriptLoad

  • ore.scriptDrop

これらの関数については、次の各項で説明します。

これらの関数の使用例は、例9-1を参照してください。

スクリプトの追加

OML4Rスクリプト・リポジトリにスクリプトとしてR関数を追加するには、ore.createScript関数を使用します。この関数を呼び出すには、RQADMINロールを持っている必要があります。ore.createScript関数の構文は次のとおりです。 

ore.scriptCreate(name, FUN, global, overwrite)

引数について、次に説明します。

引数 説明
name OML4Rスクリプト・リポジトリ内のスクリプトの名前。
fun R関数。
global スクリプトがパブリック(グローバル)であるか、プライベートであるかを示す論理値。FALSE (デフォルト)は、スクリプトがパブリックではなく、所有者または所有者が読取りアクセス権を付与したユーザーにのみ表示されることを示します。TRUEは、スクリプトがパブリックであるため、すべてのユーザーに表示されることを示します。
overwrite スクリプトのR関数を、fun引数で指定した関数に置き換えるかどうかを示す論理値。TRUEは、関数を置き換えることを示します(存在する場合)。FALSE (デフォルト)は、既存の内容を置き換えることができないことを示します。

overwrite = FALSEであるときに、同じ名前のスクリプトがOML4Rスクリプト・リポジトリにすでに存在する場合、エラー条件が発生します。それ以外の場合、ore.scriptCreateはNULLを返します。

スクリプトへの読取りアクセス権の付与または取消し

スクリプトの作成者は、ore.grant関数を使用してスクリプトへの読取りアクセス権を付与したり、ore.revoke関数を使用してそのアクセス権を取り消すことができます。これらの関数の構文は次のとおりです。 

ore.grant(name, type = "rqscript", user)
ore.revoke(name, type = "rqscript", user)

引数について、次に説明します。

引数 説明
name OML4Rスクリプト・リポジトリ内のスクリプトの名前。
type スクリプトの場合、タイプはrqscriptです。
user 読取りアクセス権を付与する、または取り消すユーザー。

nameおよびtype引数は必須です。引数userを指定しなかった場合、読取りアクセス権がすべてのユーザーに付与されるか、すべてのユーザーから取り消されます。

次のいずれかに該当する場合、エラーが発生します。

  • 指定したスクリプトがOML4Rスクリプト・リポジトリ内にありません。

  • type引数が指定されていません。

  • ユーザーが見つかりません。

  • 読取り権限がすでにユーザーに付与されているか、ユーザーから取り消されています。

  • 指定したスクリプトがパブリックです。

使用可能なスクリプトのリスト

自分が使用できるスクリプトをリストするには、ore.scriptListを使用します。名前、パターンまたはタイプに基づいてスクリプトをリストできます。関数の構文は次のとおりです。 

ore.scriptList(name, pattern, type)

引数について、次に説明します。

引数 説明
name OML4Rスクリプト・リポジトリ内のスクリプトの名前。引数patternを指定する場合は使用できません。
pattern 正規表現パターン。パターンと一致するスクリプトがリストされます。引数nameを指定する場合は使用できません。
type スクリプトのタイプとして、次のいずれかを指定できます。

  • user: 現行のユーザーが所有しているスクリプトがリストされます。

  • global: すべてのユーザーに表示されるパブリック・スクリプトがリストされます。

  • grant: 現行のユーザーが他のユーザーに読取りアクセス権を付与したスクリプトがリストされます。

  • granted: 現行のユーザーが別のユーザーによって読取りアクセス権を付与されたスクリプトがリストされます。

  • all: ユーザーのスクリプト、パブリック・スクリプトおよびアクセス権を付与されたスクリプトがすべてリストされます。

ore.scriptList関数は、OML4Rスクリプト・リポジトリ内のスクリプトおよびスクリプト内の関数の名前を含むdata.frameを返します。

R環境へのスクリプトのロード

R環境にスクリプトのR関数をロードするには、ore.scriptLoadを使用し、その構文は次のとおりです。 

ore.scriptLoad(name, owner, newname, envir)

引数について、次に説明します。

引数 説明
name OML4Rスクリプト・リポジトリ内のスクリプトの名前。
owner スクリプトの所有者。
newname スクリプトをロードする新しい関数名。
envir スクリプトをロードするR環境。

ore.scriptLoadを呼び出すユーザーにスクリプトへのアクセス権が付与されている場合、スクリプトの所有者を指定すると便利です。

OML4Rスクリプト・リポジトリ内のスクリプトの名前が有効なR関数名でない場合、新しい関数名を指定すると便利です。

次のいずれかに該当する場合、エラーが発生します。

  • スクリプトがOML4Rスクリプト・リポジトリ内にありません。

  • 現行のユーザーにスクリプトへの読取りアクセス権がありません。

  • name引数で指定した関数が有効なR関数名ではありません。

  • newname引数が有効なR関数名ではありません。

スクリプトの削除

OML4Rスクリプト・リポジトリからスクリプトを削除するには、ore.scriptDrop関数を使用します。この関数をコールするには、RQADMINロールが必要です。ore.scriptDrop関数の構文は次のとおりです。 

ore.scriptDrop(name, global, silent)

引数について、次に説明します。

引数 説明
name OML4Rスクリプト・リポジトリ内のスクリプトの名前。
global スクリプトがグローバル(パブリック)であるか、プライベートであるかを示す論理値。TRUEは、グローバル・スクリプトを削除することを示します。FALSE (デフォルト)は、現行のユーザーが所有しているスクリプトを削除することを示します。
silent ore.scriptDropでエラー条件が検出された場合にエラー・メッセージを表示するかどうかを示す論理値。TRUEは、エラー・メッセージを表示することを示します。FALSE (デフォルト)は、表示しないことを示します。

次のいずれかに該当する場合、エラー条件が発生します。

  • スクリプトがOML4Rスクリプト・リポジトリ内にありません。

  • global = TRUEの場合に、スクリプトがプライベート・スクリプトです。

  • global = FALSEの場合に、スクリプトがパブリック・スクリプトです。

成功すると、ore.scriptDropはNULLを返します。

例9-1 Rスクリプト管理関数の使用方法

# Create a temporary R data.frame proxy object for the iris data.frame. Overwrite the script another script with the same name already exists.
IRIS <- ore.push(iris)

# Create a private R script for the current user.
ore.scriptCreate("myRandomRedDots", function(divisor = 100){
                 id <- 1:10
                 plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2 )
                 data.frame(id = id, val = id / divisor)
                 }, overwrite=TRUE)

# Create another private R script.
ore.scriptCreate("MYLM",
                 function(data, formula, ...) lm(formula, data, ...), overwrite=TRUE)

# Create a public script, available to any user.
ore.scriptCreate("GLBGLM",
                 function(data, formula, ...) 
                 glm(formula = formula, data = data, ...),
                 global = TRUE,
                 overwrite=TRUE)

# List only my private scripts.
ore.scriptList()                

# List my private scripts and the public scripts. 
ore.scriptList(type = "all")    

# List my private scripts that have the specified pattern.
ore.scriptList(pattern = "MY")  

# Grant read access to a private script to all users.
ore.grant("MYLM", type = "rqscript")

# Grant read access to a private script to a specific user.
ore.grant("myRandomRedDots", user = "OMLUSER",  type = "rqscript")

# List the granted scripts.
ore.scriptList(type = "grant")

# Use the MYLM script in an Embedded R Execution function.
ore.tableApply(IRIS[1:4], FUN.NAME = "MYLM",
               formula = Sepal.Length ~ .)
# Use the GLBGLM script in an Embedded R Execution function.
ore.tableApply(IRIS[1:4], FUN.NAME = "GLBGLM",
               formula = Sepal.Length ~ .)

# Load an R script to an R function object
ore.scriptLoad(name = "MYLM")

# Invoke the function.
MYLM(iris, formula = Sepal.Length ~ .)

# Load another R script to an R function object
ore.scriptLoad(name = "GLBGLM", newname = "MYGLM")

# Invoke the function.
MYGLM(iris, formula = Sepal.Length ~ .)

# Drop some scripts.
ore.scriptDrop("MYLM")
ore.scriptDrop("GLBGLM", global = TRUE)

# List all scripts.
ore.scriptList(type = "all")

出力は、次のようなものです。

表9-2 data.frame: 7 x 2

NAME SCRIPT
<chr> <chr>
MYLM function (data, formula, ...) lm(formula, data, ...)
build.lm function (dat) { mod <- lm(Petal.Length ~ Petal.Width + Sepal.Width + Sepal.Length, dat) x <- dat[["Petal.Width"]] y <- dat[["Petal.Length"]] return(mod) }
build.lm.1 function (dat) { regr <- lm(Petal.Length ~ Petal.Width + Sepal.Width + Sepal.Length, dat) x <- dat[["Petal.Width"]] y <- dat[["Petal.Length"]] return(regr) }
buildLM.group function (dat) { mod <- lm(Petal.Length ~ Petal.Width, dat) return(mod) }
buildLM.group.1 function (dat) { mod <- lm(mpg ~ hp + vs, dat) return(mod) }
myRandomRedDots function (divisor = 100) { id <- 1:10 plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2) data.frame(id = id, val = id/divisor) }
scoreLM.1 function (dat, dsname) { ore.load(dsname) dat$Petal.Length_prediction <- predict(mod, newdata = dat) dat[, c("Petal.Length_prediction", "Petal.Length", "Species")] }

表9-3 data.frame: 20 x 3

OWNER NAME SCRIPT
<chr> <chr> <chr>
RQSYS GLBGLM function (data, formula, ...) glm(formula = formula, data = data, ...)
RQSYS RQ$R.Version function() { v <- as.character(R.Version()) v[v == ""] <- NA_character_ data.frame(name=names(R.Version()), value=unname(v), stringsAsFactors=FALSE) }
RQSYS RQ$getRversion function() { data.frame(Version=as.character(getRversion()), stringsAsFactors=FALSE) }
RQSYS RQ$installed.packages function() { data.frame(installed.packages()[,c(1L,3L,2L),drop=FALSE], stringsAsFactors=FALSE) }
RQSYS RQ$packageVersion function(pkg) { data.frame(Version=as.character(packageVersion(pkg=pkg)), stringsAsFactors=FALSE) }
RQSYS RQG$boxplot function(x, ...) { boxplot(x, ...) invisible(NULL) }
RQSYS RQG$cdplot function(x, ...) { if (NCOL(x) < 2L) stop("script RQG$cdplot requires 2 columns to produce graphic") x[[2L]] <- as.factor(x[[2L]]) cdplot(x[[1L]], x[[2L]], ...) invisible(NULL) }
RQSYS RQG$hist function(x, ...) { if (is.data.frame(x)) x <- x[[1L]] hist(x, ...) invisible(NULL) }
RQSYS RQG$matplot function(x, ...) { matplot(x, ...) invisible(NULL) }
RQSYS RQG$pairs function(x, ...) { if (NCOL(x) < 2L) stop("script RQG$pairs requires at least 2 columns to produce graphic") pairs(x, ...) invisible(NULL) }
RQSYS RQG$plot1d function(x, ...) { if (is.data.frame(x)) x <- x[[1L]] if (is.character(x)) x <- as.factor(x) plot(x, ...) invisible(NULL) }
RQSYS RQG$plot2d function(x, ...) { if (NCOL(x) < 2L) stop("script RQG$plot2d requires 2 columns to produce graphic") x <- x[1:2] if (is.character(x[[1L]])) x[[1L]] <- as.factor(x[[1L]]) if (is.character(x[[2L]])) x[[2L]] <- as.factor(x[[2L]]) plot(x[1:2], ...) invisible(NULL) }
RQSYS RQG$smoothScatter function(x, ...) { if (NCOL(x) < 2L) stop("script RQG$smoothScatter requires 2 columns to produce graphic") x <- x[1:2] if (is.character(x[[1L]])) x[[1L]] <- as.factor(x[[1L]]) if (is.character(x[[2L]])) x[[2L]] <- as.factor(x[[2L]]) smoothScatter(x[1:2], ...) invisible(NULL) }
OMLUSER MYLM function (data, formula, ...) lm(formula, data, ...)
OMLUSER build.lm function (dat) { mod <- lm(Petal.Length ~ Petal.Width + Sepal.Width + Sepal.Length, dat) x <- dat[["Petal.Width"]] y <- dat[["Petal.Length"]] return(mod) }
OMLUSER build.lm.1 function (dat) { regr <- lm(Petal.Length ~ Petal.Width + Sepal.Width + Sepal.Length, dat) x <- dat[["Petal.Width"]] y <- dat[["Petal.Length"]] return(regr) }
OMLUSER buildLM.group function (dat) { mod <- lm(Petal.Length ~ Petal.Width, dat) return(mod) }
OMLUSER buildLM.group.1 function (dat) { mod <- lm(mpg ~ hp + vs, dat) return(mod) }
OMLUSER myRandomRedDots function (divisor = 100) { id <- 1:10 plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2) data.frame(id = id, val = id/divisor) }
OMLUSER scoreLM.1 function (dat, dsname) { ore.load(dsname) dat$Petal.Length_prediction <- predict(mod, newdata = dat) dat[, c("Petal.Length_prediction", "Petal.Length", "Species")]

表9-4 data.frame: 1 x 2

  SCRIPT
<chr> <chr>
MYLM function (data, formula, ...) lm(formula, data, ...)

この例のリスト

R> # Create an ore.frame object from the data.frame for the iris data set.
R> IRIS <- ore.push(iris)
R> 
R> # Create a private R script for the current user.
R> ore.scriptCreate("myRandomRedDots", function(divisor = 100){
+                   id <- 1:10
+                   plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2 )
+                   data.frame(id = id, val = id / divisor)
+                   })
R> 
R> # Create another private R script.
R> ore.scriptCreate("MYLM",
+                   function(data, formula, ...) lm(formula, data, ...))
R> 
R> # Create a public script, available to any user.
R> ore.scriptCreate("GLBGLM",
+                   function(data, formula, ...) 
+                   glm(formula = formula, data = data, ...),
+                   global = TRUE)
R> 
R> # List only my private scripts.
R> ore.scriptList()
             NAME      SCRIPT
1            MYLM      function (data, formula, ...) \nlm(formula, data, ...)
2 myRandomRedDots      function (divisor = 100) \n{\n    id & lt\n    -1:10\n
                       plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2)\n
                       data.frame(id = id, val = id/divisor)\n}
R> 
R> # List my private scripts and the public scripts. 
R> ore.scriptList(type = "all")    
   OWNER              NAME    SCRIPT
1  RQSYS            GLBGLM    function (data, formula, ...) \nglm(formula = formula, data = data, ...)
2 OML_USER            MYLM    function (data, formula, ...) \nlm(formula, data, ...)
3 OML_USER myRandomRedDots    function (divisor = 100) \n{\n    id & lt\n    -1:10\n
                              plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 2)\n
                              data.frame(id = id, val = id/divisor)\n}
R> 
R> # List my private scripts that have the specified pattern.
R> ore.scriptList(pattern = "MY")
  NAME  SCRIPT
1 MYLM  function (data, formula, ...) \nlm(formula, data, ...)
R> 
R> # Grant read access to a private script to all users.
R> ore.grant("MYLM", type = "rqscript")
R> 
R> # Grant read access to a private script to a specific user.
R> ore.grant("myRandomRedDots", user = "SCOTT",  type = "rqscript")
R> 
R> # List the granted scripts.
R> ore.scriptList(type = "grant")
             NAME GRANTEE
1            MYLM  PUBLIC
2 myRandomRedDots   SCOTT
R> 
R> # Use the MYLM script in an Embedded R Execution function.
R> ore.tableApply(IRIS[1:4], FUN.NAME = "MYLM",
+                 formula = Sepal.Length ~ .)

Call:
lm(formula = formula, data = data)

Coefficients:
 (Intercept)   Sepal.Width  Petal.Length   Petal.Width  
      1.8560        0.6508        0.7091       -0.5565 
R> 
R> # Use the GLBGLM script in an Embedded R Execution function.
R> ore.tableApply(IRIS[1:4], FUN.NAME = "GLBGLM",
+                formula = Sepal.Length ~ .) 

Call:  glm(formula = formula, data = data)

Coefficients:
 (Intercept)   Sepal.Width  Petal.Length   Petal.Width  
      1.8560        0.6508        0.7091       -0.5565  

Degrees of Freedom: 149 Total (i.e. Null);  146 Residual
Null Deviance:      102.2 
Residual Deviance: 14.45        AIC: 84.64
R> 
R> # Load an R script to an R function object
R> ore.scriptLoad(name="MYLM")
R> 
R> # Invoke the function.
R> MYLM(iris, formula = Sepal.Length ~ .)
R> 
R> # Load another R script to an R function object
R> ore.scriptLoad(name = "GLBGLM", newname = "MYGLM")
R> 
R> # Invoke the function.
R> MYGLM(iris, formula = Sepal.Length ~ .)
R> 
R> # Drop some scripts.
R> ore.scriptDrop("MYLM")
R> ore.scriptDrop("GLBGLM", global = TRUE)
R> 
R> # List all scripts.
R> ore.scriptList(type = "all")
   OWNER               NAME    SCRIPT
  OML_USER  myRandomRedDots    function (divisor = 100) \n{\n    id & lt\n    -1:10\n
                               plot(1:100, rnorm(100), pch = 21, bg = "red", cex = 
                               2)\n data.frame(id = id, val = id/divisor)\n}

関連項目:

親トピック: 埋込みRの実行用のRインタフェース