# ---------------------------------------------------------------------
# Program: RamPath1.S  
#  Author: Steven M. Boker
#    Date: Wed Jul 19 16:56:10 EST 2000
#
# This program creates linked lists of paths, spans and bridges
# after the Rampath2000 article.
#
# ---------------------------------------------------------------------
# Revision History
#   Steven M. Boker -- Wed Jul 19 16:56:14 EST 2000
#      Created RamPath1.S.  This version does not deal with
#      nonrecursive models.
#
# ---------------------------------------------------------------------

options(object.size=5e8)
options(width=120)

# ---------------------------------------------------------------------
# Define functions

makePathList <- function(AMatrix) {
	k <- 0
	tIndex <- c(1:10000)
	tFrom <- rep(0, 10000)
	tTo <- rep(0, 10000)
	tStartID <- rep(0, 10000)
	tFromID <- rep(0, 10000)
	tLength <- rep(0, 10000)
	tValue <- rep(0, 10000)
	for (i in 1:dim(AMatrix)[1]) {
		for (j in 1:dim(AMatrix)[2]) {
			if (AMatrix[i,j] != 0) {
				k <- k + 1
				tFrom[k] <- j
				tTo[k] <- i
				tStartID[k] <- tIndex[k]
				tFromID[k] <- tIndex[k]
				tLength[k] <- 1
				tValue[k] <- AMatrix[i,j]
			}
		}
	}
	t1 <- 0
	maxLength <- 0
	while (t1 != k) {
		t1 <- k
		maxLength <- maxLength + 1
		tSelect1 <- tLength == 1
		tSelect2 <- tLength == maxLength 
		if (length(tIndex[tSelect1]) == 0 | length(tIndex[tSelect1]) == 0) 
			break
		for (i in tIndex[tSelect2]) {
			for (j in tIndex[tSelect1]) {
				if (tTo[i] == tFrom[j]) {
					k <- k + 1
					tFrom[k] <- tFrom[i]
					tTo[k] <- tTo[j]
					tStartID[k] <- tIndex[i]
					tFromID[k] <- tIndex[j]
					tLength[k] <- 1 + maxLength
					tValue[k] <- tValue[i] * tValue[j]
				}
			}
		}
	}
	return(list(index=tIndex[1:k], fromVar=tFrom[1:k], 
	            toVar=tTo[1:k], startID=tStartID[1:k], 
	            fromID=tFromID[1:k], length=tLength[1:k], 
				value=tValue[1:k]))
}

makeSpanList <- function(SMatrix) {
	k <- 0
	tIndex <- c(1:10000)
	tVarA <- rep(0, 10000)
	tVarB <- rep(0, 10000)
	tValue <- rep(0, 10000)
	for (i in 1:dim(SMatrix)[1]) {
		for (j in 1:dim(SMatrix)[2]) {
			if (SMatrix[i,j] != 0) {
				k <- k + 1
				tVarA[k] <- j
				tVarB[k] <- i
				tValue[k] <- SMatrix[i,j]
			}
		}
	}
	return(list(index=tIndex[1:k], varA=tVarA[1:k], 
	            varB=tVarB[1:k], value=tValue[1:k]))
}

makeBridgeList <- function(pathList, spanList) {
	k <- 0
	tIndex <- c(1:10000)
	tVarA <- rep(0, 10000)
	tVarB <- rep(0, 10000)
	tSpanID <- rep(0, 10000)
	tPath1ID <- rep(0, 10000)
	tPath2ID <- rep(0, 10000)
	tValue <- rep(0, 10000)
	for (i in 1:length(spanList$index)) {
		k <- k + 1
		tVarA[k] <- spanList$varA[i]
		tVarB[k] <- spanList$varB[i]
		tSpanID[k] <- spanList$index[i]
		tPath1ID[k] <- 0
		tPath2ID[k] <- 0
		tValue[k] <- spanList$value[i]
	}
	for (i in 1:length(spanList$index)) {
		for (j in 1:length(pathList$index)) {
			if (spanList$varA[i] == pathList$fromVar[j]) {
				k <- k + 1
				tVarA[k] <- pathList$toVar[j]
				tVarB[k] <- spanList$varB[i]
				tSpanID[k] <- spanList$index[i]
				tPath1ID[k] <- pathList$index[j]
				tPath2ID[k] <- 0
				tValue[k] <- spanList$value[i] * pathList$value[j]
			}
			if (spanList$varB[i] == pathList$fromVar[j]) {
				k <- k + 1
				tVarA[k] <- spanList$varB[i]
				tVarB[k] <- pathList$toVar[j]
				tSpanID[k] <- spanList$index[i]
				tPath1ID[k] <- 0
				tPath2ID[k] <- pathList$index[j]
				tValue[k] <- spanList$value[i] * pathList$value[j]
			}
		}
	}
	for (i in 1:length(spanList$index)) {
		for (j in 1:length(pathList$index)) {
			if (spanList$varA[i] == pathList$fromVar[j]) {
				for (h in 1:length(pathList$index)) {
					if (spanList$varB[i] == pathList$fromVar[h]) {
						k <- k + 1
						tVarA[k] <- pathList$toVar[j]
						tVarB[k] <- pathList$toVar[h]
						tSpanID[k] <- spanList$index[i]
						tPath1ID[k] <- pathList$index[j]
						tPath2ID[k] <- pathList$index[h]
						tValue[k] <- spanList$value[i] * pathList$value[j] * pathList$value[h]
					}
				}
			}
		}
	}
	return(list(index=tIndex[1:k], varA=tVarA[1:k], 
	            varB=tVarB[1:k], spanID=tSpanID[1:k], 
	            path1ID=tPath1ID[1:k], path2ID=tPath2ID[1:k], 
				value=tValue[1:k]))
}

# ---------------------------------------------------------------------
# Define an example model

tAMatrix <- rbind(c(0, 0, 0, 0, 0, 0),
                  c(0, 0, 0, 0, 0, 0),
                  c(0, 0, 0, 0, 0, .5),
                  c(0, 0, 0, 0, 0, .5),
                  c(0, 0, 0, 0, 0, .5),
                  c(.5, .5, 0, 0, 0, 0))
				  
tSMatrix <- rbind(c(1, .5, 0, 0, 0, 0),
                  c(.5, 1, 0, 0, 0, 0),
                  c(0, 0, 1, 0, 0, 0),
                  c(0, 0, 0, 1, 0, 0),
                  c(0, 0, 0, 0, 1, 0),
                  c(0, 0, 0, 0, 0, 1))
				  
# ---------------------------------------------------------------------
# Create expanded path list

tPathlist <- makePathList(tAMatrix)

# ---------------------------------------------------------------------
# Create span list

tSpanlist <- makeSpanList(tSMatrix)

# ---------------------------------------------------------------------
# Create bridge list

tBridgelist <- makeBridgeList(tPathlist, tSpanlist)

tMatrix <- cbind(tBridgelist$index, tBridgelist$varA, tBridgelist$varB, tBridgelist$spanID, tBridgelist$path1ID, tBridgelist$path2ID, tBridgelist$value)
# ---------------------------------------------------------------------
# quit the program here.

q()