neticaHypergraph <- function (model, netName=NetworkName(net),
                              hypergraph = CreateNetwork(netName)) {
  if (model$type == "SM") {
    NetworkUserField(hypergraph,"StudentModelID") <- model$id
  } else {
    NetworkUserField(hypergraph,"LinkID") <- model$id
  }    
  if (length (model$taskID) >0) {
    NetworkUserField(hypergraph, "TaskID") <- model$taskID
  }
  for (var in model$variables) {
    neticaAddVar(hypergraph,var)
  }
  for (dist in model$distributions) {
    neticaAddDist(hypergraph,dist)
  }
  if (model$type != "SM") {
    ## Remove the footprint to make the EM
    DeleteNodes(NetworkNodesInSet(hypergraph,"SM"))
  }
  hypergraph
}

neticaAddVar <- function(hypergraph, var) {
  levels <- var$levels
  lTitles <- NULL
  if (any(!is.IDname(levels))) {
    lTitles <- levels
    levels <- as.IDname(levels)
    if (any(duplicated(levels))) {
      stop("Non-unique level names")
    }
  }
  title <- NULL
  name <- var$name
  if (length(var$nodeName) >0) {
    title <- name
    name <- var$nodeName
  }
  if (!is.IDname(name)) {
    if (is.null(title)) {
      title <- name
    }
    name <- as.IDname(name)
  }
  node <- NewDiscreteNode(hypergraph,name,levels)
  if (!is.null(title)) 
    NodeTitle(node) <- title
  if (!is.null(lTitles)) 
    NodeStateTitles(node) <- lTitles
  NodeSets(node) <- as.vector(var$role)
  NodeUserField(node,"isOrdered") <- 
    ifelse(var$isOrdered,"true","false")
  node
}

neticaAddDist <- function(hypergraph, dist) {
  if (length(dist$consequences) > 1) {
    stop("Netica does not support multiple child nodes.")
  }
  child <- NetworkFindNode(hypergraph,as.IDname(dist$consequences))
  nparents <- length(dist$conditions)
  if (nparents >0) {
    parents <- NetworkFindNode(hypergraph,as.IDname(dist$conditions))
    if (!is.list(parents)) parents <- list(parents)
    NodeParents(child) <- parents
  }
  
  NodeUserField(child,"distType") <- dist$type

  ## We need to convert all possible names from StatShop legal names
  ## to Netica legal names. 
  table <- DistributionTable(dist)
  if (nparents>0) {
    ##Fix parent names
    names(table)[1:nparents] <- ParentNames(child)
    for (i in 1:nparents) {
      levels(table[[i]]) <- as.IDname(levels(table[[i]]))
    }
  }
  ## Fix output state names.
  names(table)[(nparents+1):length(table)] <-
    as.IDname(names(table)[(nparents+1):length(table)])
  child[] <- table


  if (!is.null(dist$parameterSet)) {
    ## Just attach this as an XML blob, so we can get it back.
    NodeUserField(child,"parameterSet") <-
      toString(xmlParameterSet(dist$parameterSet))
  } else if (!is.null(dist$parameterTable)) {
    ## Just attach this as an XML blob, so we can get it back; same
    ## strategy, although there is probably something smarter we can
    ## do with this in Netica.
    NodeUserField(child,"parameterTable") <-
      toString(xmlBuildTable(dist$parameterTable,
                             dist$conditions, "ParameterTable"))
  } else {
    if (dist$type != "Fixed Distribution") {
     warning (paste("Distribution for ",dist$consequences,
                    " has neither parameter set nor table."))
   }
  }
  child
}


PortalStatShopMap <- data.frame(
 hasParameterTable=c(TRUE,TRUE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE),
 link=c(NA,NA,"calcDSFrame","calcDSFrame","calcDSFrame","calcDSFrame","calcDNFrame",NA),
 combination=c(NA,NA,"Compensatory","Disjunctive","Conjunctive","Inhibitor","Compensatory",NA),
 row.names=c("HyperDirichlet","Fixed","Compensatory","Disjunctive","Conjunctive","Inhibitor","Correlation","Fillin")
)

   
DistributionTable <- function (dist, skillLevels, obsLevels) {
  table <- dist$table
  if (!is.null(table)) return (table)
  type <- strsplit(dist$type," ")[[1]][1]
  ## Fillin distributions have no table, so return null.
  if (type=="Fillin") return (NULL)
  if (PortalStatShopMap[type,"hasParameterTable"]) 
    return (normalize(scaleTable(dist$parameterTable)))

  ##Okay, need to extract parameters
  params <- dist$parameterSet$value
  beta <-params["Task Difficulty"]
  lnAlphas <- params[grep("Relative Importance",names(params))]
  ## I'm really relying on position and not name here
  names(lnAlphas) <- sub("Relative Importance\\((.*)\\)","\\1",
                         names(lnAlphas))
  dinc <- params[grep("Level Difficulty Increment",names(params))]
  names(dinc) <- sub("Level Difficulty Increment\\(.*,(.*)\\)","\\1",
                     names(dinc))

  do.call(PortalStatShopMap[type,"link"],
          list(skillLevels,obsLevels,lnAlphas,beta,dinc,
               PortalStatShopMap[type,"combination"]))
}


AMDtoNetica <- function (amd,directory=".",motif=NULL) {
  for (name in names(amd$studentModels)) {
   sm <- neticaHypergraph(amd$studentModels[[name]],
                          as.IDname(name))
   if (name != as.IDname(name)) {
     NetworkTitle(sm) <- name
   }
   WriteNetworks(sm,paste(directory,.Platform$file.sep,name,".dne",
                          sep=""))
   if (is.null(motif)) DeleteNetwork(sm)
  }
  for (name in names(amd$evidenceModels)) {
   em <- neticaHypergraph(amd$evidenceModels[[name]],
                          as.IDname(name))
   if (name != as.IDname(name)) {
     NetworkTitle(em) <- name
   }
   WriteNetworks(em,paste(directory,.Platform$file.sep,name,".dne",
                          sep=""))
   if (is.null(motif)) {
     DeleteNetwork(em)
   } else {
     AdjoinNetwork(sm,em,name)
   }
  }
  for (name in names(amd$linkModels)) {
   lm <- neticaHypergraph(amd$linkModels[[name]],
                          as.IDname(name))
   if (name != as.IDname(name)) {
     NetworkTitle(lm) <- name
   }
   WriteNetworks(lm,paste(directory,.Platform$file.sep,name,".dne",
                          sep=""))
   if (is.null(motif)) {
     DeleteNetwork(lm)
   } else {
     AdjoinNetwork(sm,lm,name)
   }
  }
  if (!is.null(motif)) {
    WriteNetworks(sm,paste(directory,.Platform$file.sep,motif,".dne",
                          sep=""))
  }
  sm
}