Rでのスクリプトの管理

10.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

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

これらの関数の使用例は、例10-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を返します。

例10-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")

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

表10-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")] }

表10-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")]

表10-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}