# model_power_curves

    library(funkycells)

This vignette shows the power curve for the model. This curves are based on data similar to that in the triple negative breast cancer data, for which there is another vignette `vignette("TNBC")`. To this end, we consider two cases: (1) a few number of interactions and (2) a large number of interactions.

In both cases, we consider the \(c1\_c2\) interaction of varying strength and trend between two outcomes. In the null case, there is some clustering of \(c2\) around \(c1\) in both cases (the placing normal distribution using a standard deviation of 1/40). There are 5 cases on either side of this value, i.e. increased clustering or repulsion. Additional variables are generated: an additional \(2\) cells in small and \(14\) cells in the large cases are added, and meta-variable age is included.

    nSims <- 100
    changes <- 1 / 40 * c(
      4, 3, 2, 1.5, 1.25,
      1,
      1 / 1.25, 1 / 1.5, 1 / 2, 1 / 3, 1 / 4
    )
    baseline <- changes[6]

For the small number of interactions scenario, we consider \(4\) cells and interactions between them.

    cells <- paste0("c", 1:4)
    cells_interactions <- rbind(
      data.frame(t(combn(cells, 2))),
      data.frame("X1" = cells, "X2" = cells)
    )

Next the data is generated, \(100\) data sets for each scenario (as given below).

    info <- rfdata <- list()

    for (c in 1:length(changes)) {
      cat(paste0("\n- Change: ", changes[c], "\n-- (", nSims, "): "))

      set.seed(c * 123)

      for (i in 1:nSims) {
        cat(paste0(i, ", "))
        # Generate
        dat <- simulatePP(
          agentVarData =
            data.frame(
              "outcome" = c(0, 1),
              "c1" = c(0, 0),
              "c2" = c(baseline, changes[c])^2,
              "c3" = c(1 / 50, 1 / 50),
              "c4" = c(1 / 10, 1 / 10)
            ),
          agentKappaData = data.frame(
            "agent" = paste0("c", 1:4),
            "clusterAgent" = c(NA, "c1", "c1", NA),
            "kappa" = c(
              30,
              5, 5,
              30
            )
          ),
          unitsPerOutcome = 17,
          replicatesPerUnit = 1,
          silent = T
        )
        pcaData <- getKsPCAData(
          data = dat, replicate = "replicate",
          xRange = c(0, 1), yRange = c(0, 1),
          agents_df = cells_interactions,
          silent = TRUE
        )
        pcaMeta <- simulateMeta(pcaData,
          metaInfo = data.frame(
            "var" = c("age"),
            "rdist" = c("rnorm"),
            "outcome_0" = c("25"),
            "outcome_1" = c("25")
          )
        )
        info[[i]] <- list(dat, pcaData, pcaMeta)
        rfdata[[i]] <- pcaMeta
      }

      ## Save RDS (To temp directory)
      saveRDS(info, paste0(path, "change_sim_small_info", c, ".rds"))
      saveRDS(rfdata, paste0(path, "change_sim_small_rfdata", c, ".rds"))
    }

After generation, the model is fit on all of these data sets.

    for (c in 1:length(changes)) {
      cat(paste0("\n- Change: ", changes[c], "\n-- (", nSims, "): "))

      rfdat <- readRDS(paste0(path, "change_sim_small_rfdata", c, ".rds"))

      VarVI_both <- VarVI_noi <- VarVI_int <-
        VarVI_maxint <- VarVI_bothmax <-
        data.frame("var" = c(
          "age",
          paste(cells_interactions$X1,
            cells_interactions$X2,
            sep = "_"
          )
        ))

      set.seed(c * 12345)

      for (i in 1:nSims) {
        cat(paste0(i, ", "))
        # Generate

        rfcv <- funkyModel(
          data = rfdat[[i]],
          outcome = "outcome", unit = "unit",
          metaNames = c("age"), silent = TRUE
        )

        # Org Data
        tmp <- rfcv$VariableImportance[, c("var", "est", "sd")]
        tmp <- tmp[order(-tmp$est), ]
        rownames(tmp) <- NULL
        tmp$CutoffNoise <- rfcv$NoiseCutoff
        tmp$CutoffInterp <- rfcv$InterpolationCutoff
        tmp$CutoffMaxInterp <- max(rfcv$InterpolationCutoff)

        # Above Lines
        tmp$TF_intCO <- (tmp$est > tmp$CutoffInterp)
        tmp$TF_noiCO <- (tmp$est > tmp$CutoffNoise)
        tmp[[paste0("iter", i)]] <- tmp$TF_intCO * tmp$TF_noiCO
        VarVI_both <- merge(VarVI_both, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_noiCO
        VarVI_noi <- merge(VarVI_noi, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_intCO
        VarVI_int <- merge(VarVI_int, tmp[, c("var", paste0("iter", i))])

        tmp$TF_maxIntCO <- (tmp$est > tmp$CutoffMaxInterp)
        tmp[[paste0("iter", i)]] <- tmp$TF_maxIntCO * tmp$TF_noiCO
        VarVI_bothmax <- merge(VarVI_bothmax, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_maxIntCO
        VarVI_maxint <- merge(VarVI_maxint, tmp[, c("var", paste0("iter", i))])
      }

      ## Save RDS

      results[[paste0("Change_", changes[c])]] <-
        list(
          "dat" = tmp, "fullDat" = list(
            rfcv$VariableImportance,
            rfcv$NoiseCutoff,
            rfcv$InterpolationCutoff
          ),
          "VarVI_both" = VarVI_both,
          "VarVI_noi" = VarVI_noi,
          "VarVI_int" = VarVI_int,
          "VarVI_bothmax" = VarVI_bothmax,
          "VarVI_maxint" = VarVI_maxint
        )

      ## Save RDS
      saveRDS(results, paste0(path, "change_sim_small_", c, ".rds"))
    }

The data is then summarized together:

    data <- list()
    for (i in 1:11) {
      data <- append(
        data,
        readRDS(paste0(path, "change_sim_small_", i, ".rds"))
      )
    }

    data_summary <- data.frame(
      "var" = changes, "noi" = NA, "int" = NA,
      "both" = NA, "max" = NA, "bothmax" = NA
    )

    for (i in 1:length(data)) {
      data_summary[i, "noi"] <-
        sum(data[[i]]$VarVI_noi[data[[i]]$VarVI_noi$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_noi[data[[i]]$VarVI_noi$var == "c1_c2", -1])

      data_summary[i, "int"] <-
        sum(data[[i]]$VarVI_int[data[[i]]$VarVI_int$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_int[data[[i]]$VarVI_int$var == "c1_c2", -1])

      data_summary[i, "max"] <-
        sum(data[[i]]$VarVI_max[data[[i]]$VarVI_max$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_max[data[[i]]$VarVI_max$var == "c1_c2", -1])

      data_summary[i, "both"] <-
        sum(data[[i]]$VarVI_both[data[[i]]$VarVI_both$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_both[data[[i]]$VarVI_both$var == "c1_c2", -1])

      # (max either)
      data_summary[i, "bothmax"] <-
        sum(data[[i]]$VarVI_bothmax[data[[i]]$VarVI_bothmax$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_bothmax[data[[i]]$VarVI_bothmax$var == "c1_c2", -1])
    }

    data_plot <- tidyr::pivot_longer(data_summary, cols = noi:bothmax)

And a power curve is built:

    plot_sm <-
      ggplot2::ggplot(
        data_plot[data_plot$name %in% c("noi", "int", "both"), ],
        ggplot2::aes(x = var, y = value, color = name, group = name)
      ) +
      ggplot2::geom_line(linewidth = 1.25) +
      ggplot2::geom_point(size = 3) +
      ggplot2::geom_vline(
        ggplot2::aes(xintercept = baseline),
        color = "black", linetype = "dashed", linewidth = 1.25
      ) +
      ggplot2::geom_hline(
        ggplot2::aes(yintercept = 0.05),
        linetype = "dotted"
      ) +
      ggplot2::theme_bw() +
      ggplot2::theme(
        axis.text = ggplot2::element_text(size = 18),
        axis.title = ggplot2::element_text(size = 22),
        legend.position = "none",
        legend.title = ggplot2::element_text(size = 22),
        legend.text = ggplot2::element_text(size = 18)
      ) +
      ggplot2::xlab("Standard Deviation") +
      ggplot2::ylab(NULL) +
      ggplot2::scale_x_log10() +
      ggplot2::scale_color_discrete(type = c("#40e0d0", "orange", "red"))

    plot_sm

    knitr::include_graphics("img/change_sm_curve_show.png")

The large model is created in much the same manner, only using \(16\) total cells and their interactions.

    cells <- paste0("c", 1:16)
    cells_interactions <- rbind(
      data.frame(t(combn(cells, 2))),
      data.frame("X1" = cells, "X2" = cells)
    )

Followed by data generation for \(100\) trials per scenario:

    info <- rfdata <- list()

    for (c in 1:length(changes)) {
      cat(paste0("\n- Change: ", changes[c], "\n-- (", nSims, "): "))

      set.seed(c * 1234)

      for (i in 1:nSims) {
        cat(paste0(i, ", "))
        # Generate
        dat <- simulatePP(
          agentVarData =
            data.frame(
              "outcome" = c(0, 1),
              "c1" = c(0, 0),
              "c2" = c(baseline, changes[c])^2, "c3" = c(1 / 50, 1 / 50),
              "c4" = c(0, 0), "c5" = c(0, 0), "c6" = c(0, 0),
              "c7" = c(0, 0), "c8" = c(0, 0), "c9" = c(0, 0),
              "c10" = c(0, 0), "c11" = c(0, 0), "c12" = c(1 / 30, 1 / 30)^2,
              "c13" = c(0, 0), "c14" = c(1 / 50, 1 / 50)^2,
              "c15" = c(1 / 100, 1 / 100)^2, "c16" = c(1 / 10, 1 / 10)
            ),
          agentKappaData = data.frame(
            "agent" = paste0("c", 1:16),
            "clusterAgent" = c(NA, "c1", "c1", rep(NA, 10), rep("c1", 3)),
            "kappa" = c(30, 5, 5, rep(30, 10), rep(5, 3))
          ),
          unitsPerOutcome = 17,
          replicatesPerUnit = 1,
          silent = T
        )
        pcaData <- getKsPCAData(
          data = dat, replicate = "replicate",
          xRange = c(0, 1), yRange = c(0, 1),
          agents_df = cells_interactions,
          silent = TRUE
        )
        pcaMeta <- simulateMeta(pcaData,
          metaInfo = data.frame(
            "var" = c("age"),
            "rdist" = c("rnorm"),
            "outcome_0" = c("25"),
            "outcome_1" = c("25")
          )
        )
        info[[i]] <- list(dat, pcaData, pcaMeta)
        rfdata[[i]] <- pcaMeta
      }

      ## Save RDS
      saveRDS(info, paste0(path, "change_sim_large_info", c, ".rds"))
      saveRDS(rfdata, paste0(path, "change_sim_large_rfdata", c, ".rds"))
    }

Then model fitting:

    loop <- 1:nSims # Often in sets of 10,

    for (c in 1:length(changes)) {
      cat(paste0("\n- Change: ", changes[c], "\n-- (", nSims, "): "))

      rfdat <- readRDS(paste0(path, "change_sim_large_rfdata", c, ".rds"))

      VarVI_both <- VarVI_noi <- VarVI_int <-
        VarVI_maxint <- VarVI_bothmax <-
        data.frame("var" = c(
          "age",
          paste(cells_interactions$X1,
            cells_interactions$X2,
            sep = "_"
          )
        ))

      for (i in loop) {
        cat(paste0(i - min(loop) + 1, ", "))
        # Generate

        # Move into loop so this loop can be split to allow additional computation
        set.seed(c * 12345 + i)

        rfcv <- funkyModel(
          data = rfdat[[i]],
          outcome = "outcome", unit = "unit",
          metaNames = c("age"), silent = TRUE
        )

        # Org Data
        tmp <- rfcv$VariableImportance[, c("var", "est", "sd")]
        tmp <- tmp[order(-tmp$est), ]
        rownames(tmp) <- NULL
        tmp$CutoffNoise <- rfcv$NoiseCutoff
        tmp$CutoffInterp <- rfcv$InterpolationCutoff
        tmp$CutoffMaxInterp <- max(rfcv$InterpolationCutoff)

        # Above Lines
        tmp$TF_intCO <- (tmp$est > tmp$CutoffInterp)
        tmp$TF_noiCO <- (tmp$est > tmp$CutoffNoise)
        tmp[[paste0("iter", i)]] <- tmp$TF_intCO * tmp$TF_noiCO
        VarVI_both <- merge(VarVI_both, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_noiCO
        VarVI_noi <- merge(VarVI_noi, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_intCO
        VarVI_int <- merge(VarVI_int, tmp[, c("var", paste0("iter", i))])

        tmp$TF_maxIntCO <- (tmp$est > tmp$CutoffMaxInterp)
        tmp[[paste0("iter", i)]] <- tmp$TF_maxIntCO * tmp$TF_noiCO
        VarVI_bothmax <- merge(VarVI_bothmax, tmp[, c("var", paste0("iter", i))])
        tmp[[paste0("iter", i)]] <- tmp$TF_maxIntCO
        VarVI_maxint <- merge(VarVI_maxint, tmp[, c("var", paste0("iter", i))])
      }

      ## Save RDS

      results[[paste0("Change_", changes[c])]] <-
        list(
          "dat" = tmp, "fullDat" = list(
            rfcv$VariableImportance,
            rfcv$NoiseCutoff,
            rfcv$InterpolationCutoff
          ),
          "VarVI_both" = VarVI_both,
          "VarVI_noi" = VarVI_noi,
          "VarVI_int" = VarVI_int,
          "VarVI_bothmax" = VarVI_bothmax,
          "VarVI_maxint" = VarVI_maxint
        )

      ## Save RDS
      #   Min/Max loop due to our running of splitting the inner loop to
      #     run multiple instances at once.
      saveRDS(results, paste0(
        path, "change_sim_large_", c, "_",
        min(loop), max(loop), "_", ".rds"
      ))
    }

And data summarizing:

    data <- list()
    # Breaks come
    breaks <- c("1100") # This will change based on previous loop and saving
    for (i in 1:11) {
      tmpData <- list()
      for (j in 1:length(breaks)) {
        iterData <- readRDS(
          paste0(
            path, "change_sim_large_",
            i, "_", breaks[j], "_", ".rds"
          )
        )
        # Next part may be needed depending on break scheme to recombine
        if (j == 1) {
          tmpData[[names(iterData)]] <-
            list(
              dat = iterData[[1]]$dat[, -9],
              VarVI_both = iterData[[1]]$VarVI_both,
              VarVI_noi = iterData[[1]]$VarVI_noi,
              VarVI_int = iterData[[1]]$VarVI_int,
              VarVI_bothmax = iterData[[1]]$VarVI_bothmax,
              VarVI_maxint = iterData[[1]]$VarVI_maxint,
              VarVI_both = iterData[[1]]$VarVI_both
            )
        } else {
          tmpData[[names(iterData)]] <-
            list(
              dat = rbind(
                tmpData[[1]]$dat,
                iterData[[1]]$dat[, -9]
              ),
              VarVI_both = merge(
                tmpData[[1]]$VarVI_both,
                iterData[[1]]$VarVI_both
              ),
              VarVI_noi = merge(
                tmpData[[1]]$VarVI_noi,
                iterData[[1]]$VarVI_noi
              ),
              VarVI_int = merge(
                tmpData[[1]]$VarVI_int,
                iterData[[1]]$VarVI_int
              ),
              VarVI_bothmax = merge(
                tmpData[[1]]$VarVI_bothmax,
                iterData[[1]]$VarVI_bothmax
              ),
              VarVI_maxint = merge(
                tmpData[[1]]$VarVI_maxint,
                iterData[[1]]$VarVI_maxint
              ),
              VarVI_both = merge(
                tmpData[[1]]$VarVI_both,
                iterData[[1]]$VarVI_both
              )
            )
        }
      }

      data <- append(data, tmpData)
    }

    data_summary <- data.frame(
      "var" = changes, "noi" = NA, "int" = NA,
      "both" = NA, "max" = NA, "bothmax" = NA
    )

    for (i in 1:length(data)) {
      data_summary[i, "noi"] <-
        sum(data[[i]]$VarVI_noi[data[[i]]$VarVI_noi$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_noi[data[[i]]$VarVI_noi$var == "c1_c2", -1])

      data_summary[i, "int"] <-
        sum(data[[i]]$VarVI_int[data[[i]]$VarVI_int$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_int[data[[i]]$VarVI_int$var == "c1_c2", -1])

      data_summary[i, "max"] <-
        sum(data[[i]]$VarVI_max[data[[i]]$VarVI_max$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_max[data[[i]]$VarVI_max$var == "c1_c2", -1])

      data_summary[i, "both"] <-
        sum(data[[i]]$VarVI_both[data[[i]]$VarVI_both$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_both[data[[i]]$VarVI_both$var == "c1_c2", -1])

      # (max either)
      data_summary[i, "bothmax"] <-
        sum(data[[i]]$VarVI_bothmax[data[[i]]$VarVI_bothmax$var == "c1_c2", -1]) /
          length(data[[i]]$VarVI_bothmax[data[[i]]$VarVI_bothmax$var == "c1_c2", -1])
    }

    data_plot <- tidyr::pivot_longer(data_summary, cols = noi:bothmax)

With a resulting power curve:

    plot_lg <-
      ggplot2::ggplot(
        data_plot[data_plot$name %in% c("noi", "int", "both"), ],
        ggplot2::aes(x = var, y = value, color = name, group = name)
      ) +
      ggplot2::geom_line(linewidth = 1.25) +
      ggplot2::geom_point(size = 3) +
      ggplot2::geom_vline(
        ggplot2::aes(xintercept = baseline),
        color = "black", linetype = "dashed", linewidth = 1.25
      ) +
      ggplot2::geom_hline(
        ggplot2::aes(yintercept = 0.05),
        linetype = "dotted"
      ) +
      ggplot2::theme_bw() +
      ggplot2::theme(
        axis.text = ggplot2::element_text(size = 18),
        axis.title = ggplot2::element_text(size = 22),
        legend.position = "none",
        legend.title = ggplot2::element_text(size = 22),
        legend.text = ggplot2::element_text(size = 18)
      ) +
      ggplot2::xlab("Standard Deviation") +
      ggplot2::ylab(NULL) +
      ggplot2::scale_x_log10() +
      ggplot2::scale_color_discrete(type = c("#40e0d0", "orange", "red"))

    plot_lg

    knitr::include_graphics("img/change_lg_curve_show.png")