inst/doc/Rdelta-introduction.R

In RDelta: Parse and Query DELTA-Format Taxonomic Descriptions

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5,
  eval = FALSE
)

## ----test_RDelta, echo=TRUE, eval=FALSE---------------------------------------
# 
# library(RDelta)
# 
# #--- Get command line arguments ----------------------------------------------
# # This works in both interactive and non-interactive modes
# get_args <- function() {
#   # Get all command line arguments
#   args <- commandArgs(trailingOnly = TRUE)
# 
#   # If running interactively and no arguments were provided,
#   # prompt the user for file names
#   if (interactive() && length(args) == 0) {
#     cat("\nNo command-line arguments provided.\n")
#     cat("Please enter file names (or press Enter to use defaults):\n\n")
# 
#     chars <- readline(prompt = "Characters file [chars]: ")
#     if (chars == "") chars <- "chars"
# 
#     items <- readline(prompt = "Items file [items]: ")
#     if (items == "") items <- "items"
# 
#     specs <- readline(prompt = "Specifications file [specs] (optional): ")
#     if (specs == "") specs <- NULL
# 
#     return(list(chars = chars, items = items, specs = specs))
#   }
# 
#   # Non-interactive mode or arguments provided
#   if (length(args) >= 2) {
#     chars <- args[1]
#     items <- args[2]
#     specs <- if (length(args) >= 3) args[3] else NULL
#   } else {
#     # Default files
#     chars <- "chars"
#     items <- "items"
#     specs <- "specs"
#   }
# 
#   return(list(chars = chars, items = items, specs = specs))
# }
# 
# #--- Get file names ----------------------------------------------------------
# files <- get_args()
# 
# chars_file <- files$chars
# items_file <- files$items
# specs_file <- files$specs
# 
# #--- Creates CharList, ItemList and Specs objects and parses the
# #    corresponding text files ----------------------------------------------
# if (!is.null(specs_file)) {
#   Example <- load_delta(chars_file, items_file, specs_file)
# } else {
#   Example <- load_delta(chars_file, items_file)
# }
# 
# if (!(Example$is_parsed() && Example$is_items_parsed())) {
#   stop("Error parsing characters and/or items description files")
# }
# if (Example$has_specifications() && !Example$is_specs_parsed()) {
#   stop("Error parsing specifications file")
# }
# 
# #--- Displays header -------------------------------------------------------
# cat("==================\n")
# cat("Free Delta Project\n")
# cat("==================\n")
# cat("Test of RDelta package\n\n")
# 
# stop <- FALSE
# while (!stop) {
#   #--- Menu ----------------------------------------------------------------
#   cat("\n")
#   cat("Test Options:\n")
#   cat("1. Character list\n")
#   cat("2. Retrieve a character\n")
#   cat("3. Item list\n")
#   cat("4. Retrieve an item\n")
#   cat("5. Item/character-value matching\n")
#   cat("6. Identification\n")
#   cat("7. Specifications\n")
#   cat("8. Retrieve all (debugging)\n")
#   cat("9. Exit\n")
#   opt <- readline(prompt = "Your choice: ")
#   opt <- as.integer(opt)
# 
#   if (is.na(opt)) {
#     cat("Invalid input. Please enter a number.\n")
#     next
#   }
# 
#   if (opt == 1) {
#     #----- Displays all characters features -----
#     cat("\nCHARACTERS LIST:\n")
#     for (i in 1:Example$get_chars_nb()) {
#       cat(i, " : ", Example$get_char_feature(i), "\n")
#     }
#     cat("*** ", Example$get_chars_nb(), " characters ***\n")
# 
#   } else if (opt == 2) {
#     #----- Displays information about one character -----
#     num <- readline(prompt = "Enter character number to retrieve: ")
#     num <- as.integer(num)
#     if (is.na(num) || (num < 1) || (num > Example$char_count())) {
#       cat("Invalid character number\n")
#     } else {
#       #--- Character type
#       cat("\nType : ")
#       ct <- Example$get_char_type(num)
#       if (ct == 2) {
#         cat("unordered multistate\n")
#       } else if (ct == 3) {
#         cat("ordered multistate\n")
#       } else if (ct == 4) {
#         cat("integer numeric\n")
#       } else if (ct == 5) {
#         cat("real numeric\n")
#       } else if (ct == 8) {
#         cat("text/comment\n")
#       }
# 
#       #--- Feature
#       cat("Feature : ", Example$get_char_feature(num), "\n")
# 
#       #--- State list or unit
#       if (ct == 2 || ct == 3) {  # CT_UM or CT_OM
#         for (j in 1:Example$get_states_nb(num)) {
#           cat("State ", j, " : ", Example$get_state(num, j), "\n")
#         }
#       } else if (ct == 4 || ct == 5) {  # CT_IN or CT_RN
#         cat("Unit : ", Example$get_char_unit(num), "\n")
#       }
#     }
# 
#   } else if (opt == 3) {
#     #----- Displays all items names -----
#     cat("\nITEMS LIST:\n")
#     for (i in 1:Example$get_items_nb()) {
#       cat(i, " : ", Example$get_item_name(i), "\n")
#     }
#     cat("*** ", Example$get_items_nb(), " items ***\n")
# 
#   } else if (opt == 4) {
#     #----- Displays information about an item -----
#     num <- readline(prompt = "Enter item number to retrieve: ")
#     num <- as.integer(num)
#     if (is.na(num) || (num < 1) || (num > Example$item_count())) {
#       cat("Invalid item number\n")
#     } else {
#       # Name
#       cat("\nItem name :\n")
#       cat("  ", Example$get_item_name(num), "\n")
#       # Attributes
#       cat("Attributes :\n")
#       for (j in 1:Example$get_attributes_nb(num)) {
#         cat("  ", Example$get_attribute(num, j), "\n")
#       }
#     }
# 
#   } else if (opt == 5) {
#     #----- Matching item with character value -----
#     n1 <- readline(prompt = "Enter item number: ")
#     n1 <- as.integer(n1)
#     if (is.na(n1) || (n1 < 1) || (n1 > Example$get_items_nb())) {
#       cat("Invalid item number\n")
#       next
#     }
# 
#     n2 <- readline(prompt = "Enter character number: ")
#     n2 <- as.integer(n2)
#     if (is.na(n2) || (n2 < 1) || (n2 > Example$get_chars_nb())) {
#       cat("Invalid character number\n")
#       next
#     }
# 
#     x1 <- readline(prompt = "Enter character state/value: ")
#     x1 <- as.numeric(x1)
# 
#     if (is.na(x1)) {
#       cat("Invalid value\n")
#       next
#     }
# 
#     # Display item name
#     cat("\nItem ", Example$get_item_name(n1), " is ")
# 
#     # Compare and display result - use matches_default for simple comparison
#     if (!Example$matches_default(n1, n2, x1)) {
#       cat("not ")
#     }
#     cat("matching with\n")
# 
#     # Display character and state/value
#     cat("character : ", Example$get_char_feature(n2), "\n")
#     cat("state/value : ", x1)
#     ct <- Example$get_char_type(n2)
#     if (ct == 2 || ct == 3) {  # CT_UM or CT_OM
#       cat(" ", Example$get_state(n2, as.integer(x1)), "\n")
#     } else if (ct == 4 || ct == 5) {  # CT_IN or CT_RN
#       cat(" ", Example$get_char_unit(n2), "\n")
#     }
#     cat("\n")
# 
#   } else if (opt == 6) {
#     #----- Item identification -----
#     # Check if identification.R exists
#     if (file.exists("identification.R")) {
#       source("identification.R")
#       identification(Example)
#     } else {
#       cat("Error: identification.R file not found\n")
#     }
# 
#   } else if (opt == 7) {
#     #----- Displays specification file content -----
#     if (Example$has_specifications()) {
#       cat("\nSPECIFICATIONS:\n")
#       cat(Example$retrieve_all_specs())
#     } else {
#       cat("No specifications file\n")
#     }
# 
#   } else if (opt == 8) {
#     #----- Displays all information stored after parsing (debugging) -----
#     cat("\n========================================\n")
#     cat("     FULL PACKAGE INFORMATION\n")
#     cat("========================================\n\n")
#     cat(Example$retrieve_all())
# 
#   } else if (opt == 9) {
#     #----- Exit -----
#     stop <- TRUE
#     break
#   }
# }
# 
# cat("\nTest completed.\n")

## ----identification, echo=TRUE, eval=FALSE------------------------------------
# 
# message_identification <- function() {
#   cat("\nIDENTIFICATION\n")
#   cat("This function demonstrates the possibility using RDelta package for taxa\n")
#   cat("identification.\n")
#   cat("In this example, the identification process has been simplified a lot.\n")
#   cat("It is based on successive comparisons between observed characters values,\n")
#   cat("and the items descriptions stored in the Delta files.\n")
#   cat("Advanced features, such as values combinations, implicit values, dependant\n")
#   cat("characters are not implemented. There is no characters selection during\n")
#   cat("identification (like the 'best' command in Intkey).\n")
#   cat("Of course, the user interface is very simple, and should be improved in\n")
#   cat("a public release.\n\n")
#   cat("Usage :\n")
#   cat("To make an identification, you should have a printed version of characters\n")
#   cat("description (Delta chars file).\n")
#   cat("Select a character and a value according to the taxon you want to identify.\n")
#   cat("After each selection, the program displays all characters values already\n")
#   cat("selected, and the list of remaining taxa.\n")
#   cat("To cancel a previous selected character, select it again, and input the\n")
#   cat("UNKNOWN value (-1). You can also modify a previously selected value.\n\n")
# }
# 
# identification <- function(delta) {
#   #----- Initialisation -----
#   nbval <- RDelta::get_chars_nb(delta)
#   nbitm <- RDelta::get_items_nb(delta)
# 
#   tabval <- rep(NA, nbval)
#   tabitm <- rep(1, nbitm)
# 
#   message_identification()
# 
#   #----- User input and search matching items -----
#   while (TRUE) {
#     #--- Input character number and value
#     cat("Select a character describing the item to identify :\n")
#     cat("  Enter character number (0=exit) : ")
#     charnum <- as.integer(readline())
# 
#     if (is.na(charnum) || charnum == 0) break
# 
#     if (charnum < 1 || charnum > nbval) {
#       cat("  Invalid character number\n")
#       next
#     }
# 
#     cat("  Enter character state/value (-1=unknown) : ")
#     charval <- as.numeric(readline())
# 
#     if (is.na(charval)) {
#       cat("  Invalid value, please enter a number\n")
#       next
#     }
# 
#     #--- Stores value
#     tabval[charnum] <- if (charval == -1) NA else charval
# 
#     #--- Update items table considering selected values
#     for (i in 1:nbitm) {
#       for (j in 1:nbval) {
#         if (is.na(tabval[j])) {
#           tabitm[i] <- 1
#         } else {
#           tabitm[i] <- as.integer(RDelta::matches(delta, i, j, tabval[j]))
#         }
#         if (tabitm[i] == 0) break
#       }
#     }
# 
#     #--- Displays selected characters and values, and remaining items list
#     cat("\nCHARACTERS SELECTION\n")
#     for (j in 1:nbval) {
#       if (!is.na(tabval[j])) {
#         cat(j, ". ", RDelta::get_char_feature(delta, j), "\n", sep = "")
#         cat("    state/value : ", tabval[j], sep = "")
# 
#         if (RDelta::get_char_type(delta, j) == 2) {
#           cat(" - ", RDelta::get_state(delta, j, as.integer(tabval[j])), "\n", sep = "")
#         } else if (RDelta::get_char_type(delta, j) == 4) {
#           cat(" ", RDelta::get_char_unit(delta, j), "\n", sep = "")
#         } else {
#           cat("\n")
#         }
#       }
#     }
# 
#     cat("ITEMS REMAINING\n")
#     for (i in 1:nbitm) {
#       if (tabitm[i] == 1) {
#         cat(delta$get_item_name(i), "\n")
#       }
#     }
#     cat("\n")
#   }
# }
# 
# #==============================================================================
# # Example usage (commented out):
# #
# # library(RDelta)
# # delta <- load_delta("chars_viola", "items_viola")  # read DELTA files
# # identification(delta)
# #==============================================================================