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

Bug fix für linear reg bei XL upload

Browse Source
This commit is contained in:
Franz Innerbichler
2026-05-10 11:40:46 +02:00
parent 7250a00adc
commit bc678b2525
2 changed files with 20 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+4
View File
@@ -0,0 +1,4 @@
.Rproj.user
.Rhistory
.RData
.Ruserdata
app.R
+16 -15
View File
@@ -2164,7 +2164,8 @@ server <- function(input, output, session) {
# tab <- sim2() # tab <- sim2()
if (is.character(tab)) stop(tab) if (is.character(tab)) stop(tab)
browser() #browser()
log_conc <- tab$log_dose
noDilSer = (ncol(tab)-1)/2 noDilSer = (ncol(tab)-1)/2
noDil <- nrow(tab) noDil <- nrow(tab)
Conctab <- perConcTab(tab, noDilSer) Conctab <- perConcTab(tab, noDilSer)
@@ -2173,11 +2174,11 @@ server <- function(input, output, session) {
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
} }
@@ -2185,9 +2186,9 @@ server <- function(input, output, session) {
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)
@@ -2240,9 +2241,9 @@ server <- function(input, output, session) {
# fit intercept for test and ref and common slope # fit intercept for test and ref and common slope
pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log(Conc) 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_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_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", pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="#4545BA",
inherit.aes = F) + inherit.aes = F) +
@@ -2285,9 +2286,9 @@ server <- function(input, output, session) {
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)
@@ -2338,9 +2339,9 @@ server <- function(input, output, session) {
# alternativ: modAB <- lm(readout ~ log_dose+isSample, circle) # alternativ: modAB <- lm(readout ~ log_dose+isSample, circle)
sum_mLin <- summary(mLin) sum_mLin <- summary(mLin)
pl_restS <- sum_mLin$coefficients[1,1] + sum_mLin$coefficients[2,1]*log(Conc) 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_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_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", pr2 <- p + geom_line(data=pl_rest,aes(x=lnC,y=plotS),color="blue",
inherit.aes = F) + inherit.aes = F) +