Propósito

Corroborar medidas tomadas con Truscan

Leer datos de truscan

truscan_files <- list.files(path = "./data/raw/truscan", pattern = "\\.E0",
    full.names = TRUE)

data_list <- lapply(truscan_files, function(x) {

    dat <- read.table(x, header = FALSE, sep = " ", dec = ",", skip = 2)

    full_dat <- read.table(gsub("E0", "R0", x), header = TRUE, sep = " ",
        dec = ",", skip = 1)

    col_names <- read.table(x, header = FALSE, sep = " ", dec = ",",
        skip = 1, nrows = 1)

    col_dat <- col_names[1, , drop = TRUE]
    col_dat <- col_dat[!is.na(col_dat) & !col_dat %in% c("-", "VP")]
    col_dat[col_dat == "MOVES"] <- "VP_MOVES"

    colnames(dat) <- col_dat

    dat$file <- basename(x)
    dat$nrow <- nrow(full_dat)
    dat$max.points <- max(full_dat$Point)
    dat$max.dist <- max(dat$FP_DISTANCE[dat$Point %in% 1:5])
    dat$total.dist <- dat$FP_DISTANCE[dat$Point %in% "totals"]

    dat

    return(dat)
})


# merge data with different columns
cnms <- unique(unlist(lapply(data_list, names)))

data_list2 <- lapply(data_list, function(X) {
    nms <- names(X)
    if (length(nms) != length(cnms))
        for (i in cnms[!cnms %in% nms]) {
            X <- data.frame(X, NA, stringsAsFactors = FALSE, check.names = FALSE)
            names(X)[ncol(X)] <- i
        }
    return(X)
})

truscan_data <- do.call("rbind", data_list2)

# remove other columns
truscan_data <- truscan_data[, sapply(truscan_data, function(x) sum(is.na(x))/nrow(truscan_data)) ==
    0]

# keep only first 5 min
truscan_data <- truscan_data[truscan_data$Point %in% 1:5, ]

# experiment label
truscan_data$experiment <- gsub("\\.E01|\\.E02", "", truscan_data$file)

truscan_data$total_distance <- truscan_data$FP_DISTANCE

# + truscan_data$MARGIN_DISTANCE + truscan_data$CENTER_DISTANCE
# + truscan_data$VP_DISTANCE

# truscan_data$total_distance <- truscan_data$MARGIN_DISTANCE +
# truscan_data$CENTER_DISTANCE

truscan_data$min <- as.character(truscan_data$Point)

Leer datos de anymaze

anymz_data <- read.csv("./data/raw/anymaze/Resultados Recorido por minuto.csv")

anymz_data$experiment <- gsub("aro|aros", "A", anymz_data$Animal)
names(anymz_data)[6:10] <- paste0("min", 1:5)

anymz_data$experiment <- as.character(anymz_data$experiment)

anymz_data$experiment[anymz_data$experiment == "TS-S1-4A"] <- "TS-S1-3A"
anymz_data$experiment[anymz_data$experiment == "TS-S3-1A"] <- "TS-S3-2A"


anymz_data <- data.frame(xtabs(cbind(min1, min2, min3, min4, min5) ~
    experiment, anymz_data))

anymz_data <- anymz_data[order(anymz_data$experiment, anymz_data$Var2),
    ]

anymz_data$min <- gsub("min", "", anymz_data$Var2)

names(anymz_data)[3] <- "ANMZ_distance"


anymz_data$TRSC_distance <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$total_distance[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

anymz_data$file <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$file[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})


anymz_data$filas <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$nrow[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

anymz_data$maximo_muestras <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$max.points[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

anymz_data$maximo_distancia <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$max.dist[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

anymz_data$distancia_total <- sapply(1:nrow(anymz_data), function(x) {

    dists <- truscan_data$total.dist[truscan_data$min == anymz_data$min[x] &
        truscan_data$experiment == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

Leer datos solomon

Cruces de cuadrante leidos a mano

slm_files <- list.files(path = "./data/raw/solomon_2nd", pattern = "xlsx$",
    full.names = TRUE)

out <- lapply(slm_files, function(x) {
    # print(x)
    a <- as.data.frame(read_excel(x, sheet = "SPSS", skip = 17))
    a <- a[1:2, 2:ncol(a)]
    a <- a[, a[1, ] == "F"]

    df <- data.frame(Experimento = gsub("macro| |\\.xlsx", "", basename(x)),
        min = colnames(a), cruces = as.numeric(unlist(a[2, , drop = TRUE])))[1:5,
        ]

    return(df)
})


slmn_data_cruces <- do.call(rbind, out)

slmn_data_cruces$Experimento <- gsub("aro|aros", "A", slmn_data_cruces$Experimento)

slmn_data_cruces$Experimento[slmn_data_cruces$Experimento == "TS-S1-4A"] <- "TS-S1-3A"
slmn_data_cruces$Experimento[slmn_data_cruces$Experimento == "TS-S3-1A"] <- "TS-S3-2A"


write.csv(slmn_data_cruces, "./data/processed/slmn_data_cruces.csv",
    row.names = FALSE)

slmn_data_cruces <- read.csv("./data/processed/slmn_data_cruces.csv")

anymz_data$SLM_distance <- sapply(1:nrow(anymz_data), function(x) {

    dists <- slmn_data_cruces$cruces[slmn_data_cruces$min == anymz_data$min[x] &
        slmn_data_cruces$Experimento == anymz_data$experiment[x]]

    if (length(dists) == 0)
        dists <- NA

    return(dists)
})

Explorar datos

Todos juntos

Anymaze vs Truscan

ggplot(anymz_data, aes(y = TRSC_distance, x = ANMZ_distance)) + geom_point() +
    geom_smooth(method = "lm", se = FALSE) + labs(x = "Distancia del Anymaze",
    y = "Distancia del Truscan") + theme_classic()

print("correlacion:")

## [1] "correlacion:"

cor(anymz_data$TRSC_distance, anymz_data$ANMZ_distance, use = "pairwise.complete.obs")

## [1] 0.3081292

Anymaze vs Solomon

ggplot(anymz_data, aes(y = TRSC_distance, x = SLM_distance)) + geom_point() +
    geom_smooth(method = "lm", se = FALSE) + labs(x = "Distancia del Anymaze",
    y = "Distancia del Solomon") + theme_classic()

print("correlacion:")

## [1] "correlacion:"

cor(anymz_data$TRSC_distance, anymz_data$SLM_distance, use = "pairwise.complete.obs")

## [1] 0.3965539

Correlaciones por experimento

# normalize within experiment
cors <- lapply(unique(anymz_data$experiment), function(x) {

    X <- anymz_data[anymz_data$experiment == x, ]

    cr <- cor(X$ANMZ_distance, X$TRSC_distance)
    cr2 <- cor(X$ANMZ_distance, X$SLM_distance)
    cr3 <- cor(X$TRSC_distance, X$SLM_distance)

    df <- data.frame(Experimento = as.character(x), Correlacion.ANMZ.TRSC = cr,
        Correlacion.ANMZ.SLM = cr2, Correlacion.TRSC.SLM = cr3, archivo = X$file[1],
        filas = X$filas[1], muestras = X$maximo_muestras[1], distancia_total = X$distancia_total[1],
        maxima_distancia = X$maximo_distancia[1], stringsAsFactors = FALSE)

    return(df)
})


df <- do.call(rbind, cors)

df$Sesion <- as.numeric(gsub("S", "", sapply(df$Experimento, function(x) strsplit(x,
    "-")[[1]][2])))

df$Rata <- gsub("A", " aros", sapply(df$Experimento, function(x) strsplit(x,
    "-")[[1]][3]))

df$Rata <- gsub("1 aros", "1 aro", df$Rata)

# anadir metadatos
metadata <- as.data.frame(read_excel("./data/raw/metadatos_sesiones.xlsx"))


df$fecha <- sapply(1:nrow(df), function(x) {

    metadata$fecha[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$Arena <- sapply(1:nrow(df), function(x) {

    metadata$arena[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$`Aros (abajo, arriba)` <- sapply(1:nrow(df), function(x) {

    metadata$`aros (abajo, arriba)`[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$`Caja linc` <- sapply(1:nrow(df), function(x) {

    metadata$`caja linc`[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$Burucha <- sapply(1:nrow(df), function(x) {

    metadata$burucha[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$Burucha <- ifelse(df$Burucha == "no", "no", "si")

df$`Altura aro vertical` <- sapply(1:nrow(df), function(x) {

    metadata$`altura aro vertical`[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})


df$`Altura aro suelo` <- sapply(1:nrow(df), function(x) {

    metadata$`altura aro suelo`[gsub("\\.E01|\\.E02", "", metadata$`archivo resumen`) ==
        df$Experimento[x]][1]

})

df$fecha <- gsub("-2022", "", df$fecha)

df$Correlacion.ANMZ.TRSC <- round(df$Correlacion.ANMZ.TRSC, 2)
df$Correlacion.ANMZ.SLM <- round(df$Correlacion.ANMZ.SLM, 2)
df$Correlacion.TRSC.SLM <- round(df$Correlacion.TRSC.SLM, 2)

df <- df[order(df$Correlacion.ANMZ.TRSC, decreasing = TRUE), ]

# print dynamic table
datatable(df, editable = list(target = "row"), rownames = FALSE, style = "bootstrap",
    filter = "top", options = list(pageLength = 100, autoWidth = TRUE,
        dom = "ft"), autoHideNavigation = TRUE, escape = FALSE)

Por experimento:

ggplot(anymz_data[!is.na(anymz_data$TRSC_distance), ], aes(y = TRSC_distance,
    x = ANMZ_distance)) + geom_point() + geom_smooth(method = "lm",
    se = FALSE) + labs(x = "Distancia del Anymaze", y = "Distancia del Truscan") +
    theme_classic() + facet_wrap(~experiment, ncol = 2, scales = "free")

Explorar rearings

slm_files <- list.files(path = "./data/raw/solomon", pattern = "xlsx$",
    full.names = TRUE)

out <- lapply(slm_files, function(x) {

    a <- as.data.frame(read_excel(x, sheet = "SPSS", skip = 2))
    a <- a[1:2, 2:ncol(a)]
    a <- a[, a[1, ] == "F"]

    df <- data.frame(Experimento = gsub("macro| |\\.xlsx", "", basename(x)),
        min = colnames(a), rearings = as.numeric(unlist(a[2, , drop = TRUE])))[1:5,
        ]

    return(df)
})


slmn_data <- do.call(rbind, out)

slmn_data$Experimento <- gsub("aro|aros", "A", slmn_data$Experimento)

# leer datos truscan
truscan_files <- list.files(path = "./data/raw/truscan", pattern = "\\.R0",
    full.names = TRUE)

rear_data_list <- lapply(truscan_files, function(x) {
    # print(x)

    dat <- read.table(x, header = TRUE, sep = " ", dec = ",", skip = 1)

    # primeros 300 segundos
    if (nrow(dat) > 300)
        dat <- dat[1:300, ]

    dat$min <- as.numeric(cut(1:nrow(dat), breaks = seq(0, 300, 60)))

    rearings <- sapply(unique(dat$min), function(y) {

        X <- dat[dat$min == y, ]
        X$rear <- ifelse(X$Jump == "False", FALSE, TRUE)
        X$rear.num <- as.numeric(X$rear)

        for (i in nrow(X):2) if (X$rear.num[i] == 1)
            if (X$rear.num[i - 1] == 1)
                X$rear.num[i] <- 0

        return(sum(X$rear.num))
    })

    rear_df <- data.frame(Experimento = gsub("\\.R01|\\.R02", "",
        basename(x)), min = unique(dat$min), rearings = rearings,
        max = dat$Point[nrow(dat)])

    return(rear_df)
})


ts_rearing_data <- do.call(rbind, rear_data_list)


ts_rearing_data$slmn_rearing <- sapply(1:nrow(ts_rearing_data), function(w) {

    rear <- slmn_data$rearings[slmn_data$Experimento == ts_rearing_data$Experimento[w] &
        slmn_data$min == ts_rearing_data$min[w]]

    if (length(rear) == 0)
        rear <- NA

    return(rear)
})

write.csv(ts_rearing_data, "./data/processed/rearing_data_pooled.csv",
    row.names = FALSE)

‘Rearings’ detectados con Solomon vs ‘rearings’ detectados con el Truscan:

ts_rearing_data <- read.csv("./data/processed/rearing_data_pooled.csv")


ts_rearing_data <- ts_rearing_data[!is.na(ts_rearing_data$slmn_rearing),
    ]

ggplot(ts_rearing_data, aes(y = rearings, x = slmn_rearing)) + geom_point() +
    geom_smooth(method = "lm", se = FALSE) + labs(x = "Rearings del Solomon",
    y = "Rearings del Truscan") + theme_classic()

print("correlacion:")

## [1] "correlacion:"

cor(ts_rearing_data$rearings, ts_rearing_data$slmn_rearing, use = "pairwise.complete.obs")

## [1] -0.106351

Resumen

Resultados

Session information

## R version 4.2.0 (2022-04-22)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 22.04.1 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=es_CR.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=es_CR.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=es_CR.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=es_CR.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] DT_0.22           readxl_1.4.0      ggplot2_3.3.6     knitr_1.39       
## [5] kableExtra_1.3.4  klippy_0.0.0.9500
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.1.2  xfun_0.32         bslib_0.3.1       purrr_0.3.4      
##  [5] lattice_0.20-45   splines_4.2.0     colorspace_2.0-3  vctrs_0.4.1      
##  [9] generics_0.1.2    htmltools_0.5.3   viridisLite_0.4.0 yaml_2.3.5       
## [13] mgcv_1.8-40       utf8_1.2.2        rlang_1.0.4       jquerylib_0.1.4  
## [17] pillar_1.8.0      glue_1.6.2        withr_2.5.0       DBI_1.1.2        
## [21] lifecycle_1.0.1   stringr_1.4.0     munsell_0.5.0     gtable_0.3.0     
## [25] cellranger_1.1.0  rvest_1.0.2       htmlwidgets_1.5.4 evaluate_0.16    
## [29] labeling_0.4.2    fastmap_1.1.0     crosstalk_1.2.0   fansi_1.0.3      
## [33] highr_0.9         scales_1.2.0      formatR_1.12      webshot_0.5.3    
## [37] jsonlite_1.8.0    farver_2.1.1      systemfonts_1.0.4 digest_0.6.29    
## [41] stringi_1.7.8     dplyr_1.0.9       grid_4.2.0        cli_3.3.0        
## [45] tools_4.2.0       magrittr_2.0.3    sass_0.4.1        tibble_3.1.8     
## [49] pkgconfig_2.0.3   Matrix_1.4-1      xml2_1.3.3        assertthat_0.2.1 
## [53] rmarkdown_2.14    svglite_2.1.0     httr_1.4.3        rstudioapi_0.13  
## [57] R6_2.5.1          nlme_3.1-157      compiler_4.2.0

Comparar Truscan con otros métodos

Truscan
Centro de Investigación en Neurociencias

Marcelo Araya-Salas

“2022-09-14”

Propósito

Leer datos de truscan

Leer datos de anymaze

Leer datos solomon

Explorar datos

Todos juntos

Correlaciones por experimento

Explorar rearings

Resumen

Resultados

Comparar Truscan con otros métodos

Truscan Centro de Investigación en Neurociencias

Marcelo Araya-Salas

“2022-09-14”

Propósito

Leer datos de truscan

Leer datos de anymaze

Leer datos solomon

Explorar datos

Todos juntos

Correlaciones por experimento

Explorar rearings

Resumen

Resultados

Truscan
Centro de Investigación en Neurociencias