Skip to content

Commit

Permalink
Built site for gh-pages
Browse files Browse the repository at this point in the history
  • Loading branch information
Quarto GHA Workflow Runner committed Nov 21, 2024
1 parent ec1b899 commit 9161ff6
Show file tree
Hide file tree
Showing 10 changed files with 1,762 additions and 396 deletions.
2 changes: 1 addition & 1 deletion .nojekyll
Original file line number Diff line number Diff line change
@@ -1 +1 @@
23d3c3a2
03b95846
912 changes: 519 additions & 393 deletions index.html

Large diffs are not rendered by default.

Binary file modified index_files/figure-html/behav-1.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
7 changes: 7 additions & 0 deletions search.json
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,13 @@
"section": "",
"text": "Code\nlibrary(tidyverse)\nlibrary(patchwork)\nCode\ncolors_components <- c(\"#16607a\", \"#0b9d86\", \"#cc734d\")\nsize_label <- 5\n\nindex_time <- function(time_id, onset = 51, sampling_rate = 256) {\n (time_id - onset) / sampling_rate * 1000\n}\n\nfit_curve <- function(x, y) {\n nls(\n y ~ eta1 * (1 - exp(theta - eta2 * x)),\n start = list(eta1 = 1, eta2 = 0.01, theta = 0)\n )\n}\n\nprepare_corr_plotmath <- function(stats,\n col_r = \"estimate\",\n col_p = \"p.value\",\n name_r = \"italic(r)\",\n name_p = \"italic(p)[Holm]\") {\n stats |>\n rstatix::adjust_pvalue(col_p, \"p_adj\") |>\n rstatix::add_significance(\n \"p_adj\", \"p_adj_sig\",\n cutpoints = c(0, 0.001, 0.01, 0.05, 1),\n symbols = c(\"***\", \"**\", \"*\", \"\")\n ) |>\n mutate(\n label = format_r_plotmath(\n .data[[col_r]], p_adj,\n p.sig = p_adj_sig,\n name_r = name_r,\n name_p = name_p\n )\n )\n}\n\nformat_r_plotmath <- function(r, p,\n p.sig = \"\",\n name_r = \"italic(r)\",\n name_p = \"italic(p)[Holm]\") {\n paste0(\n str_glue(\"{name_r}*' = '*{round(r, 2)}\"),\n if (is.null(name_p)) {\n str_glue(\"^'{p.sig}'\")\n } else {\n paste0(\n \"*', '*\",\n if_else(\n p < 0.001,\n str_glue(\"{name_p} < 0.001^'{p.sig}'\"),\n str_glue(\"{name_p}*' = '*{round(p, 3)}^'{p.sig}'\")\n )\n )\n }\n )\n}\n\nvisualize_scatter <- function(data, mem_perf, lab_stat, col_stat,\n show_legend = FALSE) {\n data_joind <- data |>\n left_join(mem_perf, by = \"subj_id\") |>\n mutate(cca_id = factor(cca_id))\n stats <- data_joind |>\n reframe(\n cor.test(.data[[col_stat]], .data$dprime) |>\n broom::tidy(),\n .by = cca_id\n ) |>\n prepare_corr_plotmath()\n data_joind |>\n ggplot(aes(.data[[col_stat]], dprime)) +\n geom_point(aes(color = cca_id), show.legend = show_legend) +\n geom_smooth(\n aes(color = cca_id),\n method = \"lm\",\n formula = y ~ x,\n show.legend = show_legend\n ) +\n geom_text(\n aes(x = min(data_joind[[col_stat]]), y = Inf, label = label),\n stats,\n hjust = 0,\n vjust = 1,\n parse = TRUE\n ) +\n facet_grid(cols = vars(cca_id), scales = \"free\") +\n scale_x_continuous(name = lab_stat) +\n scale_y_continuous(name = \"d'\") +\n scale_color_components() +\n theme(axis.line = element_line(linewidth = 1), strip.text = element_blank())\n}\n\nvisualize_mantel <- function(patterns_x, patterns_y, stats, name_x, name_y,\n show_legend = FALSE) {\n patterns_flat <- patterns_x |>\n mutate(\n pattern = map(\n pick(last_col())[[1]],\n \\(pat) tibble(\n \"{name_x}\" := unclass(pat),\n \"{name_y}\" := unclass(patterns_y)\n )\n ),\n .keep = \"unused\"\n ) |>\n unnest(pattern)\n patterns_flat |>\n ggplot(aes(.data[[name_x]], .data[[name_y]])) +\n geom_hex(\n aes(fill = factor(cca_id), alpha = after_stat(count)),\n show.legend = FALSE\n ) +\n geom_smooth(\n aes(color = factor(cca_id)),\n method = \"lm\",\n formula = y ~ x,\n show.legend = show_legend\n ) +\n geom_text(\n aes(x = min(patterns_flat[[name_x]]), y = Inf, label = label),\n prepare_corr_plotmath(\n stats, \"statistic\",\n name_p = \"italic(p)[Holm]^{Mantel}\"\n ),\n hjust = 0, vjust = 1, parse = TRUE\n ) +\n facet_grid(cols = vars(cca_id), scales = \"free\") +\n scale_x_continuous(name = name_x) +\n scale_y_continuous(name = name_y) +\n scale_color_components(aesthetics = c(\"color\", \"fill\")) +\n theme(\n strip.text = element_blank(),\n axis.line = element_line(linewidth = 1)\n )\n}\n\nvisualize_mantel_dist <- function(data, stats, label, show_legend = FALSE) {\n data |>\n mutate(\n cca_id = factor(cca_id),\n null = map(mantel, \"perm\"),\n .keep = \"unused\"\n ) |>\n unchop(null) |>\n ggplot(aes(null)) +\n geom_histogram(aes(fill = cca_id), show.legend = show_legend) +\n geomtextpath::geom_textvline(\n aes(xintercept = statistic, label = label),\n stats |>\n mutate(cca_id = factor(cca_id)) |>\n prepare_corr_plotmath(\n \"statistic\",\n name_r = \"italic(r)[Obs]\",\n name_p = NULL\n ),\n parse = TRUE,\n vjust = -0.1\n ) +\n facet_grid(cols = vars(cca_id)) +\n scale_x_continuous(name = label) +\n scale_y_continuous(name = \"Count\", expand = expansion(mult = c(0, 0.05))) +\n scale_color_components(aesthetics = \"fill\") +\n theme(\n axis.line = element_line(linewidth = 1),\n strip.text = element_blank(),\n strip.background = element_blank()\n )\n}\n\nvisualize_dynamic <- function(stats,\n clusters_stats = NULL,\n col_stat = \"estimate\",\n lab_stat = \"Estimate\",\n col_cis = c(\"conf.low\", \"conf.high\"),\n limits = NULL,\n show_legend = FALSE) {\n if (!is.null(clusters_stats)) {\n clusters_stats <- clusters_stats |>\n mutate(cca_id = factor(cca_id)) |>\n rstatix::adjust_pvalue(\"p_perm\") |>\n rstatix::add_significance(\n \"p_perm.adj\",\n cutpoints = c(0, 0.001, 0.01, 0.05, 1),\n symbols = c(\"***\", \"**\", \"*\", \"\")\n ) |>\n filter(p_perm < 0.05)\n }\n show_cis <- !is.null(col_cis) && all(has_name(stats, col_cis))\n limits_rect <- if (show_cis) {\n range(c(stats[[col_cis[1]]], stats[[col_cis[2]]]))\n } else {\n range(stats[[col_stat]])\n }\n stats |>\n mutate(\n cca_id = factor(cca_id),\n time = index_time(time_id)\n ) |>\n ggplot(aes(time, .data[[col_stat]])) +\n geom_line(\n aes(color = cca_id),\n linewidth = 1,\n show.legend = show_legend\n ) +\n # TODO: Convert these as functions\n {\n if (show_cis) {\n geom_ribbon(\n aes(\n fill = cca_id,\n ymin = .data[[col_cis[1]]],\n ymax = .data[[col_cis[2]]]\n ),\n alpha = 0.2,\n show.legend = show_legend\n )\n }\n } +\n {\n if (!is.null(clusters_stats)) {\n list(\n geom_rect(\n data = clusters_stats,\n mapping = aes(\n xmin = index_time(start),\n xmax = index_time(end),\n ymin = limits_rect[1],\n ymax = limits_rect[2]\n ),\n inherit.aes = FALSE,\n alpha = 0.1\n ),\n geom_text(\n data = clusters_stats,\n mapping = aes(\n x = index_time((start + end) / 2),\n y = limits_rect[2],\n label = p_perm.adj.signif\n ),\n size = size_label,\n inherit.aes = FALSE\n )\n )\n }\n } +\n facet_grid(cols = vars(cca_id)) +\n geom_hline(yintercept = 0, linetype = \"dotted\", color = \"grey\") +\n geom_vline(xintercept = 0, linetype = \"dotted\", color = \"grey\") +\n scale_x_continuous(name = \"Encoding Time (ms)\") +\n scale_y_continuous(name = lab_stat, limits = limits) +\n scale_color_components(aesthetics = c(\"color\", \"fill\")) +\n theme(\n strip.text = element_blank(),\n strip.background = element_blank(),\n axis.line = element_line(linewidth = 1)\n )\n}\n\nscale_color_components <- function(...) {\n scale_color_manual(\n name = \"CCA Comp.\",\n values = colors_components,\n labels = \\(x) paste0(\"C\", x),\n ...\n )\n}\ntheme_set(ggpubr::theme_pubr(base_family = \"Gill Sans MT\", base_size = 12))"
},
{
"objectID": "index.html#mediation-analysis",
"href": "index.html#mediation-analysis",
"title": "Representation Analysis",
"section": "Mediation analysis",
"text": "Mediation analysis\n\n\nCode\nconstruct_med_data <- function(param) {\n param_formated <- param |>\n rstatix::add_significance(\n cutpoints = c(0, 0.001, 0.01, 0.05, 1),\n symbols = c(\"***\", \"**\", \"*\", \"\")\n ) |>\n mutate(\n value = str_glue(\n \"{round(Coefficient, 2)}{p.signif}\"\n ),\n signif = p < 0.05 # Flag for significance (TRUE if p < 0.05, else FALSE)\n ) |>\n select(Label, value, signif) |>\n pivot_wider(names_from = Label, values_from = c(value, signif))\n\n data.frame(\n lab_x = \"ISS\\\\n(Semantic)\",\n lab_m = \"IGS\\\\n(Fidelity)\",\n lab_y = \"Memory Performance\",\n coef_xm = param_formated$value_a,\n coef_my = param_formated$value_b,\n coef_xy = sprintf(\n \"%s (%s)\",\n param_formated$value_c,\n param_formated$value_total\n ),\n signif_xm = param_formated$signif_a,\n signif_my = param_formated$signif_b,\n signif_xy = param_formated$signif_c\n )\n}\n\nparams_med <- targets::tar_read(fit_mediation) |>\n mutate(\n param = map(\n fit,\n \\(m) parameters::model_parameters(m, standardize = TRUE) |> as_tibble()\n ),\n med_data = map(param, construct_med_data),\n .keep = \"unused\"\n )\n\n# modified based on https://stackoverflow.com/a/64886536/5996475\nmed_diagram <- function(data, height = .75, width = 2, graph_label = NA,\n node_text_size = 12, edge_text_size = 12, color = \"black\",\n ranksep = .2, minlen = 3) {\n # Set parameters for nodes and edges\n data$height <- height # node height\n data$width <- width # node width\n data$color <- color # node + edge border color\n data$ranksep <- ranksep # separation btwn mediator row and x->y row\n data$minlen <- minlen # minimum edge length\n\n data$node_text_size <- node_text_size\n data$edge_text_size <- edge_text_size\n data$graph_label <- ifelse(is.na(graph_label), \"\", paste0(\"label = '\", graph_label, \"'\"))\n\n # Define edge style based on significance: dotted if not significant\n data$style_xm <- ifelse(data$signif_xm, \"solid\", \"dotted\")\n data$style_my <- ifelse(data$signif_my, \"solid\", \"dotted\")\n data$style_xy <- ifelse(data$signif_xy, \"solid\", \"dotted\")\n\n # Construct diagram code with Glue\n diagram_out <- glue::glue_data(data,\n \"digraph flowchart {\n fontname = Helvetica\n graph [ranksep = <<ranksep>>]\n\n # node definitions with substituted label text\n node [fontname = Helvetica, shape = rectangle, fixedsize = TRUE, width = <<width>>, height = <<height>>, fontsize = <<node_text_size>>, color = <<color>>]\n mm [label = '<<lab_m>>']\n xx [label = '<<lab_x>>']\n yy [label = '<<lab_y>>']\n\n # edge definitions with the node IDs\n edge [minlen = <<minlen>>, fontname = Helvetica, fontsize = <<edge_text_size>>, color = <<color>>]\n mm -> yy [label = '<<coef_my>>', style = '<<style_my>>'];\n xx -> mm [label = '<<coef_xm>>', style = '<<style_xm>>'];\n xx -> yy [label = '<<coef_xy>>', style = '<<style_xy>>'];\n\n { rank = same; mm }\n { rank = same; xx; yy }\n\n }\n\n \",\n .open = \"<<\", .close = \">>\"\n )\n\n # Generate the diagram with DiagrammeR\n DiagrammeR::grViz(diagram_out)\n}\n\ndiagram <- targets::tar_read(fit_med_combined) |> \n parameters::model_parameters(standardize = TRUE) |>\n as_tibble() |>\n construct_med_data() |> \n med_diagram()\ndiagram\n\n\n\n\n\n\nCode\ndiagram |> \n DiagrammeRsvg::export_svg() |> \n charToRaw() |> \n rsvg::rsvg_png(\"figures/mediation.png\")"
},
{
"objectID": "index.html#inter-subject-pattern-similarity-isps",
"href": "index.html#inter-subject-pattern-similarity-isps",
Expand Down
14 changes: 14 additions & 0 deletions site_libs/DiagrammeR-styles-0.2/styles.css
Original file line number Diff line number Diff line change
@@ -0,0 +1,14 @@
.DiagrammeR,.grViz pre {
white-space: pre-wrap; /* CSS 3 */
white-space: -moz-pre-wrap; /* Mozilla, since 1999 */
white-space: -pre-wrap; /* Opera 4-6 */
white-space: -o-pre-wrap; /* Opera 7 */
word-wrap: break-word; /* Internet Explorer 5.5+ */
}

.DiagrammeR g .label {
font-family: Helvetica;
font-size: 14px;
color: #333333;
}

91 changes: 91 additions & 0 deletions site_libs/grViz-binding-1.0.11/grViz.js
Original file line number Diff line number Diff line change
@@ -0,0 +1,91 @@
HTMLWidgets.widget({

name: 'grViz',

type: 'output',

initialize: function(el, width, height) {

return {
// TODO: add instance fields as required
};
},

renderValue: function(el, x, instance) {
// Use this to sort of make our diagram responsive
// or at a minimum fit within the bounds set by htmlwidgets
// for the parent container
function makeResponsive(el){
var svg = el.getElementsByTagName("svg")[0];
if (svg) {
if (svg.width) {svg.removeAttribute("width")}
if (svg.height) {svg.removeAttribute("height")}
svg.style.width = "100%";
svg.style.height = "100%";
}
}

if (x.diagram !== "") {

if (typeof x.config === "undefined"){
x.config = {};
x.config.engine = "dot";
x.config.options = {};
}

try {

el.innerHTML = Viz(x.diagram, format="svg", engine=x.config.engine, options=x.config.options);

makeResponsive(el);

if (HTMLWidgets.shinyMode) {
// Get widget id
var id = el.id;

$("#" + id + " .node").click(function(e) {
// Get node id
var nodeid = e.currentTarget.id;
// Get node text object and make an array
var node_texts = $("#" + id + " #" + nodeid + " text");
//var node_path = $("#" + nodeid + " path")[0];
var text_array = node_texts.map(function() {return $(this).text(); }).toArray();
// Build return object *obj* with node-id, node text values and node fill
var obj = {
id: nodeid,
//fill: node_path.attributes.fill.nodeValue,
//outerHMTL: node_path.outerHTML,
nodeValues: text_array
};
// Send *obj* to Shiny's inputs (input$[id]+_click e.g.: input$vtree_click))
Shiny.setInputValue(id + "_click", obj, {priority: "event"});
});
}

// set up a container for tasks to perform after completion
// one example would be add callbacks for event handling
// styling
if (typeof x.tasks !== "undefined") {
if ((typeof x.tasks.length === "undefined") ||
(typeof x.tasks === "function")) {
// handle a function not enclosed in array
// should be able to remove once using jsonlite
x.tasks = [x.tasks];
}
x.tasks.map(function(t){
// for each tasks add it to the mermaid.tasks with el
t.call(el);
});
}
} catch(e){
var p = document.createElement("pre");
p.innerText = e;
el.appendChild(p);
}
}

},

resize: function(el, width, height, instance) {
}
});
21 changes: 21 additions & 0 deletions site_libs/htmltools-fill-0.5.8.1/fill.css
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
@layer htmltools {
.html-fill-container {
display: flex;
flex-direction: column;
/* Prevent the container from expanding vertically or horizontally beyond its
parent's constraints. */
min-height: 0;
min-width: 0;
}
.html-fill-container > .html-fill-item {
/* Fill items can grow and shrink freely within
available vertical space in fillable container */
flex: 1 1 auto;
min-height: 0;
min-width: 0;
}
.html-fill-container > :not(.html-fill-item) {
/* Prevent shrinking or growing of non-fill items */
flex: 0 0 auto;
}
}
Loading

0 comments on commit 9161ff6

Please sign in to comment.