In professorbeautiful/LevinsLoops: Building dynamic simulation for Levins loop models.

library(LevinsLoops)
data("cm.levins", package="LoopAnalyst")
nodeNames = rownames(cm.levins)

make.M = reactive({
#   if(!is.null(input$X1X1))
#     M = cbind(c(input$X1X1, input$X1X2),
#               c(input$X2X1, input$X2X2) )
#   else
  M = cm.levins
  Mtry = try({  
    for(X1 in nodeNames)
      for(X2 in nodeNames)
        M[X2,X1] = input[[nodeNameID(X1,X2)]]
  })
  print(M)
  print(Mtry)
  print(class(Mtry))
  if(class(Mtry) == 'try-error'
     | is.null(Mtry)) returnVal = M
  else returnVal = Mtry
  (returnVal)
})

nodeNameID = function(n1, n2) paste0("Input", n1, n2, sep="_")
nodeNameLabel = function(n1, n2) paste(n1, n2, sep="->")
#output$sliders = 
#renderUI(
makeSliders = function()  {
  M = cm.levins
  nameGrid = expand.grid(rownames(M), rownames(M), stringsAsFactors = FALSE)
  #print(nameGrid)
  returnVal = lapply(1:nrow(nameGrid), 
                     function(linkNum) {
                       nodes = unlist(nameGrid[linkNum, ])
                       node_to = nodes[1]
                       node_from = nodes[2]
                       numericInput(inputId = nodeNameID(node_from, node_to), 
                                   label = nodeNameLabel(node_from, node_to),
                                   min = -1.5, max = 1.5, 
                                   value = M[node_to, node_from], 
                                   step = 0.01)
                     }
         )
  returnVal = lapply(
    split(1:length(returnVal),
          (-1 + 1:length(returnVal))%/%length(returnVal)
    ),
    function(sliders) fluidRow(
      lapply(returnVal[sliders], column, width=3) 
    ))  #shiny::tagAppendAttributes() 
  returnVal                         
}
renderTable({
  make.M()  
})


fluidPage(
  makeSliders()
)


renderPlot({
  library(LevinsLoops)
  result = dynamSim(M = make.M(), returnLast = TRUE)
  abline(h=result)
  if(exists("previousResult")) 
    abline(h=previousResult, lty=2)
  previousResult <<- result
})

professorbeautiful/LevinsLoops documentation built on May 26, 2019, 8:33 a.m.