From 479169357604cf2742e9db9b310e3d400cbe2bd5 Mon Sep 17 00:00:00 2001
From: Philip Delff <philip@delff.dk>
Date: Sat, 18 Jan 2025 16:00:32 -0500
Subject: [PATCH] addOmegaCorr is adding corr of sigmas too

---
 DESCRIPTION                                   |   2 +-
 R/addOmegaCorr.R                              |  28 ++++++++++++++----
 man/NMreadSection.Rd                          |   4 +--
 .../testthat/testReference/NMcheckData_22.rds | Bin 0 -> 303 bytes
 .../testReference/NMwriteSection_08.rds       | Bin 0 -> 160 bytes
 .../testReference/addOmegaCorr_01.rds         | Bin 0 -> 796 bytes
 .../testthat/testReference/compareCols_06.rds | Bin 0 -> 202 bytes
 tests/testthat/test_addOmegaCorr.R            |  16 ++++++++++
 8 files changed, 42 insertions(+), 8 deletions(-)
 create mode 100644 tests/testthat/testReference/NMcheckData_22.rds
 create mode 100644 tests/testthat/testReference/NMwriteSection_08.rds
 create mode 100644 tests/testthat/testReference/addOmegaCorr_01.rds
 create mode 100644 tests/testthat/testReference/compareCols_06.rds
 create mode 100644 tests/testthat/test_addOmegaCorr.R

diff --git a/DESCRIPTION b/DESCRIPTION
index b490d8fb..0385902d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: NMdata
 Type: Package
 Title: Preparation, Checking and Post-Processing Data for PK/PD Modeling
-Version: 0.1.8.941
+Version: 0.1.8.942
 Authors@R:
   c(person(given="Philip", family="Delff",email = "philip@delff.dk",role = c("aut", "cre")),
     person("Brian", "Reilly", email = "reilly.brian.m@gmail.com",role = c("ctb")),
diff --git a/R/addOmegaCorr.R b/R/addOmegaCorr.R
index c4bfb6bb..c0976b7a 100644
--- a/R/addOmegaCorr.R
+++ b/R/addOmegaCorr.R
@@ -1,5 +1,4 @@
 ##' add Omega correlations to a parameter table
-
 ##' @param pars A parameter table, like returned by `NMreadExt()`.
 ##' @param by The name of a column, as a string. Calculate the
 ##'     correlations within a grouping variable?  This will often be a
@@ -42,11 +41,30 @@ addOmegaCorr <- function(pars,by=NULL,as.fun,col.value="value"){
     res.list <- lapply(
         pars.list,
         function(x){
-            Sigma <- dt2mat(x[par.type=="OMEGA"],col.value=col.value)
-            mat.cor <- suppressWarnings(cov2cor(Sigma))
-            dt.cor <- mat2dt(mat.cor,triangle="all")
+
+            x.omega <- x[par.type=="OMEGA"]
+            dt.cor <- NULL
+            if(nrow(x.omega)){
+                Sigma <- dt2mat(x.omega,col.value=col.value)
+                mat.cor <- suppressWarnings(cov2cor(Sigma))
+                dt.cor.1 <- mat2dt(mat.cor,triangle="all",as.fun="data.table")[,par.type:="OMEGA"]
+                ##x <- mergeCheck(x,dt.cor[,.(par.type="OMEGA",i,j,corr=get(col.value))],by=cc(par.type,i,j),all.x=TRUE,quiet=TRUE)
+                dt.cor <- rbind(dt.cor,dt.cor.1)
+            }
             
-            x <- mergeCheck(x,dt.cor[,.(par.type="OMEGA",i,j,corr=get(col.value))],by=cc(par.type,i,j),all.x=TRUE)
+            x.sigma <- x[par.type=="SIGMA"]
+            if(nrow(x.sigma)){
+                Sigma <- dt2mat(x.sigma,col.value=col.value)
+                mat.cor <- suppressWarnings(cov2cor(Sigma))
+                dt.cor.1 <- mat2dt(mat.cor,triangle="all",as.fun="data.table")[,par.type:="SIGMA"]
+                ## x <- mergeCheck(x,dt.cor[,.(par.type="SIGMA",i,j,corr=get(col.value))],by=cc(par.type,i,j),all.x=TRUE,quiet=TRUE)
+                dt.cor <- rbind(dt.cor,dt.cor.1)
+            }
+            if(!is.null(dt.cor)){
+                dt.cor <- dt.cor[,.(par.type,i,j,corr=get(col.value))]
+                dt.cor[is.nan(corr),corr:=0]
+                x <- mergeCheck(x,dt.cor,by=cc(par.type,i,j),all.x=TRUE,quiet=TRUE)
+            }
             x
         })
     
diff --git a/man/NMreadSection.Rd b/man/NMreadSection.Rd
index be38cc48..8ff211cb 100644
--- a/man/NMreadSection.Rd
+++ b/man/NMreadSection.Rd
@@ -94,9 +94,9 @@ suitable for the results part too.
 }
 \section{Functions}{
 \itemize{
-\item \code{NMgetSection()}: Deprecated function name. Use NMreadSection.
-
+\item \code{NMgetSection}: Deprecated function name. Use NMreadSection.
 }}
+
 \examples{
 NMreadSection(system.file("examples/nonmem/xgxr001.lst", package="NMdata"),section="DATA")
 
diff --git a/tests/testthat/testReference/NMcheckData_22.rds b/tests/testthat/testReference/NMcheckData_22.rds
new file mode 100644
index 0000000000000000000000000000000000000000..c5ff9a5570ccc754f0a71e1fb337e4d2fad689a2
GIT binary patch
literal 303
zcmV+~0nq**iwFP!000001MSw!PJ=)cfZ^d{lQuDFq7T5*Ro}pCsamyGTc!0b9cUV*
zkQC6ZkLlBhe=FmH#KfJKu=r*Ub0BkICcv;JgwTblX+k#$jTM>-ma+Ci^P8zUv5pOF
zVhh{YK@&Dw*u@_9(Z&G|afA+z(ZvZ)(L*0+IERA)hPc2bu5gVT+~N-Ra4~|+>#Q&8
zG)0x(Y&mVajQ>?^bZn=v%&Yx$^x(_Hnz*qQMwS=Feq83tT$w9#-^|sUQIJkUh7)TX
zrJ+}N$LOCgpfdWos3I4uB>v2Ald02adG$-7J7vRtY^;j<p3S1?FYhzIPELIJs15@E
z$q&@Uz3!kmi45FWO`-;Co}0Lh@r?Nkr&pQ2q3W7HRDE7}mSwMWZ|~d`_JOtv003Xv
BnK%Fd

literal 0
HcmV?d00001

diff --git a/tests/testthat/testReference/NMwriteSection_08.rds b/tests/testthat/testReference/NMwriteSection_08.rds
new file mode 100644
index 0000000000000000000000000000000000000000..a051a46be0390823767d119f98fd93e47c2442f7
GIT binary patch
literal 160
zcmV;R0AK$fiwFP!000001B>8dU|?WkU}0orU}6R_g~5CV1_6jT11FHyPzea~ck*%d
zRRDqjZ#@M+e+5q$1y4T(H_xEp5Pv_PNQDqbpaQ6RQELZ<u*9Ow#H5_mVg*BUeIo+}
z2WzOI%+xg$BFUSWr;wPElA5BBlbM&wz`z3X0wYwCH7_wYwHVD$%$a$HP$o-$X^A0_
O{s#b2xz_;=0RRB@z&$Vk

literal 0
HcmV?d00001

diff --git a/tests/testthat/testReference/addOmegaCorr_01.rds b/tests/testthat/testReference/addOmegaCorr_01.rds
new file mode 100644
index 0000000000000000000000000000000000000000..277b7f4f8955214de86aad8598059e513041c72e
GIT binary patch
literal 796
zcmV+%1LOQ3iwFP!000001B>8dU|?WkU}0orU}6R`nT3IbAP@@xu{Z+@11FGXuSl;b
zGB7e4<x-8yz`zFzVEYdYU@+8ZAm9bLABY)ghy@rBiICOJ-`Ul3l!KRp7GxnFt|5+;
zaQuB;-G?|Q*wft?ABTY%IVCdzF{m750Vx1tkU~%q$qmFj&{Pk~x%|+e1{IY;KnyB2
zMSxfoh{d4hu>mnV5OV;HV*;BGv6w9<wJbHK7;1t9OcWgOhA2EE6rM2(&jf{M3gvNu
zJ*8o&W2lKLVuVG+2rdE+F%(@85hE-j=(>zC)EHw?V~i$Zf}zU<Lzf8_T_$KErWod!
zVwhu!VU8&lb4+0(%>GVZXi>(RoRe4#i!pdSrX?nq<QD;1|BzCVBoIphu{03N0I@7}
zQxW5Ts2<tTbTb&!4TQ-74qOem6;Qqr8s8X=Z-T}L8V!zgCRn6nO?nLY3NV-$Oq>}>
z9vQP@!N_{Sb~FG9bj*OLu9?u>fbJe#?t_W*LH$7zKx&ep@Ck`i(DcE|XMi>7jvMBg
zi#jmdFKuK~xvMX2|6G4{@HK~5_Q!67PUrS~;OIDOFIfMn2P?dvuqeXK+b{OGFoeMf
z!+&ZT35AjO^D%5A6WH&TN!c}J_Y*ij?BeA)r<OG_kQn~<cY_alnD|)0`PY2sWV0I1
zz);t<U~iRYkrk!xhMRZg^5H~b2Y)z!vGgLDueU(ODvJ9ZoEjjs3zY9hEf>%X4E6Mb
zw~T<&Oh{tPXlhun=wn6JOQao)=wi6|FfnAk4A6L}{{Z5$FCs(}Q7+&WCsrO^9d3J3
zTP}Htxv8+0iy%xeH$Npc2i7MIadh%=_49|x`S}L92EZ!0lEkE(RK4Po)B;$|RFGJt
zS5jG!3gvSG`9K>=Qj3rkfGmab88cywELc71<{1IAtSm976mC>;Ns3EqnR7neD4?mi
z!6k_$Fpa6jFeY1OQciwyHcTg&Q=C}^Gm0fSzo-Z;Bsh!m%k^NP0ZK+p4M5`m|Nk#>
aRI*$ti6x18X&~<bdH(>q`YtUi5dZ+t=~x&5

literal 0
HcmV?d00001

diff --git a/tests/testthat/testReference/compareCols_06.rds b/tests/testthat/testReference/compareCols_06.rds
new file mode 100644
index 0000000000000000000000000000000000000000..548bfd57af2ce65d5abc68bc87018f360b6be2c2
GIT binary patch
literal 202
zcmV;*05$&~iwFP!000001C>zA4#FT1+&<K_iAjx#pTR$v#+%+e=n?5wO(|_CjaR?C
zx+omvCdn@B%rLuf$^jsTG>RZj=$Nc+qA0#NWVFx9bGhHSBH12}0l&B_gICmH=~V#P
zi<YA^apRf`V+E-tBi}|yJ`90(UU9>j;TMTNNUeE`fkCFb2UCPwlchCzQlidNAY3s!
zqE=k80cEYRCUE0oa#4JK;(K8(Iytt=RdL_=S^9=)tVV%V_!vLO-!?G40U0Q78<hb7
E0BMd{t^fc4

literal 0
HcmV?d00001

diff --git a/tests/testthat/test_addOmegaCorr.R b/tests/testthat/test_addOmegaCorr.R
new file mode 100644
index 00000000..9372400f
--- /dev/null
+++ b/tests/testthat/test_addOmegaCorr.R
@@ -0,0 +1,16 @@
+library(data.table)
+context("addOmegaCorr")
+
+test_that("basic",{
+
+    fileRef <- "testReference/addOmegaCorr_01.rds"
+    file.mod <- "testData/nonmem/xgxr022.mod"
+
+    ext <- NMreadExt(file.mod)
+
+    res1 <- addOmegaCorr(ext)
+
+    res1
+    expect_equal_to_reference(res1,fileRef)
+        
+})