R/metrics.R

#' @title A calculation function for all metrics
#'
#'
#' @description {Creation object containing all metrics, which are :
#' the number of empty sequence flows, the number of duplicate tasks, the number of data objects, the number of pools, the number of swimlanes,
#' the number of message flows, the density, the coefficient of network connectivity, the average connector degree,
#' the maximum connector degree, the sequentiality, the cyclicity, the diameter, the depth, the token_split,
#' the control flow complexity, the connector mismatch, the connector heterogeneity and the crs}
#'
#' @param file_path file path of the BPMN file and
#' @param cross_connectivity_metric a param indicating whether cross_connectivity shall be calculated as well
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return a tibble with one row and for each metric a column
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' calculate_metrics(file_path)
#' @export
calculate_metrics <-
  function(file_path,
           cross_connectivity_metric = TRUE,
           signavio = FALSE) {
    doc <- create_internal_doc(file_path, signavio)
    path_repetition_log <-
      create_path_and_repetition_log(doc, signavio = signavio)
    all_metrics <- tibble(
      file = file_path,
      size = size_process_model(doc, signavio),
      empty_sequence_flows = n_empty_sequence_flows(doc, signavio),
      duplicate_tasks = n_duplicate_tasks(doc, signavio),
      number_pools = n_pools(doc, signavio),
      number_data_objects = n_data_objects(doc, signavio),
      number_swimlanes = n_swimlanes(doc, signavio),
      number_message_flows = n_message_flows(doc, signavio),
      density = density_process_model(doc, signavio),
      coef_network_connectivity = coefficient_network_connectivity(doc, signavio),
      avg_connector_degree = avg_connector_degree(doc, signavio),
      max_connector_degree = max_connector_degree(doc, signavio),
      connectivity_level_between_pools = connectivity_level_between_pools(doc, signavio),
      sequentiality = sequentiality(doc, signavio),
      cyclicity = cyclicity(path_repetition_log, doc, signavio),
      diameter = diameter(path_repetition_log),
      depth = depth(path_repetition_log),
      token_split = token_split(doc, signavio),
      cfc = control_flow_complexity(doc, signavio),
      connector_mismatch = connector_mismatch(doc, signavio),
      connector_heterogeneity = connector_heterogeneity(doc, signavio),
      separability = separability(path_repetition_log, doc, signavio),
      structuredness = structuredness(path_repetition_log, doc, signavio)
    )
    if (cross_connectivity_metric) {
      cross_connectivity_result <-
        cross_connectivity(path_repetition_log, doc, signavio)
      all_metrics <- cbind(all_metrics, cross_connectivity_result)
    }
    return(all_metrics)
  }

### Metrics

#' @title Size
#'
#' @description The size of a model is the number of tasks, gateways and events
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the size
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' size_process_model(create_internal_doc(file_path))
#' @export
size_process_model <-
  function (xml_internal_doc, signavio = FALSE) {
    size <- number_tasks(xml_internal_doc, signavio) +
      number_AND_gateways(xml_internal_doc, signavio) +
      number_XOR_gateways(xml_internal_doc, signavio) +
      number_OR_gateways(xml_internal_doc, signavio) +
      number_complex_gateways(xml_internal_doc, signavio) +
      number_event_based_gateways(xml_internal_doc, signavio) +
      number_events(xml_internal_doc, signavio) +
      n_data_objects(xml_internal_doc, signavio)
    return(size)
  }

#' @title Data Objects
#'
#' @description The number of data objects includes all data objects and data stores of a BPMN diagram
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of data objects
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_data_objects(create_internal_doc(file_path))
#' @export
n_data_objects <- function(xml_internal_doc, signavio = FALSE) {
  if (!signavio) {
    data_objects <-
      getNodeSet(xml_internal_doc,
                 "//bpmn:dataStoreReference | //bpmn:dataObjectReference | //dataStore")
  } else {
    data_objects <-
      getNodeSet(
        xml_internal_doc,
        "//xmlns:dataStore | //xmlns:dataObject",
        namespace(xml_internal_doc)
      )
  }
  return(length(data_objects))
}

#' @title The connectivity level between pools
#'
#' @description The connectivity level between pools is the number of message flows over the number of pools
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the connectivity level between pools
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' connectivity_level_between_pools(create_internal_doc(file_path))
#' @export
connectivity_level_between_pools <-
  function(xml_internal_doc, signavio = FALSE) {
    if(n_pools(xml_internal_doc, signavio) == 0)
      return(n_message_flows(xml_internal_doc, signavio))
    else
      return(
        n_message_flows(xml_internal_doc, signavio) / n_pools(xml_internal_doc, signavio)
     )
  }

#' @title Empty sequence flows
#'
#' @description Empty sequence flow is defined as a flow which connects a split parallel gateway with a join parallel gateway without any tasks in between
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of empty sequence flows
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_empty_sequence_flows(create_internal_doc(file_path))
#' @export
n_empty_sequence_flows <-
  function(xml_internal_doc, signavio = FALSE) {
    #Take all sequence flow nodes and save the target and source in one object
    if (!signavio)
      sequence_flow_nodes <-
        getNodeSet(xml_internal_doc, "//bpmn:sequenceFlow | //sequenceFlow")
    else
      sequence_flow_nodes <-
        getNodeSet(xml_internal_doc,
                   "//xmlns:sequenceFlow",
                   namespace(xml_internal_doc))
    source_seq_flow <-
      unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "sourceRef"))
    target_seq_flow <-
      unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "targetRef"))
    
    #Get id of all split and join gateways which are of type parallel
    if (!signavio) {
      splits <-
        split_gateways(xml_internal_doc,
                       "//bpmn:parallelGateway | //parallelGateway",
                       signavio)
      split_activities <-
        split_gateways(
          xml_internal_doc,
          "//bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
          //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
          //bpmn:subProcess | //bpmn:callActivity | //task",
          signavio
        )
      
      joins <-
        join_gateways(xml_internal_doc,
                      "//bpmn:parallelGateway | //parallelGateway",
                      signavio)
    } else {
      splits <-
        split_gateways(xml_internal_doc, "//xmlns:parallelGateway", signavio)
      split_activities <-
        split_gateways(
          xml_internal_doc,
          "//xmlns:task | //xmlns:sendTask |
          //xmlns:receiveTask | //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask |
          //xmlns:scriptTask | //xmlns:subProcess | //xmlns:callActivity",
          signavio
        )
      
      joins <-
        join_gateways(xml_internal_doc, "//xmlns:parallelGateway", signavio)
    }
    splits <- c(split_activities, splits)
    #Check for each source and target node whether it is respectively a split and join node
    source_is_split_gateway <- source_seq_flow %in% splits
    target_is_join_gateway <- target_seq_flow %in% joins
    
    #Make a vector containing true when it is an empty sequence flow, ie the source is a split gateway
    #and the target is a join gateway
    empty_sequence_flows <-
      source_is_split_gateway & target_is_join_gateway
    
    #The sum of this vector is the number of sequence flows
    return (sum(empty_sequence_flows))
  }

#' @title Duplicate tasks
#'
#' @description Duplicate tasks are tasks which share the same name with other tasks
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of duplicate tasks
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_duplicate_tasks(create_internal_doc(file_path))
#' @export
n_duplicate_tasks <- function(xml_internal_doc, signavio = FALSE) {
  number_occurences <- NULL
  tasks <-
    task_names(xml_internal_doc = xml_internal_doc, signavio = signavio)
  #calculate how many times a name of a task occurs in a process model
  if (length(tasks) > 0) {
    number_duplicates <- tasks %>%
      group_by(task_names) %>%
      summarise(number_occurences = (n() - 1)) %>%
      summarise(number_duplicates = sum(number_occurences))
    return(as.numeric(number_duplicates))
  } else
    return(0)
}

#' @title Number of pools
#'
#' @description Number of pools in the process models. A pool represents an organisation or an entity
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of pools
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_pools(create_internal_doc(file_path))
#' @export
n_pools <- function(xml_internal_doc, signavio = FALSE) {
  if (!signavio)
    pools <-
      getNodeSet(xml_internal_doc, "//bpmn:participant | //process")
  else
    pools <-
      getNodeSet(xml_internal_doc,
                 "//xmlns:participant",
                 namespace(xml_internal_doc))
  return(length(pools))
}

#' @title Number of swimlanes
#'
#' @description Number of swimlanes in the pools. A swimlane represents a person, role or team
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of swimlanes
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_swimlanes(create_internal_doc(file_path))
#' @export
n_swimlanes <- function(xml_internal_doc, signavio = FALSE) {
  if (!signavio)
    swimlanes <- getNodeSet(xml_internal_doc, "//bpmn:lane | //lane")
  else
    swimlanes <-
      getNodeSet(xml_internal_doc,
                 "//xmlns:lane",
                 namespace(xml_internal_doc))
  return(length(swimlanes))
}

#' @title Number of message flows
#'
#' @description Number of message flows. Message flows are used for communication between processes and link message events
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the number of message flows
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' n_message_flows(create_internal_doc(file_path))
#' @export
n_message_flows <- function(xml_internal_doc, signavio = FALSE) {
  if (!signavio)
    message_flows <-
      getNodeSet(xml_internal_doc, "//bpmn:messageFlow | //messageFlow")
  else
    message_flows <-
      getNodeSet(xml_internal_doc,
                 "//xmlns:messageFlow",
                 namespace(xml_internal_doc))
  return(length(message_flows))
}

#' @title Density
#'
#' @description Density is defined as the number of sequence flows divided by the size times the size minus one
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the density
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' density_process_model(create_internal_doc(file_path))
#' @export
density_process_model <-
  function (xml_internal_doc, signavio = FALSE) {
    density_diagram <-
      number_sequence_flows(xml_internal_doc, signavio) / ((
        size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
      ) * ((
        size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
      ) - 1))
    if(is.nan(density_diagram) |is.infinite(density_diagram)) 
      density_diagram <- 0
    return(density_diagram)
  }

#' @title Coefficient of network connectivity
#'
#' @description Coefficient of network connectivity is defined as the number of sequence flows divided by the size
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the coefficient of network connectivity
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' coefficient_network_connectivity(create_internal_doc(file_path))
#' @export
coefficient_network_connectivity <-
  function (xml_internal_doc, signavio = FALSE) {
    coef_network_connectivity <-
      number_sequence_flows(xml_internal_doc, signavio) / (
        size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
      )
    if(is.nan(coef_network_connectivity) |is.infinite(coef_network_connectivity)) 
      coef_network_connectivity <- 0
    return(coef_network_connectivity)
  }

#' @title Average connector degree
#'
#' @description Average connector degree is defined as the average incoming and outgoing sequence flows of all gateways and activities with at least two incoming or outgoing sequence flows
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the average connector degree
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' avg_connector_degree(create_internal_doc(file_path))
#' @export
avg_connector_degree <-
  function (xml_internal_doc, signavio = FALSE) {
    number_gateways <- number_AND_gateways(xml_internal_doc, signavio) +
      number_XOR_gateways(xml_internal_doc, signavio) +
      number_OR_gateways(xml_internal_doc, signavio) +
      number_complex_gateways(xml_internal_doc, signavio) +
      number_event_based_gateways(xml_internal_doc, signavio)
    if (!signavio) {
      join_activities <-
        join_gateways(
          xml_internal_doc,
          "//bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
          //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
          //bpmn:subProcess | //bpmn:callActivity | //task",
          signavio
        )
      split_activities <-
        split_gateways(
          xml_internal_doc,
          "//bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
          //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
          //bpmn:subProcess | //bpmn:callActivity | //task",
          signavio
        )
    } else {
      join_activities <-
        join_gateways(
          xml_internal_doc,
          "//xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
          //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
          //xmlns:subProcess | //xmlns:callActivity",
          signavio
        )
      split_activities <-
        split_gateways(
          xml_internal_doc,
          "//xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
          //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
          //xmlns:subProcess | //xmlns:callActivity",
          signavio
        )
    }
    connector_activities <- c(join_activities, split_activities)
    number_connector_activities <-
      length(unique(connector_activities))
    
    if ((number_gateways + number_connector_activities) > 0)
      return((
        total_io_flows_gateways(xml_internal_doc, signavio) + number_io_flows_activities_with_id(xml_internal_doc, connector_activities, signavio)
      ) / (number_gateways + number_connector_activities)
      )
    else
      return(0)
  }

#' @title Maximum connector degree
#'
#' @description Maximum connector degree is defined as the gateway or activity with the most incoming and outgoing sequence flows
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the maximum connector degree
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' max_connector_degree(create_internal_doc(file_path))
#' @export
max_connector_degree <-
  function (xml_internal_doc, signavio = FALSE) {
    return(max_io_flows_gateways_activities(xml_internal_doc, signavio))
  }

#' @title Separability
#'
#' @description {A cut vertex is a node which if removed, splits the diagram into two pieces
#' The consequence is that elements which are part of each path can be defined as a cut vertex
#' Separability is defined as the number of cut vertices divided by (the size of the model - 2)}
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the separability
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' separability(path_log, create_internal_doc(file_path))
#' @export
separability <-
  function(repetition_and_path_log,
           xml_internal_doc,
           signavio = FALSE) {
    elements <- NULL
    #Take the intersection of all paths of the path log, filter the join and split element and remove duplicates
    if (length(repetition_and_path_log[[1]]) > 0) {
      intersection_elements <-
        reduce(repetition_and_path_log[[1]], intersect)
      intersection_elements <-
        intersection_elements[intersection_elements != "split" &
                                intersection_elements != "join"]
      intersection_elements <- unique(intersection_elements)
      if (!signavio) {
        split_elements <-
          split_gateways(
            xml_internal_doc,
            "//bpmn:parallelGateway | //parallelGateway | //bpmn:inclusiveGateway |
            //inclusiveGateway | //bpmn:complexGateway | //complexGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task | //bpmn:eventBasedGateway | //eventBasedGateway |
            //bpmn:exclusiveGateway | //exclusiveGateway",
            signavio
          )
        join_elements <-
          join_gateways(
            xml_internal_doc,
            "//bpmn:parallelGateway | //parallelGateway | //bpmn:inclusiveGateway |
            //inclusiveGateway | //bpmn:complexGateway | //complexGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task | //bpmn:eventBasedGateway | //eventBasedGateway |
            //bpmn:exclusiveGateway | //exclusiveGateway",
            signavio
          )
      } else {
        split_elements <-
          split_gateways(
            xml_internal_doc,
            "//xmlns:parallelGateway | //xmlns:inclusiveGateway |
            //xmlns:complexGateway  | //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity  | //xmlns:eventBasedGateway |
            //xmlns:exclusiveGateway",
            signavio
          )
        join_elements <-
          join_gateways(
            xml_internal_doc,
            "//xmlns:parallelGateway | //xmlns:inclusiveGateway |
            //xmlns:complexGateway  | //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity  | //xmlns:eventBasedGateway |
            //xmlns:exclusiveGateway",
            signavio
          )
      }
      both_split_join <- intersect(split_elements, join_elements)
      
      
      intersection_elements <- as.tibble(intersection_elements)
      colnames(intersection_elements) <- "elements"
      intersection_elements <- intersection_elements %>%
        filter(!(elements %in% both_split_join)) %>%
        pull(elements)
      
      if (!signavio)
        sequence_flow_nodes <-
        getNodeSet(xml_internal_doc, "//bpmn:sequenceFlow |
                   //sequenceFlow")
      else
        sequence_flow_nodes <-
        getNodeSet(xml_internal_doc,
                   "//xmlns:sequenceFlow",
                   namespace(xml_internal_doc))
      id_seq_flow <-
        unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "id"))
      source_seq_flow <-
        unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "sourceRef"))
      target_seq_flow <-
        unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "targetRef"))
      
      relations <-
        as.data.frame(cbind(id_seq_flow, source_seq_flow, target_seq_flow))
      if (length(relations) != 0) {
        n_cut_vertices <- relations %>%
          filter(
            source_seq_flow %in% intersection_elements &
              target_seq_flow %in% intersection_elements
          ) %>%
          summarise(n = n()) %>%
          pull(n)
      } else
        n_cut_vertices <- 0
      
      #Calculate the size of the model by taking all the unique elements of the path log
      size_model <- size_process_model(xml_internal_doc, signavio)
      
      #Make a distinction between an empty model and a model containing more than 2 elements
      #Separability is equal to the number of cut vertices divided by the size of the model - 2,
      #if the size is bigger than 2, otherwise it is 0
      if (size_model > 2)
        separability <-
        n_cut_vertices / (size_model - n_data_objects(xml_internal_doc, signavio) - 2)
      else
        separability <- 1
      
      return(separability)
    } else {
      return (1)
    }
    }

#' @title Sequentiality
#'
#' @description Sequentiality is defined as the number of sequence flows connecting two tasks divided by the total number of sequence flows
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the sequentiality
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' sequentiality(create_internal_doc(file_path))
#' @export
sequentiality <- function (xml_internal_doc, signavio = FALSE) {
  task_id <- NULL
  sequential <- NULL
  #Take all sequence flow nodes and save the target and source in one object
  if (!signavio)
    sequence_flow_nodes <-
    getNodeSet(xml_internal_doc, "//bpmn:sequenceFlow | //sequenceFlow")
  else
    sequence_flow_nodes <-
    getNodeSet(xml_internal_doc,
               "//xmlns:sequenceFlow",
               namespace(xml_internal_doc))
  source_seq_flow <-
    unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "sourceRef"))
  target_seq_flow <-
    unlist(xmlApply(sequence_flow_nodes, xmlGetAttr, name = "targetRef"))
  target_source <-
    as.data.frame(cbind(source_seq_flow, target_seq_flow))
  
  #get the id of all task and event_nodes
  task_ids <-
    task_names(xml_internal_doc,
               filter_non_connector_activities = TRUE,
               signavio)
  if (length(task_ids) > 0)
    task_ids <- task_ids %>% pull(task_id)
  if (!signavio)
    event_ids <-
    node_ids(
      xml_internal_doc,
      "//bpmn:startEvent | //bpmn:messageStartEvent | //bpmn:timerStartEvent |
      //bpmn:conditionalStartEvent | //bpmn:endEvent | //bpmn:messageEndEvent |
      //bpmn:terminateEndEvent | //bpmn:escalationEndEvent | //bpmn:errorEndEvent |
      //bpmn:compensationEndEvent | //bpmn:signalEndEvent | //bpmn:intermediateCatchEvent |
      //bpmn:intermediateThrowEvent | //bpmn:boundaryEvent | //startEvent | //endEvent | //intermediateEvent",
      sequential = TRUE,
      signavio
    )
  else
    event_ids <-
    node_ids(
      xml_internal_doc,
      "//xmlns:startEvent | //xmlns:messageStartEvent | //xmlns:timerStartEvent |
      //xmlns:conditionalStartEvent | //xmlns:endEvent | //xmlns:messageEndEvent |
      //xmlns:terminateEndEvent | //xmlns:escalationEndEvent | //xmlns:errorEndEvent |
      //xmlns:compensationEndEvent | //xmlns:signalEndEvent | //xmlns:intermediateCatchEvent |
      //xmlns:intermediateThrowEvent | //xmlns:boundaryEvent",
      sequential = TRUE,
      signavio
    )
  
  task_event_ids <- c(as.character(task_ids), event_ids)
  #take the sum of all sequence flows which connect two tasks
  target_source_both_task_event <- target_source %>%
    mutate(
      sequential = if_else(
        source_seq_flow %in% task_event_ids &
          target_seq_flow %in% task_event_ids,
        TRUE,
        FALSE
      )
    ) %>%
    summarise(sequentiality = sum(sequential))
  
  sequentiality <-
    target_source_both_task_event / number_sequence_flows(xml_internal_doc, signavio)
  return(as.numeric(sequentiality))
}

#' @title Cyclicity
#'
#' @description Cyclicity is defined as the number of nodes on a cycle divided by the total number of nodes
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the cyclicity
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' cyclicity(path_log, create_internal_doc(file_path))
#' @export
cyclicity <-
  function(repetition_and_path_log,
           xml_internal_doc,
           signavio = FALSE) {
    #Take all elements which are part of the loops
    elements_on_cycle <- unique(unlist(repetition_and_path_log[[2]]))
    
    #filter out of elements on cycle all elements which have the name split or join
    elements_on_cycle <-
      elements_on_cycle[elements_on_cycle != "split" &
                          elements_on_cycle != "join"]
    
    #if the path log is empty, return zero, otherwise return the cyclicity
    cyclicity <-
      length(elements_on_cycle) / (
        size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
      )
    return(cyclicity)
  }

#' @title Diameter
#'
#' @description Length of longest path, in practice the length of longest path.
#' The assumption is made that one repetition for each loop is allowed and these repetitions count as well for the diameter
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @return an integer indicating the diameter
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' diameter(path_log)
#' @export
diameter <- function(repetition_and_path_log) {
  path_log <- repetition_and_path_log[[1]]
  
  #filter out all join and split elements as these are not relevant for the diameter
  if (length(path_log) > 0) {
    path_log <-
      lapply(path_log, function(path) {
        path[path != "join" & path != "split"]
      })
    
    #calculate the length of each path
    length_paths <- unlist(lapply(path_log, length))
    
    #The max length is the diameter
    return(max(length_paths))
  } else {
    return (0)
  }
}

#' @title Structuredness
#'
#' @description Structuredness measures to which extent the process model can be divided into block structured structures (matching gateways)
#' Calculation: 1 - size of reduced process model / size of normal process model
#' To get the reduced process model, the following rules are applied:
#' -removal of trivial constructs (one incoming and one outgoing sequence flow)
#' -removal of matching gateways (for loops, this means first a join then a split, for all other gateways, it's the other way around)
#' -loops with other than XOR-gateways and non-matching gateways are kept
#' -gateways which are the consequence of multiple start or end events are removed
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the structuredness
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' structuredness(path_log, create_internal_doc(file_path))
#' @export
structuredness <-
  function(repetition_and_path_log,
           xml_internal_doc,
           signavio = FALSE) {
    # Take the structured path_log
    structured_path_log <- repetition_and_path_log[[4]]
    
    # Keep all elements in the path log which are non-trivial, but remove splits and joins due to multiple start/end events
    # By getting the index of these elements
    indices_elements_to_keep <-
      lapply(structured_path_log, function(path) {
        #delete all trivial constructs (one or less than one incoming and/or outgoing flow) and splits and joins which are due to multiple start/end events
        non_trivial_constructs <-
          c(
            "AND-split",
            "AND-join",
            "OR-split",
            "OR-join",
            "XOR-join",
            "XOR-split",
            "XOR-loop-split",
            "XOR-loop-join",
            "Other-loop-split",
            "Other-loop-join"
          )
        indices_non_trivial_constructs <-
          which(path %in% non_trivial_constructs)
        indices_artifacts_before_constructs <-
          indices_non_trivial_constructs - 1
        indices_elements_to_keep <-
          unique(c(
            indices_non_trivial_constructs,
            indices_artifacts_before_constructs
          ))
        return(indices_elements_to_keep)
      })
    indices_elements_to_keep <- lapply(indices_elements_to_keep, sort)
    
    #Filter all elements with the corresponding index
    reduce_path <- function(path, keep_element_indices) {
      return (path[keep_element_indices])
    }
    reduced_path_log <-
      mapply(reduce_path,
             structured_path_log,
             indices_elements_to_keep,
             SIMPLIFY = FALSE)
    
    join_elements_and_loop_split <-
      c("AND-join",
        "OR-join",
        "XOR-join",
        "XOR-loop-split",
        "Other-loop-split")
    if(length(reduced_path_log) > 0) {
    non_structured_elements <-
      unstructuredElements(reduced_path_log, join_elements_and_loop_split)
    }
    
    #remove all duplicates and make a vector in order to get the elements of the reduced model
    
    
    if(length(reduced_path_log) == 0) {
      size_reduced_model <- size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
    } else {
      non_structured_elements <- unique(unlist(non_structured_elements))
      size_reduced_model <- length(non_structured_elements)
    }
    structuredness <-
      1 - (size_reduced_model / (
        size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
      ))
    
    return (structuredness)
  }

#' @title Depth
#'
#' @description Depth is defined as the the nesting of the process model.
#' If there is a split gateway, the depth is increased with one.
#' If there is a join gateway, the depth is decreased with one.
#' The cumulative sum is taken and the maximum of the cumulative sum is calculated for each path.
#' The nesting depth is the maximum of each path value
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @return an integer indicating the depth
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' depth(path_log)
#' @export
depth <- function(repetition_and_path_log) {
  path_log <- repetition_and_path_log[[1]]
  
  #Filter out of the path log only the elements with a join or split name
  
  path_log <-
    lapply(path_log, function(path) {
      path[path == "join" | path == "split"]
    })
  if (length(path_log) > 0) {
    #Filter all join elements which come before the first split
    split_indices <-
      lapply(path_log, function(path) {
        which(path == "split")
      })
    first_split_index_path <-
      unlist(lapply(split_indices, function(split_indices_per_path) {
        split_indices_per_path[1]
      }))
    path_after_split <- function(path, index) {
      if (!(is.na(index)))
        path[index:length(path)]
      else
        path
    }
    path_log_starting_splits <-
      mapply(path_after_split, path_log, first_split_index_path)
    
    #Replace all split elements with one and all join elements with minus one
    numerical_path_log <-
      lapply(path_log_starting_splits, function(path) {
        path[which(path == "split")] <- 1
        path[which(path == "join")] <- -1
        return(path)
      })
    
    #Take the cumulative sum for each path, take the max of the cumsum for each path
    #and take the maximum of all maximum values
    cum_sum_numerical_path_log <- lapply(numerical_path_log, cumsum)
    max_cum_sum <-
      unlist(lapply(cum_sum_numerical_path_log, function(path) {
        if (length(path) != 0)
          return(max(path))
        else
          return (0)
      }))
    depth <- max(max_cum_sum)
    return(depth)
  } else
    return(0)
}


#' @title Token Split
#'
#' @description {Token split is defined as the sum of the outgoing flows of parallel, inclusive and complex gateways minus one,
#' because otherwise the token_split value is always one, while it should be zero if there are}
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the token_split
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' token_split(create_internal_doc(file_path))
#' @export
token_split <- function (xml_internal_doc, signavio = FALSE) {
  if (!signavio)
    outgoing_flows_split_gateways <-
      number_outgoing_flows(
        xml_internal_doc,
        "//bpmn:parallelGateway | //parallelGateway | //bpmn:inclusiveGateway |
        //inclusiveGateway | //bpmn:complexGateway | //complexGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
        //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
        //bpmn:subProcess | //bpmn:callActivity | //task",
        filter_split = TRUE,
        signavio
      )
  else
    outgoing_flows_split_gateways <-
      number_outgoing_flows(
        xml_internal_doc,
        "//xmlns:parallelGateway  | //xmlns:inclusiveGateway |
        //xmlns:complexGateway | //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
        //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
        //xmlns:subProcess | //xmlns:callActivity",
        filter_split = TRUE,
        signavio
      )
  if (length(outgoing_flows_split_gateways) != 0) {
    return(sum(outgoing_flows_split_gateways - 1))
  } else {
    return(0)
  }
}

#' @title Control flow complexity
#'
#' @description {Control flow complexity is defined as the sum of the outgoing of exclusive gateways, the number of parallel gateways
#' and two to the power of all outgoing sequence flows of the inclusive gateways}
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the control flow complexity
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' control_flow_complexity(create_internal_doc(file_path))
#' @export
control_flow_complexity <-
  function (xml_internal_doc, signavio = FALSE) {
    if (!signavio) {
      o_flows_exclusive <-
        number_outgoing_flows(xml_internal_doc,
                              "//bpmn:exclusiveGateway | //exclusiveGateway")
      o_flows_event <-
        number_outgoing_flows(xml_internal_doc,
                              "//bpmn:eventBasedGateway | //eventBasedGateway")
      o_flows_complex <-
        number_outgoing_flows(xml_internal_doc,
                              "//bpmn:complexGateway | //complexGateway")
      o_flows_inclusive <-
        number_outgoing_flows(xml_internal_doc,
                              "//bpmn:inclusiveGateway | //inclusiveGateway")
      
      cfc <-
        number_split_gateways(
          xml_internal_doc,
          "//bpmn:parallelGateway | //parallelGateway |
          //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
          //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
          //bpmn:subProcess | //bpmn:callActivity | //task"
        ) +
        sum(o_flows_exclusive[o_flows_exclusive > 1]) +
        sum(o_flows_event[o_flows_event > 1]) +
        sum(2 ^ o_flows_inclusive[o_flows_inclusive > 1]) +
        sum(2 ^ o_flows_complex[o_flows_complex > 1]) -
        sum(o_flows_inclusive > 1) -
        sum(o_flows_complex > 1)
    } else {
      o_flows_exclusive <-
        number_outgoing_flows(xml_internal_doc, "//xmlns:exclusiveGateway", signavio = signavio)
      o_flows_event <-
        number_outgoing_flows(xml_internal_doc, "//xmlns:eventBasedGateway", signavio = signavio)
      o_flows_complex <-
        number_outgoing_flows(xml_internal_doc, "//xmlns:complexGateway", signavio = signavio)
      o_flows_inclusive <-
        number_outgoing_flows(xml_internal_doc, "//xmlns:inclusiveGateway", signavio = signavio)
      
      cfc <-
        number_split_gateways(
          xml_internal_doc,
          "//xmlns:parallelGateway  |
          //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
          //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
          //xmlns:subProcess | //xmlns:callActivity",
          signavio = signavio
        ) +
        sum(o_flows_exclusive[o_flows_exclusive > 1]) +
        sum(o_flows_event[o_flows_event > 1]) +
        sum(2 ^ o_flows_inclusive[o_flows_inclusive > 1]) +
        sum(2 ^ o_flows_complex[o_flows_complex > 1]) -
        sum(o_flows_inclusive > 1) -
        sum(o_flows_complex > 1)
      
    }
    
    return(cfc)
  }

#' @title Connector mismatch
#'
#' @description Connector mismatch is the absolute value of the difference between split gateways and join gateways for each type of gateway, ie parallel, exclusive, inclusive, complex and event based gateways
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the connector mismatch
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' connector_mismatch(create_internal_doc(file_path))
#' @export
connector_mismatch <-
  function (xml_internal_doc, signavio = FALSE) {
    if (!signavio) {
      connector_mismatch <-
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//bpmn:exclusiveGateway | //exclusiveGateway",
            signavio
          )
          - number_join_gateways(
            xml_internal_doc,
            "//bpmn:exclusiveGateway | //exclusiveGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task",
            signavio
          )
        ) +
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//bpmn:parallelGateway | //parallelGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task",
            signavio
          )
          - number_join_gateways(
            xml_internal_doc,
            "//bpmn:parallelGateway | //parallelGateway",
            signavio
          )
        ) +
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//bpmn:inclusiveGateway | //inclusiveGateway",
            signavio
          )
          - number_join_gateways(
            xml_internal_doc,
            "//bpmn:inclusiveGateway | //inclusiveGateway",
            signavio
          )
        ) +
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//bpmn:complexGateway | //complexGateway",
            signavio
          )
          - number_join_gateways(
            xml_internal_doc,
            "//bpmn:complexGateway | //complexGateway",
            signavio
          )
        ) +
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//bpmn:eventBasedGateway | //eventBasedGateway",
            signavio
          )
          - number_join_gateways(
            xml_internal_doc,
            "//bpmn:eventBasedGateway | //eventBasedGateway",
            signavio
          )
        )
    } else {
      connector_mismatch <-
        abs(
          number_split_gateways(xml_internal_doc, "//xmlns:exclusiveGateway", signavio)
          - number_join_gateways(
            xml_internal_doc,
            "//xmlns:exclusiveGateway | //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity",
            signavio
          )
        ) +
        abs(
          number_split_gateways(
            xml_internal_doc,
            "//xmlns:parallelGateway | //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity",
            signavio
          )
          - number_join_gateways(xml_internal_doc, "//xmlns:parallelGateway", signavio)
        ) +
        abs(
          number_split_gateways(xml_internal_doc, "//xmlns:inclusiveGateway", signavio)
          - number_join_gateways(xml_internal_doc, "//xmlns:inclusiveGateway", signavio)
        ) +
        abs(
          number_split_gateways(xml_internal_doc, "//xmlns:complexGateway", signavio)
          - number_join_gateways(xml_internal_doc, "//xmlns:complexGateway", signavio)
        ) +
        abs(
          number_split_gateways(xml_internal_doc, "//xmlns:eventBasedGateway", signavio)
          - number_join_gateways(xml_internal_doc, "//xmlns:eventBasedGateway", signavio)
        )
    }
    return(connector_mismatch)
  }

#' @title Connector heterogeneity
#'
#' @description Connector heterogeneity is defined as the sum of minus - p times the log of p of all gateways. p is defined as the number of a particular type of gateway divided by all gateways.
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the connector heterogeneity
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")}
#' connector_heterogeneity(create_internal_doc(file_path))
#' @export
connector_heterogeneity <-
  function (xml_internal_doc, signavio = FALSE) {
    event_based_gateways <-
      number_event_based_gateways(xml_internal_doc, signavio)
    complex_gateways <-
      number_complex_gateways(xml_internal_doc, signavio)
    or_gateways <- number_OR_gateways(xml_internal_doc, signavio)
    if (!signavio) {
      and_gateways <-
        number_AND_gateways(xml_internal_doc, signavio) + length(
          split_gateways(
            xml_internal_doc,
            "//bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task",
            signavio
          )
        )
      xor_gateways <-
        number_XOR_gateways(xml_internal_doc, signavio) + length(
          join_gateways(
            xml_internal_doc,
            "//bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
            //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
            //bpmn:subProcess | //bpmn:callActivity | //task",
            signavio
          )
        )
    } else {
      and_gateways <-
        number_AND_gateways(xml_internal_doc, signavio) + length(
          split_gateways(
            xml_internal_doc,
            "//xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity",
            signavio
          )
        )
      xor_gateways <-
        number_XOR_gateways(xml_internal_doc, signavio) + length(
          join_gateways(
            xml_internal_doc,
            "//xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
            //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
            //xmlns:subProcess | //xmlns:callActivity",
            signavio
          )
        )
    }
    total_gateways <-
      event_based_gateways + complex_gateways + or_gateways + and_gateways + xor_gateways
    
    #If there are no gateways, return 0
    if (total_gateways == 0)
      return(0)
    
    #Calculate the number of gateway categories present in the model
    categories_present <- 0
    
    if (event_based_gateways != 0)
      categories_present <- categories_present + 1
    if (complex_gateways != 0)
      categories_present <- categories_present + 1
    if (and_gateways != 0)
      categories_present <- categories_present + 1
    if (xor_gateways != 0)
      categories_present <- categories_present + 1
    if (or_gateways != 0)
      categories_present <- categories_present + 1
    
    #if there is only one category, return 1
    if (categories_present == 1 || categories_present == 0)
      return(0)
    
    #Calculate heterogeneity and return
    p_event <- event_based_gateways / total_gateways
    p_complex <- complex_gateways / total_gateways
    p_or <- or_gateways / total_gateways
    p_and <- and_gateways / total_gateways
    p_xor <- xor_gateways / total_gateways
    
    heterogeneity <-
      -p_event * if_else(p_event != 0, log(p_event, categories_present), as.double(0)) -
      p_complex * if_else(p_complex != 0,
                          log(p_complex, categories_present),
                          as.double(0)) -
      p_or * if_else(p_or != 0, log(p_or, categories_present), as.double(0)) -
      p_and * if_else(p_and != 0, log(p_and, categories_present), as.double(0)) -
      p_xor * if_else(p_xor != 0, log(p_xor, categories_present), as.double(0))
    
    return(heterogeneity)
  }

#' @title Cross Connectivity
#'
#' @description The cross-connectivity metric that measures the strength of the links between process model elements.
#' The definition of this new metric builds on the hypothesis that process models are easier understood and contain less errors if they have a high cross-connectivity.
#' The metric is calculated based on the creation of a data frame containing the values of all connections
#' @param repetition_and_path_log repetition and path log list object created by the function create_repetition_and_path_log
#' @param xml_internal_doc document object created using the create_internal_document function
#' @param signavio boolean which indicates whether the file stems from signavio
#' @return an integer indicating the cross connectivity of a model
#' @examples 
#' \dontshow{file_path <- system.file("extdata", "doc.txt", package="understandBPMN")
#' path_log <- create_path_and_repetition_log(create_internal_doc(file_path))}
#' cross_connectivity(path_log, create_internal_doc(file_path))
#' @export
cross_connectivity <-
  function(repetition_and_path_log,
           xml_internal_doc,
           signavio = FALSE) {
    type <- NULL
    start <- NULL
    end <- NULL
    values <- NULL
    path_log <- repetition_and_path_log[[1]]
    if (!signavio)
      nodes <-
      getNodeSet(
        xml_internal_doc,
        "//bpmn:exclusiveGateway | //bpmn:parallelGateway |
        //bpmn:inclusiveGateway | //bpmn:eventBasedGateway | //bpmn:complexGateway |
        //exclusiveGateway | //parallelGateway | //inclusiveGateway | //eventBasedGateway |
        //complexGateway | //bpmn:task | //bpmn:sendTask | //bpmn:receiveTask |
        //bpmn:manualTask | //bpmn:businessRuleTask | //bpmn:userTask | //bpmn:scriptTask |
        //bpmn:subProcess | //bpmn:callActivity | //task"
      )
    else
      nodes <-
      getNodeSet(
        xml_internal_doc,
        "//xmlns:exclusiveGateway | //xmlns:parallelGateway |
        //xmlns:inclusiveGateway | //xmlns:eventBasedGateway | //xmlns:complexGateway |
        //xmlns:task | //xmlns:sendTask | //xmlns:receiveTask |
        //xmlns:manualTask | //xmlns:businessRuleTask | //xmlns:userTask | //xmlns:scriptTask |
        //xmlns:subProcess | //xmlns:callActivity",
        namespace(xml_internal_doc)
      )
    
    #Check all children of the gateway node having the name incoming
    nodes_incoming <- xmlApply(nodes,
                               xmlElementsByTagName,
                               name = "incoming",
                               recursive = FALSE)
    nodes_incoming <- lapply(nodes_incoming, length)
    
    nodes_outgoing <- xmlApply(nodes,
                               xmlElementsByTagName,
                               name = "outgoing",
                               recursive = FALSE)
    nodes_outgoing <- lapply(nodes_outgoing, length)
    
    node_id <-
      as.character(unlist(xmlApply(nodes, xmlGetAttr, name = "id")))
    
    sum_incoming_outgoing <- mapply(function(incoming, outgoing) {
      return(incoming + outgoing)
    },
    nodes_incoming,
    nodes_outgoing)
    node_with_degree <-
      as.data.frame(cbind(node_id, sum_incoming_outgoing), stringsAsFactors = FALSE)
    if (!signavio) {
      parallel_ids <-
        node_ids(xml_internal_doc,
                 "//bpmn:parallelGateway | //parallelGateway",
                 signavio = signavio)
      exclusive_ids <-
        node_ids(
          xml_internal_doc,
          "//bpmn:exclusiveGateway | //exclusiveGateway | //bpmn:eventBasedGateway | //eventBasedGateway",
          signavio = signavio
        )
      inclusive_ids <-
        node_ids(
          xml_internal_doc,
          "//bpmn:inclusiveGateway | //inclusiveGateway | //bpmn:complexGateway | //complexGateway",
          signavio = signavio
        )
    } else {
      parallel_ids <-
        node_ids(xml_internal_doc, "//xmlns:parallelGateway", signavio = signavio)
      exclusive_ids <-
        node_ids(
          xml_internal_doc,
          "//xmlns:exclusiveGateway | //xmlns:eventBasedGateway",
          signavio = signavio
        )
      inclusive_ids <-
        node_ids(
          xml_internal_doc,
          "//xmlns:inclusiveGateway | //xmlns:complexGateway",
          signavio = signavio
        )
    }
    node_with_degree <- node_with_degree %>%
      mutate(type = if_else(
        node_id %in% parallel_ids,
        "AND",
        if_else(
          node_id %in% exclusive_ids,
          "XOR",
          if_else(node_id %in% inclusive_ids, "OR", "Task")
        )
      )) %>%
      mutate(sum_incoming_outgoing = as.numeric(sum_incoming_outgoing)) %>%
      mutate(degree = if_else(
        type == "Task" | type == "AND",
        1,
        if_else(type == "XOR", 1 / sum_incoming_outgoing,
                (
                  1 / (2 ^ (sum_incoming_outgoing) - 1) + (2 ^ (sum_incoming_outgoing) - 2) / ((2 ^ (
                    sum_incoming_outgoing
                  ) - 1) * sum_incoming_outgoing)
                ))
      ))
    path_log <-
      lapply(path_log, function(path) {
        path[path != "join" & path != "split"]
      })
    
    
    if (length(path_log) > 0) {
      denominator <-
        ((
          size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio)
        ) * (
          size_process_model(xml_internal_doc, signavio) - n_data_objects(xml_internal_doc, signavio) - 1
        )
        )
      if (denominator != 0 && length(node_with_degree$degree) > 0) {
        value_connections <-
          valueOfConnectionPaths(path_log, node_with_degree)
        if(length(value_connections$values) > 0) {
        numerator <- value_connections %>%
          group_by(start, end) %>%
          summarise(values = max(values)) %>%
          ungroup() %>%
          distinct() %>%
          summarise(values = sum(values)) %>%
          pull(values)
        return(numerator / (denominator))
        } else {
          return(0)
        }
      }
      else
        return(0)
    } else
      return(0)
  }
jonaslieben/UnderstandBPMN documentation built on May 26, 2019, 12:31 p.m.