R essential for modeler 18.0

Author: wujiazhong

src/DESCRIPTION

@@ -1,8 +1,8 @@
-Package: ibmspsscf82
+Package: ibmspsscf83
 Type: Package
 Title: IBM SPSS CF R Plugin
-Version: 8.2.0.0
+Version: 8.3.0.0
 Author: IBM
-Maintainer: <***@cn.ibm.com>
+Maintainer: <zhxiaoli@cn.ibm.com>
 Description: An interface to embeded R in IBM SPSS CF based application
 License: GPL-2

src/NAMESPACE

@@ -1,4 +1,4 @@
-useDynLib(ibmspsscf82)
+useDynLib(ibmspsscf83)
 
 export(
 	ibmspsscfpkg.preaction,

src/R/action.R

@@ -32,6 +32,7 @@ ibmspsscfpkg.preaction <- function()
 
 	outputPath <- ibmspsscfoutput.GetOutputDir()
 	##set the temp workspace, put the console result and graphs in this dir
+	ibmspsscfpkg.oldwd <<- getwd()
 	setwd(outputPath)
 
 
@@ -55,12 +56,9 @@ ibmspsscfpkg.preaction <- function()
 
 	##Sys.setlocale("LC_ALL","ja_JP.utf8")
 	## set the locale of embedding R in Linux
-	if ("windows" != .Platform$OS.type)
-	{
-		out <- .C("ext_GetSystemLocale", as.character(""),as.integer(0),PACKAGE=ibmspsscf_package)
-		Sys.setlocale("LC_ALL",out[[1]])
-	}
-	
+	out <- .C("ext_GetSystemLocale", as.character(""),as.integer(0),PACKAGE=ibmspsscf_package)
+	Sys.setlocale("LC_ALL",out[[1]])
+
 	out <- .C("ext_IsDisplayTextOutput",as.integer(0),as.integer(0),PACKAGE=ibmspsscf_package)
 	last.SpssCfError <<- out[[2]] 
 	if(last.SpssCfError != 0)
@@ -140,5 +138,6 @@ ibmspsscfpkg.postaction <- function()
 
 ibmspsscfpkg.stopprocedure <- function()
 {
+	setwd(ibmspsscfpkg.oldwd)
 	.C("ext_StopProcedure",as.integer(0),PACKAGE=ibmspsscf_package)
 }

src/R/attach.R

@@ -23,7 +23,7 @@ ibmspsscf_package <- NULL
 ibmspsscf_version <- NULL
 plugin_version <- NULL
 ibmspsscf.lib <- NULL
-ibmspsscfNamespace <- "ibmspsscf82"
+ibmspsscfNamespace <- "ibmspsscf83"
 last.SpssCfError <- 0
 ## when the package is attached(via library), the hook function .onAttach is called
 ## before the package environment is sealed

src/R/data.R

@@ -83,7 +83,7 @@ ibmspsscfdata.GetData <- function(fields=NULL,
 										PACKAGE=ibmspsscf_package)
 
 	n <- length(out)
-	last.SpssCfError <- out[[n]]
+	last.SpssCfError <<- out[[n]]
 	if(last.SpssCfError !=0)
 	{
 		processSpssCFError(last.SpssCfError)
@@ -192,6 +192,13 @@ ibmspsscfdata.GetData <- function(fields=NULL,
 			{
 				## flagValues[1] is true value, flagValues[2] is false value
 				flagValues <- ibmspsscfdatamodel.GetFlagValues(i)
+				if(length(flagValues) == 0)
+				{
+					last.SpssCfError <<- 1022
+					.Call("ext_SendErrorCode",as.integer(last.SpssCfError), as.integer(3), as.list(fieldNames[[j]]), as.integer(err),PACKAGE=ibmspsscf_package)
+					stop(printSpssError(last.SpssCfError),call. = FALSE, domain = NA)
+				}
+
 				for(index in 1:length(result[[j]]))
 				{
 					if(!is.na(result[[j]][index])) {
@@ -275,13 +282,14 @@ ibmspsscfdata.GetDataFromTemp <- function(missingValue = NA,
 			colClassesVec <- c(colClassesVec, "numeric")
 		}
 	} 
-	dataFromTempFile <- read.table(dataFileName, header=TRUE, sep=" ",colClasses=colClassesVec, encoding="UTF-8")
+	dataFromTempFile <- read.table(dataFileName, header=TRUE, sep=" ",colClasses=colClassesVec,fileEncoding="UTF-8")
 	unlink(dataFileName)
 
 
 	## 2. Convert flag fields
 	## process converting flag fields to logical fields
 	fieldMeasure <- modelerDataModel[4,]
+	fieldNames <- modelerDataModel[1,]
 	fieldCount <- ibmspsscfdatamodel.GetFieldCount()
 	fields <- 0:(fieldCount-1)
    	if(logicalFields == TRUE)
@@ -293,6 +301,13 @@ ibmspsscfdata.GetDataFromTemp <- function(missingValue = NA,
 			{
 				## flagValues[1] is true value, flagValues[2] is false value
 				flagValues <- ibmspsscfdatamodel.GetFlagValues(i)
+				if(length(flagValues) == 0)
+				{
+					last.SpssCfError <<- 1022
+					.Call("ext_SendErrorCode",as.integer(last.SpssCfError), as.integer(3), as.list(fieldNames[[j]]), as.integer(0),PACKAGE=ibmspsscf_package)
+					stop(printSpssError(last.SpssCfError),call. = FALSE, domain = NA)
+				}
+				
 				## need to convert character firstly, factor will have value check 
 				dataFromTempFile[[j]] <- as.character(dataFromTempFile[[j]])
 				for(index in 1:length(dataFromTempFile[[j]]))
@@ -353,6 +368,16 @@ ibmspsscfdata.GetDataFromTemp <- function(missingValue = NA,
 		j<-1
 		for(i in fields)
 		{	
+			# only convert storage is not string, string has been converted in read.table
+			if("string" != fieldStorages[[j]] && ("nominal" == fieldMeasure[[j]] 
+			|| "discrete" == fieldMeasure[[j]]))
+			{
+				if(factorMode == "levels")
+				{
+					dataFromTempFile[[j]] <- factor(dataFromTempFile[[j]], ordered=FALSE)
+				}
+			}
+			
 			if("ordinal" == fieldMeasure[[j]])
 			{		
 				valueLabels <- ibmspsscfdatamodel.GetValueLabels(i)

src/R/datamodel.R

@@ -326,8 +326,7 @@ ibmspsscfdatamodel.SetDataModel <- function(dataModel)
 
 		##check the storage
 		if(dataModel[3, i] == "string" || dataModel[3, i] == "integer" || dataModel[3, i] == "real"
-		|| dataModel[3, i] == "date" || dataModel[3, i] == "time" || dataModel[3, i] == "timestamp"
-		|| dataModel[3, i] == "unknown")
+		|| dataModel[3, i] == "date" || dataModel[3, i] == "time" || dataModel[3, i] == "timestamp")
 		{}
 		else 
 		{
@@ -358,6 +357,23 @@ ibmspsscfdatamodel.SetDataModel <- function(dataModel)
 		}
 		fieldMeasure <- c(fieldMeasure, as.character(dataModel[4, i]))
 		fieldFormat <- c(fieldFormat, as.character(dataModel[5, i]))
+		
+		##check  the role
+		dataModelRole <- dataModel[6, i]
+		if(dataModelRole =="" || dataModelRole == "input" ||dataModelRole == "target" 
+		|| dataModelRole == "both"|| dataModelRole == "partition" || dataModelRole == "split"
+		|| dataModelRole == "freqWeight" || dataModelRole == "recordId" || dataModelRole == "none")
+		{}
+		else 
+		{
+		    last.SpssCfError <<- 1007
+		    if(is.SpssCfError(last.SpssCfError))
+		    {
+			  invalidRole <- as.character(dataModelRole)
+			  .Call("ext_SendErrorCode",as.integer(last.SpssCfError), as.integer(3), as.list(invalidRole), as.integer(err),PACKAGE=ibmspsscf_package)
+			  stop(printSpssError(last.SpssCfError),call. = FALSE, domain = NA)
+		    }
+		}
 		fieldRole <- c(fieldRole, as.character(dataModel[6, i]))
 	}
 

src/R/output.R

@@ -76,7 +76,7 @@ ibmspsscfoutput.SetHTMLWithAllGraphs <- function()
 		temp1 <- paste("<p>", as.character(name))
 		temp2 <- "<img src=\""
 		temp3 <- name
-		temp4 <- "\",width=\"500\" height=\"500\"></p>"
+		temp4 <- "\"></p>"
 		temp <- paste(temp1, temp2, temp3, temp4)
 		htmlBegin <- paste(htmlBegin, temp)
 	}

src/inst/lang/en/ibmspsscfr.properties

@@ -82,9 +82,11 @@
 [RError]_1006 = Invalid field format for SetDataModel.
 [RError]_1007 = Invalid field role for SetDataModel.
 
-[RError]_1021 = Invalid field missing value.
+
 ##this is for GetDataModel or GetData
 [RError]_1020 = Invalid field name in argument.
+[RError]_1021 = Invalid field missing value.
+[RError]_1022 = Flag field does not have values.
 
 ## data
 [RError]_1008 = Invalid value for argument factorMode (must be "none", "levels" or "labels").

src/inst/lang/ibmspsscfr.properties

@@ -82,9 +82,11 @@
 [RError]_1006 = Ung\u00fcltiges Feldformat f\u00fcr SetDataModel.
 [RError]_1007 = Ung\u00fcltige Feldrolle f\u00fcr SetDataModel.
 
-[RError]_1021 = Ung\u00fcltiger Wert f\u00fcr fehlendes Feld.
+
 ##this is for GetDataModel or GetData
 [RError]_1020 = Ung\u00fcltiger Feldname in Argument.
+[RError]_1021 = Ung\u00fcltiger Wert f\u00fcr fehlendes Feld.
+[RError]_1022 = Flagfeld enth\u00e4lt keine Werte.
 
 ## data
 [RError]_1008 = Ung\u00fcltiger Wert f\u00fcr Argument factorMode (muss "none", "levels" oder "labels" sein).