lexibel wenn fehlende Werte
This commit is contained in:
+30
-23
@@ -711,9 +711,10 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
|
||||
all_l$isRef <- isRef
|
||||
all_l$isSample <- isSample
|
||||
all_l$Conc <- exp(all_l$log_dose)
|
||||
all_l <- all_l[complete.cases(all_l),]
|
||||
all_lA <- all_l[all_l$isSample == 1, ] # TEST
|
||||
all_lB <- all_l[all_l$isSample == 0, ] # REF
|
||||
# browser()
|
||||
#browser()
|
||||
circ_ABl <- circles
|
||||
circ_Al <- circ_ABl[circ_ABl$isSample == 1, ]
|
||||
circ_Bl <- circ_ABl[circ_ABl$isSample == 0, ]
|
||||
@@ -798,40 +799,40 @@ ANOVAlintests <- function(ro_new, circles, Lim, PureErrFlag) {
|
||||
}
|
||||
|
||||
# treatment
|
||||
SStreat <- print(sum((predict(lm(readout ~ factor(log_dose) * isSample, circ_ABl)) - mean(circ_ABl$readout))^2))
|
||||
SStreat <- print(sum((predict(lm(readout ~ factor(log_dose) * isSample, circ_ABl)) - mean(circ_ABl$readout, na.rm = T))^2, na.rm = T))
|
||||
F_treat <- (SStreat / dfTreat) / (SSRes / dfRes)
|
||||
# Preparation
|
||||
SSprep <- print(sum((predict(lm(readout ~ isSample, circ_ABl)) - mean(circ_ABl$readout))^2))
|
||||
SSprep <- print(sum((predict(lm(readout ~ isSample, circ_ABl)) - mean(circ_ABl$readout, na.rm = T))^2, na.rm = T))
|
||||
F_prep <- (SSprep / dfTreat) / (SSRes / dfRes)
|
||||
# Regression
|
||||
# ANOVA tape II SS of regression
|
||||
SSreg <- Anova(lm(readout ~ log_dose + isSample, circ_ABl))[1, 1]
|
||||
# Non-parallelism
|
||||
# diff of RSS of restricted and unrestricted model
|
||||
SSnonpar <- sum(resid(modAB)^2) - sum(resid(modABu)^2)
|
||||
F_nonpar <- SSnonpar / (sum(resid(lm(readout ~ factor(log_dose) * isSample, circ_ABl))^2) / (lenCirc - 4))
|
||||
SSnonpar <- sum(resid(modAB)^2, na.rm = T) - sum(resid(modABu)^2, na.rm = T)
|
||||
F_nonpar <- SSnonpar / (sum(resid(lm(readout ~ factor(log_dose) * isSample, circ_ABl))^2, na.rm = T) / (lenCirc - 4))
|
||||
|
||||
# non-linearity
|
||||
SSnonlin <- sum((predict(modABu) - predict(lm(readout ~ as.factor(log_dose) * isSample, circ_ABl)))^2)
|
||||
SSnonlin <- sum((predict(modABu) - predict(lm(readout ~ as.factor(log_dose) * isSample, circ_ABl)))^2, na.rm = T)
|
||||
# = RSS-SSE
|
||||
# Total SS
|
||||
SStot <- sum((circ_ABl$readout - mean(circ_ABl$readout))^2)
|
||||
SStot <- sum((circ_ABl$readout - mean(circ_ABl$readout, na.rm = T))^2, na.rm=T)
|
||||
# Significance of R^2 F-ratio
|
||||
# MSR/MSE
|
||||
# sample A
|
||||
F_R2_A <- sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Al)) - mean(predict(modA)))^2 - (predict(modA) - mean(circ_Al$readout))^2) /
|
||||
(sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Al)) - circ_Al$readout)^2) / (nrow(circ_Al) - 3))
|
||||
F_R2_A <- sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Al)) - mean(predict(modA), na.rm = T))^2 - (predict(modA) - mean(circ_Al$readout, na.rm = T))^2, na.rm = T) /
|
||||
(sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Al)) - circ_Al$readout)^2, na.rm = T) / (nrow(circ_Al) - 3))
|
||||
pFR2_A <- round(pf(F_R2_A, 1, 6), 4)
|
||||
# sample B
|
||||
F_R2_B <- sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Bl)) - mean(predict(modB)))^2 - (predict(modB) - mean(circ_Bl$readout))^2) /
|
||||
(sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Bl)) - circ_Bl$readout)^2) / (nrow(circ_Bl) - 3))
|
||||
F_R2_B <- sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Bl)) - mean(predict(modB), na.rm = T))^2 - (predict(modB) - mean(circ_Bl$readout))^2, na.rm = T) /
|
||||
(sum((predict(lm(readout ~ log_dose + I(log_dose^2), circ_Bl)) - circ_Bl$readout)^2, na.rm = T) / (nrow(circ_Bl) - 3))
|
||||
pFR2_B <- round(pf(F_R2_B, 1, 6), 4)
|
||||
# sign of non-lin with pure error: MSSnonlin/MSSE
|
||||
F_nonlin <- (SSnonlin / 2) / (SSE / dfPureE)
|
||||
|
||||
# sign of slope
|
||||
F_slope_B <- sum((predict(modB) - mean(circ_Bl$readout))^2) / (sum((circ_Bl$readout - predict(modB))^2) / (nrow(circ_Bl) - 2))
|
||||
F_slope_A <- sum((predict(modA) - mean(circ_Al$readout))^2) / (sum((circ_Al$readout - predict(modA))^2) / (nrow(circ_Al) - 2))
|
||||
F_slope_B <- sum((predict(modB) - mean(circ_Bl$readout, na.rm = T))^2) / (sum((circ_Bl$readout - predict(modB))^2, na.rm = T) / (nrow(circ_Bl) - 2))
|
||||
F_slope_A <- sum((predict(modA) - mean(circ_Al$readout, na.rm = T))^2) / (sum((circ_Al$readout - predict(modA))^2, na.rm = T) / (nrow(circ_Al) - 2))
|
||||
# F-test on regression: MSSreg/MSSE
|
||||
if (is.na(F_nonlin)) F_nonlin <- 0
|
||||
if (F_nonlin > 0) {
|
||||
@@ -1201,7 +1202,8 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
|
||||
all_l$isSample <- isSample
|
||||
all_l$Conc <- exp(all_l$log_dose)
|
||||
all_l$readout[all_l$readout < 0] <- 0.01
|
||||
# browser()
|
||||
all_l <- all_l[complete.cases(all_l),]
|
||||
#browser()
|
||||
FITs <- Fitting_FUNC(ro_new = ro_new, TransFlag = FALSE)
|
||||
if (is.character(FITs)) {
|
||||
return(FITs)
|
||||
@@ -1239,19 +1241,19 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
|
||||
noConc <- length(unique(all_l$Conc))
|
||||
nofitted <- noConc
|
||||
AnovaDFs <- c(nofitted - 1, 1, 3, nofitted - 4 - 1, nrow(all_l) - nofitted, nofitted, nrow(all_l) - 2 * nofitted, nrow(all_l) - 1)
|
||||
SStreat <- round(sum((predPotU - mean(all_l$readout))^2), 5)
|
||||
SSregr <- round(sum((predPot - mean(all_l$readout))^2), 5)
|
||||
SStreat <- round(sum((predPotU - mean(all_l$readout, na.rm = T))^2, na.rm = T), 5)
|
||||
SSregr <- round(sum((predPot - mean(all_l$readout, na.rm=T))^2, na.rm=T), 5)
|
||||
# non-parallelism
|
||||
SSnonparall <- round(sum(smr$residuals^2) - sum(smu$residuals^2), 5)
|
||||
SSprep <- round(sum((predict(lm(readout ~ isSample, all_l)) - mean(all_l$readout))^2), 5)
|
||||
|
||||
RSS <- round(sum(smu$residuals^2), 5)
|
||||
SSnonparall <- round(sum(smr$residuals^2, na.rm=T) - sum(smu$residuals^2, na.rm=T), 5)
|
||||
SSprep <- round(sum((predict(lm(readout ~ isSample, all_l)) - mean(all_l$readout, na.rm=T))^2, na.rm=T), 5)
|
||||
# browser()
|
||||
RSS <- round(sum(smu$residuals^2, na.rm=T), 5)
|
||||
RSS_df <- AnovaDFs[5]
|
||||
MSEunr <- RSS / RSS_df
|
||||
RMSEunr <- sqrt(RSS / RSS_df)
|
||||
# Pure Err
|
||||
FitAnova <- anova(lm(readout ~ factor(Conc) * isSample, all_l))
|
||||
SSE <- sum(resid(lm(readout ~ factor(Conc) * isSample, all_l))^2) # =FitAnova[4,2]
|
||||
SSE <- sum(resid(lm(readout ~ factor(Conc) * isSample, all_l))^2, na.rm=T) # =FitAnova[4,2]
|
||||
SSE_df <- FitAnova[4, 1]
|
||||
PureMSE <- SSE / SSE_df
|
||||
RMSE_pure <- sqrt(PureMSE)
|
||||
@@ -1276,7 +1278,7 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
|
||||
|
||||
test_a <- test_b <- test_d <- test_ad <- logical()
|
||||
|
||||
RSS_r <- round(sum(smr$residuals^2), 5)
|
||||
RSS_r <- round(sum(smr$residuals^2, na.rm=T), 5)
|
||||
MSE_r <- RSS_r / (nrow(all_l) - 5)
|
||||
RMSE_r <- round(sqrt(MSE_r), 6)
|
||||
DatL$RMSE_r <- RMSE_r
|
||||
@@ -1428,7 +1430,10 @@ tests_FUNC <- function(ro_new, Lim, PureErrFlag) {
|
||||
#' ANOVA4plUnresfunc(ro_new)
|
||||
#'
|
||||
ANOVA4plUnresfunc <- function(ro_new) {
|
||||
|
||||
all_l <- melt(data.frame(ro_new), id.vars = "log_dose", variable.name = "replname", value.name = "readout")
|
||||
|
||||
#browser()
|
||||
all_len <- nrow(all_l)
|
||||
isRef <- rep(c(1, 0), 1, each = all_len / 2)
|
||||
isSample <- rep(c(0, 1), 1, each = all_len / 2)
|
||||
@@ -1436,7 +1441,9 @@ ANOVA4plUnresfunc <- function(ro_new) {
|
||||
all_l$isSample <- isSample
|
||||
all_l$Conc <- exp(all_l$log_dose)
|
||||
all_l$readout[all_l$readout < 0] <- 0.01
|
||||
|
||||
all_l <- all_l[complete.cases(all_l),]
|
||||
|
||||
|
||||
FITs <- Fitting_FUNC(ro_new = ro_new, TransFlag = FALSE)
|
||||
smr <- FITs[[1]]
|
||||
smu <- FITs[[2]]
|
||||
|
||||
Reference in New Issue
Block a user