Guxa/dashboard-app
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

linear reg evaluation for EXCEL upload

Browse Source
This commit is contained in:
Franz Innerbichler
2026-05-10 11:22:31 +02:00
parent 26aa2b8b2e
commit 7250a00adc
1 changed files with 115 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app.R
+115 -103
View File
@@ -1096,18 +1096,25 @@ server <- function(input, output, session) {
tabPanel("linear Analysis", tabPanel("linear Analysis",
sidebarLayout( sidebarLayout(
sidebarPanel( sidebarPanel(
width=3, width=2,
fluidRow( fluidRow(
column(6, column(12,
numericInput("Limits",p("limit to be >", bsButton("q4",label="", icon=icon("info"), style="primary", size="extra-small")), 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( mainPanel(
tabsetPanel(id="tabs", tabsetPanel(id="tabs",
tabPanel("linear PLA", tabPanel("linear PLA",
box(title="ANOVA table", status="primary",solidHeader = T, width=12,
tableOutput("Anovatab")), column(12,
column(6,
htmlOutput("PureErrW3"), htmlOutput("PureErrW3"),
tags$head(tags$style("#PureErrW3{color: red; tags$head(tags$style("#PureErrW3{color: red;
font-size: 16px; font-size: 16px;
@@ -1118,18 +1125,19 @@ server <- function(input, output, session) {
h4("Unrestricted linear model (SSSI):"), h4("Unrestricted linear model (SSSI):"),
tableOutput("SummaryModABu"), tableOutput("SummaryModABu"),
h4("Restricted linear model (CSSI):"), h4("Restricted linear model (CSSI):"),
tableOutput("SummaryModAB")), tableOutput("SummaryModAB"),
column(3,
h3("Tests for linear PLA):"), 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("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("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"), h5("All other tests pass if p-value > 0.05"),
"SST CI for difference of slopes:", "SST CI for difference of slopes:",
tableOutput("SlopeDiffCI")), tableOutput("SlopeDiffCI"),
column(3,
h3("ANOVA for parallel line assay"), h3("ANOVA for parallel line assay"),
DT::dataTableOutput("ANOVAlin"))), DTOutput("ANOVAlin"))),
tabPanel("Report", tabPanel("Report",
h4("Settings for report") h4("Settings for report")
)) ))
@@ -1489,6 +1497,7 @@ server <- function(input, output, session) {
coeffsMR <- Smr$coefficients[,1] coeffsMR <- Smr$coefficients[,1]
coeffsMU <- Smu$coefficients[,1] coeffsMU <- Smu$coefficients[,1]
Dat$coeffsMRes <- coeffsMR Dat$coeffsMRes <- coeffsMR
Dat$coeffsMUnr <- coeffsMU
names(coeffsMU) <- c("lowAsym REF", "slope REF","upperAsym REF","EC50 REF","lowAsym TEST","slope TEST","upperAsym TEST","r") names(coeffsMU) <- c("lowAsym REF", "slope REF","upperAsym REF","EC50 REF","lowAsym TEST","slope TEST","upperAsym TEST","r")
if (!PureErrFlag) { if (!PureErrFlag) {
@@ -2150,102 +2159,105 @@ server <- function(input, output, session) {
#### linear Plot output ---- #### linear Plot output ----
output$plotLin <- renderPlot({ output$plotLin <- renderPlot({
tab <- Dat$EXCEL tab <- Dat$EXCEL
# tab <- sim2() # tab <- sim2()
# if (is.character(tab)) stop(tab) if (is.character(tab)) stop(tab)
# #browser() browser()
# if (!is.na(Dils()[4])) noDilSer <- Dils()[4] else noDilSer = (ncol(tab)-1)/2 noDilSer = (ncol(tab)-1)/2
# Conc <- CONC() noDil <- nrow(tab)
# Conctab <- Dat$Conctab Conctab <- perConcTab(tab, noDilSer)
# if (!is.na(Dils()[3])) noDil <- Dils()[3] else noDil = length(Conc) # if (!is.na(Dils()[3])) noDil <- Dils()[3] else noDil = length(Conc)
# #
# slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2) slopeSt <- slopeTe <- matrix(NA, nrow=noDil-2,ncol=2)
# for (i in 1:(noDil-2)) { for (i in 1:(noDil-2)) {
# avs <- Conctab[noDilSer+1,] avs <- Conctab[noDilSer+1,]
# threes <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avs[i:(i+2)]) threes <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avs[i:(i+2)])
# lm3St <- lm(resp ~ lnC, data=threes) lm3St <- lm(resp ~ lnC, data=threes)
# slopeSt[i,] <- lm3St$coefficients slopeSt[i,] <- lm3St$coefficients
# avt <- Conctab[noDilSer*2+4,] avt <- Conctab[noDilSer*2+4,]
# threet <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avt[i:(i+2)]) threet <- data.frame(lnC=log(Conc[i:(i+2)]), resp=avt[i:(i+2)])
# lm3Te <- lm(resp ~ lnC, data=threet) lm3Te <- lm(resp ~ lnC, data=threet)
# slopeTe[i,] <- lm3Te$coefficients slopeTe[i,] <- lm3Te$coefficients
# } }
#
# indS <- which(abs(slopeSt[,2]) == max(abs(slopeSt[,2]))) indS <- which(abs(slopeSt[,2]) == max(abs(slopeSt[,2])))
# indT <- which(abs(slopeTe[,2]) == max(abs(slopeTe[,2]))) indT <- which(abs(slopeTe[,2]) == max(abs(slopeTe[,2])))
#
# pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log(Conc) pl_ <- slopeSt[indS,1]+slopeSt[indS,2]*log(Conc)
# pl_T <- slopeTe[indT,1]+slopeTe[indT,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) 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") 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) isRef <- rep(c(1,0), 1,each=nrow(all_l)/2)
# isSample <- rep(c(0,1), 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_l2 <- cbind(all_l,isRef, isSample)
# all_l2S <- all_l2[all_l2$isRef == 1,] all_l2S <- all_l2[all_l2$isRef == 1,]
# all_l2T <- all_l2[all_l2$isRef == 0,] all_l2T <- all_l2[all_l2$isRef == 0,]
# all_mS <- all_l2S[order(all_l2S$log_dose, decreasing=TRUE),] all_mS <- all_l2S[order(all_l2S$log_dose, decreasing=TRUE),]
# all_mT <- all_l2T[order(all_l2T$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),] circleS <- all_mS[(indS*noDilSer-(noDilSer-1)):((indS+2)*noDilSer),]
# circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),] circleT <- all_mT[(indT*noDilSer-(noDilSer-1)):((indT+2)*noDilSer),]
# circle <- rbind(circleS,circleT) circle <- rbind(circleS,circleT)
#
# Dat$circles <- circle Dat$circles <- circle
# sigmoid <- sigmoid() #browser()
# log_dose <- unique(all_l$log_dose) mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose,
# seq_x <- seq(min(log_dose), max(log_dose),0.1) data=circle,
# SAMPLEtrue <- sigmoid[2] + (sigmoid[4]-sigmoid[2])/(1+exp(sigmoid[6]*((sigmoid[7]-log(input$potencydiff/100)-seq_x)))) start=list(intS = 0, k=1,r=0),
# REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[5]*((sigmoid[7]-seq_x)))) control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10))
# # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
# truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue) sum_mLin <- summary(mLin)
# sigmoid <- Dat$coeffsMUnr
# p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) + log_dose <- unique(all_l$log_dose)
# geom_point() + seq_x <- seq(min(log_dose), max(log_dose),0.1)
# labs(title=paste("linear regression model", indS,indT), color="product") + SAMPLEtrue <- sigmoid[5] + (sigmoid[7]-sigmoid[5])/(1+exp(sigmoid[6]*((sigmoid[4]-sigmoid[8]-seq_x))))
# scale_colour_manual(labels = c("test","reference"), values=c("red","blue")) + REFtrue <- sigmoid[1] + (sigmoid[3]-sigmoid[1])/(1+exp(sigmoid[2]*((sigmoid[4]-seq_x))))
# ylim(min(all_l2$readout),max(all_l2$readout)) +
# theme_bw() truePL_df <- cbind(seq_x,SAMPLEtrue, REFtrue)
# p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="blue",
# inherit.aes = F) + p <- ggplot(all_l2,aes(x=log_dose,y=readout, color=factor(isRef))) +
# geom_line(data=pl_df,aes(x=lnC,y=plotT),color="red", geom_point() +
# inherit.aes = F) + labs(title=paste("linear regression model", indS,indT), color="product") +
# geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4, scale_colour_manual(labels = c("test","reference"), values=c("#C2173F","#4545BA")) +
# inherit.aes = F) + ylim(min(all_l2$readout),max(all_l2$readout)) +
# geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4, theme_bw()
# inherit.aes = F) + p2 <- p + geom_line(data=pl_df,aes(x=lnC,y=plotS),color="#4545BA",
# labs(title = paste("unrestricted linear regression model",indS,indT), color="product") + inherit.aes = F) +
# theme(legend.position="none", axis.text = element_text(size=14)) geom_line(data=pl_df,aes(x=lnC,y=plotT),color="#C2173F",
# p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), inherit.aes = F) +
# size=5,alpha=0.2), inherit.aes = FALSE) + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
# scale_shape_manual(labels=c("test","reference"), values=c(21,21)) inherit.aes = F) +
# geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
# mLin <- gsl_nls(readout ~ (intS+r)*isSample + intS*isRef + k*log_dose, inherit.aes = F) +
# data=circle, labs(title = paste("unrestricted linear regression model",indS,indT), color="product") +
# start=list(intS = 0, k=1,r=0), theme(legend.position="none", axis.text = element_text(size=14))
# control = gsl_nls_control(xtol=1e-10,ftol=1e-10,gtol=1e-10)) p3 <- p2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
# # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle) size=5,alpha=0.2), inherit.aes = FALSE) +
# sum_mLin <- summary(mLin) 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) 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)
# pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="blue", pl_rest <- data.frame(lnC=log(Conc), plotS=pl_restS, plotT=pl_restT)
# inherit.aes = F) +
# geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="red", pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="#4545BA",
# inherit.aes = F) + inherit.aes = F) +
# geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="red", linetype=2,alpha=0.4, geom_line(data=pl_rest,aes(x=lnC,y=plotT),color="#C2173F",
# inherit.aes = F) + inherit.aes = F) +
# geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="blue", linetype=2,alpha=0.4, geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=SAMPLEtrue),color="#C2173F", linetype=2,alpha=0.4,
# inherit.aes = F) + inherit.aes = F) +
# labs(title = paste("restricted linear regression model",indS,indT), color="product") + geom_line(data=data.frame(truePL_df),aes(x=seq_x,y=REFtrue),color="#4545BA", linetype=2,alpha=0.4,
# theme(legend.position="none", axis.text = element_text(size=14)) inherit.aes = F) +
# pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef), labs(title = paste("restricted linear regression model",indS,indT), color="product") +
# size=5,alpha=0.2), inherit.aes = FALSE) + theme(legend.position="none", axis.text = element_text(size=14))
# scale_shape_manual(labels=c("test","reference"), values=c(21,21)) pr3 <- pr2 + geom_point(circle, mapping=aes(x=log_dose, y=readout, shape=factor(isRef),
# grid.arrange(p3,pr3,nrow=1) 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)
}) })