R/methods.R

In ick003/vesselett: A suite of target tracking algorithm, with a specialization for marine radar

#' Ploting the observations
#' @param x dataframe: observations
#' @param varnames string: string of variables to plot
#' @export
plot_obs <- function(x, varnames){

    if(missing(varnames)){
        varnames = c("north", "east", "v_north", "v_east")
    }

    x_long = pivot_longer(select(x, .data$time, all_of(varnames)), varnames)

    ggplot(data = x_long) +
         geom_point(aes_string(x = "time", y = "value"), col = "black", shape = 1, size = .5) +
         facet_wrap(~ name, ncol = 1, scales = "free") + theme(panel.border = element_blank(),
         panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
         panel.background = element_rect(fill = "white", colour = NA),
         axis.line = element_line(size = 0.5, linetype = "solid", colour = "black"),
          legend.position = 'none')
}

#' Ploting the results of a cphd tracker
#' @param x cphd object
#' @param ... tracking variables to plot
#' @method plot cphd
#' @export
plot.cphd <- function(x, ...){

    dots = list(...)
    varnames = dots[[match("varnames", names(dots))]]

    if(is.null(varnames)){
        varnames = attr(x,"varnames")
    }

    Tracks = x$Tracks
    Tracks <- arrange(Tracks, .data$time)
    tracksP = pivot_longer(select(Tracks, .data$time, .data$target_id, all_of(varnames)), varnames)
    ggplot() +
        geom_point(data = tracksP ,
                   aes_string(x = "time", y = "value", col = "target_id"), size = 1, shape = 3)+
        geom_line(data = tracksP ,
                  aes_string(x = "time", y = "value", group = "target_id"),col = "black", size = 0.5) +
        facet_wrap( ~ name, ncol = 1, strip.position="left", scales = "free") +
        theme(panel.border = element_blank(),
              panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
              panel.background = element_rect(fill = "white", colour = NA),
              legend.position = 'none',
              axis.line = element_line(size = 0.5, linetype = "solid", colour = "black"))
}

#' Ploting the results of a pf tracker
#' @param x pf object
#' @param ... tracking variables to plot
#' @method plot pf
#' @export
plot.pf <- function(x, ...){


    dots = list(...)
    varnames = dots[[match("varnames", names(dots))]]

    if(is.null(varnames)){
        varnames = attr(x,"varnames")
    }

    Tracks = x$Tracks
    Tracks <- arrange(Tracks, .data$time)
    tracksP = pivot_longer(select(Tracks, .data$time, .data$component, all_of(varnames)), varnames)
    ggplot() +
        geom_point(data = tracksP ,
                   aes_string(x = "time", y = "value", col = "component"), size = 1, shape = 3)+
        geom_line(data = tracksP ,
                  aes_string(x = "time", y = "value", group = "component"),col = "black", size = 0.5) +
        facet_wrap( ~ name, ncol = 1, strip.position="left", scales = "free") +
        theme(panel.border = element_blank(),
              panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
              panel.background = element_rect(fill = "white", colour = NA),
              legend.position = 'none',
              axis.line = element_line(size = 0.5, linetype = "solid", colour = "black"))
}

#' Ploting the results of a cphd tracker
#' @param x cphd object
#' @param ... additional arguments
#' @method print cphd
#' @export
print.cphd <- function(x, ...){

    cat("\n Tracker:")
    print(class(x))
    cat("\nTracking variables:")
    print(attr(x,"varnames"))
    cat("\nModel:\n")
    print(attr(x, "type"))

}


#' Ploting the trajectory results of a pf tracker
#' @param x pf object
#' @param varnames tracking variables to plot
#' @param drop_low logical droping states with low weights
#' @param tau numeric drop weight threshold
#' @export
plot_traj <- function(x, varnames, drop_low = TRUE, tau = 1e-2){

    if(missing(varnames)){
        varnames = attr(x,"varnames")[1:2]
    }
    if(length(varnames)>2){
        stop("Can plot more than 2D trajectories")
    }

    grouping = case_when(class(x)=="pf" ~ "component",
                         class(x) %in% c("phd", "cphd") ~ "target_id")

    if(drop_low){Tracks = filter(x$Tracks, .data$weight > tau)}
    Tracks <- arrange(Tracks, .data$time)
    tracksP = ungroup(mutate(group_by_at(select(Tracks, .data$time, all_of(c(varnames, grouping))), grouping),
                     labels = case_when(.data$time == min(.data$time) ~ "S",
                                        .data$time == max(.data$time) ~ "F",
                                        TRUE ~ NA_character_)))
    ggplot() +
        geom_point(data = tracksP ,
                   aes_string(x = varnames[1], y = varnames[2], group = grouping, col = grouping), size = 1, shape = 3)+
        geom_path(data = tracksP ,
                  aes_string(x = varnames[1], y = varnames[2], group = grouping,col = grouping), size = 1)+
        geom_point(data = filter(tracksP, !is.na(.data$labels)),
                   aes_string(x = varnames[1], y = varnames[2], group = grouping, col = grouping), size = 3)+
        geom_point(data = filter(tracksP, !is.na(.data$labels)),
                   aes_string(x = varnames[1], y = varnames[2], group = grouping), col = "white",size = 2.5)+
        geom_text(data = filter(tracksP, !is.na(.data$labels)),
                  aes_string(x = varnames[1], y = varnames[2], label = "labels", col = grouping), size = 2)+
        theme(panel.border = element_blank(),
              panel.grid.major = element_blank(),panel.grid.minor = element_blank(),
              panel.background = element_rect(fill = "white", colour = NA),
              axis.line = element_line(size = 0.5, linetype = "solid", colour = "black"))
}