Extend mxGetExpected to 'sideways' model references

Tim Bates presented an issue with mxAutoStart in which
the function failed due to the expectation in a multigroup
model refering to a matrix in a parent model or a sibling
model.

Testing with ?umxACE examples led to this solution.

Resolves an issue with mxAutoStart.

R/MxExpectationLISREL.R

@@ -640,7 +640,7 @@ extractNAname <- function(name, subname){
 	if(single.na(name)){
 		return(name)
 	} else {
-		return(paste(subname, name, sep="."))
+		return(.modifyDottedName(subname, name, sep="."))
 	}
 }
 

R/MxExpectationNormal.R

@@ -85,11 +85,21 @@ setMethod("genericExpRename", signature("MxExpectationNormal"),
 		return(.Object)
 })
 
+.modifyDottedName <- function(sub, obj, sep='.'){
+	if(single.na(obj)) {return(obj)}
+	if(length(obj) > 1) {stop('Please pass me one object name at a time.')}
+	if(length(strsplit(obj, split=sep, fixed=TRUE)[[1]]) > 1 ){
+		return(obj)
+	} else {
+		return(paste(sub, obj, sep=sep))
+	}
+}
+
 setMethod("genericGetExpected", signature("MxExpectationNormal"),
 	function(.Object, model, what, defvar.row=1, subname=model@name) {
 		ret <- list()
 		if ('covariance' %in% what) {
-			covname <- paste(subname, .Object@covariance, sep=".")
+			covname <- .modifyDottedName(subname, .Object@covariance)
 			cov <- mxEvalByName(covname, model, compute=TRUE, defvar.row=defvar.row)
 			dnames <- .Object$dims
 			if(!single.na(dnames)){
@@ -101,7 +111,7 @@ setMethod("genericGetExpected", signature("MxExpectationNormal"),
 		if ('means' %in% what) {
 			meanname <- .Object@means
 			if(!single.na(meanname)){
-				meanname <- paste(subname, meanname, sep=".")
+				meanname <- .modifyDottedName(subname, meanname, sep=".")
 				mean <- mxEvalByName(meanname, model, compute=TRUE, defvar.row=defvar.row)
 				dnames <- .Object$dims
 				if(!single.na(dnames)){
@@ -113,7 +123,7 @@ setMethod("genericGetExpected", signature("MxExpectationNormal"),
 		if ('thresholds' %in% what) {
 			thrname <- .Object@thresholds
 			if(!single.na(thrname)){
-				thrname <- paste(subname, thrname, sep=".")
+				thrname <- .modifyDottedName(subname, thrname, sep=".")
 				thr <- mxEvalByName(thrname, model, compute=TRUE, defvar.row=defvar.row)
 				tnames <- .Object$threshnames
 				if(!single.na(tnames)){

R/MxExpectationRAM.R

@@ -285,9 +285,9 @@ setMethod("genericNameToNumber", signature("MxExpectationRAM"),
 setMethod("genericGetExpected", signature("MxExpectationRAM"),
 	  function(.Object, model, what, defvar.row=1, subname=model@name) {
 		  ret <- list()
-		  Aname <- paste(subname, .Object@A, sep=".")
-		  Sname <- paste(subname, .Object@S, sep=".")
-		  Fname <- paste(subname, .Object@F, sep=".")
+		  Aname <- .modifyDottedName(subname, .Object@A, sep=".")
+		  Sname <- .modifyDottedName(subname, .Object@S, sep=".")
+		  Fname <- .modifyDottedName(subname, .Object@F, sep=".")
 		  Mname <- .Object@M
 		  A <- mxEvalByName(Aname, model, compute=TRUE, defvar.row=defvar.row)
 		  S <- mxEvalByName(Sname, model, compute=TRUE, defvar.row=defvar.row)
@@ -302,7 +302,7 @@ setMethod("genericGetExpected", signature("MxExpectationRAM"),
 				if(single.na(Mname)){
 					mean <- matrix( , 0, 0)
 				} else {
-					Mname <- paste(subname, Mname, sep=".")
+					Mname <- .modifyDottedName(subname, Mname, sep=".")
 					M <- mxEvalByName(Mname, model, compute=TRUE, defvar.row=defvar.row)
 					mean <- M %*% t(solve(I-A)) %*% t(F)
 			  }
@@ -311,7 +311,7 @@ setMethod("genericGetExpected", signature("MxExpectationRAM"),
 			if ('thresholds' %in% what) {
 				thrname <- .Object@thresholds
 				if(!single.na(thrname)){
-					thrname <- paste(subname, thrname, sep=".")
+					thrname <- .modifyDottedName(subname, thrname, sep=".")
 					thr <- mxEvalByName(thrname, model, compute=TRUE, defvar.row=defvar.row)
 				} else {thr <- matrix( , 0, 0)}
 				ret[['thresholds']] <- thr