nm.process.scm(): suggested code

[bergsmat]

per Marita:

nm.process.scm = function (path) 
{
  scm = readLines(paste(path, "scmlog.txt", sep = "/"))
  scmshort = readLines(paste(path, "short_scmlog.txt", sep = "/"))
  model = which(substring(scm, 1, 5) == "MODEL")
  nothing = which(scm == "")
  nothing = sapply(model, function(x, y) y[y > x][1], y = nothing)
  scmTITLE = scm[model[1]]
  fullSCM = lapply(seq(along = model), function(x, start, end, 
                                                scm) {
    as.character(scm[(start[x] + 1):(end[x] - 1)])
  }, start = model, end = nothing, scm = scm)
  unravel.scm = function(x) {
    c(substring(x, 1, 11), substring(x, 18, 21), substring(x, 
                                                           23, 30), substring(x, 35, 45), substring(x, 57, 67), 
      substring(x, 68, 70), substring(x, 73, 85), substring(x, 
                                                            81, 85), substring(x, 86, 97), substring(x, 98))
  }
  fullSCM = lapply(fullSCM, function(y) sapply(y, function(x) unravel.scm(x)))
  fullSCM = lapply(fullSCM, function(y) apply(y, 2, function(x) trimSpace(x)))

  scmlist2df = function(x) if(length(x)==10) data.frame(matrix(c(x), nrow=1)) else data.frame(apply(x, 1, t))
  fullSCM = lapply(fullSCM, scmlist2df)

  nFwd = grep("Parameter-covariate relation chosen in this forward step:", 
              scm)
  nBwd = grep("Parameter-covariate relation chosen in this backward step:", 
              scm)
  length(fullSCM)
  names(fullSCM) = c(paste("START FORWARD STEP", (1:length(nFwd))), 
                     paste("START BACKWARD STEP", (1:length(nBwd))))
  fullSCM = lapply(fullSCM, function(x) {
    x$X3 = sprintf("%.1f", as.numeric(x$X3))
    x$X4 = sprintf("%.1f", as.numeric(x$X4))
    x$X5 = sprintf("%.3f", as.numeric(x$X5))
#     x$X7 = sprintf("%.2f", as.numeric(x$X7))
    return(x)
  })

  scmNames = c("MODEL", "TEST", "BASE.OFV", "NEW.OFV", "TEST", "OFV.DROP", "GOAL", "dDF", "SIGNIFICANT", "PVAL")
  fullSCM = lapply(fullSCM, function(x, nams) {
    names(x) = nams
    return(x)
  }, nams = scmNames)

  fullSCM = lapply(fullSCM, function(x) {
    x = x[, -6]
    x$SIGNIFICANT = ifelse(x$SIGNIFICANT=="1        YES", 'YES!','~')
   x=rename(x,OFV.DROP=TEST.1)  
   x$PVAL = substring(x$PVAL,2)
    return(x)
  })

  scmNames = c("MODEL", "TEST", "BASE.OFV", "NEW.OFV", "OFV.DROP", "GOAL", "dDF", "SIGNIFICANT", "PVAL")

  relations = which(substring(scmshort, 1, 5) == "Relat")
  scm.summary = scmshort[1:(relations[1] - 1)]
  scm.summary = sapply(scm.summary, function(x) unravel.scm(x))
  scm.summary = apply(scm.summary, 2, function(x) trimSpace(x))
  scm.summary = scmlist2df(scm.summary)
  names(scm.summary) = scmNames
  dashes = which(substring(scmshort, 1, 5) == "-----")
  final.model = scmshort[(tail(relations, 1) + 1):(tail(dashes, 
                                                        1) - 1)]
  final.model = sapply(final.model, function(x) unlist(strsplit(x, 
                                                                "\\s+")))
  final.model = lapply(final.model, function(x) {
    data.frame(Parameter = x[1], Covariates = paste(if (length(x) > 
                                                        1) 
      x[-1]
      else "", collapse = ", "))
  })
  final.model = do.call("rbind", final.model)
  row.names(final.model) = NULL
  steps = grep("Relations included after final step:", scmshort)
  seltxt = "Parameter-covariate relation chosen in this forward step: "
  forwardSteps = sub(seltxt, "", scm[grep(seltxt, scm)])
  seltxt = "Parameter-covariate relation chosen in this backward step: "
  backwardSteps = sub(seltxt, "", scm[grep(seltxt, scm)])
  allSteps = c(paste("ADDED", forwardSteps), paste("REMOVED", 
                                                   backwardSteps))
  allSteps[allSteps == "ADDED --"] = "NOTHING ADDED"
  allSteps[allSteps == "REMOVED "] = "NOTHING REMOVED"
  step.n = length(nFwd) + length(nBwd)
  step.labels = character(step.n)
  step.action = allSteps
  for (i in 1:step.n) {
    step.labels[i] = ifelse(i <= length(nFwd), paste("START FORWARD STEP", 
                                                     i), paste("START BACKWARD STEP", i - length(nFwd)))
  }
  steps = list()
  for (i in 1:step.n) {
    steps[[i]] = list(label = step.labels[i], runs = fullSCM[i], 
                      action = step.action[i])
  }
  empty.row = fullSCM[[1]][1, ]
  empty.row[1, ] = rep("~", ncol(empty.row))
  fullSCM.latex = lapply(1:length(fullSCM), function(x, er, 
                                                     allSteps, fullSCM) {
    ER = rbind(er, er, er)
    ER[2, 1] = allSteps[x]
    ER[1, 1] = names(fullSCM)[x]
    ER[3, 1] = "\\cmidrule{2-8}%"
    y = data.frame(rbind(ER[1, ], fullSCM[[x]], ER[2, ], 
                         ER[3, ]))
    names(y) = names(fullSCM[[x]])
    return(y)
  }, er = empty.row, fullSCM = fullSCM, allSteps = allSteps)
  fullSCM.latex = data.frame(do.call("rbind", fullSCM.latex))
  names(fullSCM.latex) = scmNames

  fullSCM.latex$MODEL[fullSCM.latex$MODEL=='START BACKWARD STEP 1'] = "START FORWARD STEP 3" 
  fullSCM.latex$MODEL[fullSCM.latex$MODEL=='NOTHING REMOVED'] = "NOTHING ADDED" 
  fullSCM.latex$MODEL[fullSCM.latex$MODEL=='START BACKWARD STEP 0'] = "START BACKWARD STEP 1" 

  fullSCM.latex$SIGNIFICANT[fullSCM.latex$MODEL=="START BACKWARD STEP 1" ] = "INSIGNIFICANT" 

  fullSCM.latex$MODEL[76] = "NOTHING REMOVED" 

    msel.fwd = grep("FORWARD", fullSCM.latex$MODEL)
  msel.bwd = grep("BACKWARD", fullSCM.latex$MODEL)
  msel.add = grep("ADDED", fullSCM.latex$MODEL)
  msel.rem = grep("REMOVED", fullSCM.latex$MODEL)
  msel = c(msel.fwd,msel.bwd,msel.add,msel.rem)
  fullSCM.latex$MODEL[msel] = paste("$\\textit{",fullSCM.latex$MODEL[msel],"}$", sep = "")

  fullSCM.latex$SIGNIFICANT[fullSCM.latex$SIGNIFICANT == "1"] = "~"
  fullSCM.latex$OFV.DROP = paste("$", fullSCM.latex$OFV.DROP, 
                                 "$", sep = "")
  ok = isNumeric(fullSCM.latex$GOAL)
  fullSCM.latex$GOAL[ok] = signif(asNumeric(fullSCM.latex$GOAL[ok]), 
                                  4)
  # fullSCM.latex$GOAL = paste(fullSCM.latex$OFV.DROP, fullSCM.latex$GOAL)
  # fullSCM.latex$OFV.DROP = NULL
  ok = isNumeric(fullSCM.latex$PVAL)
  fullSCM.latex$PVAL[ok] = substring(sprintf("%4f", signif(asNumeric(fullSCM.latex$PVAL[ok]), 
                                                           4)), 1, 6)
  fullSCM.latex$PVAL[fullSCM.latex$PVAL == "0.0000"] = "$<$0.0001"
  fullSCM.latex$PVAL[fullSCM.latex$PVAL == "9999.0"] = "$>$0.9999"
  aadp = align.around.decimal.point
  fullSCM.latex$BASE.OFV[ok] = aadp(round(asNumeric(fullSCM.latex$BASE.OFV[ok]), 
                                          1), len = max(5, max(nchar(fullSCM.latex$BASE.OFV[ok])) - 
                                                          2))
  fullSCM.latex$NEW.OFV[ok] = aadp(round(asNumeric(fullSCM.latex$NEW.OFV[ok]), 
                                         1), len = max(5, max(nchar(fullSCM.latex$BASE.OFV[ok])) - 
                                                         2))
  fullSCM.latex$DIFF[ok] = aadp(round(asNumeric(fullSCM.latex$DIFF[ok]), 
                                      2), len = max(nchar(round(extract.number(fullSCM.latex$DIFF[ok])))))
  fullSCM.latex$TEST[fullSCM.latex$TEST == "PVAL"] = "~"
  names(fullSCM.latex) = c("MODEL", "TEST","OFV$_{base}$", "OFV$_{test}$", "$\\Delta$OFV", "GOAL", "$\\Delta$DF", 
                           "SIGNIFICANT", "P value")
  fullSCM.latex$TEST = NULL
  SCM = structure(list(full.scm = fullSCM, summary = scm.summary, 
                       model = final.model, steps = steps, scm.latex = fullSCM.latex), 
                  class = "SCM")
  return(SCM)
}

[bergsmat]

To support PsN 4.8. With the old function, something goes wrong in printing ‘BACKWARDS STEP 1’ etc….

[bergsmat]

Need PsN 4.8 example files that break old version.

[krinaj]

Update as of 28 Jan 2020: Tested the function on a messy output from SCM, and updates were needed. The latest version of function provided here:

nm.process.scm.new = function (path) {

myfile = paste(path, "scmlog.txt", sep="/")

scm = readLines(myfile)

SCM file update to remove some spaces to read in properly later

updatetext = function(x) { x = gsub("TEST OFV (DROP)", " TestOFV ", x, fixed = TRUE) x = gsub("BASE OFV", " BaseOFV", x) x = gsub("NEW OFV", " NewOFV", x) x = gsub(">", " ", x) return(x) }

scm = updatetext(scm)

con <- file(myfile) writeLines(scm, con) close(con)

skip <- c("Model", "--------------------", "CRITERION", "BASE_MODEL_OFV", "CHOSEN_MODEL_OFV", "Relations", "--------------------", "MODEL")

%nin% <- Negate(%in%)

Open connection and read in and update to have desired output

con <- file(myfile) open(con) scm <- read.table(con, fill=TRUE) %>% filter(V9!="" | V8!="" | V7!="") %>% filter(V1 %nin% skip) %>% mutate(Chosen = ifelse(grepl("-", V8), ifelse(grepl("e", V8), NA, V8), NA)) %>% mutate(V9 = paste(V8, V9, sep=" "), V8 = ifelse(grepl("YES!", V8), "YES", ""), row = as.numeric(rownames(.)), Step = ifelse(grepl("forward", V6), "Forward", ifelse(grepl("backward", V6), "Backward", ifelse(row==1, "Forward", ifelse(grepl("inside", V7), "Backward", NA)))), V3 = signif(as.numeric(V3)), V4=signif(as.numeric(V4)), V5 = signif(as.numeric(V5)), V6=signif(as.numeric(V6)), V1 = gsub("Parameter-covariate", "", V1, fixed = TRUE), V1 = gsub("Forward", "", V1), V7 = gsub("step:", "", V7, fixed = TRUE), V7 = gsub("inside", "", V7))%>% select(Step, V1, V3, V4, V5, V6, V7, V8, V9, Chosen) names(scm) <- c("Step", "Model", "OFV_base", "OFV_test", "dOFV", "Goal", "dDF", "Significant", "p-value", "Chosen") close(con)

scm <- scm %>% mutate(p-value = gsub("[^0-9.-]", "", p-value)) %>% mutate(p-value = readr::parse_number(p-value)) %>% mutate(dDF = as.numeric(dDF)) %>% mutate(p-value = ifelse(as.numeric(p-value)>0.9999, ">0.9999", ifelse(as.numeric(p-value)<0.0001, "<0.0001", as.character(signif(as.numeric(p-value), 3)))))

return(scm) }

[krinaj]

shortscm code:

nm.process.scm.short = function(path) {

scm = nm.process.scm.new(path)

forward = scm %>% filter(Step == "Forward") %>% mutate(Chosen = gsub("-", "", Chosen, fixed = TRUE)) forward = unique(forward$Chosen)

backward = scm %>% filter(Step == "Backward") %>% mutate(Chosen = gsub("-", "", Chosen, fixed = TRUE)) backward = unique(backward$Chosen)

%nin% <- Negate(%in%)

shortscm = scm %>% filter(Significant=="YES") %>% mutate(Model1 = gsub("-", "", Model, fixed = TRUE)) %>% filter(Model1 %in% forward) %>% filter(Model1 %nin% backward) %>% select(-Step, -Chosen, -Model1) %>% group_by(Model) %>% slice(1) %>% ungroup()

return(shortscm) }

[bergsmat]

fixed @2fa3b