changed so phrLoadDatabaseString/phrRunString accept lists

git-svn-id: svn://136.177.114.72/svn_GW/IPhreeqc/trunk@8549 1feff8c3-07ed-0310-ac33-dd36852eb9cd
This commit is contained in:
Scott R Charlton 2014-03-07 07:35:28 +00:00
parent ff17087266
commit a7b5f4509c
11 changed files with 233 additions and 122 deletions

122
R/R.cpp
View File

@ -29,12 +29,40 @@ accumLine(SEXP line)
error("AccumulateLine:line is not a single string\n");
}
str_in = CHAR(STRING_ELT(line, 0));
if (STRING_ELT(line, 0) != NA_STRING) {
str_in = CHAR(STRING_ELT(line, 0));
if (R::singleton().AccumulateLine(str_in) != VR_OK) {
std::ostringstream oss;
oss << R::singleton().GetErrorString();
error(oss.str().c_str());
}
}
if (R::singleton().AccumulateLine(str_in) != VR_OK) {
std::ostringstream oss;
oss << R::singleton().GetErrorString();
error(oss.str().c_str());
return(R_NilValue);
}
SEXP
accumLineLst(SEXP line)
{
const char* str_in;
// check args
if (!isString(line)) {
error("a character vector argument expected");
}
int n = length(line);
std::ostringstream oss;
for (int i = 0; i < n; ++i) {
if (STRING_ELT(line, i) != NA_STRING) {
str_in = CHAR(STRING_ELT(line, 0));
if (R::singleton().AccumulateLine(str_in) != VR_OK) {
std::ostringstream err;
err << R::singleton().GetErrorString();
error(err.str().c_str());
}
}
}
return(R_NilValue);
@ -383,15 +411,15 @@ loadDB(SEXP filename)
// check args
if (!isString(filename) || length(filename) != 1) {
error("filename is not a single string\n");
error("'filename' is not a single string");
}
name = CHAR(STRING_ELT(filename, 0));
if (R::singleton().LoadDatabase(name) != VR_OK) {
std::ostringstream oss;
oss << R::singleton().GetErrorString();
error(oss.str().c_str());
std::ostringstream err;
err << R::singleton().GetErrorString();
error(err.str().c_str());
}
return(R_NilValue);
@ -404,20 +432,47 @@ loadDBStr(SEXP input)
// check args
if (!isString(input) || length(input) != 1) {
error("input is not a single string\n");
error("'input' is not a single string");
}
string = CHAR(STRING_ELT(input, 0));
if (R::singleton().LoadDatabaseString(string) != VR_OK) {
std::ostringstream oss;
oss << R::singleton().GetErrorString();
error(oss.str().c_str());
std::ostringstream err;
err << R::singleton().GetErrorString();
error(err.str().c_str());
}
return(R_NilValue);
}
SEXP
loadDBLst(SEXP input)
{
// check args
if (!isString(input)) {
error("a character vector argument expected");
}
int n = length(input);
std::ostringstream oss;
for (int i = 0; i < n; ++i) {
if (STRING_ELT(input, i) != NA_STRING) {
oss << CHAR(STRING_ELT(input, i)) << "\n";
}
}
if (R::singleton().LoadDatabaseString(oss.str().c_str()) != VR_OK) {
std::ostringstream err;
err << R::singleton().GetErrorString();
error(err.str().c_str());
}
return(R_NilValue);
}
SEXP
getAccumLines(void)
{
@ -456,8 +511,8 @@ runFile(SEXP filename)
const char* name;
// check args
if (!isString(filename) || length(filename) != 1) {
error("RunFile: filename is not a single string\n");
if (!isString(filename) || length(filename) != 1 || STRING_ELT(filename, 0) == NA_STRING) {
error("'filename' must be a single character string");
}
name = CHAR(STRING_ELT(filename, 0));
@ -476,8 +531,8 @@ runString(SEXP input)
const char* in;
// check args
if (!isString(input) || length(input) != 1) {
error("RunString: input is not a single string\n");
if (!isString(input)) {
error("a character vector argument expected");
}
in = CHAR(STRING_ELT(input, 0));
@ -490,6 +545,34 @@ runString(SEXP input)
return(R_NilValue);
}
SEXP
runStringLst(SEXP input)
{
const char* in;
// check args
if (!isString(input)) {
error("a character vector argument expected");
}
int n = length(input);
std::ostringstream oss;
for (int i = 0; i < n; ++i) {
if (STRING_ELT(input, i) != NA_STRING) {
oss << CHAR(STRING_ELT(input, i)) << "\n";
}
}
if (R::singleton().RunString(oss.str().c_str()) != VR_OK) {
std::ostringstream err;
err << R::singleton().GetErrorString();
error(err.str().c_str());
}
return(R_NilValue);
}
SEXP
getCol(int ncol)
{
@ -680,6 +763,7 @@ getSelOut(void)
SET_VECTOR_ELT(list, c, col);
SET_STRING_ELT(attr, c, mkChar(vn.sVal));
UNPROTECT(1);
VarClear(&vn);
}
@ -697,12 +781,12 @@ getSelOut(void)
setAttrib(list, R_RowNamesSymbol, row_names);
UNPROTECT(1);
UNPROTECT(2+cols);
UNPROTECT(2);
return list;
}
SEXP
getSelOuts(void)
getSelOutLst(void)
{
SEXP list;
SEXP attr;

View File

@ -1,12 +1,22 @@
# databases
Amm.dat <- paste(scan("../database/Amm.dat", what="", sep="\n"), collapse="\n")
iso.dat <- paste(scan("../database/iso.dat", what="", sep="\n"), collapse="\n")
llnl.dat <- paste(scan("../database/llnl.dat", what="", sep="\n"), collapse="\n")
minteq.dat <- paste(scan("../database/minteq.dat", what="", sep="\n"), collapse="\n")
minteq.v4.dat <- paste(scan("../database/minteq.v4.dat", what="", sep="\n"), collapse="\n")
pitzer.dat <- paste(scan("../database/pitzer.dat", what="", sep="\n"), collapse="\n")
sit.dat <- paste(scan("../database/sit.dat", what="", sep="\n"), collapse="\n")
phreeqc.dat <- paste(scan("../database/phreeqc.dat", what="", sep="\n"), collapse="\n")
wateq4f.dat <- paste(scan("../database/wateq4f.dat", what="", sep="\n"), collapse="\n")
Amm.dat.string <- paste(scan("../database/Amm.dat", what="", sep="\n"), collapse="\n")
iso.dat.string <- paste(scan("../database/iso.dat", what="", sep="\n"), collapse="\n")
llnl.dat.string <- paste(scan("../database/llnl.dat", what="", sep="\n"), collapse="\n")
minteq.dat.string <- paste(scan("../database/minteq.dat", what="", sep="\n"), collapse="\n")
minteq.v4.dat.string <- paste(scan("../database/minteq.v4.dat", what="", sep="\n"), collapse="\n")
pitzer.dat.string <- paste(scan("../database/pitzer.dat", what="", sep="\n"), collapse="\n")
sit.dat.string <- paste(scan("../database/sit.dat", what="", sep="\n"), collapse="\n")
phreeqc.dat.string <- paste(scan("../database/phreeqc.dat", what="", sep="\n"), collapse="\n")
wateq4f.dat.string <- paste(scan("../database/wateq4f.dat", what="", sep="\n"), collapse="\n")
# lists
Amm.dat.list <- scan("../database/Amm.dat", what="", sep="\n")
iso.dat.list <- scan("../database/iso.dat", what="", sep="\n")
llnl.dat.list <- scan("../database/llnl.dat", what="", sep="\n")
minteq.dat.list <- scan("../database/minteq.dat", what="", sep="\n")
minteq.v4.dat.list <- scan("../database/minteq.v4.dat", what="", sep="\n")
pitzer.dat.list <- scan("../database/pitzer.dat", what="", sep="\n")
sit.dat.list <- scan("../database/sit.dat", what="", sep="\n")
phreeqc.dat.list <- scan("../database/phreeqc.dat", what="", sep="\n")
wateq4f.dat.list <- scan("../database/wateq4f.dat", what="", sep="\n")
save(list = ls(all=TRUE), file="phreeqc/data/databases.RData")
rm(list = ls(all=TRUE))

View File

@ -1,12 +1,23 @@
# examples
ex1 <- paste(scan("../phreeqc3-examples/ex1", what="", sep="\n"), collapse="\n")
ex2 <- paste(scan("../phreeqc3-examples/ex2", what="", sep="\n"), collapse="\n")
ex3 <- paste(scan("../phreeqc3-examples/ex3", what="", sep="\n"), collapse="\n")
ex4 <- paste(scan("../phreeqc3-examples/ex4", what="", sep="\n"), collapse="\n")
ex5 <- paste(scan("../phreeqc3-examples/ex5", what="", sep="\n"), collapse="\n")
ex6 <- paste(scan("../phreeqc3-examples/ex6", what="", sep="\n"), collapse="\n")
ex7 <- paste(scan("../phreeqc3-examples/ex7", what="", sep="\n"), collapse="\n")
ex8 <- paste(scan("../phreeqc3-examples/ex8", what="", sep="\n"), collapse="\n")
ex9 <- paste(scan("../phreeqc3-examples/ex9", what="", sep="\n"), collapse="\n")
# strings
ex1.string <- paste(scan("../phreeqc3-examples/ex1", what="", sep="\n"), collapse="\n")
ex2.string <- paste(scan("../phreeqc3-examples/ex2", what="", sep="\n"), collapse="\n")
ex3.string <- paste(scan("../phreeqc3-examples/ex3", what="", sep="\n"), collapse="\n")
ex4.string <- paste(scan("../phreeqc3-examples/ex4", what="", sep="\n"), collapse="\n")
ex5.string <- paste(scan("../phreeqc3-examples/ex5", what="", sep="\n"), collapse="\n")
ex6.string <- paste(scan("../phreeqc3-examples/ex6", what="", sep="\n"), collapse="\n")
ex7.string <- paste(scan("../phreeqc3-examples/ex7", what="", sep="\n"), collapse="\n")
ex8.string <- paste(scan("../phreeqc3-examples/ex8", what="", sep="\n"), collapse="\n")
ex9.string <- paste(scan("../phreeqc3-examples/ex9", what="", sep="\n"), collapse="\n")
# lists
ex1.list <- scan("../phreeqc3-examples/ex1", what="", sep="\n")
ex2.list <- scan("../phreeqc3-examples/ex2", what="", sep="\n")
ex3.list <- scan("../phreeqc3-examples/ex3", what="", sep="\n")
ex4.list <- scan("../phreeqc3-examples/ex4", what="", sep="\n")
ex5.list <- scan("../phreeqc3-examples/ex5", what="", sep="\n")
ex6.list <- scan("../phreeqc3-examples/ex6", what="", sep="\n")
ex7.list <- scan("../phreeqc3-examples/ex7", what="", sep="\n")
ex8.list <- scan("../phreeqc3-examples/ex8", what="", sep="\n")
ex9.list <- scan("../phreeqc3-examples/ex9", what="", sep="\n")
save(list = ls(all=TRUE), file="phreeqc/data/examples.RData")
rm(list = ls(all=TRUE))

View File

@ -40,11 +40,9 @@ export(
"phrGetErrorString",
"phrGetSelectedOutput",
"phrLoadDatabase",
"phrLoadDatabaseList",
"phrLoadDatabaseString",
"phrPHREEQC_DAT",
"phrRunAccumulated",
"phrRunFile",
"phrRunString"
)

View File

@ -3,7 +3,7 @@
phrAccumulateLine =
function(line)
{
invisible(.Call("accumLine", as.character(line), PACKAGE=.packageName))
invisible(.Call("accumLineLst", as.character(line), PACKAGE=.packageName))
}
phrClearAccumulatedLines =
@ -15,9 +15,15 @@ function()
phrGetSelectedOutput =
function(allow_ = TRUE)
{
sel_out <- .Call("getSelOut", PACKAGE=.packageName)
if(!is.null(sel_out)) names(sel_out) <- make.names(names(sel_out), unique = TRUE, allow_ = allow_)
return(sel_out)
sel_outs <- .Call("getSelOutLst", PACKAGE=.packageName)
if (!is.null(sel_outs)) {
for (t in names(sel_outs)) {
if (!is.null(sel_outs[[t]])) {
names(sel_outs[[t]]) <- make.names(names(sel_outs[[t]]), unique = TRUE, allow_ = allow_)
}
}
}
return(sel_outs)
}
phrGetErrorString =
@ -187,7 +193,6 @@ function()
}
phrGetComponentList =
function()
{
@ -206,6 +211,11 @@ function(input)
invisible(.Call("loadDBStr", as.character(input), PACKAGE=.packageName))
}
phrLoadDatabaseList =
function(input)
{
invisible(.Call("loadDBLst", as.character(input), PACKAGE=.packageName))
}
phrGetAccumulatedLines =
function()
@ -219,11 +229,11 @@ function()
return(.Call("getAccumLines", PACKAGE=.packageName))
}
phrPHREEQC_DAT =
function()
{
return(.Call("phreeqcDat", PACKAGE=.packageName))
}
##phrPHREEQC_DAT =
##function()
##{
## return(.Call("phreeqcDat", PACKAGE=.packageName))
##}
phrRunAccumulated =
function()
@ -240,5 +250,5 @@ function(filename)
phrRunString =
function(input)
{
invisible(.Call("runString", as.character(input), PACKAGE=.packageName))
invisible(.Call("runStringLst", as.character(input), PACKAGE=.packageName))
}

View File

@ -23,11 +23,7 @@ The line(s) to add for input to phreeqc.
This function returns NULL.
}
\references{
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
\author{
David Parkhurst \email{dlpark@usgs.gov}\cr
Maintainer: Scott Charlton \email{charlton@usgs.gov}
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
\note{
%% ~~further notes~~

View File

@ -5,7 +5,7 @@
Retrieve the accumulated input string.
}
\description{
%% ~~ A concise (1-5 lines) description of what the function does. ~~
Returns the accumulated text in the input buffer of the phreeqc object.
}
\usage{
phrGetAccumulatedLines()
@ -15,17 +15,14 @@ phrGetAccumulatedLines()
%% ~~ If necessary, more details than the description above ~~
}
\value{
%% ~Describe the value returned
%% If it is a LIST, use
%% \item{comp1 }{Description of 'comp1'}
%% \item{comp2 }{Description of 'comp2'}
%% ...
The input as a single string.
}
\references{
%% ~put references to the literature/web site here ~
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
\author{
%% ~~who you are~~
David Parkhurst \email{dlpark@usgs.gov}\cr
Maintainer: Scott Charlton \email{charlton@usgs.gov}
}
\note{
%% ~~further notes~~
@ -34,17 +31,13 @@ phrGetAccumulatedLines()
%% ~Make other sections like Warning with \section{Warning }{....} ~
\seealso{
%% ~~objects to See Also as \code{\link{help}}, ~~~
\code{\link{phrAccumulateLine}}, \code{\link{phrRunAccumulated}}
}
\examples{
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function ()
{
}
# This example loads some keyword input and displays the contents.
phrAccumulateLine("SOLUTION 1")
phrAccumulateLine("END")
cat(paste("The accumulated input is:", phrGetAccumulatedLines(), sep="\n"))
}
% Add one or more standard keywords, see file 'KEYWORDS' in the
% R documentation directory.

View File

@ -35,8 +35,8 @@ Maintainer: Scott Charlton \email{charlton@usgs.gov}
}
\examples{
# This example runs the ex2 input file and echos the list of components.
phrLoadDatabase("phreeqc/phreeqc.dat")
phrRunFile("phreeqc/ex2")
phrLoadDatabaseString(phreeqc.dat)
phrRunString(ex2)
cat("components:\n")
for (c in phrGetComponentList()) {
cat(c, "\n")

View File

@ -1,7 +1,7 @@
\name{phrGetSelectedOutput}
\alias{phrGetSelectedOutput}
\title{
Return the results of a phreeqc run.
Returns the contents of the selected output as a data frame.
}
\description{
phrGetSelectedOutput return the results of a phreeqc run specified
@ -17,28 +17,34 @@
\arguments{
} %END arguments
\details{
Accessing selected outputs having a user number other than 1 requires
setting the current selected output user number with \code{\link{phrSetCurrentSelectedOutputUserNumber}}.
Any details about the operation of this function should go here.
*** Should we return a list of data.frames??? ***
} %END details
\value{
Returns a data frame containing ...
Returns a data frame containing the selected_output from the previous run.
}
\references{
Literature references and web URLs can go here.
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
\author{
Scott Charlton <charlton@usgs.gov>
Lopaka(Rob) Lee <rclee@usgs.gov>
David Parkhurst \email{dlpark@usgs.gov}\cr
Maintainer: Scott Charlton \email{charlton@usgs.gov}
}
\seealso{
\code{\link{phrReadDB}},
\code{\link{phrReadString}},
\code{\link{phrRun}}
\code{\link{phrGetCurrentSelectedOutputUserNumber}},
\code{\link{phrGetSelectedOutputFileOn}},
\code{\link{phrSetCurrentSelectedOutputUserNumber}},
}
\examples{
# Simple example here
# Load database and run ex2
phrLoadDatabaseString(phreeqc.dat)
phrRunString(ex2)
# display a summary of the results
df <- phrGetSelectedOutput()
summary(df)
}
\keyword{interface}

View File

@ -1,54 +1,45 @@
\name{phrLoadDatabaseString}
\alias{phrLoadDatabaseString}
%- Also NEED an '\alias' for EACH other topic documented here.
\title{
TODO
}
\title{Load a phreeqc database as a string.}
\description{
%% ~~ A concise (1-5 lines) description of what the function does. ~~
Load the specified string as a database into phreeqc. Returns NULL if successful.
}
\usage{
phrLoadDatabaseString(input)
phrLoadDatabaseString(input)
}
%- maybe also 'usage' for other objects documented here.
\arguments{
\item{input}{
%% ~~Describe \code{input} here~~
}
}
\item{input}{String containing data to be used as the phreeqc database.}
} %END arguments
\details{
%% ~~ If necessary, more details than the description above ~~
}
\value{
%% ~Describe the value returned
%% If it is a LIST, use
%% \item{comp1 }{Description of 'comp1'}
%% \item{comp2 }{Description of 'comp2'}
%% ...
This function returns NULL.
}
\references{
%% ~put references to the literature/web site here ~
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
\author{
%% ~~who you are~~
David Parkhurst \email{dlpark@usgs.gov}\cr
Maintainer: Scott Charlton \email{charlton@usgs.gov}
}
\note{
%% ~~further notes~~
All previous definitions are cleared.
}
%% ~Make other sections like Warning with \section{Warning }{....} ~
\seealso{
%% ~~objects to See Also as \code{\link{help}}, ~~~
\code{\link{phrLoadDatabase}}
}
\examples{
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function (input)
{
\examples{
# this example loads the phreeqc.dat database, turns on the
# output file and runs ex2 as a string
phrLoadDatabaseString(phreeqc.dat.string)
phrSetOutputFileOn(TRUE)
if (is.null(phrRunString(ex2))) {
cat(paste("see ", phrGetOutputFileName(), ".\n", sep=""))
}
}
% Add one or more standard keywords, see file 'KEYWORDS' in the

View File

@ -19,20 +19,32 @@ License: \tab Unlimited\cr
~~ An overview of how to use the package, including the most important functions ~~
}
\author{
David Parkhurst \email{dlpark@usgs.gov}\cr
Maintainer: Scott Charlton \email{charlton@usgs.gov}
David L. Parkhurst \email{dlpark@usgs.gov}\cr
C.A.J. Appelo \email{appt@hydrochemistry.eu}\cr
Maintainer: Scott R. Charlton \email{charlton@usgs.gov}
}
\references{
\url{http://wwwbrr.cr.usgs.gov/projects/GWC_coupled/phreeqc}
}
~~ Optionally other standard keywords, one per line, from file KEYWORDS in the R ~~
~~ documentation directory ~~
\keyword{ package }
\seealso{
}
\examples{
phrLoadDatabase("phreeqc/phreeqc.dat")
if (is.null(phrRunFile("phreeqc/ex2"))) {
phrGetSelectedOutput()
}
# load the phreeqc.dat database
phrLoadDatabaseString(phreeqc.dat)
# run example 2
phrRunString(ex2)
# retrieve selected_output as a list of data.frame
so <- phrGetSelectedOutput()
# plot the results
attach(so$n1)
title <- "Gypsum-Anhydrite Stability"
xlabel <- "Temperature, in degrees celcius"
ylabel <- "Saturation index"
plot(temp.C., si_gypsum, main=title, xlab=xlabel, ylab=ylabel, col="darkred", xlim=c(25, 75), ylim=c(-0.4, 0.0))
points(temp.C., si_anhydrite, col="darkgreen")
legend("bottomright", c("Gypsum", "Anhydrite"), col = c("darkred", "darkgreen"), pch = c(1, 1))
}