# expand_frame expands a matrix or data-frame to an indicator supermatrix and 
# optionally converts this to a data-frame again. By default NA becomes zero 
# and constant rows and columns are eliminated.

expandFrame<-function(tab,clean=TRUE,zero=TRUE,returnFrame=TRUE) {
n<-dim(tab)[1]; m<-dim(tab)[2]; g<-matrix(0,n,0); l<-rep("",0)
lab1<-labels(tab)[[1]]; lab2<-labels(tab)[[2]]
for (j in 1:m) {
	y<-as.factor(tab[,j]); h<-levels(y)
	g<-cbind(g,ifelse(outer(y,h,"=="),1,0))
	l<-c(l,paste(lab2[j],"_",h,sep=""))
	}
if (zero) g<-ifelse(is.na(g),0,as.matrix(g))
if (clean) {
	g<-g[which(rowSums(g)>0),which(colSums(g)>0)]
	g<-g[,which(colSums(g)<n)]
	}
if (!returnFrame) return(g)
g<-as.data.frame(g,row.names=lab1)
names(g)<-l
return(g)
}

# burtTable makes a Burt matrix out of a data-frame or a
# profile frequency matrix

burtTable<-function(data,pf=FALSE) {
nvar<-dim(data)[2]; if(pf) nvar<-nvar-1
ff<-rep(1,dim(data)[1]); if (pf) ff<-data[,dim(data)[2]]
ncat<-sapply(1:nvar,function(j) length(table(data[,j])))
tcat<-sum(ncat); first<-cumsum(c(1,ncat))[1:nvar]
burt<-matrix(0,tcat,tcat)
for (i in 1:nvar) {
	ii<-first[i]:(first[i]+ncat[i]-1); dd<-as.factor(data[,i])
	gi<-ifelse(outer(dd,levels(dd),"=="),1,0)
	if (i < nvar) {
		for (j in (i+1):nvar) {
			jj<-first[j]:(first[j]+ncat[j]-1); dd<-as.factor(data[,j])
			gj<-ifelse(outer(dd,levels(dd),"=="),1,0)
			burt[jj,ii]<-t(burt[ii,jj]<-crossprod(gi,gj*ff))
			}
		}
	burt[ii,ii]<-crossprod(gi,gi*ff)
	}
return(burt)
}

# profileFrequencies returns a data-frame with all profiles from a data
# matrix, plus a column with profiles frequencies. If reduce is TRUE,
# profiles with zero frequencies are deleted.

profileFrequencies<-function(data,reduce=FALSE) {
z<-as.data.frame(table(as.data.frame(data)))
if (reduce) z<-z[which(z[,dim(z)[2]]>0),]
return(z)
}

blowupProfiles<-function() {}

# codeInteractive takes a data frame with m columns and a list of 
# s vectors with elements between 1 and m. It then creates labels for
# the s interactive variables and returns them in a dataframe.

codeInteractive<-function(data,sets) {
n<-dim(data)[1]; m<-length(sets)
new<-matrix(0,n,m)
for (i in 1:n)
	for (j in 1:m) {
	    s<-as.character(as.matrix(data[i,sets[[j]]]))
		new[i,j]<-paste(s,sep="",collapse="")
		}
as.data.frame(new)
}

# mkIndiList takes a data frame, a vector of types, a list of knot vectors, and a vector
# of orders. It returns a list of codings for the variable. If type is "C" it returns
# a crisp indicator, if type is "A" it returns a numerical version of the variable, and
# if type is "F" is returns the b-spline basis as a fuzzy indicator. In the last case,
# a knot sequence and an order must also be defined for the variable.

mkIndiList<-function(data,type=rep("C",dim(data)[2]),knots=repList(0,length(type)),ord=rep(1,length(type))) {
m<-dim(data)[2]; n<-dim(data)[1]; fz<-list()
for (j in 1:m) 
   {
   if (type[j]=="C") 
	fz<-c(fz,list(mkCrisp(data[[j]])))
   if (type[j]=="A") 
	fz<-c(fz,list(as.real(data[[j]])))
   if (type[j]=="F")
	fz<-c(fz,list(bsplineS(data[[j]],knots[[j]],ord[j])))
   }
return(fz)
}

mkCrisp<-function(x) {
x<-as.factor(x)
return(ifelse(outer(x, levels(x),"=="),1,0))
}

repList<-function(x,n) {
z<-list()
for (i in 1:n)
    z<-c(z,list(x))
return(z)
}

# expandTab expands a table with frequencies to a data frame with two variables Row and Col

expandTab<-function(x) {
n<-nrow(x); m<-ncol(x); s<-sum(x)
a<-rownames(kolomoki); b<-names(kolomoki)
g<-matrix(0,0,2)
for (i in 1:n) for (j in 1:m) 
    if (x[i,j] > 0) g<-rbind(g,matrix(c(a[i],b[j]),x[i,j],2,byrow=TRUE))
g<-as.data.frame(g)
names(g)<-c("Row","Col")
return(g)
}