Skip to content
Snippets Groups Projects
Commit 49406701 authored by wactbprot's avatar wactbprot
Browse files

jeder SZ mit jedem SZ

parent 6b771a68
Branches
Tags
No related merge requests found
......@@ -70,26 +70,31 @@ ce3.calDeltaVDeltat <- function(ccc){
## sz-Drücke; die "Extrapolationslänge"
## wird so minimal.
## ------------------------------------##
out <- which(correlCoef < 0.95)
mt <- mt - min(mt)
ci <- mp - slope * mt
t0 <- (mean(mp) - ci) / slope
# if(length(out) > 0){
# t0[out] <- NA
# msg <- paste(msg
# , "exclude saw tooth:"
# , toString(out)
# , "because of bad (<0.95) correlation")
# }
nt <- length(t0)
deltat <- diff(t0) * tconv
t0 <- (mean(mp, na.rm =TRUE) - ci) / slope
out <- which(correlCoef < 0.98)
if(length(out) > 0){
t0[out] <- NA
msg <- paste(msg
, "exclude saw tooth:"
, toString(out)
, "because of bad (<0.98) correlation")
}
# deltat <- diff(t0) * tconv
deltat <- c((t0[5] - t0[4])/1,
(t0[5] - t0[3])/2,
(t0[5] - t0[2])/3,
(t0[5] - t0[1])/4,
(t0[4] - t0[3])/1,
(t0[4] - t0[2])/2,
(t0[4] - t0[1])/3,
(t0[3] - t0[2])/1,
(t0[3] - t0[1])/2,
(t0[2] - t0[1])/1) * tconv
## ------------------------------------##
## Güte des SZ: Steigung mp ~ mt möglichst klein
......@@ -114,9 +119,10 @@ ce3.calDeltaVDeltat <- function(ccc){
A <- (fn.Afit(cf,h[i2]) - fn.Afit(cf,h[i1]))/(h[i2] - h[i1])
deltaV <- A * (h[i2] - h[i1]) * vconv
## Leitwert = dV/dt *(1- m.D/m.SZ)
dVdt <- deltaV / deltat * (1 - dcorr[j])
L[j] <- mean(dVdt)
sdL[j] <- sd(dVdt)
dVdt <- mean(deltaV) / deltat * (1 - dcorr[j])
L[j] <- mean(dVdt, na.rm =TRUE)
sdL[j] <- sd(dVdt, na.rm =TRUE)
lL[j] <- length(dVdt)
## ------------------------------------##
}
......
......@@ -19,7 +19,6 @@ cuco.uncertDigit <- function(ccc){
m <- regexec("E[+-][0-9]*$",fp)
u <- as.numeric(paste(di,unlist(regmatches(fp, m)), sep=""))*0.29
ccc$Calibration$Analysis$Values$Uncertainty <-
setCcl(ccc$Calibration$Analysis$Values$Uncertainty,
......
......@@ -7,7 +7,7 @@ resError <- function(ccc){
p.target <- as.numeric(a$cpt$Values$Pressure$Value)
maxdev <- as.numeric(a$cpt$MaxDev)
k <- 2 # Erweiterungsfaktor
maxdev <- 0.25
maxdev <- 0.1
##-------------##
## pcal
##-------------##
......@@ -84,20 +84,23 @@ resError <- function(ccc){
## bei dem e.delta kleiner als 3-sigma ist
## wobei e.delte die Abweichung vom Reverenzwert ist
e.delta <- abs(result[i.take] - revV)
i.out <- which(e.delta > mean(ut[i.take])/k*3)
i.out <- which(e.delta > mean(ut[i.take], na.rm = TRUE)/k*3)
print("öööÖÖÖÖÖÖÖÖÖ")
print(i)
print(e.delta)
print( i.out)
if(length(i.out) > 0){
i.take <- i.take[-i.out]
msg <- paste(msg, "from these I skip the points: ",
toString(i.take[i.out]))
}
}
td.pcal[i] <- unlist(mean(pcal[i.take]))
td.ut[i] <- unlist(mean(ut[i.take]))
td.result[i] <- unlist(mean(result[i.take]))
td.pind[i] <- unlist(mean(pind[i.take]))
td.pindoffs[i] <- unlist(mean(pindoffs[i.take]))
td.pindcorr[i] <- unlist(mean(pindcorr[i.take]))
td.pcal[i] <- unlist(mean(pcal[i.take], na.rm = TRUE))
td.ut[i] <- unlist(mean(ut[i.take], na.rm = TRUE))
td.result[i] <- unlist(mean(result[i.take], na.rm = TRUE))
td.pind[i] <- unlist(mean(pind[i.take], na.rm = TRUE))
td.pindoffs[i] <- unlist(mean(pindoffs[i.take], na.rm = TRUE))
td.pindcorr[i] <- unlist(mean(pindcorr[i.take], na.rm = TRUE))
} #for
PCAL$Value <- formatC(td.pcal, digits=3, format="E")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment