library(stringr)
library(readr)
library(dplyr)
library(data.table)
library(readxl)
library(tidyr)
library(fuzzyjoin)
library(xfun)
library(purrr)
library(knitr)
library(reactable)
library(plotly)
library(ggplot2)Análise artigo 1 - Evidências de validade iniciais da TASComp
Dados individuos grupo controle
Foram analisadas a acurácia e o tempo médio de resposta por cada participante em cada tipo de sentença, e agrupado por cada tipo de sentença considerando a amostra total
Neste arquivo será apresentado o passo a passo do código para leitura dos dados
Carregando pacotes
.libPaths()[1] "C:/Users/carol/AppData/Local/R/win-library/4.4"
[2] "C:/Program Files/R/R-4.4.2/library" Selecionando o diretório
Selecionar o diretório para “puxar” os dados da pasta
Os arquivos do Psytoolkit são salvos separadamente, por participante - e também separados em arquivos de experimento e arquivos de eperimento
Unindo os arquivos separados em um dataframe
Juntando os arquivos do psytookit em um mesmo dataframe
100 participantes saudáveis – sem comprometimento cognitivo autorrelatado
dadossaudaveis <- list.files(full.names = FALSE, pattern = "\\.txt$") %>%# organiza arquivos da pasta
sapply(., read_table, col_names = FALSE , simplify = F) %>%
# faz a leitura dos arquivos e transforma em lista
rbindlist(., use.names = TRUE, idcol = "id", fill= TRUE) %>%
# transforma a variavel em um data frame e cria uma coluna com o nome do arquivo de origem
mutate(id = str_sub(id, end = -5)) # para tirar os textos "a mais"
names(dadossaudaveis)=c("ID", "exp","questao" ,"tipo", "condicao","RT", "pontuacao", "tempo", "acerto", "resposta") #renomeia o nome de cada coluna do data frame
# Count the number of unique IDs
num_unique_IDs <- length(unique(dadossaudaveis$ID))
# Print the result
num_unique_IDs[1] 101- Salvando data frame em um arquivo csv - corrigir pontuações erradas do script primeiramente para depois calcular os acertos no teste
write.csv(dadossaudaveis, "banco_101part.csv")- Nesse primeiro momento o tempo não será calculado, aqui estará calculada as respostas corretas
- Primeiramente carregando o banco do experimento já corrigido respostas corretas e incorretas
bloco_101 <- read.csv("banco101_correct.csv", sep= ";")Calculando a porcentagem de acertos
acerto_bl - porcentagem de acertos por participante em cada condição
cond_percent - porcentagem de acertos por condição
acerto_part -porcentagem de acertos em cada participante
# Percent correct by ID and condition
acerto_bl <- bloco_101 %>%
group_by(ID, condicao) %>%
summarise(percent = round(sum(acerto == "Correto") * 100 / n(), 2))
# Percent correct by condition
cond_percent <- bloco_101 %>%
group_by(condicao) %>%
summarise(percent = round(sum(acerto == "Correto") * 100 / n(), 2))
# Percent correct by participant (ID)
acerto_part <- bloco_101 %>%
group_by(ID) %>%
summarise(percent = round(sum(acerto == "Correto") * 100 / n(), 2))
# percent para tipo de sentença
acerto_tipo <- bloco_101 %>%
group_by(tipo) %>%
summarise(percent = round(sum(acerto == "Correto") * 100 / n(), 2))Arquivos
O arquivo dados saudaveis contém todas as respostas de todos os participantes
O arquivo final_dados já agrupa o tempo e os acertos por condição, em cada participante - assim como define a acurácia em porcentagem
Cálculo do tempo de resposta
- Não estamos calculando o tempo
#remover outliers +- 2dp
#dados <- subset(filtro,filtro$RT > mean(filtro$RT, na.rm = TRUE) -
#2*sd(filtro$RT, na.rm = TRUE) &
#filtro$RT < mean(filtro$RT, na.rm = TRUE) +
#2*sd(filtro$RT, na.rm = TRUE))
#filtro <- dadospiloto %>% filter(ID != "", Status == "Correto",
#Block != "training")Tabela - porcentagem de acertos em cada bloco e em cada participante
Gráfico ggplot
- Gráfico da porcentragem de erros por item
library(dplyr)
corretos_sum <- bloco_101 %>%
group_by(questao) %>%
summarise(total_corretos = sum(pontuacao, na.rm = TRUE))
corretos_pct <- bloco_101 %>%
group_by(questao) %>%
summarise(percent_corretos = sum(pontuacao, na.rm = TRUE) / 100 * 100)
library(ggplot2)
ggplot(corretos_pct, aes(x = reorder(questao, -percent_corretos), y = percent_corretos)) +
geom_bar(stat = "identity", fill = "#2E86AB") +
labs(
title = "N de acertos por item",
x = "Item",
y = "Número de acertos por item"
) +
theme_minimal()
library(plotly)
fig <- plot_ly(corretos_pct,
x = ~questao,
y = ~percent_corretos,
type = "bar"
)
figreactable(corretos_sum)
graph_lines <- ggplot(corretos_pct, aes(x = reorder(questao, percent_corretos), y = percent_corretos, color = questao, group = 1)) +
geom_line(size = 1) +
geom_point(size = 3) +
coord_flip() + # horizontal orientation
scale_y_continuous(limits = c(70, 100), breaks = seq(70, 100, 0.5)) +
labs(
title = "Porcentagem de respostas corretas por item",
x = "Item",
y = "Porcentagem de respostas corretas (%)"
) +
theme_minimal() +
theme(
axis.line = element_blank(), # remove all axis lines
axis.ticks = element_blank(), # remove all axis ticks
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 8), # increase y-axis labels
axis.text.x = element_text(size = 10), # increase x-axis labels
axis.title.x = element_text(size = 12), # x-axis title
axis.title.y = element_text(size = 12), # y-axis title
plot.title = element_text(size = 14, face = "bold")
)
ggsave("percent_correct_items.jpg", width = 18, height = 20, units = "in", dpi = 500)
fig <- ggplotly(graph_lines)
figcorretos_part <-bloco_101 %>%
filter(tipo != "treino") %>% # exclude treino items
group_by(ID) %>%
summarise(perct_part = sum(pontuacao, na.rm = TRUE / 48 * 100))
corretos_part$perct_part <- as.numeric(corretos_part$perct_part)
library(dplyr)
library(ggplot2)
library(plotly)
# (Assumindo que 'bloco_100' existe)
# (Usando dados fictícios se 'bloco_100' não existir para este exemplo)
if (!exists("bloco_101")) {
bloco_100 <- data.frame(
ID = rep(paste0("P", 1:10), each = 50),
tipo = rep(c("teste", "treino", "teste", "teste", "teste"), times = 100),
pontuacao = sample(c(0, 1), 500, replace = TRUE, prob = c(0.15, 0.85))
)
}
# --- 1. CÁLCULO CORRIGIDO ---
corretos_part <- bloco_101 %>%
filter(tipo != "treino") %>%
group_by(ID) %>%
# Parênteses corrigidos para o cálculo da porcentagem
summarise(perct_part = (sum(pontuacao, na.rm = TRUE) / 48) * 100)
# (A linha as.numeric não é mais necessária, pois o cálculo já retorna numeric)
# corretos_part$perct_part <- as.numeric(corretos_part$perct_part)
# --- 2. GGPLOT CORRIGIDO ---
graph_lines_part <- ggplot(corretos_part,
# AES CORRIGIDO:
# x = ID reordenado por perct_part
# y = perct_part
# group = 1 (para conectar a linha)
aes(x = reorder(ID, perct_part),
y = perct_part,
color = ID,
group = 1)) +
geom_line(size = 1) +
geom_point(size = 3) +
coord_flip() +
# ESCALA CORRIGIDA (ex: 60% a 100%)
scale_y_continuous(limits = c(60, 100), breaks = seq(60, 100, 5)) +
labs(
title = "Porcentagem de respostas corretas por participante",
# Os eixos são trocados pelo coord_flip, então X é 'Participant'
x = "Participante",
y = "Porcentagem de respostas corretas (%)"
) +
theme_minimal() +
theme(
axis.line = element_blank(),
axis.ticks = element_blank(),
panel.grid.minor = element_blank(),
axis.text.y = element_text(size = 8),
axis.text.x = element_text(size = 10),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
plot.title = element_text(size = 14, face = "bold"),
# Adicionado para remover a legenda de cores (costuma poluir este tipo de gráfico)
legend.position = "none"
)
# --- 3. PLOTLY ---
fig1 <- ggplotly(graph_lines_part)
fig1Gráfico
% acurácia em cada bloco
# Gráfico de barras com formatação dos eixos e título
cond_graph <- ggplot(cond_percent, aes(x = condicao, y = percent, fill= condicao)) +
geom_bar(stat = "identity") +
labs(
title = "% de acertos em cada bloco", # título geral
x = "Condição", # título eixo X
y = "Média de Acurácia" # título eixo Y
) +
theme_classic() + # estilo mais limpo
theme(
plot.title = element_text(hjust = 0.5, face = "bold", size = 14), # centraliza e negrita o título
axis.title.x = element_text(size = 12, face = "bold"), # título eixo X
axis.title.y = element_text(size = 12, face = "bold"), # título eixo Y
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1) # texto eixo X na vertical
) +
coord_cartesian(ylim = c(50, 100)) # define limites do eixo Y
# Converter para gráfico interativo
cond_g_plotly <- ggplotly(cond_graph) %>%
layout(
showlegend = FALSE, # <--- hides the legend
yaxis = list(range = c(50, 100)) # <--- keeps same y range
)
cond_g_plotlyplot_ly(
data = acerto_tipo,
x = ~tipo,
y = ~percent,
type = "bar",
color = ~tipo, # <- cada bloco com cor diferente
colors = "Set2", # <- paleta de cores (pode trocar: "Set1", "Viridis", "Dark2", etc.)
name = "Média de Acurácia"
) %>%
layout(
title = "% de acertos no tipo de sentença",
xaxis = list(title = "Condição", tickangle = 45),
yaxis = list(
title = "Média de Acurácia",
range = c(50, 100) # <- define mínimo e máximo do eixo Y
),
bargap = 0.3,
showlegend = FALSE
)- acertos de questões por cada participante
criando um dataframe com os acertos dos participantes em cada bloco, para que depois possa juntar com o data frame do survey criando um data para analise por bloco
unindo o data frame dos dados sociodemografico, do survey do psytookit, com as colunas do número de acertos em cada bloco em colunas
por último iremos colocar cada item como uma coluna diferente, evidenciando acertos e erros - para calculo do alfa e do omega de mcdonald
agora vamos unir todos os bancos - questao - acertos e etc
calculando o KR-20 para os itens do teste
Análise do KR-20 Consistência Interna
Consistência interna para itens dicotômicos - Kuder-Richardson 20 (KR-20) e 21 (KR-21)
# install.packages("psych")
library(psych)
# Assuming your data frame is named ãct_quest and has a column "ID"
# Rename it for safe variable handling:
act_quest <- `act_quest`
# Remove the ID, treino_1, and treino_2 columns
items <- act_quest[ , !(names(act_quest) %in% c("ID", "treino_1", "treino_2"))]
# --- Check ---
dim(items) # should show 101 rows × 46 items[1] 101 48head(items)# A tibble: 6 × 48
bl1_1 bl1_10 bl1_11 bl1_12 bl1_13 bl1_14 bl1_15 bl1_16 bl1_2 bl1_3 bl1_4 bl1_5
<int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
1 1 1 1 1 1 1 1 1 0 1 0 1
2 0 1 1 1 0 0 1 0 0 1 1 1
3 1 1 1 1 1 1 1 1 1 1 1 1
4 1 1 1 1 1 1 1 1 1 1 1 1
5 1 1 1 1 1 1 1 1 1 1 1 1
6 1 1 1 1 1 1 1 1 1 0 1 1
# ℹ 36 more variables: bl1_6 <int>, bl1_7 <int>, bl1_8 <int>, bl1_9 <int>,
# bl2_17 <int>, bl2_18 <int>, bl2_19 <int>, bl2_20 <int>, bl2_21 <int>,
# bl2_22 <int>, bl2_23 <int>, bl2_24 <int>, bl3_25 <int>, bl3_26 <int>,
# bl3_27 <int>, bl3_28 <int>, bl3_29 <int>, bl3_30 <int>, bl3_31 <int>,
# bl3_32 <int>, bl3_33 <int>, bl3_34 <int>, bl3_35 <int>, bl3_36 <int>,
# bl4_37 <int>, bl4_38 <int>, bl4_39 <int>, bl4_40 <int>, bl4_41 <int>,
# bl4_42 <int>, bl4_43 <int>, bl4_44 <int>, bl4_45 <int>, bl4_46 <int>, …# --- KR-20 calculation ---
k <- ncol(items) # number of items (should be 46)
p <- colMeans(items, na.rm = TRUE) # proportion correct
q <- 1 - p # proportion incorrect
total_score <- rowSums(items, na.rm = TRUE)
var_total <- var(total_score, na.rm = TRUE)
KR20 <- (k / (k - 1)) * (1 - (sum(p * q) / var_total))
KR20[1] 0.6705232Interpret KR-20 like Cronbach’s α:
≥ 0.9 = Excellent
0.8–0.9 = Good
0.7–0.8 = Acceptable
< 0.7 = Low internal consistency
índice assume que todos os itens apresentam a mesma dificuldade, assim não seria consistente.
Calculando o KR-20 por bloco
# install.packages("psych") library(psych) library(dplyr) # --- Data preparation --- act_quest <- `act_quest` # Remove non-item columns items <- act_quest %>% select(-ID, -treino_1, -treino_2) # Check structure dim(items)[1] 101 48# bloco_101 should have columns: "questao" (item name) and "condicao" head(bloco_101)Column1 ID exp questao tipo condicao RT 1 1 AF1 treino treino_1 treino treino_inst B 2 2 AF1 treino treino_2 treino treino_inst A 3 3 AF1 experimento bl1_9 relativa rel_sujeito_ram_direita A 4 4 AF1 experimento bl1_1 relativa rel_obj_central D 5 5 AF1 experimento bl2_23 clivada clivada_sujeito A 6 6 AF1 experimento bl1_16 relativa rel_obj_ram_direita A pontuacao tempo acerto resposta 1 1 3460 Correto 2 2 1 8254 Correto 1 3 1 9151 Correto 1 4 1 30615 Correto 4 5 1 12864 Correto 1 6 1 18833 Correto 1# --- Define a KR20 function --- kr20 <- function(df) { k <- ncol(df) p <- colMeans(df, na.rm = TRUE) q <- 1 - p total_score <- rowSums(df, na.rm = TRUE) var_total <- var(total_score, na.rm = TRUE) (k / (k - 1)) * (1 - (sum(p * q) / var_total)) } # --- Calculate KR-20 per condition --- kr20_results <- bloco_101 %>% group_by(condicao) %>% summarise( KR20 = { item_names <- questao[questao %in% names(items)] if (length(item_names) > 1) { kr20(items[, item_names, drop = FALSE]) } else { NA # cannot compute KR-20 with < 2 items } }, n_items = sum(questao %in% names(items)) ) kr20_results# A tibble: 13 × 3 condicao KR20 n_items <chr> <dbl> <int> 1 ativa_irresversivel 0.992 404 2 ativa_perspectiva 0.992 404 3 ativa_reversivel 0.995 404 4 clivada_objeto 0.995 404 5 clivada_sujeito 0.992 404 6 passiva_irreversivel 0.994 404 7 passiva_revers_implausivel 0.994 404 8 passiva_revers_neutra 0.992 404 9 rel_obj_central 0.996 404 10 rel_obj_ram_direita 0.995 404 11 rel_sujeito_central 0.995 404 12 rel_sujeito_ram_direita 0.992 404 13 treino_inst NA 0reactable(kr20_results)
# install.packages(c("psych", "dplyr", "reactable"))
library(psych)
library(dplyr)
library(reactable)
library(reactablefmtr)
# --- Prepare data ---
act_quest <- `act_quest`
items <- act_quest %>% select(-ID, -treino_1, -treino_2)
# KR-20 function
kr20 <- function(df) {
k <- ncol(df)
if (k < 2) return(NA) # avoid division by zero
p <- colMeans(df, na.rm = TRUE)
q <- 1 - p
total_score <- rowSums(df, na.rm = TRUE)
var_total <- var(total_score, na.rm = TRUE)
(k / (k - 1)) * (1 - (sum(p * q) / var_total))
}
# --- Compute KR20 per condition ---
kr20_results <- bloco_101 %>%
group_by(condicao) %>%
summarise(
KR20 = {
item_names <- questao[questao %in% names(items)]
if (length(item_names) > 1) {
kr20(items[, item_names, drop = FALSE])
} else {
NA
}
},
n_items = sum(questao %in% names(items)),
.groups = "drop"
)
# --- Display in interactive table ---
reactable(
kr20_results,
filterable = TRUE,
searchable = TRUE,
sortable = TRUE,
pagination = TRUE,
highlight = TRUE,
striped = TRUE,
bordered = TRUE,
defaultPageSize = 10,
columns = list(
condicao = colDef(name = "Condition", align = "center"),
KR20 = colDef(name = "KR-20", align = "center", format = colFormat(digits = 3)),
n_items = colDef(name = "Number of Items", align = "center")
),
theme = reactablefmtr::fivethirtyeight()
)