user430997's questions

Tenho este conjunto de dados em R:

set.seed(123)

num_patients <- 50
patient_ids <- rep(1:num_patients, each = sample(2:10, num_patients, replace = TRUE))
n_visits <- length(patient_ids)

start_date <- as.Date("2022-01-01")
end_date <- as.Date("2023-12-31")
visit_dates <- sample(seq(start_date, end_date, by = "day"), n_visits, replace = TRUE)

results <- sample(c("miss", "attend"), n_visits, replace = TRUE, prob = c(0.25, 0.75))

patient_visits <- data.frame(
  patient_id = patient_ids,
  visit_date = sort(visit_dates[order(patient_ids)]),
  result = results
)

head(patient_visits)

Este conjunto de dados mostra como diferentes pacientes compareceram ou faltaram às consultas:

 patient_id visit_date result
1          1 2022-01-05   miss
2          1 2022-01-13 attend
3          1 2022-01-20 attend
4          1 2022-01-24 attend
5          2 2022-01-26 attend
6          2 2022-02-03   miss

Quero responder a seguinte pergunta:

- Para pacientes que têm exatamente 1 consulta: qual foi a taxa de faltas na primeira consulta?

- Para pacientes que têm exatamente 2 consultas: qual foi a taxa de faltas na primeira consulta? qual foi a taxa de faltas na segunda consulta?

- Para pacientes que têm exatamente 3 consultas: qual foi a taxa de faltas na primeira consulta? qual foi a taxa de faltas na segunda consulta? qual foi a taxa de faltas na terceira consulta?

- Para pacientes que têm exatamente 4 consultas: qual foi a taxa de faltas na primeira consulta? qual foi a taxa de faltas na segunda consulta? qual foi a taxa de faltas na terceira consulta? qual foi a taxa de faltas em todas as outras consultas (agrupadas em uma)?

Tentei fazer isso manualmente para cada combinação:

patient_visits <- patient_visits[order(patient_visits$patient_id, patient_visits$visit_date), ]
patient_visits$appt_seq <- unlist(tapply(patient_visits$patient_id, patient_visits$patient_id, FUN = function(x) 1:length(x)))

appt_counts <- table(patient_visits$patient_id)

patients_with_1_appt <- as.numeric(names(appt_counts[appt_counts == 1]))
patients_with_2_appt <- as.numeric(names(appt_counts[appt_counts == 2]))
patients_with_3_appt <- as.numeric(names(appt_counts[appt_counts == 3]))
patients_with_4_appt <- as.numeric(names(appt_counts[appt_counts == 4]))

results_df <- data.frame(
  total_appointments = numeric(),
  appointment_number = character(),
  miss_rate = numeric(),
  stringsAsFactors = FALSE
)

visits_1 <- patient_visits[patient_visits$patient_id %in% patients_with_1_appt, ]
miss_rate_1 <- mean(visits_1$result == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = 1,
  appointment_number = "1",
  miss_rate = miss_rate_1
))

visits_2 <- patient_visits[patient_visits$patient_id %in% patients_with_2_appt, ]
miss_rate_2_first <- mean(visits_2[visits_2$appt_seq == 1, "result"] == "miss")
miss_rate_2_second <- mean(visits_2[visits_2$appt_seq == 2, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(2, 2),
  appointment_number = c("1", "2"),
  miss_rate = c(miss_rate_2_first, miss_rate_2_second)
))

visits_3 <- patient_visits[patient_visits$patient_id %in% patients_with_3_appt, ]
miss_rate_3_first <- mean(visits_3[visits_3$appt_seq == 1, "result"] == "miss")
miss_rate_3_second <- mean(visits_3[visits_3$appt_seq == 2, "result"] == "miss")
miss_rate_3_third <- mean(visits_3[visits_3$appt_seq == 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(3, 3, 3),
  appointment_number = c("1", "2", "3"),
  miss_rate = c(miss_rate_3_first, miss_rate_3_second, miss_rate_3_third)
))

visits_4 <- patient_visits[patient_visits$patient_id %in% patients_with_4_appt, ]
miss_rate_4_first <- mean(visits_4[visits_4$appt_seq == 1, "result"] == "miss")
miss_rate_4_second <- mean(visits_4[visits_4$appt_seq == 2, "result"] == "miss")
miss_rate_4_third <- mean(visits_4[visits_4$appt_seq == 3, "result"] == "miss")
miss_rate_4_other <- mean(visits_4[visits_4$appt_seq > 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(4, 4, 4, 4),
  appointment_number = c("1", "2", "3", "4+"),
  miss_rate = c(miss_rate_4_first, miss_rate_4_second, miss_rate_4_third, miss_rate_4_other)
))

Existe uma maneira mais fácil de fazer isso no R básico?

Eu escrevi este código R que faz um gráfico 3D em diferentes valores da variável p3.

Primeiro, defino todas as funções:

library(plotly)
library(dplyr)

calculate_b_values <- function(p1, p2, p3, weights) {
  grid <- expand.grid(p1 = p1, p2 = p2)
  grid$B <- (weights$w4 / weights$w2) * weights$w3 * grid$p1 * grid$p2 * p3
  matrix(grid$B, nrow = length(p1), ncol = length(p2))
}

create_surface_plot <- function(p1, p2, z_matrix, p3_value) {
  plot_ly() %>% 
    add_surface(
      z = z_matrix,
      x = p1,
      y = p2,
      colorscale = "Viridis",
      opacity = 0.9
    ) %>% 
    layout(
      scene = list(
        xaxis = list(title = "p1"),
        yaxis = list(title = "p2"),
        zaxis = list(title = "B"),
        aspectratio = list(x = 1, y = 1, z = 0.7)
      ),
      title = paste("Surface Plot with p3 =", p3_value)
    )
}

generate_surface_plots <- function(p_range = seq(0.1, 1, length.out = 20),
                                  p3_values = c(0.1, 0.4, 0.7, 1.0),
                                  weights = list(w1 = 10, w2 = 5, w3 = 3, w4 = 8)) {
  plot_list <- list()
  for (i in seq_along(p3_values)) {
    p3_fixed <- p3_values[i]
    z_matrix <- calculate_b_values(p_range, p_range, p3_fixed, weights)
    plot_list[[i]] <- create_surface_plot(p_range, p_range, z_matrix, p3_fixed)
  }
  names(plot_list) <- paste0("p3_", p3_values)
  return(plot_list)
}

Então, chamo as funções para fazer todos os 4 gráficos:

weights <- list(w1 = 10, w2 = 5, w3 = 3, w4 = 8)
p_vals <- seq(0.1, 1, length.out = 20)
p3_values <- c(0.1, 0.4, 0.7, 1.0)

plots <- generate_surface_plots(p_vals, p3_values, weights)

plots[[1]]
plots[[2]]
plots[[3]]
plots[[4]]

Quero exibir todos os 4 gráficos na mesma página . Isso parece poder ser feito usando o recurso subplot ( https://plotly.com/r/subplots/ ):

plots <- generate_surface_plots(p_vals, p3_values, weights)

combined_plot <- subplot(
  plots[[1]], plots[[2]],
  plots[[3]], plots[[4]],
  nrows = 2, 
  titleX = TRUE,
  titleY = TRUE,
  margin = 0.05
)

combined_plot <- combined_plot %>%
  layout(
    title = list(
      text = "Surface Plots at Different p3 Values",
      font = list(size = 16)
    )
  )

combined_plot

Mas isso os coloca todos no mesmo terreno:

Como posso colocar todos os 4 gráficos separadamente na mesma página , por exemplo

• Uma referência Python ( https://plotly.com/python/3d-subplots/ ), gostaria de poder fazer isso em R

Tenho uma coluna (somecolumn) em uma tabela (sometable) no seguinte formato (DATE):2025-01-01 00:00:00

Usando SQL, quero criar as 2 colunas a seguir:

1) Extraia o número do mês com base no calendário abril-abril, ou seja, abril = 1, maio = 2, ...

2) Identifique o ano com base no calendário abril-abril, ou seja, 1º de janeiro de 2025 está no ano de 2024-2025.

O primeiro é fácil de fazer manualmente:

SELECT 
    CASE 
        WHEN EXTRACT(MONTH FROM somedate) = 4 THEN 1
        WHEN EXTRACT(MONTH FROM somedate) = 5 THEN 2
        WHEN EXTRACT(MONTH FROM somedate) = 6 THEN 3
        WHEN EXTRACT(MONTH FROM somedate) = 7 THEN 4
        WHEN EXTRACT(MONTH FROM somedate) = 8 THEN 5
        WHEN EXTRACT(MONTH FROM somedate) = 9 THEN 6
        WHEN EXTRACT(MONTH FROM somedate) = 10 THEN 7
        WHEN EXTRACT(MONTH FROM somedate) = 11 THEN 8
        WHEN EXTRACT(MONTH FROM somedate) = 12 THEN 9
        WHEN EXTRACT(MONTH FROM somedate) = 1 THEN 10
        WHEN EXTRACT(MONTH FROM somedate) = 2 THEN 11
        WHEN EXTRACT(MONTH FROM somedate) = 3 THEN 12
    END AS new_month
FROM sometable;

O segundo é mais confuso. Tentei pensar na lógica dividindo os meses em (janeiro-março e outros):

    CASE 
        WHEN EXTRACT(MONTH FROM somecolumn) <= 3 
        THEN (EXTRACT(YEAR FROM somecolumn) - 1) || '-' || EXTRACT(YEAR FROM somecolumn)
        ELSE EXTRACT(YEAR FROM somecolumn) || '-' || (EXTRACT(YEAR FROM somecolumn) + 1)
    END AS new_year
FROM sometable;

Essa é a lógica correta?

Tenho este gráfico em R em que cada nó tem um peso aleatório:

library(igraph)
library(tidyverse)
set.seed(123)

g <- sample_gnm(n = 20, m = 30, directed = FALSE)
V(g)$weight <- runif(20)

Estou tentando descobrir qual nó tem um peso mais próximo da média de todos os nós.

Se isso não fosse um gráfico de rede, seria bem fácil de fazer. No entanto, não tenho certeza de como fazer isso usando um objeto de gráfico de rede.

Tentei fazer isso da seguinte maneira:

tibble(
    node_id = 1:20,
    weight = V(g)$weight,
    mean_weight_of_all_nodes = mean(V(g)$weight),
    abs_distance_from_mean = abs(weight - mean_weight_of_all_nodes)
) %>%
    arrange(abs_distance_from_mean) %>%
    mutate(rank = row_number())

O resultado fica assim:

# A tibble: 20 × 5
   node_id weight mean_weight_of_all_nodes abs_distance_from_mean  rank
     <int>  <dbl>                    <dbl>                  <dbl> <int>
 1      12 0.414                     0.396                 0.0180     1
 2      11 0.415                     0.396                 0.0188     2
 3      13 0.369                     0.396                 0.0269     3
 4      17 0.466                     0.396                 0.0702     4
 5       8 0.318                     0.396                 0.0776     5
 6       5 0.478                     0.396                 0.0820     6
 7      18 0.266                     0.396                 0.130      7
 8      16 0.233                     0.396                 0.163      8
 9       9 0.232                     0.396                 0.164      9
10       7 0.216                     0.396                 0.179     10
11      14 0.152                     0.396                 0.243     11
12      10 0.143                     0.396                 0.253     12
13      15 0.139                     0.396                 0.257     13
14       2 0.691                     0.396                 0.295     14
15      20 0.0458                    0.396                 0.350     15
16       6 0.758                     0.396                 0.363     16
17       4 0.0246                    0.396                 0.371     17
18       3 0.795                     0.396                 0.400     18
19      19 0.858                     0.396                 0.462     19
20       1 0.902                     0.396                 0.507     20

Essa é a maneira correta de fazer isso?

Este é o problema com o qual estou trabalhando.

Tenho essas duas saídas de modelos de séries temporais em R:

library(forecast)
library(dplyr)
set.seed(123)

dates <- seq(as.Date("2000-01-01"), by = "month", length.out = 100)
##################


values1 <- rnorm(100, mean = 100, sd = 100)
ts_data1 <- ts(values1, start = c(2000, 1), frequency = 12)
model1 <- auto.arima(ts_data1)

forecast_data1 <- forecast(model1, h = 12)
forecast_data1$class = 1

####################


values2 <- rnorm(100, mean = 200, sd = 100)
ts_data2 <- ts(values2, start = c(2000, 1), frequency = 12)
model2 <- auto.arima(ts_data2)

forecast_data2 <- forecast(model2, h = 12)
forecast_data2$class = 2

Estou tentando unir esses dois, por exemplo

 rbind(data.frame(forecast_data1), data.frame(forecast_data2))
          Point.Forecast        Lo.80    Hi.80       Lo.95    Hi.95
May 2008       116.88772   2.03451679 231.7409  -58.765094 292.5405
Jun 2008        84.77524 -30.07795384 199.6284  -90.877564 260.4281
Jul 2008        88.15699 -26.69621184 203.0102  -87.495822 263.8098
Aug 2008        97.84920 -17.00400178 212.7024  -77.803612 273.5020
Sep 2008       104.59216 -10.26103639 219.4454  -71.060647 280.2450
Oct 2008       123.46321   8.61001633 238.3164  -52.189594 299.1160
Nov 2008        80.16232 -34.69087853 195.0155  -95.490489 255.8151
Dec 2008       122.86121   8.00801357 237.7144  -52.791597 298.5140
Jan 2009        62.16134 -52.69186110 177.0145 -113.491472 237.8141
Feb 2009        76.41793 -38.43527070 191.2711  -99.234881 252.0707
Mar 2009       114.92293   0.06973034 229.7761  -60.729880 290.5757
Apr 2009       132.14088  17.28768324 246.9941  -43.511927 307.7937
May 20081      173.02664  50.54760673 295.5057  -14.288876 360.3422
Jun 20081      196.17783  73.69880321 318.6569    8.862321 383.4933
Jul 20081      181.38489  58.90585584 303.8639   -5.930626 368.7004
Aug 20081      196.21547  73.73644398 318.6945    8.899962 383.5310
Sep 20081      189.46162  66.98258965 311.9407    2.146107 376.7771
Oct 20081      200.14378  77.66475146 322.6228   12.828269 387.4593
Nov 20081      214.71057  92.23154347 337.1896   27.395061 402.0261
Dec 20081      151.90221  29.42317702 274.3812  -35.413305 339.2177
Jan 20091      176.64285  54.16381860 299.1219  -10.672664 363.9584
Feb 20091      211.48637  89.00734228 333.9654   24.170860 398.8019
Mar 20091      196.08048  73.60144798 318.5595    8.764966 383.3960
Apr 20091      210.85820  88.37916960 333.3372   23.542687 398.1737

Mas, por algum motivo, a variável de classe (ou seja, 1 ou 2) não está aparecendo para mostrar de qual modelo as previsões são.

Como posso consertar isso?

Tenho esses dados em R:

library(ggplot2)
library(dplyr)

set.seed(123)

data <- data.frame(
    height = rnorm(1000, mean = 170, sd = 10),
    weight = rnorm(1000, mean = 70, sd = 15),
    country = sample(c("USA", "Canada", "UK", "Australia"), 1000, replace = TRUE)
)

Eu uso esse código para criar uma faceta de altura versus peso para cada país:

library(ggplot2)
library(gridExtra)

# Create separate plots for each country
p1 <- ggplot(data %>% filter(country == "USA"), aes(x = height, y = weight)) +
    geom_point(alpha = 0.5) +
    labs(title = "USA", x = "Height (cm)", y = "Weight (kg)") +
    theme_minimal()

p2 <- ggplot(data %>% filter(country == "Canada"), aes(x = height, y = weight)) +
    geom_point(alpha = 0.5) +
    labs(title = "Canada", x = "Height (cm)", y = "Weight (kg)") +
    theme_minimal()

p3 <- ggplot(data %>% filter(country == "UK"), aes(x = height, y = weight)) +
    geom_point(alpha = 0.5) +
    labs(title = "UK", x = "Height (cm)", y = "Weight (kg)") +
    theme_minimal()

p4 <- ggplot(data %>% filter(country == "Australia"), aes(x = height, y = weight)) +
    geom_point(alpha = 0.5) +
    labs(title = "Australia", x = "Height (cm)", y = "Weight (kg)") +
    theme_minimal()



grid.arrange(p1, p2, p3, p4, ncol = 2)

Existe alguma maneira em R que, em vez de criar manualmente todos esses gráficos, eu possa criar automaticamente cada gráfico com os títulos corretos e colocá-los lado a lado na mesma página?

No momento, estou fazendo isso manualmente e está demorando um pouco (por exemplo, tenho 20 gráficos desse tipo). Não é possível fazer isso automaticamente?

Tenho um conjunto de dados em R que se parece com isto:

data = structure(list(quarter = c("Q1 2005", "Q2 2005", "Q3 2005", "Q4 2005", 
"Q1 2006"), value = c(128.76, 178.83, 140.9, 188.3, 194.05)), class = "data.frame", row.names = c(NA, 
-5L))

Quero expandir esse conjunto de dados para ter uma coluna extra chamada "mês" (por exemplo, jan, fev, mar...) ... e quero dividir a diferença entre todos os meses entre trimestres sucessivos para que os números ainda somem entre os trimestres.

Tentei fazer assim:

library(dplyr)

expand_dataset <- function(data) {
quarter_to_months <- list(
    "Q1" = c("Jan", "Feb", "Mar"),
    "Q2" = c("Apr", "May", "Jun"),
    "Q3" = c("Jul", "Aug", "Sep"),
    "Q4" = c("Oct", "Nov", "Dec")
    )

expanded_data <- data.frame()

for (i in 1:(nrow(data) - 1)) {
    current_value <- data$value[i]
    next_value <- data$value[i + 1]
    
    diff <- (next_value - current_value) / 3
    
    quarter <- substr(data$quarter[i], 1, 2)
    year <- substr(data$quarter[i], 4, 7)
    months <- quarter_to_months[[quarter]]
    
    for (j in 1:3) {
        month_value <- current_value + (j - 1) * diff
        expanded_data <- rbind(expanded_data, data.frame(
            quarter = data$quarter[i],
            month = months[j],
            year = year,
            value = month_value
        ))
    }
    }

return(expanded_data)
}

expanded_data <- expand_dataset(data)
print(expanded_data)

Essa é a maneira correta de fazer isso? Existe uma maneira mais fácil de fazer isso?