dt2mat generalization

R/NMextractDataFile.R

@@ -49,6 +49,7 @@ NMextractDataFile <- function(file,dir.data=NULL,file.mod,file.data=NULL){
 ### containing the data. Since it is to be used in a FORTRAN OPEN statement,
 ### this name may not include embedded commas, semi-colons, parentheses, or
 ### spaces.
+
         lines.data <- NMreadSection(file,section="DATA",keep.name=FALSE,keep.comments=FALSE,keep.empty=FALSE)
         if(is.null(lines.data)) {
             lines.data <- NMreadSection(file,section="INFILE",keep.name=FALSE,keep.comments=FALSE,keep.empty=FALSE)

R/dt2mat.R

@@ -10,19 +10,26 @@
 ##' @return a matrix
 ##' @export
 
-dt2mat <- function(pars){
+dt2mat <- function(pars,fill=0){
 
     . <- NULL
     est <- NULL
     i <- NULL
     j <- NULL
 
-    pars.mat <- rbind(pars,
+
+
+    pars.mat <- rbind(pars[,.(i,j,est)],
                       pars[i!=j]
                       [,.(i=j,j=i,est)]
                      ,fill=T)
+    i.missing <- setdiff(min(pars$i):max(pars$i),pars$i)
+    pars.mat <- rbind(pars.mat,data.table(i=i.missing,j=i.missing),fill=TRUE)
+
     ## note, dcast returns a keyed data.table (keys are LHS vars) so it is always ordered by i.
     matrix.pars <- as.matrix(dcast(pars.mat,i~j,value.var="est")[,!("i")])
-
+    if(!isFALSE(fill)){
+        matrix.pars[is.na(matrix.pars)] <- fill
+    }
     matrix.pars
 }

_pkgdown.yml

@@ -90,6 +90,7 @@ reference:
   - cc
   - cl
   - dt2mat
+  - mat2dt
   - egdt
   - dims
   - findCovs
@@ -98,7 +99,6 @@ reference:
   - fnExtension
   - is.NMdata
   - unNMdata
-  - mat2dt
   - NMisNumeric
   - NMreadSection
   - NMextractDataFile

devel/NMreadShk.R

@@ -0,0 +1,32 @@
+
+## Type 1=etabar
+## Type 2=Etabar SE
+## Type 3=P val
+## Type 4=%Eta shrinkage SD version
+## Type 5=%EPS shrinkage SD version
+## Type 6=%Eta shrinkage based on empirical Bayes Variance (SD version)
+## Type 7=number of subjects used.
+## Type 8=%Eta shrinkage variance version
+## Type 9=%Eta shrinkage based on empirical Bayes Variance (variance version)
+## Type 10=%EPS shrinkage variance version
+## Type 11=%Relative information
+
+
+
+file.shk <- fnExtension(file.lst,"shk")
+lines.shk <- readLines(file.shk)
+idx.tabstart <- grep("^TABLE NO",lines.shk)
+idx.tabstart
+dt.ts2 <- data.table(idx=c(idx.tabstart,length(lines.shk)+1))
+dt.ts3 <- data.table(start=dt.ts2[-.N],end=dt.ts2[-1]-1)
+dt.ts3[,tableno:=sub(" *TABLE NO\\. +([1-9][0-9]*).*","\\1",lines.shk[start.idx])]
+dt.ts3
+## dt.ts3[,fread(text=lines.shk[(start.idx+1):end.idx]),by=tableno]
+list.shk <- lapply(
+    split(dt.ts3,by="tableno")
+      ,function(x)fread(text=x[,lines.shk[(start.idx+1):end.idx]]))
+lapply(names(list.shk),function(name)list.shk[[name]][,tableno:=name])
+
+shk <- list.shk[[length(list.shk)]]
+shk
+

devel/NMrelate.R

@@ -0,0 +1,32 @@
+NMrelate <- function(file.mod,type="eta"){
+
+    type <- toupper(type)
+    str.regex <- switch(type,
+                        ETA="[^H]ETA"
+                        ,THETA="THETA")
+    lines <- c(NMreadSection(file.mod,section="PRED",keep.comments=FALSE),
+               NMreadSection(file.mod,section="PK",keep.comments=FALSE))
+
+
+    dt.code <- data.table(line.eta = lines[grepl(str.regex,lines)])
+    ## remove spaces
+    dt.code[,line2:=gsub(" ","",line.eta)]
+
+    dt.code <- dt.code[,.(text.eta=regmatches(line2, gregexpr(paste0(str.regex,"\\(([0-9]+)\\)"),line2)) |> unlist()),by=.(line.eta,line2)]
+
+
+    dt.code[,i:=as.numeric(sub(paste0(".*",str.regex,"\\(([1-9][0-9]*)\\)"),"\\1",text.eta))]
+
+    dt.code[,LHS:=sub("(.*)=.*","\\1",line2)]
+
+    dt.code.eta <- dt.code[,.(label=paste(unique(LHS),collapse=", "),
+               code=paste(line2,collapse=", ")
+               ),by=.(i,LHS)]
+
+    ## if a LHS is affected by multiple ETAs we number them
+    dt.code.eta[,nrep.LHS:=.N,by=.(LHS)]
+    dt.code.eta[nrep.LHS>1,label:=paste0(label," - ",type,"(",i,")")]
+
+    dt.code.eta[order(i)]
+
+}