eisr: eisR - Fitting EIS

# FUNCIONES CON NÚMEROS COMPLEJOS The functions Re, Im, Mod, Arg and Conj have their usual interpretation
# as returning the real part, imaginary part, modulus, argument and complex conjugate for complex values.
# The modulus and argument are also called the polar coordinates. If z = x + i y with real x and y, for r
# = Mod(z) = √(x^2 + y^2), and φ = Arg(z), x = r*cos(φ) and y = r*sin(φ).



j <- (0 + (0+1i))  # unidad compleja imaginaria

# Impedancia de un capacitor
zc <- function(f, c) {
    -j/(2 * pi * f * c)  # o 1/(j*2*pi*f*c)
}

# Impedancia de un inductor
zl <- function(f, l) {
    j * 2 * pi * f * l
}

# Impedancia Warburg
zw <- function(f, Yo) {
    1/(sqrt(j * 2 * pi * f) * Yo)
}

# Impedancia CPE -Elemento de fase constante Q
zq <- function(f, Yo, n) {
    (jω)^(-n)/Yo  # o 1/(((j*2*pi*f)^n)*Yo)
}

# Impedancia FSW - Finite length diffusion elements.  The FSW (Finite Space Warburg) T
zt <- function(f, Yo, B) {
    omega <- 2 * pi * f
    argu <- B * sqrt(j * omega)
    (cosh(argu))/sinh(argu)/Yo * sqrt(j * omega)
}

# Impedancia FLW - Finite length diffusion elements.  The FLW (Finite Length Warburg) O
zo <- function(f, Yo, B) {
    omega <- 2 * pi * f
    argu <- B * sqrt(j * omega)
    tanh(argu)/Yo * sqrt(j * omega)
}

# Impedancia Gerisher G.
zg <- function(f, Yo, k) {
    omega <- 2 * pi * f
    (k + j * omega)^(-0.5)/Yo
}

# Impedancia Gerisher Fractal F.
zf <- function(f, Yo, k, alfa) {
    omega <- 2 * pi * f
    (k + j * omega)^(alfa)/Yo
}

## Calcula la impedancia de n elementos en paralelo Recibe una lista y determina que impedancia usar en
## base al nombre de cada parametro.  OJO!!! los parametros deben empezar con las letras del CDC zpar <-
## function(frec,E1,E2) { if (is.complex(E1)) { E1 ## Recursion } else { if (is.complex(E2)) { E2 ##
## Recursion } else { switch(substr(names(E1[1]),1,1), R = E1 , ## no hace nada es una resistencia..  C =
## E1[[1]] <- zc(frec, E1[[1]]), ## calcula impedancia condensador L = E1[[1]] <- zl(frec, E1[[1]]), ##
## calcula impedancia bobina W = E1[[1]] <- zw(frec, E1[[1]]), ## calcula impedancia Warburg Q = E1[[1]] <-
## zq(frec, E1[[1]], lista_imp[[i+1]]), ## calcula impedancia CPE n = E1[[1]] <- next(), ## exponente CPE
## no hace nada T = E1[[1]] <- zt(frec, E1[[1]], lista_imp[[i+1]]), ## calcula impedancia FSW B = E1[[1]]
## <- next(), ## parametro de FSW, no hace nada..  O = E1[[1]] <- zo(frec, E1[[1]], lista_imp[[i+1]]), ##
## calcula impedancia FLW B = E1[[1]] <- next(), ## parametro de FLW, no hace nada..  G = E1[[1]] <-
## zg(frec, E1[[1]], lista_imp[[i+1]]), ## calcula impedancia Gerisher k = E1[[1]] <- next(), ## parametro
## de G, no hace nada..  F = E1[[1]] <- zgf(frec, E1[[1]], lista_imp[[i+1]], lista_imp[[i+2]]), ## calcula
## impedancia Gerisher fractal k = E1[[1]] <- next(), ## parametro de F, no hace nada..  a = E1[[1]] <-
## next() ## parametro de F, no hace nada..  ) switch(substr(names(E2[1]),1,1), R = E2, ## no hace nada es
## una resistencia..  C = E2[[1]] <- zc(frec, E2[[1]]), ## calcula impedancia condensador L = E2[[1]] <-
## zl(frec, E2[[1]]), ## calcula impedancia bobina W = E2[[1]] <- zw(frec, E2[[1]]), ## calcula impedancia
## Warburg Q = E2[[1]] <- zq(frec, E2[[1]], lista_imp[[i+1]]), ## calcula impedancia CPE n = E2[[1]] <-
## next(), ## exponente CPE no hace nada T = E2[[1]] <- zt(frec, E2[[1]], lista_imp[[i+1]]), ## calcula
## impedancia FSW B = E2[[1]] <- next(), ## parametro de FSW, no hace nada..  O = E2[[1]] <- zo(frec,
## E2[[1]], lista_imp[[i+1]]), ## calcula impedancia FLW B = E2[[1]] <- next(), ## parametro de FLW, no
## hace nada..  G = E2[[1]] <- zg(frec, E2[[1]], lista_imp[[i+1]]), ## calcula impedancia Gerisher k =
## E2[[1]] <- next(), ## parametro de G, no hace nada..  F = E2[[1]] <- zgf(frec, E2[[1]],
## lista_imp[[i+1]], lista_imp[[i+2]]), ## calcula impedancia Gerisher fractal k = E2[[1]] <- next(), ##
## parametro de F, no hace nada..  a = E2[[1]] <- next() ## parametro de F, no hace nada..  )
## E1[[1]]*E2[[1]]/E1[[1]]+E2[[1]] } }}

################################ LEE models.fit #####################################
leeModelo <- function(arch = "models.fit") {
    readModels.fit <- function() {
        conection <- file(arch)
        filas <- readLines(conection, warn = FALSE)
        ## si comienzan con # descarto
        filas <- filas[-grep("^#", filas)]
        close(conection)
        filas
    }
    filas <- readModels.fit()
    colMax <- max(nchar(filas))
    filMax <- length(filas)
    matriz <- matrix(nrow = filMax, ncol = colMax)
    for (i in 1:filMax) {
        for (j in 1:colMax) {
            matriz[i, j] <- substr(filas[i], j, j)
        }
    }  ## hasta aca esta armada la matriz sin unir caracteres
    ## Ahora intento unir caracteres
    cheqLetra <- function(cad) {
        carNoElem <- c(" ", "|", "-", "")  # caracteres de espacio, conectores  y union paralelo
        !is.element(cad, carNoElem)
    }
    ant <- FALSE
    for (i in 1:filMax) {
        for (j in 1:colMax) {
            if (cheqLetra(matriz[i, j])) {
                if (ant) {
                  matriz[i, pos] <- paste(matriz[i, pos], matriz[i, j], sep = "")
                  matriz[i, j] <- "-"
                } else {
                  pos <- j
                  ant <- TRUE
                }
            } else ant <- FALSE

        }  # end for j
    }  # end for i
    return(matriz)
}

## Genera barrido de frecuencias
sweep <- function(fi, ff, step) {
    ## fi: frecuencia inicial ff: frecuencia final step: muestras por decada TO DO: falta modo lineal y
    ## paso/octava
    return(c(10^(seq(log10(fi), log10(ff), by = -(step/100))), ff))
}


# ################ aca terminan las funciones #####################3 Rs <- 150 param <-
# list(Rp=1350,Cdl=3e-6, W=0.003) frec <- sweep(65535,0.00005, 10) datos_sinteticos <- Rs + zpar(frec,
# param) nyquist_and_bode(frec, datos_sinteticos) nyquist(frec, datos_sinteticos) bode(frec,
# datos_sinteticos) ############################################################# ## Cargo datos celda
# fantasma library(readr) fantasma <- read_csv('fantasma.z', col_names = FALSE, skip = 11) # Separate the
# data into f, zr, and zi frec <- fantasma$X1 # Complex impedance data list impedancia <- fantasma$X5 +
# 1i*fantasma$X6 nyquist_and_bode(frec, impedancia) ### simulo y ajusto ## Rango de frecuencias sobre los
# que voy a simular los datos frec <- sweep(65535,0.05, 10) # Modelo Randles , basado en una lista de
# parámetros # los params son: Rs - Rp - Cdl -Rpo -W f_transfer <- function(param, frec) { param[[1]] +
# zpar(frec, param[2], zpar(frec,param[3], param[4])) } ## parametros usados para simular los datos... los
# que queremos hallar param <- list(Cs=516, Cp=6e-5, C=3e-9, C=1534) ## simulated data, with noise
# set.seed(22) #Calculo la funcion de transferencia y le agrego ruido simRuido <- f_transfer(param,frec) +
# rnorm(length(frec),sd=0.1) ## plot data bode(frec,Mod(simRuido)) nyquist(frec,simRuido) ## residual
# function residFun <- function(par, experimental, xx) { errz <- experimental - f_transfer(par,xx) err =
# c(Re(errz), Im(errz)) return (err) } ## starting values for parameters guess <- list(CRs=2000, Cp=2e-5,
# C=1e-9, C=2000) ### valores originales ) ## param <- list(Rs=350,Rp=2000, F=3e-3, k=0.5, alfa=0.3) ##
# perform fit nls.out <- nls.lm(par=guess, fn = residFun, experimental = simRuido, xx = frec, control =
# nls.lm.control(nprint=1)) ## plot model evaluated at final parameter estimates
# plot(frec,Mod(f_transfer(as.list(coef(nls.out)), frec)), col=2, type='l', log='x') ## summary
# information on parameter estimates parteReal <- Re(simRuido) parteImag <- Im(simRuido) Real_calcul <-
# Re(f_transfer(as.list(coef(nls.out)), frec)) Imag_calcul <- Im(f_transfer(as.list(coef(nls.out)), frec))
# nyquist(frec, f_transfer(param, frec)) lines(Real_calcul, -Imag_calcul, col='red') summary(nls.out)