From 7250a00adcae3425e5f65172bea3b36a6d5a5197 Mon Sep 17 00:00:00 2001 From: Franz Innerbichler Date: Sun, 10 May 2026 11:22:31 +0200 Subject: [PATCH] linear reg evaluation for EXCEL upload --- app.R | 218 +++++++++++++++++++++++++++++++--------------------------- 1 file changed, 115 insertions(+), 103 deletions(-) diff --git a/app.R b/app.R index b497040..ea7f1b6 100644 --- a/app.R +++ b/app.R @@ -1096,18 +1096,25 @@ server <- function(input, output, session) { tabPanel("linear Analysis", sidebarLayout( sidebarPanel( - width=3, + width=2, fluidRow( - column(6, + column(12, numericInput("Limits",p("limit to be >", bsButton("q4",label="", icon=icon("info"), style="primary", size="extra-small")), - bsPopover(id="q4", title="", content="The calculated limits ..."))) + bsPopover(id="q4", title="", content="The calculated limits ...")), + checkboxGroupInput("selectedSSTsLinear", "Which suitability tests to be used?", + choices= c("F-test on Regr."="1", + "F-test on non-linearity"= "2", + "F-test on R^2 A"= "3","F-test on R^2 B"= "4", + "F-test on slope A"= "5", "F-test on slope B"="6", + "F-test on non-parallelism"= "7", "F-test on preparation"="8"), + selected= c("1","2","3","4","5","6","7","8")), + ) )), mainPanel( tabsetPanel(id="tabs", tabPanel("linear PLA", - box(title="ANOVA table", status="primary",solidHeader = T, width=12, - tableOutput("Anovatab")), - column(6, + + column(12, htmlOutput("PureErrW3"), tags$head(tags$style("#PureErrW3{color: red; font-size: 16px; @@ -1118,18 +1125,19 @@ server <- function(input, output, session) { h4("Unrestricted linear model (SSSI):"), tableOutput("SummaryModABu"), h4("Restricted linear model (CSSI):"), - tableOutput("SummaryModAB")), - column(3, + tableOutput("SummaryModAB"), + h3("Tests for linear PLA):"), - DT::dataTableOutput("TESTSlin"), + box(title="Suitability tests", status="primary",solidHeader = T, width=12, + DTOutput("TESTSlin")), h5("The estimate is the p-value of the test"), h5("F-tests on regression, significance of slopes, and preparation need to have a p-value <0.05 to pass"), h5("All other tests pass if p-value > 0.05"), "SST CI for difference of slopes:", - tableOutput("SlopeDiffCI")), - column(3, + tableOutput("SlopeDiffCI"), + h3("ANOVA for parallel line assay"), - DT::dataTableOutput("ANOVAlin"))), + DTOutput("ANOVAlin"))), tabPanel("Report", h4("Settings for report") )) @@ -1489,6 +1497,7 @@ server <- function(input, output, session) { coeffsMR <- Smr$coefficients[,1] coeffsMU <- Smu$coefficients[,1] Dat$coeffsMRes <- coeffsMR + Dat$coeffsMUnr <- coeffsMU names(coeffsMU) <- c("lowAsym REF", "slope REF","upperAsym REF","EC50 REF","lowAsym TEST","slope TEST","upperAsym TEST","r") if (!PureErrFlag) { @@ -2150,102 +2159,105 @@ server <- function(input, output, session) { #### linear Plot output ---- output$plotLin <- renderPlot({ + tab <- Dat$EXCEL # tab <- sim2() - # if (is.character(tab)) stop(tab) - # #browser() - # if (!is.na(Dils()[4])) noDilSer <- Dils()[4] else noDilSer = (ncol(tab)-1)/2 - # Conc <- CONC() - # Conctab <- Dat$Conctab + if (is.character(tab)) stop(tab) + browser() + noDilSer = (ncol(tab)-1)/2 + noDil <- nrow(tab) + Conctab <- perConcTab(tab, noDilSer) # if (!is.na(Dils()[3])) noDil <- Dils()[3] else noDil = length(Conc) # - # slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2) - # for (i in 1:(noDil-2)) { - # avs <- Conctab[noDilSer+1,] - # threes <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avs[i:(i+2)]) - # lm3St <- lm(resp ~ lnC, data=threes) - # slopeSt[i,] <- lm3St$coefficients - # avt <- Conctab[noDilSer*2+4,] - # threet <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avt[i:(i+2)]) - # lm3Te <- lm(resp ~ lnC, data=threet) - # slopeTe[i,] <- lm3Te$coefficients - # } - # - # indS <- which(abs(slopeSt[,2]) == max(abs(slopeSt[,2]))) - # indT <- which(abs(slopeTe[,2]) == max(abs(slopeTe[,2]))) - # - # pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log(Conc) - # pl_T <- slopeTe[indT,1]+slopeTe[indT,2]*log(Conc) - # pl_df <- data.frame(lnC=log(Conc), plotS=pl_, plotT=pl_T) - # - # all_l <- melt(data.frame(tab), id.vars="log_dose",variable.name="replname",value.name="readout") - # isRef <- rep(c(1,0), 1,each=nrow(all_l)/2) - # isSample <- rep(c(0,1), 1,each=nrow(all_l)/2) - # all_l2 <- cbind(all_l,isRef, isSample) - # all_l2S <- all_l2[all_l2$isRef == 1,] - # all_l2T <- all_l2[all_l2$isRef == 0,] - # all_mS <- all_l2S[order(all_l2S$log_dose, decreasing=TRUE),] - # all_mT <- all_l2T[order(all_l2T$log_dose, decreasing=TRUE),] - # - # circleS <- all_mS[(indS*noDilSer-(noDilSer-1)):((indS+2)*noDilSer),] - # circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),] - # circle <- rbind(circleS,circleT) - # - # Dat$circles <- circle - # sigmoid <- sigmoid() - # log_dose <- unique(all_l$log_dose) - # seq_x <- seq(min(log_dose), max(log_dose),0.1) - # SAMPLEtrue <- sigmoid[2] + (sigmoid[4]-sigmoid[2])/(1+exp(sigmoid[6]*((sigmoid[7]-log(input$potencydiff/100)-seq_x)))) - # REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[5]*((sigmoid[7]-seq_x)))) - # - # truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue) - # - # p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) + - # geom_point() + - # labs(title=paste("linear regression model", indS,indT), color="product") + - # scale_colour_manual(labels = c("test","reference"), values=c("red","blue")) + - # ylim(min(all_l2$readout),max(all_l2$readout)) + - # theme_bw() - # p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="blue", - # inherit.aes = F) + - # geom_line(data=pl_df,aes(x=lnC,y=plotT),color="red", - # inherit.aes = F) + - # geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4, - # inherit.aes = F) + - # geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4, - # inherit.aes = F) + - # labs(title = paste("unrestricted linear regression model",indS,indT), color="product") + - # theme(legend.position="none", axis.text = element_text(size=14)) - # p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), - # size=5,alpha=0.2), inherit.aes = FALSE) + - # scale_shape_manual(labels=c("test","reference"), values=c(21,21)) - # - # mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose, - # data=circle, - # start=list(intS = 0, k=1,r=0), - # control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10)) - # # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle) - # sum_mLin <- summary(mLin) - # - # pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log(Conc) - # pl_restT <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[3,1] + sum_mLin$coefficients[2,1]*log(Conc) - # pl_rest <- data.frame(lnC=log(Conc), plotS=pl_restS, plotT=pl_restT) - # - # pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="blue", - # inherit.aes = F) + - # geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="red", - # inherit.aes = F) + - # geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4, - # inherit.aes = F) + - # geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4, - # inherit.aes = F) + - # labs(title = paste("restricted linear regression model",indS,indT), color="product") + - # theme(legend.position="none", axis.text = element_text(size=14)) - # pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), - # size=5,alpha=0.2), inherit.aes = FALSE) + - # scale_shape_manual(labels=c("test","reference"), values=c(21,21)) - # grid.arrange(p3,pr3,nrow=1) + slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2) + for (i in 1:(noDil-2)) { + avs <- Conctab[noDilSer+1,] + threes <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avs[i:(i+2)]) + lm3St <- lm(resp ~ lnC, data=threes) + slopeSt[i,] <- lm3St$coefficients + avt <- Conctab[noDilSer*2+4,] + threet <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avt[i:(i+2)]) + lm3Te <- lm(resp ~ lnC, data=threet) + slopeTe[i,] <- lm3Te$coefficients + } + + indS <- which(abs(slopeSt[,2]) == max(abs(slopeSt[,2]))) + indT <- which(abs(slopeTe[,2]) == max(abs(slopeTe[,2]))) + + pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log(Conc) + pl_T <- slopeTe[indT,1]+slopeTe[indT,2]*log(Conc) + pl_df <- data.frame(lnC=log(Conc), plotS=pl_, plotT=pl_T) + + all_l <- melt(data.frame(tab), id.vars="log_dose",variable.name="replname",value.name="readout") + isRef <- rep(c(1,0), 1,each=nrow(all_l)/2) + isSample <- rep(c(0,1), 1,each=nrow(all_l)/2) + all_l2 <- cbind(all_l,isRef, isSample) + all_l2S <- all_l2[all_l2$isRef == 1,] + all_l2T <- all_l2[all_l2$isRef == 0,] + all_mS <- all_l2S[order(all_l2S$log_dose, decreasing=TRUE),] + all_mT <- all_l2T[order(all_l2T$log_dose, decreasing=TRUE),] + + circleS <- all_mS[(indS*noDilSer-(noDilSer-1)):((indS+2)*noDilSer),] + circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),] + circle <- rbind(circleS,circleT) + + Dat$circles <- circle + #browser() + mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose, + data=circle, + start=list(intS = 0, k=1,r=0), + control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10)) + # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle) + sum_mLin <- summary(mLin) + sigmoid <- Dat$coeffsMUnr + log_dose <- unique(all_l$log_dose) + seq_x <- seq(min(log_dose), max(log_dose),0.1) + SAMPLEtrue <- sigmoid[5] + (sigmoid[7]-sigmoid[5])/(1+exp(sigmoid[6]*((sigmoid[4]-sigmoid[8]-seq_x)))) + REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[2]*((sigmoid[4]-seq_x)))) + + truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue) + + p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) + + geom_point() + + labs(title=paste("linear regression model", indS,indT), color="product") + + scale_colour_manual(labels = c("test","reference"), values=c("#C2173F","#4545BA")) + + ylim(min(all_l2$readout),max(all_l2$readout)) + + theme_bw() + p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA", + inherit.aes = F) + + geom_line(data=pl_df,aes(x=lnC,y=plotT),color="#C2173F", + inherit.aes = F) + + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4, + inherit.aes = F) + + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4, + inherit.aes = F) + + labs(title = paste("unrestricted linear regression model",indS,indT), color="product") + + theme(legend.position="none", axis.text = element_text(size=14)) + p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), + size=5,alpha=0.2), inherit.aes = FALSE) + + scale_shape_manual(labels=c("test","reference"), values=c(21,21)) +# fit intercept for test and ref and common slope + + + pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log(Conc) + pl_restT <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[3,1] + sum_mLin$coefficients[2,1]*log(Conc) + pl_rest <- data.frame(lnC=log(Conc), plotS=pl_restS, plotT=pl_restT) + + pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="#4545BA", + inherit.aes = F) + + geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="#C2173F", + inherit.aes = F) + + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4, + inherit.aes = F) + + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4, + inherit.aes = F) + + labs(title = paste("restricted linear regression model",indS,indT), color="product") + + theme(legend.position="none", axis.text = element_text(size=14)) + pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), + size=5,alpha=0.2), inherit.aes = FALSE) + + scale_shape_manual(labels=c("test","reference"), values=c(21,21)) + grid.arrange(p3,pr3,nrow=1) })