diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml index bacc9cfe..3b11048a 100644 --- a/.github/workflows/check-bioc.yml +++ b/.github/workflows/check-bioc.yml @@ -216,6 +216,7 @@ jobs: BiocCheck::BiocCheck( dir('check', 'tar.gz$', full.names = TRUE), `quit-with-status` = TRUE, + `no-check-version-num` = TRUE, `no-check-R-ver` = TRUE, `no-check-bioc-help` = TRUE ) diff --git a/DESCRIPTION b/DESCRIPTION index ee2355a5..61d0c8ef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: Pedixplorer -Version: 1.1.4 +Version: 1.1.5 Date: 2024-10-01 Title: Pedigree Functions Authors@R: c( @@ -35,7 +35,8 @@ Imports: plotly, colourpicker, shinytoastr, - scales + scales, + shinycssloaders Description: Routines to handle family data with a Pedigree object. The initial purpose was to create correlation structures that describe family relationships such as kinship and identity-by-descent, which can be used to @@ -62,7 +63,8 @@ Suggests: covr, devtools, R.devices, - usethis + usethis, + magick Config/testthat/edition: 3 biocViews: Software, DataRepresentation, Genetics, GraphAndNetwork, Visualization BugReports: https://github.com/LouisLeNezet/Pedixplorer/issues diff --git a/NAMESPACE b/NAMESPACE index 12e1f4cc..8a9cc599 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,7 +27,6 @@ export(Scales) export(affected) export(align) export(ancestors) -export(anchor_to_factor) export(auto_hint) export(avail) export(best_hint) @@ -71,9 +70,7 @@ export(isinf) export(kin) export(kindepth) export(kinship) -export(make_class_info) export(make_famid) -export(make_rownames) export(min_dist_inf) export(momid) export(na_to_length) @@ -219,11 +216,13 @@ importFrom(dplyr,mutate_at) importFrom(dplyr,mutate_if) importFrom(dplyr,n) importFrom(dplyr,one_of) +importFrom(dplyr,pull) importFrom(dplyr,rename) importFrom(dplyr,rowwise) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(dplyr,sym) +importFrom(dplyr,ungroup) importFrom(ggplot2,aes) importFrom(ggplot2,annotate) importFrom(ggplot2,element_blank) @@ -319,6 +318,7 @@ importFrom(shiny,uiOutput) importFrom(shinyWidgets,pickerInput) importFrom(shinyWidgets,switchInput) importFrom(shinyWidgets,updateSwitchInput) +importFrom(shinycssloaders,withSpinner) importFrom(shinytoastr,toastr_error) importFrom(shinytoastr,toastr_info) importFrom(shinytoastr,toastr_success) diff --git a/NEWS.md b/NEWS.md index c290bed2..51e82dcd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,15 @@ -# NEWS +## Changes in v1.1.5 -NEWS file for the Pedixplorer package +- Change code of ped_to_legdf +- When plotting with the main plot, the legend gets its own +space separate from the plot. This allow better control over +the size and localisation of the legend. +- The graphical parameters are reset after each use of plot_fromdf +- Add tooltips control in Pedigree plots and add it to the app +- Add example of interactivness in vignette +- Fix plot area function and legend creation for better alignment -## Changes in version 1.1.4 +## Changes in v1.1.4 - Update website and logo - Improve `ped_shiny()` esthetics @@ -16,17 +23,17 @@ functions for users - Standardize the vignettes and add more documentation - Fix label adjusting position in plot functions -## Changes in version 1.1.3 +## Changes in v1.1.3 - Fix github workflows - Disable `ped_shiny()` execution in markdown - Publish with `pkgdown` -## Changes in version 1.1.2 +## Changes in v1.1.2 - Use R version 4.4 and update workflows -## Changes in version 1.1.1 +## Changes in v1.1.1 - A [shiny application](https://shiny.posit.co/) is now available through the `ped_shiny()` function. @@ -46,7 +53,7 @@ to reduce noise between platform. computed by `ped_to_plotdf()`. - `useful_inds()` function has been improved. -## Changes in version 0.99.0 +## Changes in v0.99.0 - Kinship2 is renamed to Pedixplorer and hosted on Bioconductor. - Pedigree is now a S4 object, all functions are updated to work with diff --git a/R/app_plot_download.R b/R/app_plot_download.R index 8884cc2d..20f41409 100644 --- a/R/app_plot_download.R +++ b/R/app_plot_download.R @@ -105,11 +105,11 @@ plot_download_server <- function( paste(myfilename(), input$ext, sep = ".") }, content = function(file) { if (input$ext == "html") { - if ("ggplot" %in% class(my_plot())) { + if ("htmlwidget" %in% class(my_plot())) { + htmlwidgets::saveWidget(file = file, my_plot()) + } else if ("ggplot" %in% class(my_plot())) { plot_html <- plotly::ggplotly(my_plot()) htmlwidgets::saveWidget(file = file, plot_html) - } else if ("htmlwidget" %in% class(my_plot())) { - htmlwidgets::saveWidget(file = file, my_plot()) } else { shinytoastr::toastr_error( title = "Error in plot type selected", diff --git a/R/app_plot_legend.R b/R/app_plot_legend.R index c53e3db2..ba53d3b6 100644 --- a/R/app_plot_legend.R +++ b/R/app_plot_legend.R @@ -1,8 +1,8 @@ #### UI function of the module #### ---------- -#' @rdname plot_legend +#' @rdname plot_legend_app #' @export #' @importFrom shiny NS column plotOutput -plot_legend_ui <- function(id, height = "200px") { +plot_legend_ui <- function(id, height = "400px") { ns <- shiny::NS(id) shiny::column(12, shiny::plotOutput(ns("plotlegend"), height = height) @@ -25,13 +25,13 @@ plot_legend_ui <- function(id, height = "200px") { #' if (interactive()) { #' plot_legend_demo() #' } -#' @rdname plot_legend +#' @rdname plot_legend_app #' @keywords internal #' @export #' @importFrom shiny moduleServer is.reactive renderPlot req plot_legend_server <- function( - id, pedi, leg_loc = c(0.2, 1, 0, 1), - lwd = par("lwd"), boxw = 1, boxh = 1, + id, pedi, leg_loc = c(0, 1, 0, 1), + lwd = par("lwd"), boxw = 0.1, boxh = 0.1, adjx = 0, adjy = 0 ) { stopifnot(shiny::is.reactive(pedi)) @@ -51,11 +51,13 @@ plot_legend_server <- function( } #### Demo function of the module #### ---------- -#' @rdname plot_legend +#' @rdname plot_legend_app #' @export #' @importFrom utils data #' @importFrom shiny shinyApp fluidPage reactive -plot_legend_demo <- function(height = "200px", leg_loc = c(0.2, 1, 0, 1)) { +plot_legend_demo <- function( + height = "400px", leg_loc = c(0.2, 0.8, 0.2, 0.6) +) { data_env <- new.env(parent = emptyenv()) utils::data("sampleped", envir = data_env, package = "Pedixplorer") pedi <- shiny::reactive({ diff --git a/R/app_plot_ped.R b/R/app_plot_ped.R index 13cdc0c0..aaff73d7 100644 --- a/R/app_plot_ped.R +++ b/R/app_plot_ped.R @@ -31,6 +31,7 @@ plot_ped_ui <- function(id) { #' @param precision An integer to set the precision of the plot. #' @param max_ind An integer to set the maximum number of individuals to plot. #' @inheritParams plot_fromdf +#' @inheritParams ped_to_plotdf #' @returns A reactive ggplot or the pedigree object. #' @examples #' if (interactive()) { @@ -46,15 +47,24 @@ plot_ped_ui <- function(id) { #' @importFrom shiny tagList checkboxInput plotOutput #' @importFrom ggplot2 scale_y_reverse theme element_blank #' @importFrom plotly ggplotly renderPlotly plotlyOutput +#' @importFrom shinycssloaders withSpinner plot_ped_server <- function( id, pedi, title, precision = 2, - max_ind = 500, lwd = par("lwd") + max_ind = 500, lwd = par("lwd"), + tips = NULL ) { stopifnot(shiny::is.reactive(pedi)) shiny::moduleServer(id, function(input, output, session) { ns <- shiny::NS(id) + mytips <- shiny::reactive({ + if (shiny::is.reactive(tips)) { + tips <- tips() + } + tips + }) + mytitle <- shiny::reactive({ if (shiny::is.reactive(title)) { title <- title() @@ -95,8 +105,9 @@ plot_ped_server <- function( pedi_val(), aff_mark = TRUE, label = NULL, ggplot_gen = input$interactive, cex = 1, symbolsize = 1, force = TRUE, - mar = c(0.5, 0.5, 1.5, 0.5), title = mytitle(), - precision = precision, lwd = lwd + ped_par = list(mar = c(0.5, 0.5, 1.5, 0.5)), + title = mytitle(), tips = mytips(), + precision = precision, lwd = lwd / 3 ) ggp <- ped_plot_lst$ggplot + ggplot2::scale_y_reverse() + @@ -115,7 +126,8 @@ plot_ped_server <- function( ggp + ggplot2::theme(legend.position = "none"), tooltip = "text" - ) + ) %>% + plotly::layout(hoverlabel = list(bgcolor = "darkgrey")) }) output$plotpedi <- shiny::renderUI({ if (is.null(input$interactive)) { @@ -125,7 +137,8 @@ plot_ped_server <- function( output$ped_plotly <- plotly::renderPlotly({ plotly_ped() }) - plotly::plotlyOutput(ns("ped_plotly"), height = "700px") + plotly::plotlyOutput(ns("ped_plotly"), height = "700px") %>% + shinycssloaders::withSpinner(color = "#8aca25") } else { output$ped_plot <- shiny::renderPlot({ shiny::req(pedi_val()) @@ -133,11 +146,13 @@ plot_ped_server <- function( pedi_val(), aff_mark = TRUE, label = NULL, cex = 1, symbolsize = 1, force = TRUE, - mar = c(0.5, 0.5, 1.5, 0.5), title = mytitle(), + ped_par = list(mar = c(0.5, 0.5, 1.5, 0.5)), + title = mytitle(), precision = precision, lwd = lwd ) }) - shiny::plotOutput(ns("ped_plot"), height = "700px") + shiny::plotOutput(ns("ped_plot"), height = "700px") %>% + shinycssloaders::withSpinner(color = "#8aca25") } }) @@ -156,7 +171,7 @@ plot_ped_server <- function( #' @rdname plot_ped #' @export #' @importFrom shiny shinyApp fluidPage -plot_ped_demo <- function(pedi, precision = 2, max_ind = 500) { +plot_ped_demo <- function(pedi, precision = 2, max_ind = 500, tips = NULL) { ui <- shiny::fluidPage( plot_ped_ui("plot_ped"), plot_download_ui("saveped") @@ -165,7 +180,7 @@ plot_ped_demo <- function(pedi, precision = 2, max_ind = 500) { ped_plot <- plot_ped_server( "plot_ped", pedi, "My Pedigree", max_ind = max_ind, - precision = precision + precision = precision, tips = tips ) plot_download_server("saveped", ped_plot) } diff --git a/R/app_server.R b/R/app_server.R index aa9ab942..6674a9e9 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -298,7 +298,6 @@ ped_server <- function( ) ## Plotting pedigree -------------------------------------------------- - cust_title <- function(short) { shiny::reactive({ shiny::req(lst_fam()) @@ -315,16 +314,35 @@ ped_server <- function( }) } + ### Tips column selection -------------------------------------------- + output$col_sel_tips <- renderUI({ + shiny::req(ped_subfam()) + all_cols <- colnames(Pedixplorer::as.data.frame(ped(ped_subfam()))) + select <- c("affection", "affected", "avail", "status") + select <- select[select %in% all_cols] + shiny::selectInput( + "tips_col", + label = "Select columns for tips", + choices = all_cols, selected = select, + multiple = TRUE + ) + }) + + my_tips <- shiny::reactive({ + input$tips_col + }) + plot_ped <- plot_ped_server( "ped", ped_subfam, cust_title(short = FALSE), - precision = precision, lwd = 2 + precision = precision, lwd = 2, + tips = my_tips ) plot_legend_server( "legend", ped_subfam, - boxw = 0.03, boxh = 0.07, adjx = 0.3, adjy = -0.015, - leg_loc = c(0.2, 1.2, 0.2, 0.95), lwd = 2 + boxw = 0.02, boxh = 0.08, adjx = 0, adjy = 0, + leg_loc = c(0.1, 0.7, 0.01, 0.95), lwd = 1.5 ) ## Download data and plot --------------------------------------------- diff --git a/R/app_ui.R b/R/app_ui.R index af5895a5..28d78cdd 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -129,7 +129,8 @@ ped_ui <- function() { shiny::fluidRow( shiny::column(5, plot_download_ui("saveped"), - data_download_ui("plot_data_dwnl") + data_download_ui("plot_data_dwnl"), + shiny::uiOutput("col_sel_tips") ), shiny::column(7, plot_legend_ui("legend", "350px") diff --git a/R/ped_to_legdf.R b/R/ped_to_legdf.R index 7f23ed23..d807b6b6 100644 --- a/R/ped_to_legdf.R +++ b/R/ped_to_legdf.R @@ -73,19 +73,17 @@ setMethod("ped_to_legdf", "Pedigree", function( all_lab <- c(all_lab, all_aff) max_lab <- lapply(lapply( all_lab, graphics::strwidth, - units = "inches", cex = cex + units = "figure", cex = cex ), max) - posx <- unlist(lapply(max_lab, function(x) { - c(c(boxw, boxw, boxw / 5), x * 3) - })) - posx <- cumsum(posx) - boxw - posx <- c(posx[seq_along(posx) %% 2 == 1], posx[length(posx)]) + + posx_all <- cumsum(unlist(max_lab) + boxw * 2) + posx <- c(0, posx_all[seq_len((length(posx_all) - 1))]) n_max <- max(unlist(lapply(all_lab, function(x) { length(x) }))) - posy <- rep(boxh, n_max * 2) + posy <- rep(c(boxh, boxh / 3), n_max) posy <- cumsum(posy) posy <- posy[seq_along(posy) %% 2 == 0] @@ -95,7 +93,7 @@ setMethod("ped_to_legdf", "Pedigree", function( # Categories titles lab_title <- c("Sex", "Border", unique(all_aff$column_values)) titles <- data.frame( - x0 = posx[seq_along(posx) %% 2 == 0] - boxw, y0 = 0, + x0 = posx, y0 = 0, type = "text", label = lab_title, adjx = 0.5, adjy = 0, fill = "black", cex = cex * 1.5, id = "titles" @@ -109,7 +107,7 @@ setMethod("ped_to_legdf", "Pedigree", function( poly1 <- polygons(1) all_sex <- unique(as.numeric(ped_df$sex)) sex <- data.frame( - x0 = posx[1], y0 = posy[all_sex], + x0 = posx[1], y0 = posy[all_sex] - boxh / 2, type = paste(names(poly1)[all_sex], 1, 1, sep = "_"), fill = "white", border = "black", @@ -117,7 +115,7 @@ setMethod("ped_to_legdf", "Pedigree", function( ) sex_label <- data.frame( - x0 = posx[2] + adjx, + x0 = posx[1] + boxw + adjx, y0 = posy[all_sex] + adjy, label = sex_equiv[all_sex], cex = cex, type = "text", adjx = 0, adjy = 0.5, @@ -130,7 +128,8 @@ setMethod("ped_to_legdf", "Pedigree", function( # Border border_mods <- unique(ped_df[, unique(border(obj)$column_mods)]) border <- data.frame( - x0 = posx[3], y0 = posy[seq_along(border_mods)], + x0 = posx[2], + y0 = posy[seq_along(border_mods)] - boxh / 2, type = rep("square_1_1", length(border_mods)), border = border(obj)$border[match(border_mods, border(obj)$mods)], fill = "white", @@ -139,7 +138,7 @@ setMethod("ped_to_legdf", "Pedigree", function( lab <- border(obj)$labels[match(border_mods, border(obj)$mods)] lab[is.na(lab)] <- "NA" border_label <- data.frame( - x0 = posx[4] + adjx, + x0 = posx[2] + boxw + adjx, y0 = posy[seq_along(border_mods)] + adjy, label = lab, cex = cex, adjx = 0, adjy = 0.5, type = "text", @@ -154,7 +153,8 @@ setMethod("ped_to_legdf", "Pedigree", function( aff_df <- all_aff[all_aff$order == aff, ] aff_mods <- aff_df$mods aff_bkg <- data.frame( - x0 = posx[3 + aff * 2], y0 = posy[seq_along(aff_mods)], + x0 = posx[2 + aff], + y0 = posy[seq_along(aff_mods)] - boxh / 2, type = rep(paste("square", 1, 1, sep = "_"), length(aff_mods) ), @@ -163,7 +163,8 @@ setMethod("ped_to_legdf", "Pedigree", function( ) affected <- data.frame( - x0 = posx[3 + aff * 2], y0 = posy[seq_along(aff_mods)], + x0 = posx[2 + aff], + y0 = posy[seq_along(aff_mods)] - boxh / 2, type = rep(paste("square", n_aff, aff, sep = "_"), length(aff_mods) ), @@ -174,8 +175,9 @@ setMethod("ped_to_legdf", "Pedigree", function( lab <- aff_df$labels lab[is.na(lab)] <- "NA" + affected_label <- data.frame( - x0 = posx[4 + aff * 2] + adjx, + x0 = posx[2 + aff] + boxw + adjx, y0 = posy[seq_along(aff_mods)] + adjy, label = lab, cex = cex, adjx = 0, adjy = 0.5, type = "text", diff --git a/R/ped_to_plotdf.R b/R/ped_to_plotdf.R index 99f90654..ce5a7357 100644 --- a/R/ped_to_plotdf.R +++ b/R/ped_to_plotdf.R @@ -39,6 +39,8 @@ NULL #' corresponding to the value of the column given. #' @param lwd default=par("lwd"). Controls the line width of the #' segments, arcs and polygons. +#' @param tips A character vector of the column names of the data frame to +#' use as tooltips. If `NULL`, no tooltips are added. #' @param ... Other arguments passed to [par()] #' @inheritParams set_plot_area #' @inheritParams kindepth @@ -76,7 +78,7 @@ setMethod("ped_to_plotdf", "Pedigree", function( align = c(1.5, 2), align_parents = TRUE, force = FALSE, cex = 1, symbolsize = cex, pconnect = 0.5, branch = 0.6, aff_mark = TRUE, id_lab = "id", label = NULL, precision = 3, - lwd = par("lwd"), ... + lwd = par("lwd"), tips = NULL, ... ) { famlist <- unique(famid(ped(obj))) @@ -111,8 +113,10 @@ setMethod("ped_to_plotdf", "Pedigree", function( xrange <- range(plist$pos[plist$nid > 0]) maxlev <- nrow(plist$pos) + labels <- unname(unlist(as.data.frame(ped(obj))[c(id_lab, label)])) + params_plot <- set_plot_area( - cex, id(ped(obj)), maxlev, xrange, symbolsize, precision, ... + cex, labels, maxlev, xrange, symbolsize, precision, ... ) boxw <- params_plot$boxw @@ -141,6 +145,8 @@ setMethod("ped_to_plotdf", "Pedigree", function( border_mods <- ped_df[id[idx], unique(border(obj)$column_mods)] border_idx <- match(border_mods, border(obj)$mods) + ped_df$tips <- create_text_column(ped_df, id_lab, c(label, tips)) + for (aff in seq_len(n_aff)) { aff_df <- all_aff[all_aff$order == aff, ] aff_mods <- ped_df[id[idx], unique(aff_df[["column_mods"]])] @@ -162,7 +168,7 @@ setMethod("ped_to_plotdf", "Pedigree", function( density = aff_df[aff_idx, "density"], angle = aff_df[aff_idx, "angle"], border = border(obj)$border[border_idx], - cex = lwd, + cex = lwd, tips = ped_df[id[idx], "tips"], id = "polygon" ) plot_df <- plyr::rbind.fill(plot_df, ind) @@ -172,7 +178,7 @@ setMethod("ped_to_plotdf", "Pedigree", function( y0 = i[idx] + boxh / 2, label = ped_df[id[idx], unique(aff_df[["column_values"]])], fill = "black", adjx = 0.5, adjy = 0.5, - type = "text", cex = cex, + type = "text", cex = cex, tips = ped_df[id[idx], "tips"], id = "aff_mark" ) plot_df <- plyr::rbind.fill(plot_df, aff_mark_df) @@ -196,10 +202,10 @@ setMethod("ped_to_plotdf", "Pedigree", function( ## Add ids id_df <- data.frame( - x0 = pos[idx], y0 = i[idx] + boxh + labh * 1.2, + x0 = pos[idx], y0 = i[idx] + boxh + labh, label = ped_df[id[idx], id_lab], fill = "black", - type = "text", cex = cex, adjx = 0.5, adjy = 0.5, - id = "id" + type = "text", cex = cex, adjx = 0.5, adjy = 1, + id = "id", tips = ped_df[id[idx], "tips"] ) plot_df <- rbind.fill(plot_df, id_df) @@ -212,7 +218,7 @@ setMethod("ped_to_plotdf", "Pedigree", function( label = ped_df[id[idx], label], fill = "black", adjy = 1, adjx = 0.5, type = "text", cex = cex, - id = "label" + id = "label", tips = ped_df[id[idx], "tips"] ) plot_df <- rbind.fill(plot_df, label) } diff --git a/R/plot_fct.R b/R/plot_fct.R index 13a74561..1a890722 100644 --- a/R/plot_fct.R +++ b/R/plot_fct.R @@ -235,6 +235,7 @@ draw_segment <- function( #' @param border Border color #' @param density Density of shading #' @param angle Angle of shading +#' @param tips Text to be displayed when hovering over the polygon #' @inheritParams draw_segment #' #' @return Plot the polygon to the current device @@ -247,7 +248,7 @@ draw_polygon <- function( x, y, p = NULL, ggplot_gen = FALSE, fill = "grey", border = "black", density = NULL, angle = 45, - lwd = par("lwd") + lwd = par("lwd"), tips = NULL ) { graphics::polygon( x, y, col = fill, border = border, @@ -255,11 +256,14 @@ draw_polygon <- function( lwd = lwd ) if (ggplot_gen) { + if (is.null(tips)) { + tips <- "None" + } p <- p + - ggplot2::geom_polygon( - ggplot2::aes(x = x, y = y), fill = fill, - color = border, linewidth = lwd - ) + suppressWarnings(ggplot2::geom_polygon( + ggplot2::aes(x = x, y = y, text = tips), + fill = fill, color = border, linewidth = lwd + )) # To add pattern stripes use ggpattern::geom_polygon_pattern # pattern_density = density[i], pattern_angle = angle[i])) } @@ -273,6 +277,7 @@ draw_polygon <- function( #' @param col Text color #' @param adjx x adjustment #' @param adjy y adjustment +#' @param tips Text to be displayed when hovering over the text #' @inheritParams draw_segment #' @inheritParams draw_polygon #' @@ -283,14 +288,17 @@ draw_polygon <- function( #' @importFrom ggplot2 annotate #' @importFrom graphics text draw_text <- function(x, y, label, p = NULL, ggplot_gen = FALSE, - cex = 1, col = NULL, adjx = 0.5, adjy = 0.5 + cex = 1, col = NULL, adjx = 0.5, adjy = 0.5, tips = NULL ) { graphics::text(x, y, label, cex = cex, col = col, adj = c(adjx, adjy)) if (ggplot_gen) { - p <- p + ggplot2::annotate( - "text", x = x, y = y, label = label, - size = cex / 0.3, colour = col - ) + if (is.null(tips)) { + tips <- label + } + p <- p + suppressWarnings(ggplot2::geom_text(ggplot2::aes( + x = x, y = y, label = label, + text = tips + ), size = cex / 0.3, colour = col)) } p } @@ -368,7 +376,7 @@ set_plot_area <- function( # horizontal scale in inches hscale <- signif((psize[1] - boxsize) / diff(xrange), precision) vscale <- signif( - (psize[2] - (stemp3 + stemp2 / 2 + boxsize)) / + (psize[2] - (stemp3 + stemp2 + boxsize)) / max(1, maxlev - 1), precision ) # box width in user units @@ -379,8 +387,9 @@ set_plot_area <- function( labh <- signif(stemp2 / vscale, precision) # how tall are the 'legs' up from a child legh <- signif(min(1 / 4, boxh * 1.5), precision) + usr <- c(xrange[1] - boxw / 2, xrange[2] + boxw / 2, - maxlev + boxh + stemp3 + stemp2 / 2, 1 + maxlev + boxh + stemp3 / vscale + stemp2 / vscale, 1 ) list(usr = usr, old_par = old_par, boxw = boxw, boxh = boxh, labh = labh, legh = legh diff --git a/R/plot_fromdf.R b/R/plot_fromdf.R index 13b55982..e9144495 100644 --- a/R/plot_fromdf.R +++ b/R/plot_fromdf.R @@ -65,11 +65,13 @@ plot_fromdf <- function( ) { if (!add_to_existing) { graphics::frame() + op <- par(no.readonly = TRUE) if (!is.null(usr)) { graphics::par(usr = usr) } + } else { + op <- par(no.readonly = TRUE) } - p <- ggplot2::ggplot() + ggplot2::theme( plot.margin = ggplot2::unit(c(0, 0, 0, 0), "cm"), @@ -126,7 +128,7 @@ plot_fromdf <- function( p, ggplot_gen, fill = boxes$fill[i], border = boxes$border[i], density = boxes$density[i], angle = boxes$angle[i], - lwd = boxes$cex[i] + lwd = boxes$cex[i], tips = boxes$tips[i] ) } } @@ -159,11 +161,11 @@ plot_fromdf <- function( p <- draw_text( txt_xy$x0, txt_xy$y0, txt_xy$label, p, ggplot_gen, txt_xy$cex, txt_xy$fill, - adjx, adjy + adjx, adjy, tips = txt_xy$tips ) } } } - + par(op) invisible(p) } diff --git a/R/plot_pedigree.R b/R/plot_pedigree.R index fbc43cfa..cff897a6 100644 --- a/R/plot_pedigree.R +++ b/R/plot_pedigree.R @@ -3,29 +3,48 @@ #' Small internal function to be used for plotting a Pedigree #' object legend #' @inheritParams ped_to_legdf -#' @keywords internal, plot_legend +#' @return an invisible list containing +#' - df : the data.frame used to plot the Pedigree +#' - par_usr : the user coordinates used to plot the Pedigree +#' @section Side Effects: +#' Creates plot on current plotting device. +#' @keywords internal +#' @keywords plot_legend #' @importFrom scales rescale plot_legend <- function( - pedi, cex = 1, boxw = 0.1, boxh = 0.1, adjx = 0, adjy = 0, + obj, cex = 1, boxw = 0.1, boxh = 0.1, adjx = 0, adjy = 0, leg_loc = c(0, 1, 0, 1), add_to_existing = FALSE, usr = NULL, lwd = par("lwd") ) { leg <- ped_to_legdf( - pedi, cex = cex, + obj, cex = cex, boxw = boxw, boxh = boxh, adjx = adjx, adjy = adjy, lwd = lwd ) - leg$df$x0 <- scales::rescale(leg$df$x0, - c(leg_loc[1], leg_loc[2]) - ) - leg$df$y0 <- scales::rescale(leg$df$y0, - c(leg_loc[3], leg_loc[4]) - ) + if (!is.null(leg_loc)) { + distx0 <- max(leg$df$x0) - min(leg$df$x0) + leg$df$x0 <- scales::rescale(leg$df$x0, + c(leg_loc[1], leg_loc[2]) + ) + disty0 <- max(leg$df$y0) - min(leg$df$y0) + leg$df$y0 <- scales::rescale(leg$df$y0, + c(leg_loc[3], leg_loc[4]) + ) + boxw <- boxw * ((max(leg$df$x0) - min(leg$df$x0)) / distx0) + boxh <- boxh * ((max(leg$df$y0) - min(leg$df$y0)) / disty0) + if (leg_loc[3] > leg_loc[4]) { + label <- stringr::str_detect(leg$df$type, "label") + symbol <- !label & leg$df$type != "text" + leg$df[symbol, ]$y0 <- leg$df[symbol, ]$y0 - boxh + } + } plot_fromdf( leg$df, add_to_existing = add_to_existing, boxw = boxw, boxh = boxh, usr = usr ) + + invisible(list(df = leg$df, par_usr = usr)) } @@ -90,13 +109,18 @@ plot_legend <- function( #' @param leg_loc default=NULL. If NULL, the legend will be placed in the #' upper right corner of the plot. Otherwise, a 4-element vector of the form #' (x0, x1, y0, y1) can be used to specify the location of the legend. +#' The legend will be fitted to the specified and might be distorted if the +#' aspect ratio of the legend is different from the aspect ratio of the +#' specified location. #' @param leg_adjx default=0. Controls the horizontal labels adjustment of #' the legend. #' @param leg_adjy default=0. Controls the vertical labels adjustment #' of the legend. -#' @param ... Extra options that feed into the +#' @param ped_par default=list(). A list of parameters to use as graphical +#' parameteres for the main plot. +#' @param leg_par default=list(). A list of parameters to use as graphical +#' parameters for the legend. #' @inheritParams subregion -#' [ped_to_plotdf()] function. #' #' @return an invisible list containing #' - df : the data.frame used to plot the Pedigree @@ -116,9 +140,11 @@ plot_legend <- function( #' @include ped_to_plotdf.R #' @include ped_to_legdf.R #' @include plot_fromdf.R +#' @include utils.R #' @aliases plot.Pedigree #' @aliases plot,Pedigree #' @keywords Pedigree-plot +#' @importFrom graphics par #' @export #' @docType methods #' @rdname plot_pedigree @@ -130,7 +156,8 @@ setMethod("plot", c(x = "Pedigree", y = "missing"), title = NULL, subreg = NULL, pconnect = 0.5, fam_to_plot = 1, legend = FALSE, leg_cex = 0.8, leg_symbolsize = 0.5, leg_loc = NULL, leg_adjx = 0, leg_adjy = 0, precision = 2, - lwd = par("lwd"), ... + lwd = par("lwd"), ped_par = list(), leg_par = list(), + tips = NULL ) { famlist <- unique(famid(ped(x))) if (length(famlist) > 1) { @@ -142,10 +169,14 @@ setMethod("plot", c(x = "Pedigree", y = "missing"), } x <- x[famid(ped(x)) == fam_to_plot] } + op <- par(ped_par) lst <- ped_to_plotdf( - x, packed, width, align, align_parents, force, - cex, symbolsize, pconnect, branch, aff_mark, id_lab, label, - precision, lwd = lwd, ... + obj = x, packed = packed, width = width, align = align, + align_parents = align_parents, force = force, + cex = cex, symbolsize = symbolsize, + pconnect = pconnect, branch = branch, + aff_mark = aff_mark, id_lab = id_lab, label = label, + tips = tips, precision = precision, lwd = lwd ) if (is.null(lst)) { @@ -158,10 +189,11 @@ setMethod("plot", c(x = "Pedigree", y = "missing"), } p <- plot_fromdf( - lst$df, lst$par_usr$usr, + df = lst$df, usr = lst$par_usr$usr, title = title, ggplot_gen = ggplot_gen, boxw = lst$par_usr$boxw, boxh = lst$par_usr$boxh ) + par(op) if (legend) { if (is.null(leg_loc)) { @@ -170,12 +202,15 @@ setMethod("plot", c(x = "Pedigree", y = "missing"), lst$par_usr$usr[3] + 0.1, lst$par_usr$usr[3] + 0.4 ) } - plot_legend(x, cex = leg_cex, - boxw = lst$par_usr$boxw * leg_symbolsize, - boxh = lst$par_usr$boxh * leg_symbolsize, + par(leg_par) + graphics::box(col = "#00000000") + plot_legend(obj = x, cex = leg_cex, + boxw = leg_symbolsize, + boxh = leg_symbolsize, adjx = leg_adjx, adjy = leg_adjy, leg_loc = leg_loc, add_to_existing = TRUE ) + par(op) } if (ggplot_gen) { diff --git a/R/utils.R b/R/utils.R index b8cb67be..0dffc826 100644 --- a/R/utils.R +++ b/R/utils.R @@ -431,8 +431,7 @@ vect_to_binary <- function(vect, logical = FALSE) { #' @return An ordered factor vector containing the transformed variable #' "either" < "left" < "right" #' @examples -#' anchor_to_factor(c(1, 2, 0, "left", "right", "either")) -#' @export +#' Pedixplorer:::anchor_to_factor(c(1, 2, 0, "left", "right", "either")) #' @keywords internal anchor_to_factor <- function(anchor) { if (is.factor(anchor) || is.numeric(anchor)) { @@ -467,8 +466,7 @@ anchor_to_factor <- function(anchor) { #' @return A character vector of rownames #' @keywords internal #' @examples -#' Pedixplorer::make_rownames(rownames(mtcars), nrow(mtcars), 3, 3) -#' @export +#' Pedixplorer:::make_rownames(rownames(mtcars), nrow(mtcars), 3, 3) make_rownames <- function( x_rownames, nrow, nhead, ntail ) { @@ -494,8 +492,7 @@ make_rownames <- function( #' @return A character vector of class information #' @keywords internal #' @examples -#' Pedixplorer::make_class_info(list(1, "a", 1:3, list(1, 2))) -#' @export +#' Pedixplorer:::make_class_info(list(1, "a", 1:3, list(1, 2))) #' @importFrom S4Vectors classNameForDisplay make_class_info <- function(x) { vapply( @@ -506,3 +503,45 @@ make_class_info <- function(x) { character(1), USE.NAMES = FALSE ) } + + +#' Create a text column +#' +#' Aggregate multiple columns into a single text column +#' separated by a newline character. +#' +#' @param df A dataframe +#' @param title The title of the text column +#' @param cols A vector of columns to concatenate +#' @param na_strings A vector of strings that should be considered as NA +#' @return The concatenated text column +#' @keywords internal +#' @examples +#' df <- data.frame(a = 1:3, b = c("4", "NA", 6), c = c("", "A", 2)) +#' Pedixplorer:::create_text_column(df, "a", c("b", "c")) +#' @importFrom dplyr rowwise mutate ungroup pull +create_text_column <- function( + df, title = NULL, cols = NULL, na_strings = c("", "NA") +) { + check_columns(df, c(title, cols), NULL, others_cols = TRUE) + df %>% + dplyr::rowwise() %>% + dplyr::mutate(text = paste( + paste( + "", + as.character(get(title)), + "
", sep = "" + ), paste( + unlist(lapply(cols, function(col) { + value <- as.character(get(col)) + if (value %in% na_strings) { + return(NULL) + } else { + return(paste("", col, ": ", value, sep = "")) + } + })), collapse = "
", sep = "" + ), collapse = "
", sep = "" + )) %>% + dplyr::ungroup() %>% + dplyr::pull(text) +} diff --git a/man/anchor_to_factor.Rd b/man/anchor_to_factor.Rd index 861e4c30..290515a4 100644 --- a/man/anchor_to_factor.Rd +++ b/man/anchor_to_factor.Rd @@ -22,6 +22,6 @@ An ordered factor vector containing the transformed variable Anchor variable to ordered factor } \examples{ -anchor_to_factor(c(1, 2, 0, "left", "right", "either")) +Pedixplorer:::anchor_to_factor(c(1, 2, 0, "left", "right", "either")) } \keyword{internal} diff --git a/man/create_text_column.Rd b/man/create_text_column.Rd new file mode 100644 index 00000000..d39cb6ae --- /dev/null +++ b/man/create_text_column.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{create_text_column} +\alias{create_text_column} +\title{Create a text column} +\usage{ +create_text_column(df, title = NULL, cols = NULL, na_strings = c("", "NA")) +} +\arguments{ +\item{df}{A dataframe} + +\item{title}{The title of the text column} + +\item{cols}{A vector of columns to concatenate} + +\item{na_strings}{A vector of strings that should be considered as NA} +} +\value{ +The concatenated text column +} +\description{ +Aggregate multiple columns into a single text column +separated by a newline character. +} +\examples{ +df <- data.frame(a = 1:3, b = c("4", "NA", 6), c = c("", "A", 2)) +Pedixplorer:::create_text_column(df, "a", c("b", "c")) +} +\keyword{internal} diff --git a/man/draw_polygon.Rd b/man/draw_polygon.Rd index ad435878..21f538b9 100644 --- a/man/draw_polygon.Rd +++ b/man/draw_polygon.Rd @@ -13,7 +13,8 @@ draw_polygon( border = "black", density = NULL, angle = 45, - lwd = par("lwd") + lwd = par("lwd"), + tips = NULL ) } \arguments{ @@ -34,6 +35,8 @@ draw_polygon( \item{angle}{Angle of shading} \item{lwd}{Line width} + +\item{tips}{Text to be displayed when hovering over the polygon} } \value{ Plot the polygon to the current device diff --git a/man/draw_text.Rd b/man/draw_text.Rd index 35f041f7..48b93f3a 100644 --- a/man/draw_text.Rd +++ b/man/draw_text.Rd @@ -13,7 +13,8 @@ draw_text( cex = 1, col = NULL, adjx = 0.5, - adjy = 0.5 + adjy = 0.5, + tips = NULL ) } \arguments{ @@ -34,6 +35,8 @@ draw_text( \item{adjx}{x adjustment} \item{adjy}{y adjustment} + +\item{tips}{Text to be displayed when hovering over the text} } \value{ Plot the text to the current device diff --git a/man/make_class_info.Rd b/man/make_class_info.Rd index 51967760..319b84f4 100644 --- a/man/make_class_info.Rd +++ b/man/make_class_info.Rd @@ -16,6 +16,6 @@ A character vector of class information Make class information } \examples{ -Pedixplorer::make_class_info(list(1, "a", 1:3, list(1, 2))) +Pedixplorer:::make_class_info(list(1, "a", 1:3, list(1, 2))) } \keyword{internal} diff --git a/man/make_rownames.Rd b/man/make_rownames.Rd index 519d7f84..5b94f750 100644 --- a/man/make_rownames.Rd +++ b/man/make_rownames.Rd @@ -22,6 +22,6 @@ A character vector of rownames Make rownames for rectangular data display } \examples{ -Pedixplorer::make_rownames(rownames(mtcars), nrow(mtcars), 3, 3) +Pedixplorer:::make_rownames(rownames(mtcars), nrow(mtcars), 3, 3) } \keyword{internal} diff --git a/man/ped_to_plotdf.Rd b/man/ped_to_plotdf.Rd index 5433df2a..68adbf0c 100644 --- a/man/ped_to_plotdf.Rd +++ b/man/ped_to_plotdf.Rd @@ -21,6 +21,7 @@ label = NULL, precision = 3, lwd = par("lwd"), + tips = NULL, ... ) } @@ -79,6 +80,9 @@ corresponding to the value of the column given.} \item{lwd}{default=par("lwd"). Controls the line width of the segments, arcs and polygons.} + +\item{tips}{A character vector of the column names of the data frame to +use as tooltips. If \code{NULL}, no tooltips are added.} } \value{ A list containing the data frame and the user coordinates. diff --git a/man/plot_legend.Rd b/man/plot_legend.Rd index 93dd15ea..41d5bc68 100644 --- a/man/plot_legend.Rd +++ b/man/plot_legend.Rd @@ -1,29 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/app_plot_legend.R, R/plot_pedigree.R -\name{plot_legend_ui} -\alias{plot_legend_ui} -\alias{plot_legend_server} -\alias{plot_legend_demo} +% Please edit documentation in R/plot_pedigree.R +\name{plot_legend} \alias{plot_legend} -\title{Shiny module to generate pedigree graph legend.} +\title{Plot legend} \usage{ -plot_legend_ui(id, height = "200px") - -plot_legend_server( - id, - pedi, - leg_loc = c(0.2, 1, 0, 1), - lwd = par("lwd"), - boxw = 1, - boxh = 1, - adjx = 0, - adjy = 0 -) - -plot_legend_demo(height = "200px", leg_loc = c(0.2, 1, 0, 1)) - plot_legend( - pedi, + obj, cex = 1, boxw = 0.1, boxh = 0.1, @@ -36,12 +18,9 @@ plot_legend( ) } \arguments{ -\item{id}{A string.} +\item{obj}{A Pedigree object} -\item{pedi}{A reactive pedigree object.} - -\item{lwd}{default=par("lwd"). Controls the bordering line width of the -elements in the legend.} +\item{cex}{Character expansion of the text} \item{boxw}{Width of the polygons elements} @@ -53,25 +32,24 @@ the labels in the legend.} \item{adjy}{default=0. Controls the vertical text adjustment of the labels in the legend.} -\item{cex}{Character expansion of the text} +\item{lwd}{default=par("lwd"). Controls the bordering line width of the +elements in the legend.} } \value{ -A static UI with the legend. +an invisible list containing +\itemize{ +\item df : the data.frame used to plot the Pedigree +\item par_usr : the user coordinates used to plot the Pedigree +} } \description{ -This module allows to plot the legend of a pedigree object. -The function is composed of two parts: the UI and the server. -The UI is called with the function \code{plot_legend_ui()} and the server -with the function \code{plot_legend_server()}. - Small internal function to be used for plotting a Pedigree object legend } -\examples{ -if (interactive()) { - plot_legend_demo() -} +\section{Side Effects}{ + +Creates plot on current plotting device. } + \keyword{internal} -\keyword{internal,} \keyword{plot_legend} diff --git a/man/plot_legend_app.Rd b/man/plot_legend_app.Rd new file mode 100644 index 00000000..485c777b --- /dev/null +++ b/man/plot_legend_app.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/app_plot_legend.R +\name{plot_legend_ui} +\alias{plot_legend_ui} +\alias{plot_legend_server} +\alias{plot_legend_demo} +\title{Shiny module to generate pedigree graph legend.} +\usage{ +plot_legend_ui(id, height = "400px") + +plot_legend_server( + id, + pedi, + leg_loc = c(0, 1, 0, 1), + lwd = par("lwd"), + boxw = 0.1, + boxh = 0.1, + adjx = 0, + adjy = 0 +) + +plot_legend_demo(height = "400px", leg_loc = c(0.2, 0.8, 0.2, 0.6)) +} +\arguments{ +\item{id}{A string.} + +\item{pedi}{A reactive pedigree object.} + +\item{lwd}{default=par("lwd"). Controls the bordering line width of the +elements in the legend.} + +\item{boxw}{Width of the polygons elements} + +\item{boxh}{Height of the polygons elements} + +\item{adjx}{default=0. Controls the horizontal text adjustment of +the labels in the legend.} + +\item{adjy}{default=0. Controls the vertical text adjustment +of the labels in the legend.} +} +\value{ +A static UI with the legend. +} +\description{ +This module allows to plot the legend of a pedigree object. +The function is composed of two parts: the UI and the server. +The UI is called with the function \code{plot_legend_ui()} and the server +with the function \code{plot_legend_server()}. +} +\examples{ +if (interactive()) { + plot_legend_demo() +} +} +\keyword{internal} diff --git a/man/plot_ped.Rd b/man/plot_ped.Rd index 0f66ee8f..51c68fef 100644 --- a/man/plot_ped.Rd +++ b/man/plot_ped.Rd @@ -14,10 +14,11 @@ plot_ped_server( title, precision = 2, max_ind = 500, - lwd = par("lwd") + lwd = par("lwd"), + tips = NULL ) -plot_ped_demo(pedi, precision = 2, max_ind = 500) +plot_ped_demo(pedi, precision = 2, max_ind = 500, tips = NULL) } \arguments{ \item{id}{A string.} @@ -29,6 +30,12 @@ plot_ped_demo(pedi, precision = 2, max_ind = 500) \item{precision}{An integer to set the precision of the plot.} \item{max_ind}{An integer to set the maximum number of individuals to plot.} + +\item{lwd}{default=par("lwd"). Controls the line width of the +segments, arcs and polygons.} + +\item{tips}{A character vector of the column names of the data frame to +use as tooltips. If \code{NULL}, no tooltips are added.} } \value{ A reactive ggplot or the pedigree object. diff --git a/man/plot_pedigree.Rd b/man/plot_pedigree.Rd index 786ec3a9..67ba8fe9 100644 --- a/man/plot_pedigree.Rd +++ b/man/plot_pedigree.Rd @@ -33,7 +33,9 @@ leg_adjy = 0, precision = 2, lwd = par("lwd"), - ... + ped_par = list(), + leg_par = list(), + tips = NULL ) } \arguments{ @@ -108,7 +110,10 @@ If character, it is the family id to plot.} \item{leg_loc}{default=NULL. If NULL, the legend will be placed in the upper right corner of the plot. Otherwise, a 4-element vector of the form -(x0, x1, y0, y1) can be used to specify the location of the legend.} +(x0, x1, y0, y1) can be used to specify the location of the legend. +The legend will be fitted to the specified and might be distorted if the +aspect ratio of the legend is different from the aspect ratio of the +specified location.} \item{leg_adjx}{default=0. Controls the horizontal labels adjustment of the legend.} @@ -121,7 +126,14 @@ of the legend.} \item{lwd}{default=par("lwd"). Controls the line width of the segments, arcs and polygons.} -\item{...}{Extra options that feed into the} +\item{ped_par}{default=list(). A list of parameters to use as graphical +parameteres for the main plot.} + +\item{leg_par}{default=list(). A list of parameters to use as graphical +parameters for the legend.} + +\item{tips}{A character vector of the column names of the data frame to +use as tooltips. If \code{NULL}, no tooltips are added.} } \value{ an invisible list containing diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index d2d8d128..2f43fb22 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -18,9 +18,9 @@ template: news: releases: - - text: "Version 1.1.4" - href: "https://github.com/LouisLeNezet/Pedixplorer/releases/tag/v1.1.4" - - text: "Version 1.0.0" + - text: "Latest devel release : Version 1.1.5" + href: "https://github.com/LouisLeNezet/Pedixplorer/releases/tag/v1.1.5" + - text: "Latest main release : Version 1.0.0" href: https://www.bioconductor.org/packages/release/bioc/html/Pedixplorer.html reference: diff --git a/tests/testthat/_snaps/align/best-hint.svg b/tests/testthat/_snaps/align/best-hint.svg index 11124f4e..5d80c933 100644 --- a/tests/testthat/_snaps/align/best-hint.svg +++ b/tests/testthat/_snaps/align/best-hint.svg @@ -18,276 +18,276 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -0 -0 -0 -1 -1 -1 -1 -0 -1 -0 -1 -0 -1 -0 -1 -0 -1 -0 -0 -0 -0 -1 -1 -1 -1 -1 -1 -1 -1 -0 -1 -0 -0 -0 -1 -0 -1 -1 -1 -0 -0 -0 -0 -0 -0 -0 -1 -135 -107 -120 -130 -136 -108 -119 -131 -201 -105 -117 -132 -202 -106 -116 -133 -103 -115 -134 -104 -118 -129 -137 -112 -125 -138 -115 -126 -101 -114 -127 -102 -111 -128 -203 -110 -121 -204 -139 -122 -205 -140 -123 -206 -141 -124 -207 -110 -209 -109 -208 -210 -211 -212 -213 -214 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +0 +0 +0 +1 +1 +1 +1 +0 +1 +0 +1 +0 +1 +0 +1 +0 +1 +0 +0 +0 +0 +1 +1 +1 +1 +1 +1 +1 +1 +0 +1 +0 +0 +0 +1 +0 +1 +1 +1 +0 +0 +0 +0 +0 +0 +0 +1 +135 +107 +120 +130 +136 +108 +119 +131 +201 +105 +117 +132 +202 +106 +116 +133 +103 +115 +134 +104 +118 +129 +137 +112 +125 +138 +115 +126 +101 +114 +127 +102 +111 +128 +203 +110 +121 +204 +139 +122 +205 +140 +123 +206 +141 +124 +207 +110 +209 +109 +208 +210 +211 +212 +213 +214 diff --git a/tests/testthat/_snaps/align/sampleped-norel.svg b/tests/testthat/_snaps/align/sampleped-norel.svg index 84d1f5d0..71584349 100644 --- a/tests/testthat/_snaps/align/sampleped-norel.svg +++ b/tests/testthat/_snaps/align/sampleped-norel.svg @@ -18,276 +18,276 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -0 -1 -1 -1 -0 -1 -1 -1 -0 -0 -1 -1 -1 -1 -1 -1 -1 -0 -0 -0 -0 -0 -0 -0 -1 -0 -0 -1 -0 -1 -0 -0 -0 -0 -1 -0 -1 -1 -0 -1 -1 -0 -1 -1 -1 -1 -0 -135 -101 -109 -121 -136 -102 -110 -122 -201 -103 -111 -123 -202 -104 -112 -124 -137 -114 -127 -138 -139 -128 -203 -140 -125 -204 -141 -126 -205 -210 -129 -206 -211 -130 -207 -212 -131 -209 -213 -132 -208 -214 -133 -105 -114 -134 -106 -115 -107 -112 -108 -118 -117 -116 -119 -120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0 +1 +1 +1 +0 +1 +1 +1 +0 +0 +1 +1 +1 +1 +1 +1 +1 +0 +0 +0 +0 +0 +0 +0 +1 +0 +0 +1 +0 +1 +0 +0 +0 +0 +1 +0 +1 +1 +0 +1 +1 +0 +1 +1 +1 +1 +0 +135 +101 +109 +121 +136 +102 +110 +122 +201 +103 +111 +123 +202 +104 +112 +124 +137 +114 +127 +138 +139 +128 +203 +140 +125 +204 +141 +126 +205 +210 +129 +206 +211 +130 +207 +212 +131 +209 +213 +132 +208 +214 +133 +105 +114 +134 +106 +115 +107 +112 +108 +118 +117 +116 +119 +120 diff --git a/tests/testthat/_snaps/align/sampleped-withrel.svg b/tests/testthat/_snaps/align/sampleped-withrel.svg index d4cb0ce0..36bc8ba9 100644 --- a/tests/testthat/_snaps/align/sampleped-withrel.svg +++ b/tests/testthat/_snaps/align/sampleped-withrel.svg @@ -18,288 +18,288 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -0 -1 -1 -0 -0 -1 -1 -1 -0 -0 -1 -1 -1 -1 -1 -1 -1 -0 -0 -0 -1 -0 -0 -0 -1 -0 -0 -1 -0 -1 -0 -0 -0 -0 -0 -0 -0 -1 -1 -1 -1 -0 -0 -1 -1 -1 -1 -1 -0 -135 -101 -209 -121 -136 -102 -109 -122 -201 -103 -110 -123 -202 -104 -112 -124 -137 -111 -127 -138 -114 -128 -203 -113 -125 -204 -139 -126 -205 -140 -129 -206 -141 -130 -207 -210 -131 -209 -211 -132 -208 -212 -133 -105 -213 -134 -106 -214 -107 -114 -108 -115 -112 -118 -117 -116 -119 -120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0 +1 +1 +0 +0 +1 +1 +1 +0 +0 +1 +1 +1 +1 +1 +1 +1 +0 +0 +0 +1 +0 +0 +0 +1 +0 +0 +1 +0 +1 +0 +0 +0 +0 +0 +0 +0 +1 +1 +1 +1 +0 +0 +1 +1 +1 +1 +1 +0 +135 +101 +209 +121 +136 +102 +109 +122 +201 +103 +110 +123 +202 +104 +112 +124 +137 +111 +127 +138 +114 +128 +203 +113 +125 +204 +139 +126 +205 +140 +129 +206 +141 +130 +207 +210 +131 +209 +211 +132 +208 +212 +133 +105 +213 +134 +106 +214 +107 +114 +108 +115 +112 +118 +117 +116 +119 +120 diff --git a/tests/testthat/_snaps/kindepth/double-marriage.svg b/tests/testthat/_snaps/kindepth/double-marriage.svg index 61558958..8e384410 100644 --- a/tests/testthat/_snaps/kindepth/double-marriage.svg +++ b/tests/testthat/_snaps/kindepth/double-marriage.svg @@ -18,64 +18,64 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -3 -7 -11 -2 -4 -9 -12 -5 -8 -6 -10 -9 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +3 +7 +11 +2 +4 +9 +12 +5 +8 +6 +10 +9 diff --git a/tests/testthat/_snaps/kindepth/niece-uncle-spouse.svg b/tests/testthat/_snaps/kindepth/niece-uncle-spouse.svg index c22913d5..48e202df 100644 --- a/tests/testthat/_snaps/kindepth/niece-uncle-spouse.svg +++ b/tests/testthat/_snaps/kindepth/niece-uncle-spouse.svg @@ -18,42 +18,42 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -3 -5 -7 -2 -4 -6 -5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +3 +5 +7 +2 +4 +6 +5 diff --git a/tests/testthat/_snaps/linux-4.4/modules/data_import-001_.png b/tests/testthat/_snaps/linux-4.4/modules/data_import-001_.png index 06a7e7ba..0ceac485 100644 Binary files a/tests/testthat/_snaps/linux-4.4/modules/data_import-001_.png and b/tests/testthat/_snaps/linux-4.4/modules/data_import-001_.png differ diff --git a/tests/testthat/_snaps/linux-4.4/modules/data_import-002_.png b/tests/testthat/_snaps/linux-4.4/modules/data_import-002_.png index 604e34e6..e46c4e85 100644 Binary files a/tests/testthat/_snaps/linux-4.4/modules/data_import-002_.png and b/tests/testthat/_snaps/linux-4.4/modules/data_import-002_.png differ diff --git a/tests/testthat/_snaps/ped_to_legdf.md b/tests/testthat/_snaps/ped_to_legdf.md index 217543b8..6fb44d1f 100644 --- a/tests/testthat/_snaps/ped_to_legdf.md +++ b/tests/testthat/_snaps/ped_to_legdf.md @@ -4,104 +4,104 @@ lst Output $df - id x0 y0 x1 y1 type fill border angle - 1 titles 0.2000000 0 NA NA text black NA - 2 titles 4.4770595 0 NA NA text black NA - 3 titles 9.2009283 0 NA NA text black NA - 4 titles 14.9391751 0 NA NA text black NA - 5 titles 20.6170422 0 NA NA text black NA - 6 sex 0.0000000 2 NA NA square_1_1 white black NA - 7 sex 0.0000000 4 NA NA circle_1_1 white black NA - 8 sex_label 1.2000000 2 NA NA text black NA - 9 sex_label 1.2000000 4 NA NA text black NA - 10 border 4.2770595 2 NA NA square_1_1 white black NA - 11 border 4.2770595 4 NA NA square_1_1 white green NA - 12 border_label 5.4770595 2 NA NA text black NA - 13 border_label 5.4770595 4 NA NA text black NA - 14 aff_bkg_1_0 9.0009283 2 NA NA square_1_1 white black NA - 15 aff_bkg_1_1 9.0009283 4 NA NA square_1_1 white black NA - 16 aff_bkg_1_NA 9.0009283 6 NA NA square_1_1 white black NA - 17 affected_1_0 9.0009283 2 NA NA square_3_1 white black NA - 18 affected_1_1 9.0009283 4 NA NA square_3_1 red black NA - 19 affected_1_NA 9.0009283 6 NA NA square_3_1 grey black NA - 20 affected_label_1_0 10.2009283 2 NA NA text black NA - 21 affected_label_1_1 10.2009283 4 NA NA text black NA - 22 affected_label_1_NA 10.2009283 6 NA NA text black NA - 23 aff_bkg_2_0 14.7391751 2 NA NA square_1_1 white black NA - 24 aff_bkg_2_1 14.7391751 4 NA NA square_1_1 white black NA - 25 affected_2_0 14.7391751 2 NA NA square_3_2 white black NA - 26 affected_2_1 14.7391751 4 NA NA square_3_2 red black NA - 27 affected_label_2_0 15.9391751 2 NA NA text black NA - 28 affected_label_2_1 15.9391751 4 NA NA text black NA - 29 aff_bkg_3_1 20.4170422 2 NA NA square_1_1 white black NA - 30 aff_bkg_3_2 20.4170422 4 NA NA square_1_1 white black NA - 31 aff_bkg_3_3 20.4170422 6 NA NA square_1_1 white black NA - 32 aff_bkg_3_4 20.4170422 8 NA NA square_1_1 white black NA - 33 aff_bkg_3_5 20.4170422 10 NA NA square_1_1 white black NA - 34 aff_bkg_3_6 20.4170422 12 NA NA square_1_1 white black NA - 35 affected_3_1 20.4170422 2 NA NA square_3_3 #FFFFFF black NA - 36 affected_3_2 20.4170422 4 NA NA square_3_3 #9AB1C4 black NA - 37 affected_3_3 20.4170422 6 NA NA square_3_3 #36648B black NA - 38 affected_3_4 20.4170422 8 NA NA square_3_3 #FFC0CB black NA - 39 affected_3_5 20.4170422 10 NA NA square_3_3 #CF70DD black NA - 40 affected_3_6 20.4170422 12 NA NA square_3_3 #A020F0 black NA - 41 affected_label_3_1 21.6170422 2 NA NA text black NA - 42 affected_label_3_2 21.6170422 4 NA NA text black NA - 43 affected_label_3_3 21.6170422 6 NA NA text black NA - 44 affected_label_3_4 21.6170422 8 NA NA text black NA - 45 affected_label_3_5 21.6170422 10 NA NA text black NA - 46 affected_label_3_6 21.6170422 12 NA NA text black NA - 47 max_lim 0.0000000 0 NA NA text black NA - 48 max_lim 27.6912336 12 NA NA text black NA - density cex label tips adjx adjy - 1 NA 1.2 Sex 0 1 - 2 NA 1.2 Border 0 1 - 3 NA 1.2 affection 0 1 - 4 NA 1.2 avail 0 1 - 5 NA 1.2 val_num 0 1 - 6 NA 0.5 NA NA - 7 NA 0.5 NA NA - 8 NA 0.8 Male 0 1 - 9 NA 0.8 Female 0 1 - 10 NA 0.5 NA NA - 11 NA 0.5 NA NA - 12 NA 0.8 Non Available 0 1 - 13 NA 0.8 Available 0 1 - 14 NA 0.5 NA NA - 15 NA 0.5 NA NA - 16 NA 0.5 NA NA - 17 NA 0.5 NA NA - 18 NA 0.5 NA NA - 19 NA 0.5 NA NA - 20 NA 0.8 Healthy <= to 0.5 0 1 - 21 NA 0.8 Affected > to 0.5 0 1 - 22 NA 0.8 NA 0 1 - 23 NA 0.5 NA NA - 24 NA 0.5 NA NA - 25 NA 0.5 NA NA - 26 NA 0.5 NA NA - 27 NA 0.8 Healthy are FALSE 0 1 - 28 NA 0.8 Affected are TRUE 0 1 - 29 NA 0.5 NA NA - 30 NA 0.5 NA NA - 31 NA 0.5 NA NA - 32 NA 0.5 NA NA - 33 NA 0.5 NA NA - 34 NA 0.5 NA NA - 35 NA 0.5 NA NA - 36 NA 0.5 NA NA - 37 NA 0.5 NA NA - 38 NA 0.5 NA NA - 39 NA 0.5 NA NA - 40 NA 0.5 NA NA - 41 NA 0.8 Healthy <= to 115 : [101,106] 0 1 - 42 NA 0.8 Healthy <= to 115 : (106,110] 0 1 - 43 NA 0.8 Healthy <= to 115 : (110,115] 0 1 - 44 NA 0.8 Affected > to 115 : [116,124] 0 1 - 45 NA 0.8 Affected > to 115 : (124,133] 0 1 - 46 NA 0.8 Affected > to 115 : (133,141] 0 1 - 47 NA NA 0 1 - 48 NA NA 0 1 + id x0 y0 x1 y1 type fill border + 1 titles 0.0000000 0.00000000 NA NA text black + 2 titles 2.0692353 0.00000000 NA NA text black + 3 titles 4.1533643 0.00000000 NA NA text black + 4 titles 6.2713058 0.00000000 NA NA text black + 5 titles 8.3872347 0.00000000 NA NA text black + 6 sex 0.0000000 0.83333333 NA NA square_1_1 white black + 7 sex 0.0000000 2.16666667 NA NA circle_1_1 white black + 8 sex_label 1.0000000 1.33333333 NA NA text black + 9 sex_label 1.0000000 2.66666667 NA NA text black + 10 border 2.0692353 0.83333333 NA NA square_1_1 white black + 11 border 2.0692353 2.16666667 NA NA square_1_1 white green + 12 border_label 3.0692353 1.33333333 NA NA text black + 13 border_label 3.0692353 2.66666667 NA NA text black + 14 aff_bkg_1_0 4.1533643 0.83333333 NA NA square_1_1 white black + 15 aff_bkg_1_1 4.1533643 2.16666667 NA NA square_1_1 white black + 16 aff_bkg_1_NA 4.1533643 3.50000000 NA NA square_1_1 white black + 17 affected_1_0 4.1533643 0.83333333 NA NA square_3_1 white black + 18 affected_1_1 4.1533643 2.16666667 NA NA square_3_1 red black + 19 affected_1_NA 4.1533643 3.50000000 NA NA square_3_1 grey black + 20 affected_label_1_0 5.1533643 1.33333333 NA NA text black + 21 affected_label_1_1 5.1533643 2.66666667 NA NA text black + 22 affected_label_1_NA 5.1533643 4.00000000 NA NA text black + 23 aff_bkg_2_0 6.2713058 0.83333333 NA NA square_1_1 white black + 24 aff_bkg_2_1 6.2713058 2.16666667 NA NA square_1_1 white black + 25 affected_2_0 6.2713058 0.83333333 NA NA square_3_2 white black + 26 affected_2_1 6.2713058 2.16666667 NA NA square_3_2 red black + 27 affected_label_2_0 7.2713058 1.33333333 NA NA text black + 28 affected_label_2_1 7.2713058 2.66666667 NA NA text black + 29 aff_bkg_3_1 8.3872347 0.83333333 NA NA square_1_1 white black + 30 aff_bkg_3_2 8.3872347 2.16666667 NA NA square_1_1 white black + 31 aff_bkg_3_3 8.3872347 3.50000000 NA NA square_1_1 white black + 32 aff_bkg_3_4 8.3872347 4.83333333 NA NA square_1_1 white black + 33 aff_bkg_3_5 8.3872347 6.16666667 NA NA square_1_1 white black + 34 aff_bkg_3_6 8.3872347 7.50000000 NA NA square_1_1 white black + 35 affected_3_1 8.3872347 0.83333333 NA NA square_3_3 #FFFFFF black + 36 affected_3_2 8.3872347 2.16666667 NA NA square_3_3 #9AB1C4 black + 37 affected_3_3 8.3872347 3.50000000 NA NA square_3_3 #36648B black + 38 affected_3_4 8.3872347 4.83333333 NA NA square_3_3 #FFC0CB black + 39 affected_3_5 8.3872347 6.16666667 NA NA square_3_3 #CF70DD black + 40 affected_3_6 8.3872347 7.50000000 NA NA square_3_3 #A020F0 black + 41 affected_label_3_1 9.3872347 1.33333333 NA NA text black + 42 affected_label_3_2 9.3872347 2.66666667 NA NA text black + 43 affected_label_3_3 9.3872347 4.00000000 NA NA text black + 44 affected_label_3_4 9.3872347 5.33333333 NA NA text black + 45 affected_label_3_5 9.3872347 6.66666667 NA NA text black + 46 affected_label_3_6 9.3872347 8.00000000 NA NA text black + 47 max_lim 0.0000000 0.00000000 NA NA text black + 48 max_lim 8.3872347 8.00000000 NA NA text black + angle density cex label tips adjx adjy + 1 NA NA 1.2 Sex 0 1 + 2 NA NA 1.2 Border 0 1 + 3 NA NA 1.2 affection 0 1 + 4 NA NA 1.2 avail 0 1 + 5 NA NA 1.2 val_num 0 1 + 6 NA NA 0.5 NA NA + 7 NA NA 0.5 NA NA + 8 NA NA 0.8 Male 0 1 + 9 NA NA 0.8 Female 0 1 + 10 NA NA 0.5 NA NA + 11 NA NA 0.5 NA NA + 12 NA NA 0.8 Non Available 0 1 + 13 NA NA 0.8 Available 0 1 + 14 NA NA 0.5 NA NA + 15 NA NA 0.5 NA NA + 16 NA NA 0.5 NA NA + 17 NA NA 0.5 NA NA + 18 NA NA 0.5 NA NA + 19 NA NA 0.5 NA NA + 20 NA NA 0.8 Healthy <= to 0.5 0 1 + 21 NA NA 0.8 Affected > to 0.5 0 1 + 22 NA NA 0.8 NA 0 1 + 23 NA NA 0.5 NA NA + 24 NA NA 0.5 NA NA + 25 NA NA 0.5 NA NA + 26 NA NA 0.5 NA NA + 27 NA NA 0.8 Healthy are FALSE 0 1 + 28 NA NA 0.8 Affected are TRUE 0 1 + 29 NA NA 0.5 NA NA + 30 NA NA 0.5 NA NA + 31 NA NA 0.5 NA NA + 32 NA NA 0.5 NA NA + 33 NA NA 0.5 NA NA + 34 NA NA 0.5 NA NA + 35 NA NA 0.5 NA NA + 36 NA NA 0.5 NA NA + 37 NA NA 0.5 NA NA + 38 NA NA 0.5 NA NA + 39 NA NA 0.5 NA NA + 40 NA NA 0.5 NA NA + 41 NA NA 0.8 Healthy <= to 115 : [101,106] 0 1 + 42 NA NA 0.8 Healthy <= to 115 : (106,110] 0 1 + 43 NA NA 0.8 Healthy <= to 115 : (110,115] 0 1 + 44 NA NA 0.8 Affected > to 115 : [116,124] 0 1 + 45 NA NA 0.8 Affected > to 115 : (124,133] 0 1 + 46 NA NA 0.8 Affected > to 115 : (133,141] 0 1 + 47 NA NA NA 0 1 + 48 NA NA NA 0 1 $par_usr $par_usr$boxh @@ -114,7 +114,7 @@ [1] 0.8 $par_usr$usr - [1] 0.000000 27.691234 0.000000 12.000000 + [1] 0.0000000 9.3872347 0.0000000 8.0000000 diff --git a/tests/testthat/_snaps/ped_to_legdf/legend-alone.svg b/tests/testthat/_snaps/ped_to_legdf/legend-alone.svg index 3433d0e1..389bb8d6 100644 --- a/tests/testthat/_snaps/ped_to_legdf/legend-alone.svg +++ b/tests/testthat/_snaps/ped_to_legdf/legend-alone.svg @@ -25,51 +25,51 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - -Sex -Border -affection -avail -val_num -Male -Female -Non Available -Available -Healthy <= to 0.5 -Affected > to 0.5 -NA -Healthy are FALSE -Affected are TRUE -Healthy <= to 115 : [101,106] -Healthy <= to 115 : (106,110] -Healthy <= to 115 : (110,115] -Affected > to 115 : [116,124] -Affected > to 115 : (124,133] -Affected > to 115 : (133,141] + + + + + + + + + + + + + + + + + + + + + + + + + + +Sex +Border +affection +avail +val_num +Male +Female +Non Available +Available +Healthy <= to 0.5 +Affected > to 0.5 +NA +Healthy are FALSE +Affected are TRUE +Healthy <= to 115 : [101,106] +Healthy <= to 115 : (106,110] +Healthy <= to 115 : (110,115] +Affected > to 115 : [116,124] +Affected > to 115 : (124,133] +Affected > to 115 : (133,141] diff --git a/tests/testthat/_snaps/ped_to_legdf/plot-with-legend.svg b/tests/testthat/_snaps/ped_to_legdf/plot-with-legend.svg index 3b21628b..c5a4f3dc 100644 --- a/tests/testthat/_snaps/ped_to_legdf/plot-with-legend.svg +++ b/tests/testthat/_snaps/ped_to_legdf/plot-with-legend.svg @@ -18,305 +18,322 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1_135 -1_101 -1_109 -1_121 -1_136 -1_102 -1_110 -1_122 -1_103 -1_111 -1_123 -1_104 -1_112 -1_124 -1_137 -1_114 -1_127 -1_138 -1_139 -1_128 -1_105 -1_140 -1_125 -1_106 -1_141 -1_126 -1_107 -1_114 -1_129 -1_108 -1_115 -1_130 -1_112 -1_131 -1_118 -1_132 -1_117 -1_133 -1_116 -1_134 -1_119 -1_120 - - - - - - - - - - - - - - - - - - - - - - - - - - -Sex -Border -affection -avail -val_num -Male -Female -Non Available -Available -Healthy <= to 0.5 -Affected > to 0.5 -NA -Healthy are FALSE -Affected are TRUE -Healthy <= to 115 : [101,106] -Healthy <= to 115 : (106,110] -Healthy <= to 115 : (110,115] -Affected > to 115 : [116,124] -Affected > to 115 : (124,133] -Affected > to 115 : (133,141] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1_135 +1_101 +1_109 +1_121 +1_136 +1_102 +1_110 +1_122 +1_103 +1_111 +1_123 +1_104 +1_112 +1_124 +1_137 +1_114 +1_127 +1_138 +1_139 +1_128 +1_105 +1_140 +1_125 +1_106 +1_141 +1_126 +1_107 +1_114 +1_129 +1_108 +1_115 +1_130 +1_112 +1_131 +1_118 +1_132 +1_117 +1_133 +1_116 +1_134 +1_119 +1_120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +Sex +Border +affection +avail +val_num +Male +Female +Non Available +Available +Healthy <= to 0.5 +Affected > to 0.5 +NA +Healthy are FALSE +Affected are TRUE +Healthy <= to 115 : [101,106] +Healthy <= to 115 : (106,110] +Healthy <= to 115 : (110,115] +Affected > to 115 : [116,124] +Affected > to 115 : (124,133] +Affected > to 115 : (133,141] diff --git a/tests/testthat/_snaps/plot.md b/tests/testthat/_snaps/plot.md index 1677bc5a..ad9b1c00 100644 --- a/tests/testthat/_snaps/plot.md +++ b/tests/testthat/_snaps/plot.md @@ -49,16 +49,16 @@ 42 dead -0.0420 2.0770 0.042 1.9930 segments black 43 dead 1.9580 1.0770 2.042 0.9930 segments black 44 dead 0.9580 2.0770 1.042 1.9930 segments black - 45 id 1.0000 1.1060 NA NA text black - 46 id 0.0000 2.1060 NA NA text black - 47 id 0.7000 3.1060 NA NA text black - 48 id 1.2000 4.1060 NA NA text black - 49 id 2.0000 1.1060 NA NA text black - 50 id 1.0000 2.1060 NA NA text black - 51 id 1.7000 3.1060 NA NA text black - 52 id 2.0000 2.1060 NA NA text black - 53 id 2.7000 3.1060 NA NA text black - 54 id 3.0000 2.1060 NA NA text black + 45 id 1.0000 1.1000 NA NA text black + 46 id 0.0000 2.1000 NA NA text black + 47 id 0.7000 3.1000 NA NA text black + 48 id 1.2000 4.1000 NA NA text black + 49 id 2.0000 1.1000 NA NA text black + 50 id 1.0000 2.1000 NA NA text black + 51 id 1.7000 3.1000 NA NA text black + 52 id 2.0000 2.1000 NA NA text black + 53 id 2.7000 3.1000 NA NA text black + 54 id 3.0000 2.1000 NA NA text black 55 line_spouses 1.0350 1.0350 1.965 1.0350 segments black 56 line_spouses 0.0350 2.0350 0.965 2.0350 segments black 57 line_spouses 0.7350 3.0350 1.665 3.0350 segments black @@ -87,93 +87,176 @@ 80 line_parent_mid 1.2000 3.9000 1.200 3.6405 segments black 81 line_parent_mid 1.2000 3.6405 1.200 3.2945 segments black 82 line_parent_mid 1.2000 3.2945 1.200 3.0350 segments black - border angle density cex label tips adjx adjy - 1 black NA NA 0.5 NA NA - 2 green NA NA 0.5 NA NA - 3 black NA NA 0.5 NA NA - 4 black NA NA 0.5 NA NA - 5 green NA NA 0.5 NA NA - 6 green NA NA 0.5 NA NA - 7 green NA NA 0.5 NA NA - 8 green NA NA 0.5 NA NA - 9 green NA NA 0.5 NA NA - 10 black NA NA 0.5 NA NA - 11 NA NA 1.0 1 0.5 0.5 - 12 NA NA 1.0 0 0.5 0.5 - 13 NA NA 1.0 0 0.5 0.5 - 14 NA NA 1.0 0 0.5 0.5 - 15 NA NA 1.0 0 0.5 0.5 - 16 NA NA 1.0 1 0.5 0.5 - 17 NA NA 1.0 1 0.5 0.5 - 18 NA NA 1.0 0 0.5 0.5 - 19 NA NA 1.0 0 0.5 0.5 - 20 NA NA 1.0 1 0.5 0.5 - 21 black NA NA 0.5 NA NA - 22 green NA NA 0.5 NA NA - 23 black NA NA 0.5 NA NA - 24 black NA NA 0.5 NA NA - 25 green NA NA 0.5 NA NA - 26 green NA NA 0.5 NA NA - 27 green NA NA 0.5 NA NA - 28 green NA NA 0.5 NA NA - 29 green NA NA 0.5 NA NA - 30 black NA NA 0.5 NA NA - 31 NA NA 1.0 0 0.5 0.5 - 32 NA NA 1.0 0 0.5 0.5 - 33 NA NA 1.0 1 0.5 0.5 - 34 NA NA 1.0 0 0.5 0.5 - 35 NA NA 1.0 0.5 0.5 - 36 NA NA 1.0 1 0.5 0.5 - 37 NA NA 1.0 0 0.5 0.5 - 38 NA NA 1.0 1 0.5 0.5 - 39 NA NA 1.0 0 0.5 0.5 - 40 NA NA 1.0 0 0.5 0.5 - 41 NA NA 0.5 NA NA - 42 NA NA 0.5 NA NA - 43 NA NA 0.5 NA NA - 44 NA NA 0.5 NA NA - 45 NA NA 1.0 1_1 0.5 0.5 - 46 NA NA 1.0 1_3 0.5 0.5 - 47 NA NA 1.0 1_7 0.5 0.5 - 48 NA NA 1.0 1_10 0.5 0.5 - 49 NA NA 1.0 1_2 0.5 0.5 - 50 NA NA 1.0 1_5 0.5 0.5 - 51 NA NA 1.0 1_8 0.5 0.5 - 52 NA NA 1.0 1_6 0.5 0.5 - 53 NA NA 1.0 1_9 0.5 0.5 - 54 NA NA 1.0 1_4 0.5 0.5 - 55 NA NA 0.5 NA NA - 56 NA NA 0.5 NA NA - 57 NA NA 0.5 NA NA - 58 NA NA 0.5 NA NA - 59 NA NA 0.5 NA NA - 60 NA NA 0.5 NA NA - 61 NA NA 0.5 NA NA - 62 NA NA 0.5 NA NA - 63 NA NA 0.5 NA NA - 64 NA NA 0.5 NA NA - 65 NA NA 0.5 NA NA - 66 NA NA 0.5 NA NA - 67 NA NA 0.5 NA NA - 68 NA NA 0.5 NA NA - 69 NA NA 0.5 NA NA - 70 NA NA 0.5 NA NA - 71 NA NA 0.5 NA NA - 72 NA NA 0.5 NA NA - 73 NA NA 1.0 ? 0.5 0.5 - 74 NA NA 0.5 NA NA - 75 NA NA 0.5 NA NA - 76 NA NA 0.5 NA NA - 77 NA NA 0.5 NA NA - 78 NA NA 0.5 NA NA - 79 NA NA 0.5 NA NA - 80 NA NA 0.5 NA NA - 81 NA NA 0.5 NA NA - 82 NA NA 0.5 NA NA + border angle density cex label + 1 black NA NA 0.5 + 2 green NA NA 0.5 + 3 black NA NA 0.5 + 4 black NA NA 0.5 + 5 green NA NA 0.5 + 6 green NA NA 0.5 + 7 green NA NA 0.5 + 8 green NA NA 0.5 + 9 green NA NA 0.5 + 10 black NA NA 0.5 + 11 NA NA 1.0 1 + 12 NA NA 1.0 0 + 13 NA NA 1.0 0 + 14 NA NA 1.0 0 + 15 NA NA 1.0 0 + 16 NA NA 1.0 1 + 17 NA NA 1.0 1 + 18 NA NA 1.0 0 + 19 NA NA 1.0 0 + 20 NA NA 1.0 1 + 21 black NA NA 0.5 + 22 green NA NA 0.5 + 23 black NA NA 0.5 + 24 black NA NA 0.5 + 25 green NA NA 0.5 + 26 green NA NA 0.5 + 27 green NA NA 0.5 + 28 green NA NA 0.5 + 29 green NA NA 0.5 + 30 black NA NA 0.5 + 31 NA NA 1.0 0 + 32 NA NA 1.0 0 + 33 NA NA 1.0 1 + 34 NA NA 1.0 0 + 35 NA NA 1.0 + 36 NA NA 1.0 1 + 37 NA NA 1.0 0 + 38 NA NA 1.0 1 + 39 NA NA 1.0 0 + 40 NA NA 1.0 0 + 41 NA NA 0.5 + 42 NA NA 0.5 + 43 NA NA 0.5 + 44 NA NA 0.5 + 45 NA NA 1.0 1_1 + 46 NA NA 1.0 1_3 + 47 NA NA 1.0 1_7 + 48 NA NA 1.0 1_10 + 49 NA NA 1.0 1_2 + 50 NA NA 1.0 1_5 + 51 NA NA 1.0 1_8 + 52 NA NA 1.0 1_6 + 53 NA NA 1.0 1_9 + 54 NA NA 1.0 1_4 + 55 NA NA 0.5 + 56 NA NA 0.5 + 57 NA NA 0.5 + 58 NA NA 0.5 + 59 NA NA 0.5 + 60 NA NA 0.5 + 61 NA NA 0.5 + 62 NA NA 0.5 + 63 NA NA 0.5 + 64 NA NA 0.5 + 65 NA NA 0.5 + 66 NA NA 0.5 + 67 NA NA 0.5 + 68 NA NA 0.5 + 69 NA NA 0.5 + 70 NA NA 0.5 + 71 NA NA 0.5 + 72 NA NA 0.5 + 73 NA NA 1.0 ? + 74 NA NA 0.5 + 75 NA NA 0.5 + 76 NA NA 0.5 + 77 NA NA 0.5 + 78 NA NA 0.5 + 79 NA NA 0.5 + 80 NA NA 0.5 + 81 NA NA 0.5 + 82 NA NA 0.5 + tips adjx adjy + 1 1_1
NA NA + 2 1_3
NA NA + 3 1_7
NA NA + 4 1_10
NA NA + 5 1_2
NA NA + 6 1_5
NA NA + 7 1_8
NA NA + 8 1_6
NA NA + 9 1_9
NA NA + 10 1_4
NA NA + 11 1_1
0.5 0.5 + 12 1_3
0.5 0.5 + 13 1_7
0.5 0.5 + 14 1_10
0.5 0.5 + 15 1_2
0.5 0.5 + 16 1_5
0.5 0.5 + 17 1_8
0.5 0.5 + 18 1_6
0.5 0.5 + 19 1_9
0.5 0.5 + 20 1_4
0.5 0.5 + 21 1_1
NA NA + 22 1_3
NA NA + 23 1_7
NA NA + 24 1_10
NA NA + 25 1_2
NA NA + 26 1_5
NA NA + 27 1_8
NA NA + 28 1_6
NA NA + 29 1_9
NA NA + 30 1_4
NA NA + 31 1_1
0.5 0.5 + 32 1_3
0.5 0.5 + 33 1_7
0.5 0.5 + 34 1_10
0.5 0.5 + 35 1_2
0.5 0.5 + 36 1_5
0.5 0.5 + 37 1_8
0.5 0.5 + 38 1_6
0.5 0.5 + 39 1_9
0.5 0.5 + 40 1_4
0.5 0.5 + 41 NA NA + 42 NA NA + 43 NA NA + 44 NA NA + 45 1_1
0.5 1.0 + 46 1_3
0.5 1.0 + 47 1_7
0.5 1.0 + 48 1_10
0.5 1.0 + 49 1_2
0.5 1.0 + 50 1_5
0.5 1.0 + 51 1_8
0.5 1.0 + 52 1_6
0.5 1.0 + 53 1_9
0.5 1.0 + 54 1_4
0.5 1.0 + 55 NA NA + 56 NA NA + 57 NA NA + 58 NA NA + 59 NA NA + 60 NA NA + 61 NA NA + 62 NA NA + 63 NA NA + 64 NA NA + 65 NA NA + 66 NA NA + 67 NA NA + 68 NA NA + 69 NA NA + 70 NA NA + 71 NA NA + 72 NA NA + 73 0.5 0.5 + 74 NA NA + 75 NA NA + 76 NA NA + 77 NA NA + 78 NA NA + 79 NA NA + 80 NA NA + 81 NA NA + 82 NA NA $par_usr $par_usr$usr - [1] -0.035 3.035 4.220 1.000 + [1] -0.0350000 3.0350000 4.1366667 1.0000000 $par_usr$old_par $par_usr$old_par$xpd @@ -194,3 +277,8 @@ +# Tooltip works + + Code + html_plot + diff --git a/tests/testthat/_snaps/plot/ped-2-affections-ggplot.svg b/tests/testthat/_snaps/plot/ped-2-affections-ggplot.svg index 31156087..6417fca9 100644 --- a/tests/testthat/_snaps/plot/ped-2-affections-ggplot.svg +++ b/tests/testthat/_snaps/plot/ped-2-affections-ggplot.svg @@ -27,87 +27,87 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -0 -0 -0 -0 -1 -1 -0 -0 -1 -0 -0 -1 -0 -1 -0 -1 -0 -0 -1_1 -1_3 -1_7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +0 +0 +0 +0 +1 +1 +0 +0 +1 +0 +0 +1 +0 +1 +0 +1 +0 +0 +? +1_1 +1_3 +1_7 1_10 -1_2 -1_5 -1_8 -1_6 -1_9 -1_4 -? +1_2 +1_5 +1_8 +1_6 +1_9 +1_4 Pedigree diff --git a/tests/testthat/_snaps/plot/ped-scaling-multiple-label.svg b/tests/testthat/_snaps/plot/ped-scaling-multiple-label.svg new file mode 100644 index 00000000..a9364c36 --- /dev/null +++ b/tests/testthat/_snaps/plot/ped-scaling-multiple-label.svg @@ -0,0 +1,47 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +3 +1/1 +1/1 +1/1 +1/1 +1/1 +1/1 +2 + + diff --git a/tests/testthat/_snaps/plot/ped-simple-affection-ggplot.svg b/tests/testthat/_snaps/plot/ped-simple-affection-ggplot.svg index 07471fa0..e47ba3ea 100644 --- a/tests/testthat/_snaps/plot/ped-simple-affection-ggplot.svg +++ b/tests/testthat/_snaps/plot/ped-simple-affection-ggplot.svg @@ -68,17 +68,16 @@ -1_1 -1_3 -1_7 -1_10 -1_2 -1_5 -1_8 -1_6 -1_9 -1_4 -? +1_1 +1_3 +1_7 +1_10 +1_2 +1_5 +1_8 +1_6 +1_9 +1_4 0 0 1 @@ -88,6 +87,7 @@ 1 0 0 +? diff --git a/tests/testthat/_snaps/plot/ped-simple-affection.svg b/tests/testthat/_snaps/plot/ped-simple-affection.svg index 219362c1..b3a6ab9d 100644 --- a/tests/testthat/_snaps/plot/ped-simple-affection.svg +++ b/tests/testthat/_snaps/plot/ped-simple-affection.svg @@ -18,67 +18,67 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -0 -0 -0 -0 -1 -1 -0 -0 -1 -1_1 -1_3 -1_7 -1_10 -1_2 -1_5 -1_8 -1_6 -1_9 -1_4 -? + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +0 +0 +0 +0 +1 +1 +0 +0 +1 +? +1_1 +1_3 +1_7 +1_10 +1_2 +1_5 +1_8 +1_6 +1_9 +1_4 diff --git a/tests/testthat/_snaps/plot/ped1.svg b/tests/testthat/_snaps/plot/ped1.svg index 3406daae..06b2a327 100644 --- a/tests/testthat/_snaps/plot/ped1.svg +++ b/tests/testthat/_snaps/plot/ped1.svg @@ -18,211 +18,211 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -0 -1 -1 -1 -0 -1 -1 -0 -0 -1 -1 -1 -1 -1 -1 -0 -0 -0 -0 -1 -1 -0 -0 -0 -0 -1 -1 -1 -0 -1 -0 -1 -1 -1 -0 -1_135 -1_101 -1_109 -1_121 -1_136 -1_102 -1_110 -1_122 -1_103 -1_111 -1_123 -1_104 -1_112 -1_124 -1_137 -1_114 -1_127 -1_138 -1_139 -1_128 -1_105 -1_140 -1_125 -1_106 -1_141 -1_126 -1_107 -1_114 -1_129 -1_108 -1_115 -1_130 -1_112 -1_131 -1_118 -1_132 -1_117 -1_133 -1_116 -1_134 -1_119 -1_120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0 +1 +1 +1 +0 +1 +1 +0 +0 +1 +1 +1 +1 +1 +1 +0 +0 +0 +0 +1 +1 +0 +0 +0 +0 +1 +1 +1 +0 +1 +0 +1 +1 +1 +0 +1_135 +1_101 +1_109 +1_121 +1_136 +1_102 +1_110 +1_122 +1_103 +1_111 +1_123 +1_104 +1_112 +1_124 +1_137 +1_114 +1_127 +1_138 +1_139 +1_128 +1_105 +1_140 +1_125 +1_106 +1_141 +1_126 +1_107 +1_114 +1_129 +1_108 +1_115 +1_130 +1_112 +1_131 +1_118 +1_132 +1_117 +1_133 +1_116 +1_134 +1_119 +1_120 diff --git a/tests/testthat/_snaps/plot/ped1reorder.svg b/tests/testthat/_snaps/plot/ped1reorder.svg index 976e941d..5b11cfbe 100644 --- a/tests/testthat/_snaps/plot/ped1reorder.svg +++ b/tests/testthat/_snaps/plot/ped1reorder.svg @@ -18,215 +18,215 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -1 -0 -0 -1 -0 -0 -0 -1 -1 -0 -1 -1 -1 -1 -1 -0 -0 -1 -0 -1 -0 -0 -0 -1 -0 -0 -1 -1 -0 -1 -0 -1 -1 -1 -1 -0 -1_135 -1_137 -1_139 -1_121 -1_136 -1_138 -1_140 -1_122 -1_103 -1_141 -1_123 -1_104 -1_111 -1_124 -1_101 -1_112 -1_127 -1_102 -1_110 -1_128 -1_105 -1_109 -1_125 -1_106 -1_114 -1_126 -1_107 -1_109 -1_129 -1_108 -1_114 -1_130 -1_115 -1_131 -1_112 -1_132 -1_118 -1_133 -1_117 -1_134 -1_116 -1_119 -1_120 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +1 +0 +0 +1 +0 +0 +0 +1 +1 +0 +1 +1 +1 +1 +1 +0 +0 +1 +0 +1 +0 +0 +0 +1 +0 +0 +1 +1 +0 +1 +0 +1 +1 +1 +1 +0 +1_135 +1_137 +1_139 +1_121 +1_136 +1_138 +1_140 +1_122 +1_103 +1_141 +1_123 +1_104 +1_111 +1_124 +1_101 +1_112 +1_127 +1_102 +1_110 +1_128 +1_105 +1_109 +1_125 +1_106 +1_114 +1_126 +1_107 +1_109 +1_129 +1_108 +1_114 +1_130 +1_115 +1_131 +1_112 +1_132 +1_118 +1_133 +1_117 +1_134 +1_116 +1_119 +1_120 diff --git a/tests/testthat/_snaps/plot_fct.md b/tests/testthat/_snaps/plot_fct.md index ab484a62..52f42c34 100644 --- a/tests/testthat/_snaps/plot_fct.md +++ b/tests/testthat/_snaps/plot_fct.md @@ -46,389 +46,602 @@ 40 polygon 1.5010000e+01 4.00000 NA NA circle_1_1 41 polygon 1.4000000e+01 3.00000 NA NA square_1_1 42 polygon 1.5000000e+01 3.00000 NA NA circle_1_1 - 43 aff_mark 3.8000000e+00 1.04050 NA NA text - 44 aff_mark 0.0000000e+00 2.04050 NA NA text - 45 aff_mark 2.0546072e-04 3.04050 NA NA text - 46 aff_mark 0.0000000e+00 4.04050 NA NA text - 47 aff_mark 4.8002055e+00 1.04050 NA NA text - 48 aff_mark 1.0002055e+00 2.04050 NA NA text - 49 aff_mark 1.0000000e+00 3.04050 NA NA text - 50 aff_mark 1.0002055e+00 4.04050 NA NA text - 51 aff_mark 2.8000000e+00 2.04050 NA NA text - 52 aff_mark 2.0002055e+00 3.04050 NA NA text - 53 aff_mark 2.0002055e+00 4.04050 NA NA text - 54 aff_mark 3.8002055e+00 2.04050 NA NA text - 55 aff_mark 3.0000000e+00 3.04050 NA NA text - 56 aff_mark 3.0000000e+00 4.04050 NA NA text - 57 aff_mark 4.8000000e+00 2.04050 NA NA text - 58 aff_mark 4.0000000e+00 3.04050 NA NA text - 59 aff_mark 6.0100000e+00 4.04050 NA NA text - 60 aff_mark 5.8002055e+00 2.04050 NA NA text - 61 aff_mark 5.0000000e+00 3.04050 NA NA text - 62 aff_mark 7.0100000e+00 4.04050 NA NA text - 63 aff_mark 1.1250000e+01 2.04050 NA NA text - 64 aff_mark 6.0002055e+00 3.04050 NA NA text - 65 aff_mark 8.0102055e+00 4.04050 NA NA text - 66 aff_mark 1.2250205e+01 2.04050 NA NA text - 67 aff_mark 7.0002055e+00 3.04050 NA NA text - 68 aff_mark 9.0102055e+00 4.04050 NA NA text - 69 aff_mark 1.4010000e+01 2.04050 NA NA text - 70 aff_mark 8.0000000e+00 3.04050 NA NA text - 71 aff_mark 1.0010000e+01 4.04050 NA NA text - 72 aff_mark 1.5010205e+01 2.04050 NA NA text - 73 aff_mark 9.0002055e+00 3.04050 NA NA text - 74 aff_mark 1.1010000e+01 4.04050 NA NA text - 75 aff_mark 1.0000000e+01 3.04050 NA NA text - 76 aff_mark 1.2010000e+01 4.04050 NA NA text - 77 aff_mark 1.1000205e+01 3.04050 NA NA text - 78 aff_mark 1.3010000e+01 4.04050 NA NA text - 79 aff_mark 1.2000000e+01 3.04050 NA NA text - 80 aff_mark 1.4010205e+01 4.04050 NA NA text - 81 aff_mark 1.3000205e+01 3.04050 NA NA text - 82 aff_mark 1.5010205e+01 4.04050 NA NA text - 83 aff_mark 1.4000000e+01 3.04050 NA NA text - 84 aff_mark 1.5000205e+01 3.04050 NA NA text - 85 id 3.8000000e+00 1.12300 NA NA text - 86 id 0.0000000e+00 2.12300 NA NA text - 87 id 0.0000000e+00 3.12300 NA NA text - 88 id 0.0000000e+00 4.12300 NA NA text - 89 id 4.8000000e+00 1.12300 NA NA text - 90 id 1.0000000e+00 2.12300 NA NA text - 91 id 1.0000000e+00 3.12300 NA NA text - 92 id 1.0000000e+00 4.12300 NA NA text - 93 id 2.8000000e+00 2.12300 NA NA text - 94 id 2.0000000e+00 3.12300 NA NA text - 95 id 2.0000000e+00 4.12300 NA NA text - 96 id 3.8000000e+00 2.12300 NA NA text - 97 id 3.0000000e+00 3.12300 NA NA text - 98 id 3.0000000e+00 4.12300 NA NA text - 99 id 4.8000000e+00 2.12300 NA NA text - 100 id 4.0000000e+00 3.12300 NA NA text - 101 id 6.0100000e+00 4.12300 NA NA text - 102 id 5.8000000e+00 2.12300 NA NA text - 103 id 5.0000000e+00 3.12300 NA NA text - 104 id 7.0100000e+00 4.12300 NA NA text - 105 id 1.1250000e+01 2.12300 NA NA text - 106 id 6.0000000e+00 3.12300 NA NA text - 107 id 8.0100000e+00 4.12300 NA NA text - 108 id 1.2250000e+01 2.12300 NA NA text - 109 id 7.0000000e+00 3.12300 NA NA text - 110 id 9.0100000e+00 4.12300 NA NA text - 111 id 1.4010000e+01 2.12300 NA NA text - 112 id 8.0000000e+00 3.12300 NA NA text - 113 id 1.0010000e+01 4.12300 NA NA text - 114 id 1.5010000e+01 2.12300 NA NA text - 115 id 9.0000000e+00 3.12300 NA NA text - 116 id 1.1010000e+01 4.12300 NA NA text - 117 id 1.0000000e+01 3.12300 NA NA text - 118 id 1.2010000e+01 4.12300 NA NA text - 119 id 1.1000000e+01 3.12300 NA NA text - 120 id 1.3010000e+01 4.12300 NA NA text - 121 id 1.2000000e+01 3.12300 NA NA text - 122 id 1.4010000e+01 4.12300 NA NA text - 123 id 1.3000000e+01 3.12300 NA NA text - 124 id 1.5010000e+01 4.12300 NA NA text - 125 id 1.4000000e+01 3.12300 NA NA text - 126 id 1.5000000e+01 3.12300 NA NA text - 127 line_spouses 4.0000000e+00 1.04050 4.60 1.04050 segments - 128 line_spouses 2.0000000e-01 2.04050 0.80 2.04050 segments - 129 line_spouses 2.0000000e-01 3.04050 0.80 3.04050 segments - 130 line_spouses 3.0000000e+00 2.04050 3.60 2.04050 segments - 131 line_spouses 5.0000000e+00 2.04050 5.60 2.04050 segments - 132 line_spouses 1.1450000e+01 2.04050 12.05 2.04050 segments - 133 line_spouses 1.4210000e+01 2.04050 14.81 2.04050 segments - 134 line_spouses 8.2000000e+00 3.04050 8.80 3.04050 segments - 135 line_spouses 1.0200000e+01 3.04050 10.80 3.04050 segments - 136 line_spouses 1.2200000e+01 3.04050 12.80 3.04050 segments - 137 line_spouses 1.4200000e+01 3.04050 14.80 3.04050 segments + 43 aff_mark 3.8000000e+00 1.04150 NA NA text + 44 aff_mark 0.0000000e+00 2.04150 NA NA text + 45 aff_mark 2.0546072e-04 3.04150 NA NA text + 46 aff_mark 0.0000000e+00 4.04150 NA NA text + 47 aff_mark 4.8002055e+00 1.04150 NA NA text + 48 aff_mark 1.0002055e+00 2.04150 NA NA text + 49 aff_mark 1.0000000e+00 3.04150 NA NA text + 50 aff_mark 1.0002055e+00 4.04150 NA NA text + 51 aff_mark 2.8000000e+00 2.04150 NA NA text + 52 aff_mark 2.0002055e+00 3.04150 NA NA text + 53 aff_mark 2.0002055e+00 4.04150 NA NA text + 54 aff_mark 3.8002055e+00 2.04150 NA NA text + 55 aff_mark 3.0000000e+00 3.04150 NA NA text + 56 aff_mark 3.0000000e+00 4.04150 NA NA text + 57 aff_mark 4.8000000e+00 2.04150 NA NA text + 58 aff_mark 4.0000000e+00 3.04150 NA NA text + 59 aff_mark 6.0100000e+00 4.04150 NA NA text + 60 aff_mark 5.8002055e+00 2.04150 NA NA text + 61 aff_mark 5.0000000e+00 3.04150 NA NA text + 62 aff_mark 7.0100000e+00 4.04150 NA NA text + 63 aff_mark 1.1250000e+01 2.04150 NA NA text + 64 aff_mark 6.0002055e+00 3.04150 NA NA text + 65 aff_mark 8.0102055e+00 4.04150 NA NA text + 66 aff_mark 1.2250205e+01 2.04150 NA NA text + 67 aff_mark 7.0002055e+00 3.04150 NA NA text + 68 aff_mark 9.0102055e+00 4.04150 NA NA text + 69 aff_mark 1.4010000e+01 2.04150 NA NA text + 70 aff_mark 8.0000000e+00 3.04150 NA NA text + 71 aff_mark 1.0010000e+01 4.04150 NA NA text + 72 aff_mark 1.5010205e+01 2.04150 NA NA text + 73 aff_mark 9.0002055e+00 3.04150 NA NA text + 74 aff_mark 1.1010000e+01 4.04150 NA NA text + 75 aff_mark 1.0000000e+01 3.04150 NA NA text + 76 aff_mark 1.2010000e+01 4.04150 NA NA text + 77 aff_mark 1.1000205e+01 3.04150 NA NA text + 78 aff_mark 1.3010000e+01 4.04150 NA NA text + 79 aff_mark 1.2000000e+01 3.04150 NA NA text + 80 aff_mark 1.4010205e+01 4.04150 NA NA text + 81 aff_mark 1.3000205e+01 3.04150 NA NA text + 82 aff_mark 1.5010205e+01 4.04150 NA NA text + 83 aff_mark 1.4000000e+01 3.04150 NA NA text + 84 aff_mark 1.5000205e+01 3.04150 NA NA text + 85 id 3.8000000e+00 1.12000 NA NA text + 86 id 0.0000000e+00 2.12000 NA NA text + 87 id 0.0000000e+00 3.12000 NA NA text + 88 id 0.0000000e+00 4.12000 NA NA text + 89 id 4.8000000e+00 1.12000 NA NA text + 90 id 1.0000000e+00 2.12000 NA NA text + 91 id 1.0000000e+00 3.12000 NA NA text + 92 id 1.0000000e+00 4.12000 NA NA text + 93 id 2.8000000e+00 2.12000 NA NA text + 94 id 2.0000000e+00 3.12000 NA NA text + 95 id 2.0000000e+00 4.12000 NA NA text + 96 id 3.8000000e+00 2.12000 NA NA text + 97 id 3.0000000e+00 3.12000 NA NA text + 98 id 3.0000000e+00 4.12000 NA NA text + 99 id 4.8000000e+00 2.12000 NA NA text + 100 id 4.0000000e+00 3.12000 NA NA text + 101 id 6.0100000e+00 4.12000 NA NA text + 102 id 5.8000000e+00 2.12000 NA NA text + 103 id 5.0000000e+00 3.12000 NA NA text + 104 id 7.0100000e+00 4.12000 NA NA text + 105 id 1.1250000e+01 2.12000 NA NA text + 106 id 6.0000000e+00 3.12000 NA NA text + 107 id 8.0100000e+00 4.12000 NA NA text + 108 id 1.2250000e+01 2.12000 NA NA text + 109 id 7.0000000e+00 3.12000 NA NA text + 110 id 9.0100000e+00 4.12000 NA NA text + 111 id 1.4010000e+01 2.12000 NA NA text + 112 id 8.0000000e+00 3.12000 NA NA text + 113 id 1.0010000e+01 4.12000 NA NA text + 114 id 1.5010000e+01 2.12000 NA NA text + 115 id 9.0000000e+00 3.12000 NA NA text + 116 id 1.1010000e+01 4.12000 NA NA text + 117 id 1.0000000e+01 3.12000 NA NA text + 118 id 1.2010000e+01 4.12000 NA NA text + 119 id 1.1000000e+01 3.12000 NA NA text + 120 id 1.3010000e+01 4.12000 NA NA text + 121 id 1.2000000e+01 3.12000 NA NA text + 122 id 1.4010000e+01 4.12000 NA NA text + 123 id 1.3000000e+01 3.12000 NA NA text + 124 id 1.5010000e+01 4.12000 NA NA text + 125 id 1.4000000e+01 3.12000 NA NA text + 126 id 1.5000000e+01 3.12000 NA NA text + 127 line_spouses 4.0000000e+00 1.04150 4.60 1.04150 segments + 128 line_spouses 2.0000000e-01 2.04150 0.80 2.04150 segments + 129 line_spouses 2.0000000e-01 3.04150 0.80 3.04150 segments + 130 line_spouses 3.0000000e+00 2.04150 3.60 2.04150 segments + 131 line_spouses 5.0000000e+00 2.04150 5.60 2.04150 segments + 132 line_spouses 1.1450000e+01 2.04150 12.05 2.04150 segments + 133 line_spouses 1.4210000e+01 2.04150 14.81 2.04150 segments + 134 line_spouses 8.2000000e+00 3.04150 8.80 3.04150 segments + 135 line_spouses 1.0200000e+01 3.04150 10.80 3.04150 segments + 136 line_spouses 1.2200000e+01 3.04150 12.80 3.04150 segments + 137 line_spouses 1.4200000e+01 3.04150 14.80 3.04150 segments 138 line_children_vertical 2.8000000e+00 2.00000 2.80 1.88000 segments 139 line_children_vertical 5.8000000e+00 2.00000 5.80 1.88000 segments 140 line_children_horizontal 2.8000000e+00 1.88000 5.80 1.88000 segments - 141 line_parent_mid 4.3000000e+00 1.88000 4.30 1.62815 segments - 142 line_parent_mid 4.3000000e+00 1.62815 4.30 1.29235 segments - 143 line_parent_mid 4.3000000e+00 1.29235 4.30 1.04050 segments + 141 line_parent_mid 4.3000000e+00 1.88000 4.30 1.62845 segments + 142 line_parent_mid 4.3000000e+00 1.62845 4.30 1.29305 segments + 143 line_parent_mid 4.3000000e+00 1.29305 4.30 1.04150 segments 144 line_children_vertical 0.0000000e+00 3.00000 0.00 2.88000 segments 145 line_children_horizontal 0.0000000e+00 2.88000 0.00 2.88000 segments - 146 line_parent_mid 0.0000000e+00 2.88000 0.00 2.62815 segments - 147 line_parent_mid 0.0000000e+00 2.62815 0.50 2.29235 segments - 148 line_parent_mid 5.0000000e-01 2.29235 0.50 2.04050 segments + 146 line_parent_mid 0.0000000e+00 2.88000 0.00 2.62845 segments + 147 line_parent_mid 0.0000000e+00 2.62845 0.50 2.29305 segments + 148 line_parent_mid 5.0000000e-01 2.29305 0.50 2.04150 segments 149 line_children_vertical 1.0000000e+00 3.00000 1.00 2.88000 segments 150 line_children_vertical 2.0000000e+00 3.00000 2.00 2.88000 segments 151 line_children_vertical 3.0000000e+00 3.00000 3.00 2.88000 segments 152 line_children_vertical 4.0000000e+00 3.00000 4.00 2.88000 segments 153 line_children_horizontal 1.0000000e+00 2.88000 4.00 2.88000 segments - 154 line_parent_mid 3.3000000e+00 2.88000 3.30 2.62815 segments - 155 line_parent_mid 3.3000000e+00 2.62815 3.30 2.29235 segments - 156 line_parent_mid 3.3000000e+00 2.29235 3.30 2.04050 segments + 154 line_parent_mid 3.3000000e+00 2.88000 3.30 2.62845 segments + 155 line_parent_mid 3.3000000e+00 2.62845 3.30 2.29305 segments + 156 line_parent_mid 3.3000000e+00 2.29305 3.30 2.04150 segments 157 line_children_vertical 5.0000000e+00 3.00000 5.00 2.88000 segments 158 line_children_vertical 6.0000000e+00 3.00000 6.00 2.88000 segments 159 line_children_vertical 7.0000000e+00 3.00000 7.00 2.88000 segments 160 line_children_horizontal 5.0000000e+00 2.88000 7.00 2.88000 segments - 161 line_parent_mid 5.5000000e+00 2.88000 5.50 2.62815 segments - 162 line_parent_mid 5.5000000e+00 2.62815 5.30 2.29235 segments - 163 line_parent_mid 5.3000000e+00 2.29235 5.30 2.04050 segments + 161 line_parent_mid 5.5000000e+00 2.88000 5.50 2.62845 segments + 162 line_parent_mid 5.5000000e+00 2.62845 5.30 2.29305 segments + 163 line_parent_mid 5.3000000e+00 2.29305 5.30 2.04150 segments 164 line_children_vertical 9.0000000e+00 3.00000 9.00 2.88000 segments 165 line_children_vertical 1.1000000e+01 3.00000 11.00 2.88000 segments 166 line_children_vertical 1.3000000e+01 3.00000 13.00 2.88000 segments 167 line_children_vertical 1.4000000e+01 3.00000 14.00 2.88000 segments 168 line_children_horizontal 9.0000000e+00 2.88000 14.00 2.88000 segments - 169 line_parent_mid 1.1750000e+01 2.88000 11.75 2.62815 segments - 170 line_parent_mid 1.1750000e+01 2.62815 11.75 2.29235 segments - 171 line_parent_mid 1.1750000e+01 2.29235 11.75 2.04050 segments + 169 line_parent_mid 1.1750000e+01 2.88000 11.75 2.62845 segments + 170 line_parent_mid 1.1750000e+01 2.62845 11.75 2.29305 segments + 171 line_parent_mid 1.1750000e+01 2.29305 11.75 2.04150 segments 172 line_children_vertical 1.5000000e+01 3.00000 15.00 2.88000 segments 173 line_children_horizontal 1.5000000e+01 2.88000 15.00 2.88000 segments - 174 line_parent_mid 1.5000000e+01 2.88000 15.00 2.62815 segments - 175 line_parent_mid 1.5000000e+01 2.62815 14.51 2.29235 segments - 176 line_parent_mid 1.4510000e+01 2.29235 14.51 2.04050 segments + 174 line_parent_mid 1.5000000e+01 2.88000 15.00 2.62845 segments + 175 line_parent_mid 1.5000000e+01 2.62845 14.51 2.29305 segments + 176 line_parent_mid 1.4510000e+01 2.29305 14.51 2.04150 segments 177 line_children_vertical 0.0000000e+00 4.00000 0.00 3.88000 segments 178 line_children_vertical 1.0000000e+00 4.00000 1.00 3.88000 segments 179 line_children_vertical 2.0000000e+00 4.00000 2.00 3.88000 segments 180 line_children_vertical 3.0000000e+00 4.00000 3.00 3.88000 segments 181 line_children_horizontal 0.0000000e+00 3.88000 3.00 3.88000 segments - 182 line_parent_mid 5.0000000e-01 3.88000 0.50 3.62815 segments - 183 line_parent_mid 5.0000000e-01 3.62815 0.50 3.29235 segments - 184 line_parent_mid 5.0000000e-01 3.29235 0.50 3.04050 segments + 182 line_parent_mid 5.0000000e-01 3.88000 0.50 3.62845 segments + 183 line_parent_mid 5.0000000e-01 3.62845 0.50 3.29305 segments + 184 line_parent_mid 5.0000000e-01 3.29305 0.50 3.04150 segments 185 line_children_vertical 6.0100000e+00 4.00000 6.01 3.88000 segments 186 line_children_vertical 7.0100000e+00 4.00000 7.01 3.88000 segments 187 line_children_horizontal 6.0100000e+00 3.88000 7.01 3.88000 segments - 188 line_parent_mid 6.5100000e+00 3.88000 6.51 3.62815 segments - 189 line_parent_mid 6.5100000e+00 3.62815 8.50 3.29235 segments - 190 line_parent_mid 8.5000000e+00 3.29235 8.50 3.04050 segments + 188 line_parent_mid 6.5100000e+00 3.88000 6.51 3.62845 segments + 189 line_parent_mid 6.5100000e+00 3.62845 8.50 3.29305 segments + 190 line_parent_mid 8.5000000e+00 3.29305 8.50 3.04150 segments 191 line_children_vertical 8.0100000e+00 4.00000 8.01 3.88000 segments 192 line_children_vertical 9.0100000e+00 4.00000 9.01 3.88000 segments 193 line_children_horizontal 8.0100000e+00 3.88000 9.01 3.88000 segments - 194 line_parent_mid 8.5100000e+00 3.88000 8.51 3.62815 segments - 195 line_parent_mid 8.5100000e+00 3.62815 10.50 3.29235 segments - 196 line_parent_mid 1.0500000e+01 3.29235 10.50 3.04050 segments + 194 line_parent_mid 8.5100000e+00 3.88000 8.51 3.62845 segments + 195 line_parent_mid 8.5100000e+00 3.62845 10.50 3.29305 segments + 196 line_parent_mid 1.0500000e+01 3.29305 10.50 3.04150 segments 197 line_children_vertical 1.0010000e+01 4.00000 10.01 3.88000 segments 198 line_children_horizontal 1.0010000e+01 3.88000 10.01 3.88000 segments - 199 line_parent_mid 1.0010000e+01 3.88000 10.01 3.62815 segments - 200 line_parent_mid 1.0010000e+01 3.62815 12.50 3.29235 segments - 201 line_parent_mid 1.2500000e+01 3.29235 12.50 3.04050 segments + 199 line_parent_mid 1.0010000e+01 3.88000 10.01 3.62845 segments + 200 line_parent_mid 1.0010000e+01 3.62845 12.50 3.29305 segments + 201 line_parent_mid 1.2500000e+01 3.29305 12.50 3.04150 segments 202 line_children_vertical 1.1010000e+01 4.00000 11.01 3.88000 segments 203 line_children_vertical 1.2010000e+01 4.00000 12.01 3.88000 segments 204 line_children_vertical 1.3010000e+01 4.00000 13.01 3.88000 segments 205 line_children_vertical 1.4010000e+01 4.00000 14.01 3.88000 segments 206 line_children_vertical 1.5010000e+01 4.00000 15.01 3.88000 segments 207 line_children_horizontal 1.1010000e+01 3.88000 15.01 3.88000 segments - 208 line_parent_mid 1.4500000e+01 3.88000 14.50 3.62815 segments - 209 line_parent_mid 1.4500000e+01 3.62815 14.50 3.29235 segments - 210 line_parent_mid 1.4500000e+01 3.29235 14.50 3.04050 segments + 208 line_parent_mid 1.4500000e+01 3.88000 14.50 3.62845 segments + 209 line_parent_mid 1.4500000e+01 3.62845 14.50 3.29305 segments + 210 line_parent_mid 1.4500000e+01 3.29305 14.50 3.04150 segments 211 arc 3.0000000e+00 3.00000 10.00 3.00000 arc 212 arc 4.0000000e+00 3.00000 8.00 3.00000 arc - fill border angle density cex label tips adjx adjy - 1 grey black NA NA 0.5 NA NA - 2 white black NA NA 0.5 NA NA - 3 white green NA NA 0.5 NA NA - 4 red black NA NA 0.5 NA NA - 5 grey black NA NA 0.5 NA NA - 6 red black NA NA 0.5 NA NA - 7 red green NA NA 0.5 NA NA - 8 white black NA NA 0.5 NA NA - 9 red black NA NA 0.5 NA NA - 10 red black NA NA 0.5 NA NA - 11 white black NA NA 0.5 NA NA - 12 white black NA NA 0.5 NA NA - 13 red black NA NA 0.5 NA NA - 14 red green NA NA 0.5 NA NA - 15 grey black NA NA 0.5 NA NA - 16 red black NA NA 0.5 NA NA - 17 red green NA NA 0.5 NA NA - 18 grey black NA NA 0.5 NA NA - 19 red black NA NA 0.5 NA NA - 20 red green NA NA 0.5 NA NA - 21 grey black NA NA 0.5 NA NA - 22 white green NA NA 0.5 NA NA - 23 white green NA NA 0.5 NA NA - 24 grey black NA NA 0.5 NA NA - 25 white green NA NA 0.5 NA NA - 26 white green NA NA 0.5 NA NA - 27 red black NA NA 0.5 NA NA - 28 red black NA NA 0.5 NA NA - 29 white green NA NA 0.5 NA NA - 30 white black NA NA 0.5 NA NA - 31 white black NA NA 0.5 NA NA - 32 white green NA NA 0.5 NA NA - 33 red black NA NA 0.5 NA NA - 34 red black NA NA 0.5 NA NA - 35 red green NA NA 0.5 NA NA - 36 white black NA NA 0.5 NA NA - 37 red black NA NA 0.5 NA NA - 38 white green NA NA 0.5 NA NA - 39 red green NA NA 0.5 NA NA - 40 red black NA NA 0.5 NA NA - 41 red green NA NA 0.5 NA NA - 42 white black NA NA 0.5 NA NA - 43 black NA NA 1.0 0.5 0.5 - 44 black NA NA 1.0 0 0.5 0.5 - 45 black NA NA 1.0 0 0.5 0.5 - 46 black NA NA 1.0 1 0.5 0.5 - 47 black NA NA 1.0 0.5 0.5 - 48 black NA NA 1.0 1 0.5 0.5 - 49 black NA NA 1.0 1 0.5 0.5 - 50 black NA NA 1.0 0 0.5 0.5 - 51 black NA NA 1.0 1 0.5 0.5 - 52 black NA NA 1.0 1 0.5 0.5 - 53 black NA NA 1.0 0 0.5 0.5 - 54 black NA NA 1.0 0 0.5 0.5 - 55 black NA NA 1.0 1 0.5 0.5 - 56 black NA NA 1.0 1 0.5 0.5 - 57 black NA NA 1.0 0.5 0.5 - 58 black NA NA 1.0 1 0.5 0.5 - 59 black NA NA 1.0 1 0.5 0.5 - 60 black NA NA 1.0 0.5 0.5 - 61 black NA NA 1.0 1 0.5 0.5 - 62 black NA NA 1.0 1 0.5 0.5 - 63 black NA NA 1.0 0.5 0.5 - 64 black NA NA 1.0 0 0.5 0.5 - 65 black NA NA 1.0 0 0.5 0.5 - 66 black NA NA 1.0 0.5 0.5 - 67 black NA NA 1.0 0 0.5 0.5 - 68 black NA NA 1.0 0 0.5 0.5 - 69 black NA NA 1.0 1 0.5 0.5 - 70 black NA NA 1.0 1 0.5 0.5 - 71 black NA NA 1.0 0 0.5 0.5 - 72 black NA NA 1.0 0 0.5 0.5 - 73 black NA NA 1.0 0 0.5 0.5 - 74 black NA NA 1.0 0 0.5 0.5 - 75 black NA NA 1.0 1 0.5 0.5 - 76 black NA NA 1.0 1 0.5 0.5 - 77 black NA NA 1.0 1 0.5 0.5 - 78 black NA NA 1.0 0 0.5 0.5 - 79 black NA NA 1.0 1 0.5 0.5 - 80 black NA NA 1.0 0 0.5 0.5 - 81 black NA NA 1.0 1 0.5 0.5 - 82 black NA NA 1.0 1 0.5 0.5 - 83 black NA NA 1.0 1 0.5 0.5 - 84 black NA NA 1.0 0 0.5 0.5 - 85 black NA NA 1.0 1_135 0.5 0.5 - 86 black NA NA 1.0 1_101 0.5 0.5 - 87 black NA NA 1.0 1_109 0.5 0.5 - 88 black NA NA 1.0 1_121 0.5 0.5 - 89 black NA NA 1.0 1_136 0.5 0.5 - 90 black NA NA 1.0 1_102 0.5 0.5 - 91 black NA NA 1.0 1_110 0.5 0.5 - 92 black NA NA 1.0 1_122 0.5 0.5 - 93 black NA NA 1.0 1_103 0.5 0.5 - 94 black NA NA 1.0 1_111 0.5 0.5 - 95 black NA NA 1.0 1_123 0.5 0.5 - 96 black NA NA 1.0 1_104 0.5 0.5 - 97 black NA NA 1.0 1_112 0.5 0.5 - 98 black NA NA 1.0 1_124 0.5 0.5 - 99 black NA NA 1.0 1_137 0.5 0.5 - 100 black NA NA 1.0 1_114 0.5 0.5 - 101 black NA NA 1.0 1_127 0.5 0.5 - 102 black NA NA 1.0 1_138 0.5 0.5 - 103 black NA NA 1.0 1_139 0.5 0.5 - 104 black NA NA 1.0 1_128 0.5 0.5 - 105 black NA NA 1.0 1_105 0.5 0.5 - 106 black NA NA 1.0 1_140 0.5 0.5 - 107 black NA NA 1.0 1_125 0.5 0.5 - 108 black NA NA 1.0 1_106 0.5 0.5 - 109 black NA NA 1.0 1_141 0.5 0.5 - 110 black NA NA 1.0 1_126 0.5 0.5 - 111 black NA NA 1.0 1_107 0.5 0.5 - 112 black NA NA 1.0 1_114 0.5 0.5 - 113 black NA NA 1.0 1_129 0.5 0.5 - 114 black NA NA 1.0 1_108 0.5 0.5 - 115 black NA NA 1.0 1_115 0.5 0.5 - 116 black NA NA 1.0 1_130 0.5 0.5 - 117 black NA NA 1.0 1_112 0.5 0.5 - 118 black NA NA 1.0 1_131 0.5 0.5 - 119 black NA NA 1.0 1_118 0.5 0.5 - 120 black NA NA 1.0 1_132 0.5 0.5 - 121 black NA NA 1.0 1_117 0.5 0.5 - 122 black NA NA 1.0 1_133 0.5 0.5 - 123 black NA NA 1.0 1_116 0.5 0.5 - 124 black NA NA 1.0 1_134 0.5 0.5 - 125 black NA NA 1.0 1_119 0.5 0.5 - 126 black NA NA 1.0 1_120 0.5 0.5 - 127 black NA NA 0.5 NA NA - 128 black NA NA 0.5 NA NA - 129 black NA NA 0.5 NA NA - 130 black NA NA 0.5 NA NA - 131 black NA NA 0.5 NA NA - 132 black NA NA 0.5 NA NA - 133 black NA NA 0.5 NA NA - 134 black NA NA 0.5 NA NA - 135 black NA NA 0.5 NA NA - 136 black NA NA 0.5 NA NA - 137 black NA NA 0.5 NA NA - 138 black NA NA 0.5 NA NA - 139 black NA NA 0.5 NA NA - 140 black NA NA 0.5 NA NA - 141 black NA NA 0.5 NA NA - 142 black NA NA 0.5 NA NA - 143 black NA NA 0.5 NA NA - 144 black NA NA 0.5 NA NA - 145 black NA NA 0.5 NA NA - 146 black NA NA 0.5 NA NA - 147 black NA NA 0.5 NA NA - 148 black NA NA 0.5 NA NA - 149 black NA NA 0.5 NA NA - 150 black NA NA 0.5 NA NA - 151 black NA NA 0.5 NA NA - 152 black NA NA 0.5 NA NA - 153 black NA NA 0.5 NA NA - 154 black NA NA 0.5 NA NA - 155 black NA NA 0.5 NA NA - 156 black NA NA 0.5 NA NA - 157 black NA NA 0.5 NA NA - 158 black NA NA 0.5 NA NA - 159 black NA NA 0.5 NA NA - 160 black NA NA 0.5 NA NA - 161 black NA NA 0.5 NA NA - 162 black NA NA 0.5 NA NA - 163 black NA NA 0.5 NA NA - 164 black NA NA 0.5 NA NA - 165 black NA NA 0.5 NA NA - 166 black NA NA 0.5 NA NA - 167 black NA NA 0.5 NA NA - 168 black NA NA 0.5 NA NA - 169 black NA NA 0.5 NA NA - 170 black NA NA 0.5 NA NA - 171 black NA NA 0.5 NA NA - 172 black NA NA 0.5 NA NA - 173 black NA NA 0.5 NA NA - 174 black NA NA 0.5 NA NA - 175 black NA NA 0.5 NA NA - 176 black NA NA 0.5 NA NA - 177 black NA NA 0.5 NA NA - 178 black NA NA 0.5 NA NA - 179 black NA NA 0.5 NA NA - 180 black NA NA 0.5 NA NA - 181 black NA NA 0.5 NA NA - 182 black NA NA 0.5 NA NA - 183 black NA NA 0.5 NA NA - 184 black NA NA 0.5 NA NA - 185 black NA NA 0.5 NA NA - 186 black NA NA 0.5 NA NA - 187 black NA NA 0.5 NA NA - 188 black NA NA 0.5 NA NA - 189 black NA NA 0.5 NA NA - 190 black NA NA 0.5 NA NA - 191 black NA NA 0.5 NA NA - 192 black NA NA 0.5 NA NA - 193 black NA NA 0.5 NA NA - 194 black NA NA 0.5 NA NA - 195 black NA NA 0.5 NA NA - 196 black NA NA 0.5 NA NA - 197 black NA NA 0.5 NA NA - 198 black NA NA 0.5 NA NA - 199 black NA NA 0.5 NA NA - 200 black NA NA 0.5 NA NA - 201 black NA NA 0.5 NA NA - 202 black NA NA 0.5 NA NA - 203 black NA NA 0.5 NA NA - 204 black NA NA 0.5 NA NA - 205 black NA NA 0.5 NA NA - 206 black NA NA 0.5 NA NA - 207 black NA NA 0.5 NA NA - 208 black NA NA 0.5 NA NA - 209 black NA NA 0.5 NA NA - 210 black NA NA 0.5 NA NA - 211 black NA NA 0.5 NA NA - 212 black NA NA 0.5 NA NA + fill border angle density cex label + 1 grey black NA NA 0.5 + 2 white black NA NA 0.5 + 3 white green NA NA 0.5 + 4 red black NA NA 0.5 + 5 grey black NA NA 0.5 + 6 red black NA NA 0.5 + 7 red green NA NA 0.5 + 8 white black NA NA 0.5 + 9 red black NA NA 0.5 + 10 red black NA NA 0.5 + 11 white black NA NA 0.5 + 12 white black NA NA 0.5 + 13 red black NA NA 0.5 + 14 red green NA NA 0.5 + 15 grey black NA NA 0.5 + 16 red black NA NA 0.5 + 17 red green NA NA 0.5 + 18 grey black NA NA 0.5 + 19 red black NA NA 0.5 + 20 red green NA NA 0.5 + 21 grey black NA NA 0.5 + 22 white green NA NA 0.5 + 23 white green NA NA 0.5 + 24 grey black NA NA 0.5 + 25 white green NA NA 0.5 + 26 white green NA NA 0.5 + 27 red black NA NA 0.5 + 28 red black NA NA 0.5 + 29 white green NA NA 0.5 + 30 white black NA NA 0.5 + 31 white black NA NA 0.5 + 32 white green NA NA 0.5 + 33 red black NA NA 0.5 + 34 red black NA NA 0.5 + 35 red green NA NA 0.5 + 36 white black NA NA 0.5 + 37 red black NA NA 0.5 + 38 white green NA NA 0.5 + 39 red green NA NA 0.5 + 40 red black NA NA 0.5 + 41 red green NA NA 0.5 + 42 white black NA NA 0.5 + 43 black NA NA 1.0 + 44 black NA NA 1.0 0 + 45 black NA NA 1.0 0 + 46 black NA NA 1.0 1 + 47 black NA NA 1.0 + 48 black NA NA 1.0 1 + 49 black NA NA 1.0 1 + 50 black NA NA 1.0 0 + 51 black NA NA 1.0 1 + 52 black NA NA 1.0 1 + 53 black NA NA 1.0 0 + 54 black NA NA 1.0 0 + 55 black NA NA 1.0 1 + 56 black NA NA 1.0 1 + 57 black NA NA 1.0 + 58 black NA NA 1.0 1 + 59 black NA NA 1.0 1 + 60 black NA NA 1.0 + 61 black NA NA 1.0 1 + 62 black NA NA 1.0 1 + 63 black NA NA 1.0 + 64 black NA NA 1.0 0 + 65 black NA NA 1.0 0 + 66 black NA NA 1.0 + 67 black NA NA 1.0 0 + 68 black NA NA 1.0 0 + 69 black NA NA 1.0 1 + 70 black NA NA 1.0 1 + 71 black NA NA 1.0 0 + 72 black NA NA 1.0 0 + 73 black NA NA 1.0 0 + 74 black NA NA 1.0 0 + 75 black NA NA 1.0 1 + 76 black NA NA 1.0 1 + 77 black NA NA 1.0 1 + 78 black NA NA 1.0 0 + 79 black NA NA 1.0 1 + 80 black NA NA 1.0 0 + 81 black NA NA 1.0 1 + 82 black NA NA 1.0 1 + 83 black NA NA 1.0 1 + 84 black NA NA 1.0 0 + 85 black NA NA 1.0 1_135 + 86 black NA NA 1.0 1_101 + 87 black NA NA 1.0 1_109 + 88 black NA NA 1.0 1_121 + 89 black NA NA 1.0 1_136 + 90 black NA NA 1.0 1_102 + 91 black NA NA 1.0 1_110 + 92 black NA NA 1.0 1_122 + 93 black NA NA 1.0 1_103 + 94 black NA NA 1.0 1_111 + 95 black NA NA 1.0 1_123 + 96 black NA NA 1.0 1_104 + 97 black NA NA 1.0 1_112 + 98 black NA NA 1.0 1_124 + 99 black NA NA 1.0 1_137 + 100 black NA NA 1.0 1_114 + 101 black NA NA 1.0 1_127 + 102 black NA NA 1.0 1_138 + 103 black NA NA 1.0 1_139 + 104 black NA NA 1.0 1_128 + 105 black NA NA 1.0 1_105 + 106 black NA NA 1.0 1_140 + 107 black NA NA 1.0 1_125 + 108 black NA NA 1.0 1_106 + 109 black NA NA 1.0 1_141 + 110 black NA NA 1.0 1_126 + 111 black NA NA 1.0 1_107 + 112 black NA NA 1.0 1_114 + 113 black NA NA 1.0 1_129 + 114 black NA NA 1.0 1_108 + 115 black NA NA 1.0 1_115 + 116 black NA NA 1.0 1_130 + 117 black NA NA 1.0 1_112 + 118 black NA NA 1.0 1_131 + 119 black NA NA 1.0 1_118 + 120 black NA NA 1.0 1_132 + 121 black NA NA 1.0 1_117 + 122 black NA NA 1.0 1_133 + 123 black NA NA 1.0 1_116 + 124 black NA NA 1.0 1_134 + 125 black NA NA 1.0 1_119 + 126 black NA NA 1.0 1_120 + 127 black NA NA 0.5 + 128 black NA NA 0.5 + 129 black NA NA 0.5 + 130 black NA NA 0.5 + 131 black NA NA 0.5 + 132 black NA NA 0.5 + 133 black NA NA 0.5 + 134 black NA NA 0.5 + 135 black NA NA 0.5 + 136 black NA NA 0.5 + 137 black NA NA 0.5 + 138 black NA NA 0.5 + 139 black NA NA 0.5 + 140 black NA NA 0.5 + 141 black NA NA 0.5 + 142 black NA NA 0.5 + 143 black NA NA 0.5 + 144 black NA NA 0.5 + 145 black NA NA 0.5 + 146 black NA NA 0.5 + 147 black NA NA 0.5 + 148 black NA NA 0.5 + 149 black NA NA 0.5 + 150 black NA NA 0.5 + 151 black NA NA 0.5 + 152 black NA NA 0.5 + 153 black NA NA 0.5 + 154 black NA NA 0.5 + 155 black NA NA 0.5 + 156 black NA NA 0.5 + 157 black NA NA 0.5 + 158 black NA NA 0.5 + 159 black NA NA 0.5 + 160 black NA NA 0.5 + 161 black NA NA 0.5 + 162 black NA NA 0.5 + 163 black NA NA 0.5 + 164 black NA NA 0.5 + 165 black NA NA 0.5 + 166 black NA NA 0.5 + 167 black NA NA 0.5 + 168 black NA NA 0.5 + 169 black NA NA 0.5 + 170 black NA NA 0.5 + 171 black NA NA 0.5 + 172 black NA NA 0.5 + 173 black NA NA 0.5 + 174 black NA NA 0.5 + 175 black NA NA 0.5 + 176 black NA NA 0.5 + 177 black NA NA 0.5 + 178 black NA NA 0.5 + 179 black NA NA 0.5 + 180 black NA NA 0.5 + 181 black NA NA 0.5 + 182 black NA NA 0.5 + 183 black NA NA 0.5 + 184 black NA NA 0.5 + 185 black NA NA 0.5 + 186 black NA NA 0.5 + 187 black NA NA 0.5 + 188 black NA NA 0.5 + 189 black NA NA 0.5 + 190 black NA NA 0.5 + 191 black NA NA 0.5 + 192 black NA NA 0.5 + 193 black NA NA 0.5 + 194 black NA NA 0.5 + 195 black NA NA 0.5 + 196 black NA NA 0.5 + 197 black NA NA 0.5 + 198 black NA NA 0.5 + 199 black NA NA 0.5 + 200 black NA NA 0.5 + 201 black NA NA 0.5 + 202 black NA NA 0.5 + 203 black NA NA 0.5 + 204 black NA NA 0.5 + 205 black NA NA 0.5 + 206 black NA NA 0.5 + 207 black NA NA 0.5 + 208 black NA NA 0.5 + 209 black NA NA 0.5 + 210 black NA NA 0.5 + 211 black NA NA 0.5 + 212 black NA NA 0.5 + tips adjx adjy + 1 1_135
NA NA + 2 1_101
NA NA + 3 1_109
NA NA + 4 1_121
NA NA + 5 1_136
NA NA + 6 1_102
NA NA + 7 1_110
NA NA + 8 1_122
NA NA + 9 1_103
NA NA + 10 1_111
NA NA + 11 1_123
NA NA + 12 1_104
NA NA + 13 1_112
NA NA + 14 1_124
NA NA + 15 1_137
NA NA + 16 1_114
NA NA + 17 1_127
NA NA + 18 1_138
NA NA + 19 1_139
NA NA + 20 1_128
NA NA + 21 1_105
NA NA + 22 1_140
NA NA + 23 1_125
NA NA + 24 1_106
NA NA + 25 1_141
NA NA + 26 1_126
NA NA + 27 1_107
NA NA + 28 1_114
NA NA + 29 1_129
NA NA + 30 1_108
NA NA + 31 1_115
NA NA + 32 1_130
NA NA + 33 1_112
NA NA + 34 1_131
NA NA + 35 1_118
NA NA + 36 1_132
NA NA + 37 1_117
NA NA + 38 1_133
NA NA + 39 1_116
NA NA + 40 1_134
NA NA + 41 1_119
NA NA + 42 1_120
NA NA + 43 1_135
0.5 0.5 + 44 1_101
0.5 0.5 + 45 1_109
0.5 0.5 + 46 1_121
0.5 0.5 + 47 1_136
0.5 0.5 + 48 1_102
0.5 0.5 + 49 1_110
0.5 0.5 + 50 1_122
0.5 0.5 + 51 1_103
0.5 0.5 + 52 1_111
0.5 0.5 + 53 1_123
0.5 0.5 + 54 1_104
0.5 0.5 + 55 1_112
0.5 0.5 + 56 1_124
0.5 0.5 + 57 1_137
0.5 0.5 + 58 1_114
0.5 0.5 + 59 1_127
0.5 0.5 + 60 1_138
0.5 0.5 + 61 1_139
0.5 0.5 + 62 1_128
0.5 0.5 + 63 1_105
0.5 0.5 + 64 1_140
0.5 0.5 + 65 1_125
0.5 0.5 + 66 1_106
0.5 0.5 + 67 1_141
0.5 0.5 + 68 1_126
0.5 0.5 + 69 1_107
0.5 0.5 + 70 1_114
0.5 0.5 + 71 1_129
0.5 0.5 + 72 1_108
0.5 0.5 + 73 1_115
0.5 0.5 + 74 1_130
0.5 0.5 + 75 1_112
0.5 0.5 + 76 1_131
0.5 0.5 + 77 1_118
0.5 0.5 + 78 1_132
0.5 0.5 + 79 1_117
0.5 0.5 + 80 1_133
0.5 0.5 + 81 1_116
0.5 0.5 + 82 1_134
0.5 0.5 + 83 1_119
0.5 0.5 + 84 1_120
0.5 0.5 + 85 1_135
0.5 1.0 + 86 1_101
0.5 1.0 + 87 1_109
0.5 1.0 + 88 1_121
0.5 1.0 + 89 1_136
0.5 1.0 + 90 1_102
0.5 1.0 + 91 1_110
0.5 1.0 + 92 1_122
0.5 1.0 + 93 1_103
0.5 1.0 + 94 1_111
0.5 1.0 + 95 1_123
0.5 1.0 + 96 1_104
0.5 1.0 + 97 1_112
0.5 1.0 + 98 1_124
0.5 1.0 + 99 1_137
0.5 1.0 + 100 1_114
0.5 1.0 + 101 1_127
0.5 1.0 + 102 1_138
0.5 1.0 + 103 1_139
0.5 1.0 + 104 1_128
0.5 1.0 + 105 1_105
0.5 1.0 + 106 1_140
0.5 1.0 + 107 1_125
0.5 1.0 + 108 1_106
0.5 1.0 + 109 1_141
0.5 1.0 + 110 1_126
0.5 1.0 + 111 1_107
0.5 1.0 + 112 1_114
0.5 1.0 + 113 1_129
0.5 1.0 + 114 1_108
0.5 1.0 + 115 1_115
0.5 1.0 + 116 1_130
0.5 1.0 + 117 1_112
0.5 1.0 + 118 1_131
0.5 1.0 + 119 1_118
0.5 1.0 + 120 1_132
0.5 1.0 + 121 1_117
0.5 1.0 + 122 1_133
0.5 1.0 + 123 1_116
0.5 1.0 + 124 1_134
0.5 1.0 + 125 1_119
0.5 1.0 + 126 1_120
0.5 1.0 + 127 NA NA + 128 NA NA + 129 NA NA + 130 NA NA + 131 NA NA + 132 NA NA + 133 NA NA + 134 NA NA + 135 NA NA + 136 NA NA + 137 NA NA + 138 NA NA + 139 NA NA + 140 NA NA + 141 NA NA + 142 NA NA + 143 NA NA + 144 NA NA + 145 NA NA + 146 NA NA + 147 NA NA + 148 NA NA + 149 NA NA + 150 NA NA + 151 NA NA + 152 NA NA + 153 NA NA + 154 NA NA + 155 NA NA + 156 NA NA + 157 NA NA + 158 NA NA + 159 NA NA + 160 NA NA + 161 NA NA + 162 NA NA + 163 NA NA + 164 NA NA + 165 NA NA + 166 NA NA + 167 NA NA + 168 NA NA + 169 NA NA + 170 NA NA + 171 NA NA + 172 NA NA + 173 NA NA + 174 NA NA + 175 NA NA + 176 NA NA + 177 NA NA + 178 NA NA + 179 NA NA + 180 NA NA + 181 NA NA + 182 NA NA + 183 NA NA + 184 NA NA + 185 NA NA + 186 NA NA + 187 NA NA + 188 NA NA + 189 NA NA + 190 NA NA + 191 NA NA + 192 NA NA + 193 NA NA + 194 NA NA + 195 NA NA + 196 NA NA + 197 NA NA + 198 NA NA + 199 NA NA + 200 NA NA + 201 NA NA + 202 NA NA + 203 NA NA + 204 NA NA + 205 NA NA + 206 NA NA + 207 NA NA + 208 NA NA + 209 NA NA + 210 NA NA + 211 NA NA + 212 NA NA # set_plot_area works @@ -436,7 +649,7 @@ set_plot_area(2, c("Test", "Test2"), 3, c(0, 10), 1, 2) Output $usr - [1] -0.40 10.40 3.56 1.00 + [1] -0.4000000 10.4000000 3.4285714 1.0000000 $old_par $old_par$xpd diff --git a/tests/testthat/_snaps/plot_fct/subregion.svg b/tests/testthat/_snaps/plot_fct/subregion.svg index 3d32c41f..cf122d2d 100644 --- a/tests/testthat/_snaps/plot_fct/subregion.svg +++ b/tests/testthat/_snaps/plot_fct/subregion.svg @@ -55,16 +55,16 @@ 1 1 1 -1_105 -1_106 -1_141 -1_107 -1_114 -1_115 -1_112 -1_118 -1_117 -1_116 -1_119 +1_105 +1_106 +1_141 +1_107 +1_114 +1_115 +1_112 +1_118 +1_117 +1_116 +1_119 diff --git a/tests/testthat/_snaps/shrink/pedigree-shrink-1.svg b/tests/testthat/_snaps/shrink/pedigree-shrink-1.svg index aa589574..54a5a1f6 100644 --- a/tests/testthat/_snaps/shrink/pedigree-shrink-1.svg +++ b/tests/testthat/_snaps/shrink/pedigree-shrink-1.svg @@ -18,136 +18,136 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -0 -0 -0 -1 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -5_44 -5_70 -5_46 -5_55 -5_45 -5_54 -5_65 -5_56 -5_47 -5_57 -5_48 -5_58 -5_66 -5_59 -5_49 -5_60 -5_67 -5_61 -5_50 -5_62 -5_51 -5_63 -5_52 -5_64 -5_79 -5_53 -5_69 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0 +0 +0 +1 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +5_44 +5_70 +5_46 +5_55 +5_45 +5_54 +5_65 +5_56 +5_47 +5_57 +5_48 +5_58 +5_66 +5_59 +5_49 +5_60 +5_67 +5_61 +5_50 +5_62 +5_51 +5_63 +5_52 +5_64 +5_79 +5_53 +5_69 diff --git a/tests/testthat/_snaps/shrink/pedigree-shrink-2.svg b/tests/testthat/_snaps/shrink/pedigree-shrink-2.svg index e299e3a0..56a4dc08 100644 --- a/tests/testthat/_snaps/shrink/pedigree-shrink-2.svg +++ b/tests/testthat/_snaps/shrink/pedigree-shrink-2.svg @@ -18,151 +18,151 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -0 -0 -1 -1 -0 -0 -0 -0 -0 -0 -0 -0 -0 -0 -1 -0 -1 -0 -0 -1 -0 -0 -0 -0 -0 -0 -0 -0 -8_135 -8_161 -8_137 -8_156 -8_136 -8_142 -8_138 -8_157 -8_143 -8_159 -8_158 -8_162 -8_139 -8_144 -8_140 -8_163 -8_141 -8_145 -8_149 -8_146 -8_150 -8_165 -8_151 -8_147 -8_152 -8_166 -8_153 -8_148 -8_154 -8_155 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +0 +0 +1 +1 +0 +0 +0 +0 +0 +0 +0 +0 +0 +0 +1 +0 +1 +0 +0 +1 +0 +0 +0 +0 +0 +0 +0 +0 +8_135 +8_161 +8_137 +8_156 +8_136 +8_142 +8_138 +8_157 +8_143 +8_159 +8_158 +8_162 +8_139 +8_144 +8_140 +8_163 +8_141 +8_145 +8_149 +8_146 +8_150 +8_165 +8_151 +8_147 +8_152 +8_166 +8_153 +8_148 +8_154 +8_155 diff --git a/tests/testthat/_snaps/shrink/shrinked-ped.svg b/tests/testthat/_snaps/shrink/shrinked-ped.svg index 77c94fbd..db3d5e85 100644 --- a/tests/testthat/_snaps/shrink/shrinked-ped.svg +++ b/tests/testthat/_snaps/shrink/shrinked-ped.svg @@ -19,59 +19,59 @@ Shrinked ped - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -1 -0 -0 -0 -1 -1 -1 -0 -0 -2_201 -2_203 -2_211 -2_202 -2_204 -2_212 -2_206 -2_214 -2_207 -2_209 -2_208 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +1 +0 +0 +0 +1 +1 +1 +0 +0 +2_201 +2_203 +2_211 +2_202 +2_204 +2_212 +2_206 +2_214 +2_207 +2_209 +2_208 diff --git a/tests/testthat/_snaps/shrink/whole-ped.svg b/tests/testthat/_snaps/shrink/whole-ped.svg index 38128f90..24460f51 100644 --- a/tests/testthat/_snaps/shrink/whole-ped.svg +++ b/tests/testthat/_snaps/shrink/whole-ped.svg @@ -19,70 +19,70 @@ Whole ped - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -1 -0 -0 -0 -0 -1 -0 -1 -1 -0 -0 -2_201 -2_203 -2_210 -2_202 -2_204 -2_211 -2_205 -2_212 -2_206 -2_213 -2_207 -2_214 -2_209 -2_208 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +1 +0 +0 +0 +0 +1 +0 +1 +1 +0 +0 +2_201 +2_203 +2_210 +2_202 +2_204 +2_211 +2_205 +2_212 +2_206 +2_213 +2_207 +2_214 +2_209 +2_208 diff --git a/tests/testthat/_snaps/windows-4.3/modules/data_import-001_.png b/tests/testthat/_snaps/windows-4.3/modules/data_import-001_.png index 595b84a3..bd522779 100644 Binary files a/tests/testthat/_snaps/windows-4.3/modules/data_import-001_.png and b/tests/testthat/_snaps/windows-4.3/modules/data_import-001_.png differ diff --git a/tests/testthat/_snaps/windows-4.3/modules/data_import-002_.png b/tests/testthat/_snaps/windows-4.3/modules/data_import-002_.png index f9920620..5ae7457e 100644 Binary files a/tests/testthat/_snaps/windows-4.3/modules/data_import-002_.png and b/tests/testthat/_snaps/windows-4.3/modules/data_import-002_.png differ diff --git a/tests/testthat/_snaps/windows-4.4/app/ped_shiny-001-Ped_F2_K3_T_IAll_SF1.png b/tests/testthat/_snaps/windows-4.4/app/ped_shiny-001-Ped_F2_K3_T_IAll_SF1.png new file mode 100644 index 00000000..d4ddfa40 Binary files /dev/null and b/tests/testthat/_snaps/windows-4.4/app/ped_shiny-001-Ped_F2_K3_T_IAll_SF1.png differ diff --git a/tests/testthat/_snaps/windows-4.4/app/ped_shiny-002-Ped_F1_K2_I1_121-1_131_SF2.csv b/tests/testthat/_snaps/windows-4.4/app/ped_shiny-002-Ped_F1_K2_I1_121-1_131_SF2.csv new file mode 100644 index 00000000..0480d344 --- /dev/null +++ b/tests/testthat/_snaps/windows-4.4/app/ped_shiny-002-Ped_F1_K2_I1_121-1_131_SF2.csv @@ -0,0 +1,10 @@ +"";"id";"dadid";"momid";"sex";"famid";"steril";"status";"avail";"affected";"useful";"kin";"isinf";"num_child_tot";"num_child_dir";"num_child_ind";"family";"indId";"fatherId";"motherId";"gender";"affection";"available";"num";"error";"sterilisation";"vitalStatus";"affection_mods";"avail_mods" +"2_105";"2_105";NA;NA;"male";"2";NA;NA;FALSE;NA;TRUE;3;FALSE;1;1;0;"1";"105";NA;NA;1;NA;0;6;NA;NA;NA;NA;0 +"2_106";"2_106";NA;NA;"female";"2";NA;NA;FALSE;NA;TRUE;3;FALSE;1;1;0;"1";"106";NA;NA;2;NA;0;1;NA;NA;NA;NA;0 +"2_119";"2_119";"2_105";"2_106";"male";"2";NA;NA;TRUE;TRUE;TRUE;2;FALSE;5;5;0;"1";"119";"105";"106";1;1;1;6;NA;NA;NA;1;1 +"2_120";"2_120";NA;NA;"female";"2";NA;NA;FALSE;FALSE;TRUE;2;FALSE;5;5;0;"1";"120";"107";"108";2;0;0;2;NA;NA;NA;0;0 +"2_130";"2_130";"2_119";"2_120";"male";"2";NA;NA;TRUE;FALSE;TRUE;2;FALSE;0;0;0;"1";"130";"119";"120";1;0;1;3;NA;NA;NA;0;1 +"2_131";"2_131";"2_119";"2_120";"male";"2";NA;NA;FALSE;TRUE;TRUE;1;TRUE;0;0;0;"1";"131";"119";"120";1;1;0;1;NA;NA;NA;1;0 +"2_132";"2_132";"2_119";"2_120";"male";"2";NA;NA;FALSE;FALSE;TRUE;2;FALSE;0;0;0;"1";"132";"119";"120";1;0;0;0;NA;NA;NA;0;0 +"2_133";"2_133";"2_119";"2_120";"female";"2";NA;NA;TRUE;FALSE;TRUE;2;FALSE;0;0;0;"1";"133";"119";"120";2;0;1;2;NA;NA;NA;0;1 +"2_134";"2_134";"2_119";"2_120";"female";"2";NA;NA;FALSE;TRUE;TRUE;2;FALSE;0;0;0;"1";"134";"119";"120";2;1;0;4;NA;NA;NA;1;0 diff --git a/tests/testthat/_snaps/windows-4.4/modules/data_import-001_.png b/tests/testthat/_snaps/windows-4.4/modules/data_import-001_.png index fda9d23c..bd522779 100644 Binary files a/tests/testthat/_snaps/windows-4.4/modules/data_import-001_.png and b/tests/testthat/_snaps/windows-4.4/modules/data_import-001_.png differ diff --git a/tests/testthat/_snaps/windows-4.4/modules/data_import-002_.png b/tests/testthat/_snaps/windows-4.4/modules/data_import-002_.png index 447bea52..5ae7457e 100644 Binary files a/tests/testthat/_snaps/windows-4.4/modules/data_import-002_.png and b/tests/testthat/_snaps/windows-4.4/modules/data_import-002_.png differ diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index 42a3d234..dc0142b2 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -175,7 +175,9 @@ test_that("plot_ped works", { Pedigree(sampleped[sampleped$famid == "1", ]) }) app <- shinytest2::AppDriver$new( - plot_ped_demo(pedi = pedi), name = "plot_ped", + plot_ped_demo( + pedi = pedi, tips = c("id", "momid", "num") + ), name = "plot_ped", variant = shinytest2::platform_variant() ) app$set_window_size(width = 1611, height = 956) @@ -185,6 +187,7 @@ test_that("plot_ped works", { app$click("saveped-download") app$wait_for_idle() app$set_inputs(`saveped-ext` = "html") + app$wait_for_idle() path <- app$get_download("saveped-plot_dwld") expect_true(file.exists(path)) expect_equal(tools::file_ext(path), "html") diff --git a/tests/testthat/test-ped_to_legdf.R b/tests/testthat/test-ped_to_legdf.R index 2c51d376..0a8c0175 100644 --- a/tests/testthat/test-ped_to_legdf.R +++ b/tests/testthat/test-ped_to_legdf.R @@ -37,8 +37,8 @@ test_that("Pedigree legend works", { vdiffr::expect_doppelganger("Legend alone", function() { suppressWarnings(plot_legend( - ped, boxh = 0.07, boxw = 0.07, cex = 0.8, - leg_loc = c(0, 1.2, 0, 0.9), adjx = 0.5, adjy = 0.04 + ped, boxh = 0.07, boxw = 0.07, cex = 0.7, + leg_loc = c(0, 0.9, 0, 0.9), adjx = 0, adjy = 0 )) } ) @@ -48,8 +48,10 @@ test_that("Pedigree legend works", { suppressWarnings(plot( ped[!is.na(famid(ped(ped)))], cex = 0.8, symbolsize = 1.5, aff_mark = FALSE, - legend = TRUE, leg_cex = 0.6, leg_symbolsize = 0.4, - leg_loc = c(7, 16, 1, 1.8) + legend = TRUE, leg_cex = 0.8, leg_symbolsize = 0.01, + leg_loc = c(0, 0.8, 0, 0.25), + ped_par = list(oma = c(12, 1, 1, 1), mar = rep(0, 4)), + leg_par = list(oma = c(1, 1, 1, 1), mar = rep(0, 4)) )) } ) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 43c882ac..1b39a297 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -66,3 +66,37 @@ test_that("Pedigree fails to line up", { function() plot(ped1reord, precision = 1) ) }) + +test_that("Fix of vertical scaling", { + # Simple trio with multiline labels + pedi <- Pedigree( + 1:3, dadid = c(0, 0, 1), momid = c(0, 0, 2), sex = c(1, 2, 1), + na_strings = 0 + ) + mcols(pedi)$labels <- c("1", "2", "3\n1/1\n1/1\n1/1\n1/1\n1/1\n1/1") + + vdiffr::expect_doppelganger("Ped scaling multiple label", + function() { + # Plot + par(mar = rep(2, 4), oma = rep(1, 4)) + plot( + pedi, id_lab = "labels", + ped_par = list(mar = rep(2, 4), oma = rep(1, 4)) + ) + } + ) +}) + +test_that("Tooltip works", { + data(sampleped) + pedi <- Pedigree(sampleped) + p <- plot( + pedi, ggplot_gen = TRUE, precision = 1, + label = "num", tips = c("momid"), symbolsize = 1.5 + )$ggplot + + html_plot <- ggplotly(p, tooltip = "text") %>% + plotly::layout(hoverlabel = list(bgcolor = "darkgrey")) + + expect_snapshot(html_plot) +}) diff --git a/vignettes/pedigree_plot.Rmd b/vignettes/pedigree_plot.Rmd index fe45464e..581e2ea7 100644 --- a/vignettes/pedigree_plot.Rmd +++ b/vignettes/pedigree_plot.Rmd @@ -243,14 +243,34 @@ $0 \le z \le 1$ and are in the ''forward''' part of the ray. This latter is true if the inner product $x \cos(\theta) + y \sin(\theta) >0$. Exactly one of the polygon sides will satisfy both conditions. -Final output -========================== +Final output and interactivness +================================ The Pedigree is plotted in a new frame or added to the current device. If `ggplot_gen = TRUE`, then a ggplot object is create with the same informations and available in the invisible object given back by `plot_fromdf()*` +This ggplot object can be used to further customise the plot, add +annotations, or make it interactive. The `tips` argument can be used +to add tooltips to the plot. They will be displayed when hovering +over the corresponding element through the `text` element. + +```{r, interactive_plot, fig.alt = "Interactive plot", eval = FALSE} +data(sampleped) +pedi <- Pedigree(sampleped) + +p <- plot( + pedi, ggplot_gen = TRUE, + tips = c("affected", "momid", "dadid"), + symbolsize = 1.5, cex = 0.8 +) +plotly::layout( + plotly::ggplotly(p$ggplot, tooltip = "text"), + hoverlabel = list(bgcolor = "darkgrey") +) +``` + Notes: Remind the user of subjects who did not get plotted; these are ususally subjects who are married in but without