# Goal: Generate and export S3 class/methods to estimate transmission flows
#       and document using roxygen tags

#' @title \code{estimate_transmission_flows_and_ci} Estimates transmission flows and corresponding confidence intervals
#'
#' @description This function estimates transmission flows or the relative probability
#'              of transmission within and between population groups accounting for
#'              variable sampling among population groups.
#'
#' Corresponding confidence intervals are provided with the following methods: Goodman,
#' Goodman with a continuity correction, Sison-Glaz and Queensbury-Hurst.
#'
#' @aliases estimate_transmission_flows_and_ci flows_and_ci
#'
#' @param group_in, A character vector indicating population groups/strata (e.g. communities, age-groups, genders or trial arms) between which transmission flows will be evaluated,
#' @param individuals_sampled_in, A numeric vector indicating the number of individuals sampled per population group,
#' @param individuals_population_in, A numeric vector of the estimated number of individuals per population group,
#' @param linkage_counts_in A data.frame of counts of linked pairs identified between samples of each population
#'        group pairing of interest. \cr
#'        The data.frame should contain the following three fields:
#'  	   \itemize{
#'  	       \item H1_group (character) Name of population group 1
#'  	       \item H2_group (character) Name of population group 2
#'  	       \item number_linked_pairs_observed (numeric) Number of
#'  	             observed directed transmission pairs between samples
#'  	             from population groups 1 and 2}
#' @param verbose_output, A boolean value to display intermediate output (Default is \code{FALSE})
#' @param detailed_report, A boolean value to produce detailed output of the analysis
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#' 	    \item H1_group, Name of population group 1
#' 	    \item H2_group, Name of population group 2
#' 	    \item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#' 	    \item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#' 	    \item number_hosts_population_group_1, Estimated number of individuals in population group 1
#' 	    \item number_hosts_population_group_2, Estimated number of individuals in population group 2
#' 	    \item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#' 	    \item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#' 	    \item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#' 	    \item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#' 	    \item est_linkedpairs_in_population, Estimated transmission pairs between population groups 1 and 2
#' 	    \item theta_hat, Estimated transmission flows or relative probability of transmission within and between population groups 1 and 2 adjusted
#' 	          for sampling heterogeneity. More precisely, the conditional probability that a pair of pathogen sequences is from a specific population
#' 	          group pairing given that the pair is linked.
#' 	    \item obs_trm_pairs_est_goodman, Point estimate, Goodman method Confidence intervals for observed transmission pairs
#' 	    \item obs_trm_pairs_lwr_ci_goodman, Lower bound of Goodman confidence interval
#' 	    \item obs_trm_pairs_upr_ci_goodman, Upper bound of Goodman confidence interval
#' 	    \item est_goodman, Point estimate, Goodman method Confidence intervals for estimated transmission flows
#' 	    \item lwr_ci_goodman, Lower bound of Goodman confidence interval
#' 	    \item upr_ci_goodman, Upper bound of Goodman confidence interval
#' }
#'
#' The following additional fields are returned if the detailed_report flag is set
#'
#' \itemize{
#' 	    \item prob_group_pairing_and_linked, Probability that a pair of pathogen sequences is from a specific population group pairing and is linked
#' 	    \item c_hat, Probability that a randomly selected pathogen sequence in one population group links to at least
#' 	          one pathogen sequence in another population group i.e. probability of clustering
#' 	    \item est_goodman_cc, Point estimate, Goodman method Confidence intervals with continuity correction
#' 	    \item lwr_ci_goodman_cc, Lower bound of Goodman confidence interval
#' 	    \item upr_ci_goodman_cc, Upper bound of Goodman confidence interval
#' 	    \item est_sisonglaz, Point estimate, Sison-Glaz method Confidence intervals
#' 	    \item lwr_ci_sisonglaz, Lower bound of Sison-Glaz confidence interval
#' 	    \item upr_ci_sisonglaz, Upper bound of Sison-Glaz confidence interval
#' 	    \item est_qhurst_acswr, Point estimate, Queensbury-Hurst method Confidence intervals via ACSWR r package
#' 	    \item lwr_ci_qhurst_acswr, Lower bound of Queensbury-Hurst confidence interval
#' 	    \item upr_ci_qhurst_acswr, Upper bound of Queensbury-Hurst confidence interval
#' 	    \item est_qhurst_coinmind, Point estimate, Queensbury-Hurst method Confidence intervals via CoinMinD r package
#' 	    \item lwr_ci_qhurst_coinmind, Lower bound of Queensbury-Hurst confidence interval
#' 	    \item upr_ci_qhurst_coinmind, Upper bound of Queensbury-Hurst confidence interval
#' 	    \item lwr_ci_qhurst_adj_coinmind, Lower bound of Queensbury-Hurst confidence interval adjusted
#' 	    \item upr_ci_qhurst_adj_coinmind, Upper bound of Queensbury-Hurst confidence interval adjusted
#' }
#'
#' @details Counts of observed directed transmission pairs can be obtained from
#'     deep-sequence phylogenetic data (via phyloscanner) or from known
#'     epidemiological contacts. Note: Deep-sequence data is also commonly
#'     referred to as high-throughput or next-generation sequence data. See
#'     references to learn more about phyloscanner.
#'
#' The \code{estimate_transmission_flows_and_ci()} function is a
#' wrapper function that calls the following functions:
#'
#' \enumerate{
#'
#'    \item The \code{prep_p_hat()} function to determine all possible
#'          combinations of the population groups/strata provided by
#'          the user. Type \code{?prep_p_hat()} at R prompt to learn
#'          more.
#'
#'    \item The \code{estimate_p_hat()} function to compute the
#'          probability of linkage between pathogen sequences from
#'          two individuals randomly sampled from their respective
#'          population groups. Type \code{?estimate_p_hat()} at R
#'          prompt to learn more.
#'
#'    \item The \code{estimate_theta_hat()} function that uses
#'          \code{p_hat} estimates to compute the conditional
#'          probability of linkage that a pair of pathogen sequences
#'          is from a specific population group pairing given that
#'          the pair is linked. The conditional  probability,
#'          \code{theta_hat} represents transmission flows or
#'          the relative probability of transmission within and between
#'          population groups adjusted for variable sampling among
#'          population groups. Type \code{?estimate_theta_hat()} at R
#'          prompt to learn more.
#'
#'    \item The \code{estimate_multinom_ci()} function to estimate
#'          corresponding confidence intervals for the computed
#'          transmission flows.
#' }
#'
#' Further to estimating transmission flows and corresponding confidence
#' intervals the \code{estimate_transmission_flows_and_ci()} function provides
#' estimates for:
#'
#' \enumerate{
#'
#'    \item \code{prob_group_pairing_and_linked}, the joint probability that a
#'          pair of pathogen sequences is from a specific population group
#'          pairing and linked. Type \code{?estimate_prob_group_pairing_and_linked()}
#'          at R prompt to learn more.
#'
#'    \item \code{c_hat}, the probability of clustering that a pathogen sequence
#'          from a population group of interest is linked to one or more
#'          pathogen sequences in another population group of interest. Type
#'          \code{?estimate_c_hat()} at R prompt to learn more.
#'
#' }
#'
#' @seealso \code{\link{estimate_theta_hat}} and \code{\link{estimate_multinom_ci}} to learn
#'          more about estimation of transmission flows and confidence intervals.
#'
#' @references
#' \enumerate{
#'
#'    \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'          HIV transmission in the context of a universal testing and treatment
#'          trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#'    \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 		    village residents in Botswana: estimation of linkage rates in the
#' 		    presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 		    p. e1003430.
#'
#'    \item Cherry, S., A Comparison of Confidence Interval Methods for Habitat
#'          Use-Availability Studies. The Journal of Wildlife Management, 1996.
#'          60(3): p. 653-658.
#'
#'    \item Ratmann, O., et al., Inferring HIV-1 transmission networks and sources of
#' 		    epidemic spread in Africa with deep-sequence phylogenetic analysis.
#' 		    Nature Communications, 2019. 10(1): p. 1411.
#'
#'    \item Wymant, C., et al., PHYLOSCANNER: Inferring Transmission from Within- and
#' 		    Between-Host Pathogen Genetic Diversity. Molecular Biology and Evolution,
#' 		    2017. 35(3): p. 719-733.
#'
#'    \item Goodman, L. A. On Simultaneous Confidence Intervals for Multinomial Proportions
#' 		    Technometrics, 1965. 7, 247-254.
#'
#'    \item Sison, C.P and Glaz, J. Simultaneous confidence intervals and sample size determination
#' 		    for multinomial proportions. Journal of the American Statistical Association,
#' 		    1995. 90:366-369.
#'
#'    \item Glaz, J., Sison, C.P. Simultaneous confidence intervals for multinomial proportions.
#' 		    Journal of Statistical Planning and Inference, 1999. 82:251-262.
#'
#'    \item May, W.L., Johnson, W.D. Constructing two-sided simultaneous confidence intervals for
#' 		    multinomial proportions for small counts in a large number of cells.
#' 		    Journal of Statistical Software, 2000. 5(6).
#' 		    Paper and code available at https://www.jstatsoft.org/v05/i06.
#'
#' }
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Estimate transmission flows and confidence intervals
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#' # View counts of observed directed HIV transmissions within and between intervention
#' # and control communities
#' counts_hiv_transmission_pairs
#'
#' # View the estimated number of individuals with HIV in intervention and control
#' # communities and the number of individuals sampled from each
#' sampling_frequency
#'
#' # Estimate transmission flows within and between intervention and control communities
#' # accounting for variable sampling among population groups.
#'
#' # Basic output
#' results_estimate_transmission_flows_and_ci <- estimate_transmission_flows_and_ci(
#'     group_in = sampling_frequency$population_group,
#'     individuals_sampled_in = sampling_frequency$number_sampled,
#'     individuals_population_in = sampling_frequency$number_population,
#'     linkage_counts_in = counts_hiv_transmission_pairs)
#'
#' # View results
#' results_estimate_transmission_flows_and_ci
#'
#' # Retrieve dataset of estimated transmission flows
#' dframe <- results_estimate_transmission_flows_and_ci$flows_dataset
#'
#' # Detailed output
#' results_estimate_transmission_flows_and_ci_detailed <- estimate_transmission_flows_and_ci(
#'     group_in = sampling_frequency$population_group,
#' 	   individuals_sampled_in = sampling_frequency$number_sampled,
#' 	   individuals_population_in = sampling_frequency$number_population,
#' 	   linkage_counts_in = counts_hiv_transmission_pairs,
#' 	   detailed_report = TRUE)
#'
#' # View results
#' results_estimate_transmission_flows_and_ci_detailed
#'
#' # Retrieve dataset of estimated transmission flows
#' dframe <- results_estimate_transmission_flows_and_ci_detailed$flows_dataset
#'
#' # Options:
#' # To show intermediate output set verbose_output = TRUE
#'
#' # Basic output
#' results_estimate_transmission_flows_and_ci <- estimate_transmission_flows_and_ci(
#'     group_in = sampling_frequency$population_group,
#' 	   individuals_sampled_in = sampling_frequency$number_sampled,
#' 	   individuals_population_in = sampling_frequency$number_population,
#' 	   linkage_counts_in = counts_hiv_transmission_pairs,
#' 	   verbose_output = TRUE)
#'
#' # View results
#' results_estimate_transmission_flows_and_ci
#'
#' # Detailed output
#' results_estimate_transmission_flows_and_ci_detailed <- estimate_transmission_flows_and_ci(
#'     group_in = sampling_frequency$population_group,
#' 	   individuals_sampled_in = sampling_frequency$number_sampled,
#' 	   individuals_population_in = sampling_frequency$number_population,
#' 	   linkage_counts_in = counts_hiv_transmission_pairs,
#' 	   detailed_report = TRUE,
#' 	   verbose_output = TRUE)
#'
#' # View results
#' results_estimate_transmission_flows_and_ci_detailed
#'
#' @export
estimate_transmission_flows_and_ci <- function(group_in, individuals_sampled_in, individuals_population_in, linkage_counts_in, ...) UseMethod("estimate_transmission_flows_and_ci")

#' @describeIn estimate_transmission_flows_and_ci Estimates transmission flows and accompanying confidence intervals

#' @export
estimate_transmission_flows_and_ci.default <- function(group_in,
                                                       individuals_sampled_in,
                                                       individuals_population_in,
                                                       linkage_counts_in,
                                                       detailed_report = FALSE,
                                                       verbose_output = FALSE,
                                                       ...) {

	results_estimate_transmission_flows <- estimate_transmission_flows(group_in, individuals_sampled_in, individuals_population_in, linkage_counts_in, detailed_report, verbose_output)

    results_estimate_transmission_flows$call <- match.call()

    class(results_estimate_transmission_flows) <- "estimate_transmission_flows_and_ci"

    results_estimate_transmission_flows

}

#' @title \code{prep_p_hat} Prepares input data to estimate \code{p_hat}
#'
#' @description This function generates variables required for estimating
#'              \code{p_hat}, the probability that pathogen sequences from
#'              two individuals randomly sampled from their respective
#'              population groups are linked. For a population group
#'              pairing \eqn{(u,v)}, \code{prep_p_hat} determines all possible
#'              group pairings i.e. \eqn{(uu, uv, vu, vv)}.
#'
#' @aliases pp prep_phat prep_p_hat
#'
#' @param group_in A character vector indicating population groups/strata
#'        (e.g. communities, age-groups, genders or trial arms) between which
#'        transmission flows will be evaluated,
#' @param individuals_sampled_in A numeric vector indicating the number of
#'        individuals sampled per population group,
#' @param individuals_population_in A numeric vector of the estimated number
#'        of individuals per population group,
#' @param linkage_counts_in A data.frame of counts of linked pairs identified
#'        between samples of each population group pairing of interest. \cr
#'        The data.frame should contain the following three fields:
#' 	   \itemize{
#' 	       \item H1_group (character) Name of population group 1
#' 	       \item H2_group (character) Name of population group 2
#' 	       \item number_linked_pairs_observed (numeric) Number of
#' 	             observed directed transmission pairs between samples
#' 	             from population groups 1 and 2
#' 	   }
#' @param verbose_output A boolean value to display intermediate output.
#'        (Default is \code{FALSE})
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#' \item H1_group, Name of population group 1
#' \item H2_group, Name of population group 2
#' \item number_hosts_sampled_group_1, Number of individuals sampled
#'       from population group 1
#' \item number_hosts_sampled_group_2, Number of individuals sampled
#'       from population group 2
#' \item number_hosts_population_group_1, Estimated number of individuals
#'       in population group 1
#' \item number_hosts_population_group_2, Estimated number of individuals
#'       in population group 2
#' \item max_possible_pairs_in_sample, Number of distinct possible transmission
#'       pairs between individuals sampled from population groups 1 and 2
#' \item max_possible_pairs_in_population, Number of distinct possible
#'       transmission pairs between individuals in population groups 1 and 2
#' \item num_linked_pairs_observed, Number of observed directed transmission
#'       pairs between samples from population groups 1 and 2
#' }
#'
#' @seealso \code{\link{estimate_p_hat}}
#'
#' @details Counts of observed directed transmission pairs can be obtained from
#'          deep-sequence phylogenetic data (via phyloscanner) or from known
#'          epidemiological contacts. Note: Deep-sequence data is also commonly
#'          referred to as high-throughput or next-generation sequence data. See
#'          references to learn more about phyloscanner.
#'
#' @references
#' \enumerate{
#'
#' \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#' \item Ratmann, O., et al., Inferring HIV-1 transmission networks and
#'       sources of epidemic spread in Africa with deep-sequence phylogenetic
#'       analysis. Nature Communications, 2019. 10(1): p. 1411.
#'
#' \item Wymant, C., et al., PHYLOSCANNER: Inferring Transmission from Within
#'       and Between-Host Pathogen Genetic Diversity. Molecular Biology and
#'       Evolution, 2017. 35(3): p. 719-733.
#'
#' }
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Prepare input to estimate p_hat
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#' # View counts of observed directed HIV transmissions within and between intervention
#' # and control communities
#' counts_hiv_transmission_pairs
#'
#' # View the estimated number of individuals with HIV in intervention and control
#' # communities and the number of individuals sampled from each
#' sampling_frequency
#'
#' results_prep_p_hat <- prep_p_hat(group_in = sampling_frequency$population_group,
#'                                  individuals_sampled_in = sampling_frequency$number_sampled,
#'                                  individuals_population_in = sampling_frequency$number_population,
#'                                  linkage_counts_in = counts_hiv_transmission_pairs,
#'                                  verbose_output = TRUE)
#'
#' # View results
#' results_prep_p_hat
#'
#' @export
prep_p_hat <- function(group_in, individuals_sampled_in, individuals_population_in, linkage_counts_in, ...) UseMethod("prep_p_hat")

#' @describeIn prep_p_hat Prepares input data to estimate \code{p_hat}
#' @export
prep_p_hat.default <- function(group_in,
							   individuals_sampled_in,
							   individuals_population_in,
							   linkage_counts_in,
							   verbose_output = FALSE, ...) {

    # Check whether all required variables are present

    if (missing(group_in))
        stop("Group value missing, need to specify a character vector of population groups/strata between which to estimate transmission flows.")

    if (missing(individuals_sampled_in))
        stop("Individuals sampled missing, need to specify a numeric vector of the number of individuals sampled per population group.")

    if (missing(individuals_population_in))
        stop("Individuals in population missing, need to specify a numeric vector of the estimated number of individuals per population group.")

    if (missing(linkage_counts_in))
        stop("Identified transmission pairs missing, need to specify a data.frame containing the number of directed transmission pairs identified/observed in the sample per population group pairing.")

    # Verify data types of required variables
    if (!is.numeric(c(individuals_sampled_in, individuals_population_in))) {

        stop("individuals_sampled_in and individuals_population_in should be of type, numeric.")

    }

    if (!is.character(c(group_in))) {

        stop("group_in should be of type, character.")

    }

    if (!(ncol(linkage_counts_in) == 3)) {

        stop("linkage_counts_in should be a data.frame with three fields: H1_counts, H2_counts and number_linked_pairs_observed.")

    }

	results_prepare_input_for_get_p_hat <- prepare_input_for_get_p_hat(group_in,
																	   individuals_sampled_in,
																	   individuals_population_in,
																	   linkage_counts_in,
																	   verbose_output)

    results_prepare_input_for_get_p_hat

}

#' @title \code{estimate_p_hat} Estimates probability of linkage between two individuals
#'
#' @description This function computes the probability that pathogen sequences from
#'              two individuals randomly sampled from their respective population groups
#'              (e.g. communities) are linked.
#'
#' @details For a population group pairing \eqn{(u,v)}, \code{p_hat} is computed as the
#' 		 fraction of distinct possible pairs between samples from groups \eqn{u} and
#' 		 \eqn{v} that are linked. Note: The number of distinct possible \eqn{(u,v)}
#' 		 pairs in the sample is the product of sampled individuals in groups \eqn{u}
#' 		 and \eqn{u}. If \eqn{u = v}, then the distinct possible pairs is the number
#' 		 of individuals sampled in population group \eqn{u} choose 2. See bumblebee
#' 		 website for more details \url{https://magosil86.github.io/bumblebee/}.
#'
#' @aliases p_hat phat est_p_hat estim_p_hat estimate_p_hat
#'
#' @param df_counts A data.frame returned by the function: [prep_p_hat()]
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#'     \item H1_group, Name of population group 1
#'     \item H2_group, Name of population group 2
#' 	   \item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#' 	   \item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#' 	   \item number_hosts_population_group_1, Estimated number of individuals in population group 1
#' 	   \item number_hosts_population_group_2, Estimated number of individuals in population group 2
#' 	   \item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#' 	   \item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#' 	   \item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#' 	   \item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#' }
#'
#' @seealso See \code{\link{prep_p_hat}} to prepare input data to estimate \code{p_hat}
#'
#' @references
#' \enumerate{
#'
#' \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#' \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 	     village residents in Botswana: estimation of linkage rates in the
#' 	     presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 	     p. e1003430.
#'
#'}
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Estimate the probability of linkage between two individuals randomly sampled from
#' # two population groups of interest.
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#' # Prepare input to estimate p_hat
#'
#' # View counts of observed directed HIV transmissions within and between intervention
#' # and control communities
#' counts_hiv_transmission_pairs
#'
#' # View the estimated number of individuals with HIV in intervention and control
#' # communities and the number of individuals sampled from each
#' sampling_frequency
#'
#' results_prep_p_hat <- prep_p_hat(group_in = sampling_frequency$population_group,
#'                                  individuals_sampled_in = sampling_frequency$number_sampled,
#'                                  individuals_population_in = sampling_frequency$number_population,
#'                                  linkage_counts_in = counts_hiv_transmission_pairs,
#'                                  verbose_output = FALSE)
#'
#' # View results
#' results_prep_p_hat
#'
#' # Estimate p_hat
#' results_estimate_p_hat <- estimate_p_hat(df_counts = results_prep_p_hat)
#'
#' # View results
#' results_estimate_p_hat
#'
#'
#' @export
estimate_p_hat <- function(df_counts, ...) UseMethod("estimate_p_hat")

#' @describeIn estimate_p_hat Estimates probability of linkage between two individuals
#' @export
estimate_p_hat.default <- function(df_counts, ...) {

	# Check whether the input is a data.frame
	if (!is.data.frame(df_counts)) {

		stop("Check input! Expecting a data.frame produced by function: prep_p_hat(), type ?prep_p_hat() for help")

	}

	# Check whether all required variables are present

	provided_field_names <- names(df_counts)
	expected_field_names <- c("H1_group", "H2_group",
	                          "number_hosts_sampled_group_1", "number_hosts_sampled_group_2",
	                          "number_hosts_population_group_1", "number_hosts_population_group_2",
	                          "max_possible_pairs_in_sample", "max_possible_pairs_in_population",
	                          "num_linked_pairs_observed")

	if (base::isFALSE(base::all(expected_field_names %in% provided_field_names))) {

	    message <- list('Check input! One or more required fields is missing. \nExpecting a data.frame produced by function: prep_p_hat(), type ?prep_p_hat() for help')
	    stop(message)

	}

	results_get_p_hat <- get_p_hat(df_counts)

	results_get_p_hat

}

#' @title \code{estimate_prob_group_pairing_and_linked} Estimates joint probability of linkage
#'
#' @description This function computes the joint probability that a pair
#'              of pathogen sequences is from a specific population group
#'              pairing and linked.
#'
#' @details For a population group pairing \eqn{(u,v)}, the joint probability that a pair
#'          is from groups \eqn{(u,v)} and is linked is computed as
#'
#' \deqn{(N_uv / N_choose_2) * p_hat_uv ,}
#'
#' where,
#' \itemize{
#'     \item N_uv = N_u * N_v: maximum distinct possible \eqn{(u,v)} pairs in population
#'     \item p_hat_uv: probability of linkage between two individuals randomly sampled
#'       from groups \eqn{u} and \eqn{v}
#'     \item N choose 2 or (N * (N - 1))/2 : all distinct possible pairs in population.
#' }
#'
#' See bumblebee website for more details \url{https://magosil86.github.io/bumblebee/}.
#'
#' @aliases prob_group_pairing_and_linked estimate_prob_group_pairing_and_linked
#'
#' @param df_counts_and_p_hat A data.frame returned by function: [estimate_p_hat()]
#' @param individuals_population_in A numeric vector of the estimated number of individuals per population group
#' @param verbose_output A boolean value to display intermediate output.
#'        (Default is \code{FALSE})
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#'     \item H1_group, Name of population group 1
#' 	   \item H2_group, Name of population group 2
#' 	   \item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#' 	   \item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#' 	   \item number_hosts_population_group_1, Estimated number of individuals in population group 1
#' 	   \item number_hosts_population_group_2, Estimated number of individuals in population group 2
#' 	   \item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#' 	   \item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#' 	   \item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#' 	   \item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#' 	   \item prob_group_pairing_and_linked, Probability that a pair of pathogen sequences is from a specific population group pairing and is linked
#' }
#'
#' @seealso See \code{\link{estimate_p_hat}} to prepare input data to estimate \code{prob_group_pairing_and_linked}
#'
#' @references
#' \enumerate{
#'
#' \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#' \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 	     village residents in Botswana: estimation of linkage rates in the
#' 	     presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 	     p. e1003430.
#'
#'}
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Estimate joint probability that a pair is from a specific group pairing and linked
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#'
#' # Load and view data
#' #
#' # The input data comprises counts of observed directed HIV transmission pairs
#' # within and between intervention and control communities in the BCPP/Ya Tsie
#' # trial, sampling information and the probability of linkage between individuals
#' # sampled from intervention and control communities (i.e. \code{p_hat})
#' #
#' # See ?estimate_p_hat() for details on estimating p_hat
#' results_estimate_p_hat <- estimated_hiv_transmission_flows[, c(1:10)]
#'
#' results_estimate_p_hat
#'
#' # Estimate prob_group_pairing_and_linked
#' results_prob_group_pairing_and_linked <- estimate_prob_group_pairing_and_linked(
#'     df_counts_and_p_hat = results_estimate_p_hat,
#'     individuals_population_in = sampling_frequency$number_population)
#'
#' # View results
#' results_prob_group_pairing_and_linked
#'
#' @export
estimate_prob_group_pairing_and_linked <- function(df_counts_and_p_hat, individuals_population_in, ...) UseMethod("estimate_prob_group_pairing_and_linked")

#' @describeIn estimate_prob_group_pairing_and_linked Estimates joint probability of linkage
#'
#' @export
estimate_prob_group_pairing_and_linked.default <- function(df_counts_and_p_hat,
                                                           individuals_population_in,
                                                           verbose_output = FALSE, ...) {

	# Check whether the input is a data.frame
	if (!is.data.frame(df_counts_and_p_hat)) {

		stop("Check input! df_counts_and_p_hat should be a data.frame produced by function: estimate_p_hat(), type ?estimate_p_hat() for help")

	}

	# Check whether all required variables are present

	provided_field_names <- names(df_counts_and_p_hat)
	expected_field_names <- c("H1_group", "H2_group", "number_hosts_sampled_group_1",
	                          "number_hosts_sampled_group_2", "number_hosts_population_group_1",
	                          "number_hosts_population_group_2", "max_possible_pairs_in_sample",
	                          "max_possible_pairs_in_population", "num_linked_pairs_observed",
	                          "p_hat")

	if (base::isFALSE(base::all(expected_field_names %in% provided_field_names))) {

	    message <- list('Check input! One or more required fields is missing. \nExpecting a data.frame produced by function: estimate_p_hat(), type ?estimate_p_hat() for help')
	    stop(message)

	}

    if (missing(individuals_population_in))
        stop("Individuals in population missing, need to specify a numeric vector of the estimated number of individuals per population group.")

    results_get_prob_group_pairing_and_linked <- get_prob_group_pairing_and_linked(df_counts_and_p_hat, individuals_population_in, verbose_output)

    results_get_prob_group_pairing_and_linked

}

#' @title \code{estimate_theta_hat} Estimates conditional probability of linkage (transmission flows)
#'
#' @description This function estimates \code{theta_hat}, the relative probability of
#'              transmission within and between population groups accounting for variable
#'              sampling rates among population groups. This relative probability is also
#'              refferred to as transmission flows.
#'
#' @details For a population group pairing \eqn{(u,v)}, the estimated transmission flows
#'          within and between population groups \eqn{u} and \eqn{v}, are represented by
#'          the vector theta_hat,
#'
#' \deqn{\hat{\theta} = ( \hat{\theta}_{uu}, \hat{\theta}_{uv}, \hat{\theta}_{vu}, \hat{\theta}_{vv} ) ,}
#'
#' and are computed as \deqn{\hat{\theta_{ij}} = Pr(pair from groups (i,j) | pair is linked), where i = u,v and j = u,v ,}
#'
#' \deqn{\hat{\theta_{ij}} = \frac{N_{ij}p_{ij}}{ \sum_m \sum_{n \ge m}N_{mn}p_{mn}}, where i = u,v and j = u,v ,}
#'
#' See bumblebee website for more details \url{https://magosil86.github.io/bumblebee/}.
#'
#' @aliases theta_hat est_theta_hat estim_theta_hat estimate_theta_hat
#'
#' @param df_counts_and_p_hat  A data.frame returned by the function: [estimate_p_hat()]
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#' 	    \item H1_group, Name of population group 1
#' 	    \item H2_group, Name of population group 2
#' 	    \item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#' 	    \item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#' 	    \item number_hosts_population_group_1, Estimated number of individuals in population group 1
#' 	    \item number_hosts_population_group_2, Estimated number of individuals in population group 2
#' 	    \item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#' 	    \item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#' 	    \item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#' 	    \item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#' 	    \item est_linkedpairs_in_population, Estimated transmission pairs between population groups 1 and 2
#' 	    \item theta_hat, Estimated transmission flows or relative probability of transmission within and between population groups 1 and 2 adjusted
#' 		      for sampling heterogeneity. More precisely, the conditional probability that a pair of pathogen sequences is from a specific population
#' 		      group pairing given that the pair is linked.}
#'
#' @seealso See \code{\link{estimate_p_hat}} to prepare input data to estimate \code{theta_hat}
#'
#' @references
#' \enumerate{
#'
#' \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#' \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 	     village residents in Botswana: estimation of linkage rates in the
#' 	     presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 	     p. e1003430.
#'
#'}
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Estimate transmission flows within and between population groups accounting for variable
#' # sampling among population groups
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#'
#' # Load and view data
#' #
#' # The input data comprises counts of observed directed HIV transmission pairs within
#' # and between intervention and control communities in the BCPP/Ya Tsie trial,
#' # sampling information and the probability of linkage between individuals sampled
#' # from intervention and control communities (i.e. \code{p_hat})
#' #
#' # See ?estimate_p_hat() for details on estimating p_hat
#' results_estimate_p_hat <- estimated_hiv_transmission_flows[, c(1:10)]
#'
#' results_estimate_p_hat
#'
#' # Estimate theta_hat
#' results_estimate_theta_hat <- estimate_theta_hat(df_counts_and_p_hat = results_estimate_p_hat)
#'
#' # View results
#' results_estimate_theta_hat
#'
#' @export
estimate_theta_hat <- function(df_counts_and_p_hat, ...) UseMethod("estimate_theta_hat")

#' @describeIn estimate_theta_hat Estimates conditional probability of linkage (transmission flows)
#'
#' @export
estimate_theta_hat.default <- function(df_counts_and_p_hat, ...) {

	# Check whether the input is a data.frame
	if (!is.data.frame(df_counts_and_p_hat)) {

	    stop("Check input! df_counts_and_p_hat should be a data.frame produced by function: estimate_p_hat(), type ?estimate_p_hat() for help")

	}

    results_get_theta_hat <- get_theta_hat(df_counts_and_p_hat)

    results_get_theta_hat

}

#' @title \code{estimate_c_hat} Estimates probability of clustering
#'
#' @description This function estimates \code{c_hat}, the probability that a randomly
#'              selected pathogen sequence in one population group links to at least
#'              one pathogen sequence in another population group.
#'
#' @aliases c_hat est_c_hat estim_c_hat estimate_c_hat
#'
#' @param df_counts_and_p_hat  A data.frame returned by the function: [estimate_p_hat()]
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#'     \item H1_group, Name of population group 1
#'     \item H2_group, Name of population group 2
#'     \item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#'     \item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#'     \item number_hosts_population_group_1, Estimated number of individuals in population group 1
#'     \item number_hosts_population_group_2, Estimated number of individuals in population group 2
#'     \item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#'     \item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#'     \item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#'     \item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#'     \item c_hat, Probability that a randomly selected pathogen sequence in one population group links to at least
#'           one pathogen sequence in another population group i.e. probability of clustering
#' }
#'
#' @seealso See \code{\link{estimate_p_hat}} to prepare input data to estimate \code{c_hat}
#'
#' @references
#' \enumerate{
#'
#' \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#' \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 	     village residents in Botswana: estimation of linkage rates in the
#' 	     presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 	     p. e1003430.
#'
#'}
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Estimate the probability of clustering between individuals from two population groups of interest
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs, ?sampling_frequency and ?estimated_hiv_transmission_flows
#'
#'
#' # Load and view data
#' #
#' # The input data comprises counts of observed directed HIV transmission pairs within and
#' # between intervention and control communities in the BCPP/Ya Tsie trial, sampling
#' # information and the probability of linkage between individuals sampled from
#' # intervention and control communities (i.e. \code{p_hat})
#' #
#' # See ?estimate_p_hat() for details on estimating p_hat
#' results_estimate_p_hat <- estimated_hiv_transmission_flows[, c(1:10)]
#'
#' results_estimate_p_hat
#'
#' # Estimate c_hat
#' results_estimate_c_hat <- estimate_c_hat(df_counts_and_p_hat = results_estimate_p_hat)
#'
#' # View results
#' results_estimate_c_hat
#'
#' @export
estimate_c_hat <- function(df_counts_and_p_hat, ...) UseMethod("estimate_c_hat")

#' @describeIn estimate_c_hat Estimates probability of clustering
#'
#' @export
estimate_c_hat.default <- function(df_counts_and_p_hat, ...) {

	# Check whether the input is a data.frame
	if (!is.data.frame(df_counts_and_p_hat)) {

	    stop("Check input! df_counts_and_p_hat should be a data.frame produced by function: estimate_p_hat(), type ?estimate_p_hat() for help")

	}

    results_get_c_hat <- get_c_hat(df_counts_and_p_hat)

    results_get_c_hat

}

#' @title \code{estimate_multinom_ci} Estimates confidence intervals for transmission flows
#'
#' @description This function computes simultaneous confidence intervals at the
#'              5% significance level for estimated transmission flows. Available
#'              methods for computing confidence intervals are: Goodman, Goodman
#'              with a continuity correction, Sison-Glaz and Queensbury-Hurst.
#'
#' @aliases estimate_multinom_ci estim_multinom_ci est_multinom_ci
#'
#' @param df_theta_hat A data.frame returned by the function: [estimate_theta_hat()]
#' @param detailed_report A boolean value to produce detailed output of the analysis. (Default is \code{FALSE})
#' @param \dots Further arguments.
#'
#' @return Returns a data.frame containing:
#' \itemize{
#' 	\item H1_group, Name of population group 1
#' 	\item H2_group, Name of population group 2
#' 	\item number_hosts_sampled_group_1, Number of individuals sampled from population group 1
#' 	\item number_hosts_sampled_group_2, Number of individuals sampled from population group 2
#' 	\item number_hosts_population_group_1, Estimated number of individuals in population group 1
#' 	\item number_hosts_population_group_2, Estimated number of individuals in population group 2
#' 	\item max_possible_pairs_in_sample, Number of distinct possible transmission pairs between individuals sampled from population groups 1 and 2
#' 	\item max_possible_pairs_in_population, Number of distinct possible transmission pairs between individuals in population groups 1 and 2
#' 	\item num_linked_pairs_observed, Number of observed directed transmission pairs between samples from population groups 1 and 2
#' 	\item p_hat, Probability that pathogen sequences from two individuals randomly sampled from their respective population groups are linked
#' 	\item est_linkedpairs_in_population, Estimated transmission pairs between population groups 1 and 2
#' 	\item theta_hat, Estimated transmission flows or relative probability of transmission within and between population groups 1 and 2 adjusted
#' 	      for sampling heterogeneity. More precisely, the conditional probability that a pair of pathogen sequences is from a specific population
#' 	      group pairing given that the pair is linked.
#' 	\item obs_trm_pairs_est_goodman, Point estimate, Goodman method Confidence intervals for observed transmission pairs
#' 	\item obs_trm_pairs_lwr_ci_goodman, Lower bound of Goodman confidence interval
#' 	\item obs_trm_pairs_upr_ci_goodman, Upper bound of Goodman confidence interval
#' 	\item est_goodman, Point estimate, Goodman method Confidence intervals for estimated transmission flows
#' 	\item lwr_ci_goodman, Lower bound of Goodman confidence interval
#' 	\item upr_ci_goodman, Upper bound of Goodman confidence interval
#' }
#'
#' The following additional fields are returned if the detailed_report flag is set
#'
#' \itemize{
#' 	\item est_goodman_cc, Point estimate, Goodman method Confidence intervals with continuity correction
#' 	\item lwr_ci_goodman_cc, Lower bound of Goodman confidence interval
#' 	\item upr_ci_goodman_cc, Upper bound of Goodman confidence interval
#' 	\item est_sisonglaz, Point estimate, Sison-Glaz method Confidence intervals
#' 	\item lwr_ci_sisonglaz, Lower bound of Sison-Glaz confidence interval
#' 	\item upr_ci_sisonglaz, Upper bound of Sison-Glaz confidence interval
#' 	\item est_qhurst_acswr, Point estimate, Queensbury-Hurst method Confidence intervals via ACSWR r package
#' 	\item lwr_ci_qhurst_acswr, Lower bound of Queensbury-Hurst confidence interval
#' 	\item upr_ci_qhurst_acswr, Upper bound of Queensbury-Hurst confidence interval
#' 	\item est_qhurst_coinmind, Point estimate, Queensbury-Hurst method Confidence intervals via CoinMinD r package
#' 	\item lwr_ci_qhurst_coinmind, Lower bound of Queensbury-Hurst confidence interval
#' 	\item upr_ci_qhurst_coinmind, Upper bound of Queensbury-Hurst confidence interval
#' 	\item lwr_ci_qhurst_adj_coinmind, Lower bound of Queensbury-Hurst confidence interval adjusted
#' 	\item upr_ci_qhurst_adj_coinmind, Upper bound of Queensbury-Hurst confidence interval adjusted
#' }
#'
#' @seealso See \code{\link{estimate_theta_hat}} to prepare input data to estimate confidence intervals.
#'
#'          To learn more about the Goodman and Sison-Glaz confidence interval methods
#'          see \code{\link[DescTools]{MultinomCI}}. For Queensbury-Hurst confidence
#'          intervals see \code{\link[ACSWR]{QH_CI}} and \code{\link[CoinMinD]{QH}}
#'
#' @references
#' \enumerate{
#'
#'    \item Magosi LE, et al., Deep-sequence phylogenetics to quantify patterns of
#'       HIV transmission in the context of a universal testing and treatment
#'       trial – BCPP/ Ya Tsie trial. To submit for publication, 2021.
#'
#'    \item Goodman, L. A. On Simultaneous Confidence Intervals for Multinomial Proportions
#' 		 Technometrics, 1965. 7, 247-254.
#'
#'    \item Cherry, S., A Comparison of Confidence Interval Methods for Habitat
#'       Use-Availability Studies. The Journal of Wildlife Management, 1996.
#'       60(3): p. 653-658.
#'
#'    \item Sison, C.P and Glaz, J. Simultaneous confidence intervals and sample size determination
#' 		 for multinomial proportions. Journal of the American Statistical Association,
#' 		 1995. 90:366-369.
#'
#'    \item Glaz, J., Sison, C.P. Simultaneous confidence intervals for multinomial proportions.
#' 		 Journal of Statistical Planning and Inference, 1999. 82:251-262.
#'
#'    \item May, W.L., Johnson, W.D. Constructing two-sided simultaneous confidence intervals for
#' 		 multinomial proportions for small counts in a large number of cells.
#' 		 Journal of Statistical Software, 2000. 5(6).
#' 		 Paper and code available at https://www.jstatsoft.org/v05/i06.
#'
#'    \item Carnegie, N.B., et al., Linkage of viral sequences among HIV-infected
#' 		 village residents in Botswana: estimation of linkage rates in the
#' 		 presence of missing data. PLoS Computational Biology, 2014. 10(1):
#' 		 p. e1003430.
#'
#'    \item Ratmann, O., et al., Inferring HIV-1 transmission networks and sources of
#' 		 epidemic spread in Africa with deep-sequence phylogenetic analysis.
#' 		 Nature Communications, 2019. 10(1): p. 1411.
#'
#'    \item Wymant, C., et al., PHYLOSCANNER: Inferring Transmission from Within- and
#' 		 Between-Host Pathogen Genetic Diversity. Molecular Biology and Evolution,
#' 		 2017. 35(3): p. 719-733.
#' }
#'
#' @examples
#' library(bumblebee)
#' library(dplyr)
#'
#' # Compute confidence intervals for estimated transmission flows
#'
#' # We shall use the data of HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie HIV prevention trial. To learn more about the data
#' # ?counts_hiv_transmission_pairs and ?sampling_frequency
#'
#'
#' # Load and view data
#' #
#' # The data comprises counts of observed directed HIV transmission pairs between individuals
#' # sampled from intervention and control communities (i.e. num_linked_pairs_observed);
#' # and the estimated HIV transmissions within and between intervention and control
#' # communities in the BCPP/Ya Tsie trial population adjusted for sampling heterogneity
#' # (i.e. \code{est_linkedpairs_in_population}). See ?estimate_theta_hat() for details on
#' # computing \code{est_linkedpairs_in_population} and \code{theta_hat}.
#'
#' results_estimate_theta_hat <- estimated_hiv_transmission_flows[, c(1:13)]
#'
#' results_estimate_theta_hat
#'
#' # Compute Goodman confidence intervals (Default)
#' results_estimate_multinom_ci <- estimate_multinom_ci(
#'     df_theta_hat = results_estimate_theta_hat,
#'     detailed_report = FALSE)
#'
#' # View results
#' results_estimate_multinom_ci
#'
#' # Compute Goodman, Sison-Glaz and Queensbury-Hurst confidence intervals
#' results_estimate_multinom_ci_detailed <- estimate_multinom_ci(
#'     df_theta_hat = results_estimate_theta_hat,
#'     detailed_report = TRUE)
#'
#' # View results
#' results_estimate_multinom_ci_detailed
#'
#' @export
estimate_multinom_ci <- function(df_theta_hat, ...) UseMethod("estimate_multinom_ci")

#' @describeIn estimate_multinom_ci Estimates confidence intervals for transmission flows

#' @export
estimate_multinom_ci.default <- function(df_theta_hat, detailed_report = FALSE, ...) {

	# Check whether the input is a data.frame
	if (!is.data.frame(df_theta_hat)) {

	    stop("Check input! df_theta_hat should be a data.frame produced by function: estimate_theta_hat(), type ?estimate_theta_hat() for help")

	}

    # check input fields
	provided_field_names <- names(df_theta_hat)
	expected_field_names <- c("est_linkedpairs_in_population", "num_linked_pairs_observed")

	if (base::isFALSE(base::all(expected_field_names %in% provided_field_names))) {

	    message <- list('Check input! One or more required fields is missing. \nExpecting a data.frame produced by function: estimate_theta_hat(), type ?estimate_theta_hat() for help. \nTip! Minimum required fields: "est_linkedpairs_in_population" and "num_linked_pairs_observed"')
	    stop(message)

	}

    results_get_multinomial_proportion_conf_ints_extended <- get_multinomial_proportion_conf_ints_extended(df_theta_hat, detailed_report)

    results_get_multinomial_proportion_conf_ints_extended

}


library(reshape2)
library(data.table)
library(dplyr)

# 1. 데이터 로드 및 형식 변환하기
# 데이터 로드
ratings = read.csv('chapter02/data/movie_rating.csv')
# head(ratings)
# dim(ratings)
# str(ratings)

# 데이터 처리 및 형식 변환
movie_ratings = as.data.frame(acast(
    ratings, title~critic, value.var='rating'
))

# 2. 사용자 사이의 유사도 계산하기
# 유사도 계산
sim_users = cor(movie_ratings[, 1:6], use='complete.obs')
# sim_users
sim_users[colnames(sim_users) == 'Toby']

# 3. 사용자의 등급 예측하기
# 미지 값 예측하기
# Toby가 등급을 매기지 않은 영화 선정
rating_critic = setDT(movie_ratings[colnames(movie_ratings)[6]], keep.rownames=TRUE)[]
names(rating_critic) = c('title', 'rating')
titles_na_critic = rating_critic$title[is.na(rating_critic$rating)]
ratings_t = ratings[ratings$title %in% titles_na_critic, ]
ratings_t

# 각 사용자의 유사도 값을 새로운 변수로 추가
x = setDT(data.frame(sim_users[, 6]), keep.rownames=TRUE)[]
names(x) = c('critic', 'similarity')
ratings_t = merge(x=ratings_t, y=x, by='critic', all.x=TRUE)
ratings_t

# 등급과 유사도 값 곱하기
ratings_t$sim_rating = ratings_t$rating * ratings_t$similarity

# 4. 사용자 유사도 점수를 기반으로 사용자에게 아이템 추천하기
# 평가하지 않은 영화 추측
result = ratings_t %>% group_by(title) %>% summarise(sum(sim_rating) / sum(similarity))
names(result) = c('title', 'pred_rating')
result

# 추천 함수 생성
generateRecommendations <- function(userId) {
    rating_critic = setDT(movie_ratings[colnames(movie_ratings)[userId]], keep.rownames=TRUE)[]
    names(rating_critic) = c('title', 'rating')
    titles_na_critic = rating_critic$title[is.na(rating_critic$rating)]
    ratings_t = ratings[ratings$title %in% titles_na_critic,]
    x = (setDT(data.frame(sim_users[,userId]), keep.rownames=TRUE)[])
    names(x) = c('critic', 'similarity')
    ratings_t = merge(x=ratings_t, y=x, by='critic', all.x=TRUE)
    ratings_t$sim_rating = ratings_t$rating * ratings_t$similarity
    result = ratings_t %>% group_by(title) %>% summarise(sum(sim_rating)/sum(similarity))
    names(result) = c('title', 'pred_rating')
    return(result)
}

generateRecommendations(1)
generateRecommendations(3)
generateRecommendations(6)


fname       <- read.table(file="./rsme_riley_55.txt", sep=",", header=TRUE, strip.white=TRUE)

rsme_train <- as.numeric(unlist(fname[1]))
rsme_mims <- as.numeric(unlist(fname[2]))
coeff_a <- as.numeric(unlist(fname[3]))
coeff_b <- as.numeric(unlist(fname[4]))
S_train <- as.numeric(unlist(fname[5]))
S_test <- as.numeric(unlist(fname[6]))
rsme_test <- as.numeric(unlist(fname[7]))
acc <- as.numeric(unlist(fname[8]))

rsme_train_avg <- mean(rsme_train)
rsme_mims_avg <- mean(rsme_mims)
coeff_a_avg <- exp(mean(coeff_a))
coeff_b_avg <- mean(coeff_b)
S_train_avg <- mean(S_train)
S_test_avg <- mean(S_test)
rsme_test_avg <- mean(rsme_test)
acc_avg <- mean(acc)

print(rsme_train_avg)
print(rsme_test_avg)
print(rsme_mims_avg)
cat("---\n")
print(coeff_a_avg)
print(coeff_b_avg)
cat("---\n")
print(S_train_avg)
print(S_test_avg)
print(acc_avg)

#
# print(coeff_a_avg)
# print(exp(max(coeff_a)))
# print(exp(min(coeff_a)))
# cat("---\n")
# print(coeff_b_avg)
# print(max(coeff_b))
# print(min(coeff_b))
# print(coeff_b_avg)
# print(S_avg)
#
#
# print(rsme_riley_avg)
# print(max(abs(rsme_riley - rsme_riley_avg)))
# print(min(abs(rsme_riley - rsme_riley_avg)))
# print("---")
# print(rsme_mims_avg)
# print(max(abs(rsme_mims - rsme_mims_avg)))
# print(min(abs(rsme_mims - rsme_mims_avg)))
# print(max(abs(S - S_avg)))

# pdf("./variance.pdf")
# plot(rsme_riley, rsme_riley - rsme_riley_avg)

# plot(rsme_mims, rsme_mims - rsme_mims_avg, col=c("#0166FF"))

# print(rsme_riley_avg)
# print(rsme_mims_avg)


#####################################################################
# CS671: Machine Learning
# Copyright 2015 Pejman Ghorbanzade <pejman@ghorbanzade.com>
# More info: https://github.com/ghorbanzade/beacon
#####################################################################

# Load dataset
letters <- read.csv("dat/iris.csv", header=TRUE, sep=",")

# show summary of loaded dataset on console
str(letters)

# alternatively, to view the dataset in RStudio
# View(letters)

# We first need to randomize the dataset
# To do it, we first generate 150 numbers in the interval [0,1]
rand <- runif(150)

# Then we replace them with their order,
# as if we generated 150 random integer numbers from 1 to 150
rand <- order(rand)

# Then we shuffle the dataset, using the random array
iris_rand <- iris[rand, ]

# R packages specialized in SVM are Kernlab, svmlight, libsvm, e1071
# We use kernlab
# Make sure kernlab package is installed
# pkg <- select.list(sort(.packages(all.available = TRUE)), graphics=TRUE)
# if(nchar(pkg)) library(pkg, character.only=TRUE)
# library("kernlab")

# Select first 120 samples as training dataset
iris_train <- iris_rand[1:120, ]

# Select the remaining 30 samples as test dataset
iris_test <- iris_rand[121:150, ]

# Build a classifer using a linear kernel function
iris_classifier <- ksvm(Species~., data=iris_train, kernel="vanilladot")

# show classifier properties
iris_classifier

# apply classifier on the test dataset
iris_prediction <- predict(iris_classifier, iris_test)

# show header
head(iris_prediction)

# show confusion matrix
table(iris_prediction, iris_test$Species)

# show number of correct and incorrect recognitions
agreement <- iris_prediction == iris_test$Species
table(agreement)


# ranked bias overlap
# http://williamwebber.com/research/papers/wmz10_tois.pdf
# idea: compare the intersection between lists.
# But: Do this for sublists from rank one to to n vor all n in N (last rank)

average_overlap <- function(lists ) {
  # calc (number of intersected elements / number of elements in each list) in a 2,x sized vector form sublists 1:n

  intersect_n_elements <- function (n, lists){
    length(intersect(lists[1,1:n],lists[2,1:n]))/n
  }
  sum(mapply(intersect_n_elements, 1:length(lists[,1]), list(rbind(lists[,1],lists[,2])))) / length(lists[,1])
}
#test#
test_average_overlap <- function () {
  print("test average_overlap")
  print("calc vs. manual calc:")
  lists <- cbind( c("hallo", "bist", "kannst", "Du"),
                  c("hallo", "wer", "bist", "Du"))
  average_overlap(lists) == (1/1+1/2+2/3+3/4)/4
}
test_average_overlap()

## Average Overlap on n different lists to compare
#install.packages("iterpc")
library(iterpc) # to get all combinations from list
multiple_average_overlap <- function(ranked_lists) {
  # calculate all distances from given list of indices to compare
  calc_distances <- function(indices) {
    average_overlap(cbind(ranked_lists[,indices[1]],ranked_lists[,indices[2]]))
  }
  nr_of_lists <- dim(ranked_lists)[2]
  combination_iterator = iterpc(nr_of_lists, 2) # get all combinations as iterator
  all_comb <- getall(combination_iterator)
  cbind(all_comb, apply(all_comb, 1, calc_distances))
}

test_multiple_average_overlap <- function () {
  all_lists <- cbind( c("hallo", "bist", "kannst", "Du" ),
                 c("hallo", "wer", "bist", "Du"),
                 c("bist", "hallo", "kannst", "Du")
                 )
  multiple_average_overlap(all_lists)
}

test_multiple_average_overlap()

## Test on real data
dbGetQuery(mydb, "SET NAMES 'utf8'") #utf-8

get_measures_from_day <- function (date, measure, limit) {
  query = paste("SELECT * ",
                "FROM aliss15a_daily_words dw  ",
                "JOIN words  ",
                "ON dw.w_id=words.w_id ",
                "JOIN daily_words ",
                "ON dw.w_id=daily_words.w_id AND dw.date=daily_words.date ",
                "WHERE dw.date=Date( '", date,  "' ) ",
                "ORDER BY ",measure,
                " DESC LIMIT ", limit,
                sep='')
  print(query)
  response = dbSendQuery(mydb, query)
  fetch(response, n=-1)
}

get_z_value<- function() {
  query <- "SELECT @threshold:=(
    SELECT AVG(mean)
        FROM deu_news_2014.aliss15a_words
        WHERE relative_document_frequency < 0.1
);"
  response = dbSendQuery(mydb, query)
  fetch(response, n=-1)
  query <- "SELECT
            now.z_score,
            now_daily_words.freq,
            now_words.word
        FROM aliss15a_daily_words as now
        JOIN daily_words as now_daily_words on now.w_id = now_daily_words.w_id and now.date = now_daily_words.date
        JOIN words as now_words on now_words.w_id = now.w_id
        JOIN deu_news_2014.words as ref on now_words.word = ref.word
        JOIN deu_news_2014.aliss15a_words as ref_aliss on ref.w_id = ref_aliss.w_id
        WHERE now.date=Date('2015-10-31') AND ((now.relative_freq > (@threshold*10) AND ref_aliss.relative_document_frequency < 0.1) OR ref_aliss.relative_document_frequency >= 0.1)
        ORDER BY now.z_score desc
        LIMIT 100;"
  response = dbSendQuery(mydb, query)
  fetch(response, n=-1)
}

get_relwindow <- function() {
  query <- "select words.word, daily.date, daily.freq,win.window8, daily.freq/win.window8 relWindow From aliss15a_windows_of_r win JOIN words ON win.w_id=words.w_id JOIN daily_words daily ON daily.w_id=win.w_id AND daily.date=win.date WHERE win.date=Date('2015-03-25') AND daily.date=('2015-03-25') AND daily.freq>100 ORDER BY relWindow DESC limit 100;"
  response = dbSendQuery(mydb, query)
  fetch(response, n=-1)
 }
1/365
# Clear Resultset
# dbClearResult(dbListResults(mydb)[[1]])
day <- "2015-10-31"
tf_idf <- get_measures_from_day(day, "dw.tf_idf", "100")
poisson <- get_measures_from_day(day, "dw.poisson", "100")
poisson_old <- get_measures_from_day(day, "daily_words.poisson", "100")
freqratio <- get_measures_from_day(day, "dw.freqratio", "100")
freqratio_old <- get_measures_from_day(day, "daily_words.freqratio", "100")
lin_filt_freq <- get_measures_from_day(day, "lin_filt_freq", "100")
z_score <- get_z_value()

relWindow <- get_relwindow()

allInOne <- as.data.frame(poisson[,c("word")])
colnames(allInOne) <- c("poisson")
allInOne$tf_idf <- tf_idf[,c("word")]
allInOne$freqratio <- freqratio[,c("word")]
allInOne$z_score <- z_score[,c("word")]

z_score[1:20,c("word","freq")]
relWindow[1:20,c("word","freq")]

library(xtable)
xtable(allInOne[1:10,1:2], digits=2)
xtable(allInOne[1:10,3:4], digits=2)
xtable(allInOne[31:40,1:2], digits=2)
xtable(allInOne[31:40,3:4], digits=2)

??xtable

#versuchSQL <- "SELECT * FROM aliss15a_daily_words dw  JOIN words ON dw.w_id=words.w_id  WHERE dw.date=Date('15-04-01') ORDER BY dw.tf_idf DESC LIMIT 100"
#versuch2SQL <- "SELECT * FROM (SELECT * FROM aliss15a_daily_words WHERE date=Date( '15-03-01')) dw  JOIN words ON dw.w_id=words.w_id ORDER BY dw.tf_idf DESC LIMIT 100"
#response = dbSendQuery(mydb, versuchSQL)
#fetch(response, n=-1)

#freqratio <- get_measures_from_day("2015-05-01", "freqratio", "10")
all_meassures <- cbind(tf_idf$word, poisson$word, z_score$word, freqratio$word)
#all_meassures <- cbind(poisson$word,freqratio$word, freqratio_old$word, poisson_old$word)
average_overlap_data <- multiple_average_overlap(all_meassures)
#Format data in data frame
average_overlap_data <- as.data.frame(average_overlap_data)
colnames(average_overlap_data) <- c("List","List_to_compare", "average_overlap")
average_overlap_data$List <- as.factor(average_overlap_data$List)
levels(average_overlap_data$List) <- c("tf-idf", "z-score","poisson", "freqratio" )
#levels(average_overlap_data$List) <- c("tf_idf","poisson", "z-score", "freqratio")
average_overlap_data$List_to_compare <- as.factor(average_overlap_data$List_to_compare)
#levels(average_overlap_data$List_to_compare) <- c("freqratio","freqratio_old", "poisson_old")
levels(average_overlap_data$List_to_compare) <- c( "z-score","poisson", "freqratio")
#result
average_overlap_data

# data frame as tex table
library(xtable)
xtable(average_overlap_data, label = 'AvarageOverlapComparison', caption = 'Avarage Overlap Comparison')
?xtable

#save as tsv
#header for tsv (to plot graph with d3
colnames(average_overlap_data) <- c("source", "target", "value")
write.table(average_overlap_data, file='Projects/Webprojects/wortschatzMitNeuemGraph/cooc-example/comparison.tsv', quote=FALSE, sep='\t',row.names = F)


## Load Libraries
library(caret)
#library(rattle)

train_processed <- read.csv("data/processed_train.csv")
summary(train_processed)

## Define train dataset, predictors and class label
trainData <- train_processed
predictors <- c("Pclass", "NameTitle", "Sex", "Age", "SibSp", "Parch", "Fare")

predictors
classLabel <- "Survived"

## Train classifier
fitControl <- trainControl (method = "repeatedcv", number = 10, repeats = 10,
                            classProbs = TRUE, summaryFunction = twoClassSummary)

fit.rpart <- train(trainData[,predictors], trainData[, classLabel], method = "rpart",
             trControl = fitControl, metric = "ROC")

fit.rf <- train(trainData[,predictors], trainData[, classLabel], method = "rf",
             trControl = fitControl, metric = "ROC")

## Print training results
print(fit.rpart)

#fancyRpartPlot(fit.rpart$finalModel)

print(fit.rf)


library(Hmisc)
library(RColorBrewer)
library(ggplot2)
library(sp)
library(rworldmap)
library(ggmap)
library(corrplot)

#set the working directory
setwd("C:/Users/evanf/Documents/Smurfit/Capstone/Final Submission")

# my data is saved as datax
datax <- read.csv("final_dataset.csv")
colnames(datax)[1] <- "link"
names(datax)

# check that it changed
names(datax)

# check for any missing values in the data
apply(is.na(datax), 2, sum)

# check for any duplicate values
sum (is.na(duplicated(datax)))

# Remove the non-useful text rows for now
datax <- subset(datax, select = - c(link, facilities, features, description))

####DATA EXPLORATION####
dim(datax)
names(datax)
str(datax)
head(datax)
summary(datax)
describe(datax)
tail(datax)
var(datax)
datax[1:5,]

attach(datax)

write.csv(table(datax$county), file = "county_count.csv")
table(datax$ber)
table(datax$dwelling_type)
table(datax$dwelling_type_name)
table(datax$town)
table(datax$bedrooms)
table(datax$bathrooms)
table(datax$price)
table(datax$north_south)
table(datax$newCounty)

TownNumber <- table(datax$newTown)
TownNumber
TownPrice <- aggregate(price ~ newTown, mean, data = datax)
TownPrice
TownPricePerMetre <- aggregate(price_per_m2 ~ newTown, mean, data = datax)
TownPricePerMetre

write.csv(TownNumber, file = "town_number.csv")
output_town <- (cbind(table(datax$newTown), "Town2"= TownPrice$newTown, "Price" = TownPrice$price, "Town3"= TownPricePerMetre$newTown, "PricePM" = TownPricePerMetre$price_per_m2))
write.csv(output_town, file = "town_prices.csv", row.names=FALSE)

data6 <- data.frame(table(datax$newCounty))
colnames(data6)[1] <- "Postcode"
colnames(data6)[2] <- "Count"

ggplot(data6, aes(x = Postcode, y = Count)) +
  geom_bar(stat = "identity")

ggplot(data6, aes(x = reorder(Postcode, -Count), y = Count)) +
  geom_bar(stat = "identity", width=0.7, fill="steelblue") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  theme(plot.title = element_text(hjust = 0.5)) +
  ggtitle("Number of Properties in Dataset from Each Postcode") +
  labs(x = "Postcode")

barplot(datax$newCounty)

# Change Price column to Numeric
datax$price = as.numeric(as.character(datax$price))
datax$price_per_m2 = as.numeric(as.character(datax$price_per_m2))
datax$longitude = as.numeric(as.character(datax$longitude))
datax$latitude = as.numeric(as.character(datax$latitude))
datax$log_price_m2 <- log(datax$price_per_m2)
datax$colour <- ifelse(datax$price_per_m2<2000, "black", ifelse(datax$price_per_m2<3000,"blue",ifelse(datax$price_per_m2<4000,"green",ifelse(datax$price_per_m2<5500,"yellow",ifelse(datax$price_per_m2<7000,"orange","red")))))

datax$colour
datax$log_price_m2

CountyPrice <- aggregate(price ~ newCounty, mean, data = datax)
CountyPrice
data1 <- CountyPrice[order(CountyPrice[,2],decreasing=TRUE),]
data1
barplot(data1[,2],names.arg=data1[,1],cex.names=0.8, cey.names = 0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Property Price By Dublin Postcode", ylim = c(0, 1200000))

CountyPricePerMetre <- aggregate(price_per_m2 ~ newCounty, mean, data = datax)
CountyPricePerMetre
data2 <- CountyPricePerMetre[order(CountyPricePerMetre[,2],decreasing=TRUE),]
data2
barplot(data2[,2],names.arg=data2[,1],cex.names=0.8,las=2, col=brewer.pal(5,"Pastel1"), main="Average Property Price Per Metre Squared By Dublin Postcode", ylab = "Price")

DwellingPrice <- aggregate(price ~ dwelling_type, mean, data = datax)
DwellingPrice
data5 <- DwellingPrice[order(DwellingPrice[,2],decreasing=TRUE),]
data5
barplot(data5[,2],names.arg=data5[,1],cex.names=0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Price By Dwelling Type", ylim = c(0, 1200000))

DwellingPrice <- aggregate(price ~ dwelling_type, mean, data = datax)
DwellingPrice
data5 <- DwellingPrice[order(DwellingPrice[,2],decreasing=TRUE),]
data5
barplot(data5[,2],names.arg=data5[,1],cex.names=0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Price By Dwelling Type", ylim = c(0, 1200000))

DwellingPricePM <- aggregate(price_per_m2 ~ dwelling_type, mean, data = datax)
DwellingPricePM
data10 <- DwellingPricePM[order(DwellingPricePM[,2],decreasing=TRUE),]
data10
barplot(data10[,2],names.arg=data10[,1],cex.names=0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Price By Dwelling Type", ylim = c(0, 8000))

datax$bedrooms <- ifelse(datax$bedrooms >= 8, "8+", datax$bedrooms)
table(datax$bedrooms)
BedPrice <- aggregate(price ~ bedrooms, mean, data = datax)
BedPrice
data3 <- BedPrice[order(BedPrice[,1],decreasing=FALSE),]
data3
barplot(data3[,2],names.arg=data3[,1],cex.names=0.8,las=0, col=brewer.pal(5,"Pastel1"), main="Average Property Price By Number of Bedrooms", ylab = "Price", xlab = "Bedrooms")

datax$bathrooms <- ifelse(datax$bathrooms >= 8, "8+", datax$bathrooms)
table(datax$bathrooms)
BathPrice <- aggregate(price ~ bathrooms, mean, data = datax)
BathPrice
data4 <- BathPrice[order(BathPrice[,1],decreasing=FALSE),]
data4
barplot(data4[,2],names.arg=data4[,1],cex.names=0.8,las=0, col=brewer.pal(5,"Pastel1"), main="Average Property Price By Number of Bathrooms", ylab = "Price", xlab = "Bathrooms")

BerPrice <- aggregate(price ~ ber_new, mean, data = datax)
BerPrice
data6 <- BerPrice[order(BerPrice[,1],decreasing=FALSE),]
data6
barplot(data6[,2],names.arg=data6[,1],cex.names=0.8,las=1, col=brewer.pal(5,"Pastel1"), main="Average Property Price By BER rating", xlab = "BER", ylim = c(0, 1200000))

DividePrice <- aggregate(price ~ north_south, mean, data = datax)
DividePrice
data7 <- DividePrice[order(DividePrice[,2],decreasing=TRUE),]
data7
barplot(data7[,2],names.arg=data7[,1],cex.names=0.8, cey.names = 0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Property Price By Side of City", ylim = c(0, 700000))

DividePricePM <- aggregate(price_per_m2 ~ north_south, mean, data = datax)
DividePricePM
data9 <- DividePricePM[order(DividePricePM[,2],decreasing=TRUE),]
data9
barplot(data9[,2],names.arg=data9[,1],cex.names=0.8, cey.names = 0.8, las=2, col=brewer.pal(5,"Pastel1"), main="Average Property Price By Side of City")

ggplot(data9)

geom_bar(aes(x=data7[,2], y=data7[,1]), fill="tan1", colour="sienna3")+
geom_line(aes(x=data9[,2], y=data9[,1]))

#  geom_text(aes(label=Rate, x=Year, y=Rate*max(df$Response)), colour="black")+
#  geom_text(aes(label=Response, x=Year, y=0.95*Response), colour="black")+
#  scale_y_continuous(sec.axis = sec_axis(~./max(df$Response)))

newmap <- getMap(resolution = "low")
plot(newmap, xlim = c(-6.5, -6), ylim = c(53.2, 53.5), asp = 1)
points(datax$latitude,datax$longitude , col = datax$colour,cex=0.9)
datax$latitude

dublin <- get_map("Dublin Airport,Ireland",zoom=10,maptype = "toner")

p<-ggmap(dublin)
p
p+geom_point(data=datax, aes(x = latitude, y = longitude),col=datax$colour)

# + scale_color_manual(values=c(`1`='blue', `0`='red')) + theme(legend.position = "right")

# geom_text(stat = 'count', aes(label = ..count..), vjust = 0)

# p+geom_density2d(data=datax,aes(x=latitude,y=longitude, fill = datax$price_per_m2),size=0.3)+stat_density2d(data=datax,aes(x=latitude,y=longitude, fill = ..level.., alpha = ..level..),size=0.1, bins = 64, geom = "polygon") + scale_fill_gradient(low = "green", high = "red") + scale_alpha(range = c(0, 0.3), guide = FALSE)
ggplot_build(p)

dev.off()
# Remove the non-useful text rows for now
datay <- subset(datax, select = c(price, bedrooms, bathrooms, area, newCounty, newTown, dwelling_type, ber_new, longitude, latitude, price_per_m2, north_south))

#####Correlation Plot#####
# corrplot(datay, method = "circle", na.label = "NA")
corrplot(cor(sapply(datay,as.numeric), use = "pairwise.complete.obs"),method = "number", title = "Corrplot for Daft data", mar=c(0,0,1,0))

corrplot(cor(sapply(datay,as.numeric), use = "pairwise.complete.obs"),method = "circle", title = "Corrplot for Daft data", mar=c(0,0,1,0))


## 1. Importing the Cleaned NYC Schools Data into R ##

library(readr)
sat_results <- read_csv("sat_results_1.csv")
ap_2010 <- read_csv("ap_2010_1.csv")
class_size <- read_csv("class_size_1.csv")
demographics <- read_csv("demographics_1.csv")
graduation <- read_csv("graduation_1.csv")
hs_directory <- read_csv("hs_directory_1.csv")

## 3. Parsing Numbers from Strings ##

graduation <- graduation %>%
  mutate(`Total Grads - % of cohort` = parse_number(`Total Grads - % of cohort`),
         `Dropped Out - % of cohort` = parse_number(`Dropped Out - % of cohort`))

## 4. Extracting Numeric Data From Strings: Creating New Variables ##

split_location <- str_split(hs_directory$`Location 1`, "\n", simplify = TRUE)
hs_directory <- hs_directory %>%
  mutate(lat_long = split_location[,3])

## 5. Splitting Strings ##

lat_and_long <- str_split(hs_directory$lat_long, ",", simplify = TRUE)

hs_directory <- hs_directory %>%
  mutate(lat = lat_and_long[,1], long = lat_and_long[,2])

## 6. Subsetting strings ##

hs_directory <- hs_directory %>%
  mutate(lat = str_sub(lat, 2, -1), long = str_sub(long, 1, -2))%>%
  mutate_at(vars(lat, long), as.numeric)

## 8. Inner Joins ##

sat_class_size <- sat_results %>%
  inner_join(class_size, by = "DBN")

ggplot(data = sat_class_size) +
      aes(x = avg_class_size, y = avg_sat_score) +
      geom_point()

## 9. Outer Joins ##

demo_sat_left <- sat_results %>%
  left_join(demographics, by = "DBN")

demo_sat_right <- sat_results %>%
  right_join(demographics, by = "DBN")

demo_sat_full <- sat_results %>%
  full_join(demographics, by = "DBN")

## 10. Using Joins to Create A Single Data Frame ##

combined <- sat_results %>%
  full_join(ap_2010, by = "DBN") %>%
  left_join(class_size, by = "DBN") %>%
  left_join(demographics, by = "DBN") %>%
  left_join(graduation, by = "DBN") %>%
  left_join(hs_directory, by = "DBN")

Data Analyst in R/Step 3 - Data Cleaning in R/1. Data Cleaning in R/2. String Manipulation and Relational Data.r


 DGELQF Example Program Results

 Minimum-norm solution(s)
             1          2
 1      0.2371     0.7383
 2     -0.4575     0.0158
 3     -0.0085    -0.0161
 4     -0.5192     1.0768
 5      0.0239    -0.6436
 6     -0.0543    -0.6613


# analysis2.r

sample_model_posterior_parameters <- function(model) {

    #' A single sample of model parameters from model's posterior
    #'
    #' Returns a list of sampled model parameters
	#'
    #' @param model Model dumped from rstan

    outs <- rstan::extract(model, permuted = TRUE) # posterior

    # ACP

	# t=1
    phi <- apply(outs$phi, 2, function(x) sample(x, 1))

	# t>1

	# Autoregressive portion
    alp <- apply(outs$alpha, 2, function(x) sample(x, 1))
    bet <- apply(outs$beta, 2, function(x) sample(x, 1))

    # Regression portion for intercept
	if("delta" %in% names(outs)) {
		coef0 <- apply(outs$delta[, , 1], 2, function(x) sample(x, 1))
    	coef1 <- apply(outs$delta[, ,2], 2, function(x) sample(x, 1))
	} else { # alternate name used in original Sedie code
		coef0 <- apply(outs$coef[, , 1], 2, function(x) sample(x, 1))
    	coef1 <- apply(outs$coef[, ,2], 2, function(x) sample(x, 1))
	}

    # Markov
    gam <- apply(outs$gamma, 2, function(x) sample(x, 1))
    eta <- apply(outs$eta, 2, function(x) sample(x, 1))

	list(
		phi=phi,

		gam=gam,
		eta=eta,

		coef0=coef0,
		coef1=coef1,
		alp=alp,
		bet=bet
	)

}

lam <- function(coef0, coef1, alpha, beta, lambda, y, grp, t) {

	# Calculate lambda
	exp(coef0[grp] + coef1[grp] * t) +
		alpha[grp] * y[t - 1] +
		beta[grp] * lambda[t - 1]
}

tht <- function(gam, eta, y, grp, t) {

	# Calculate theta
	z <- ifelse(y[t - 1] == 0, 1, 0)
	(z * gam[grp]) + ((1 - z) * eta[grp])

}

posterior_sim <- function(data, model) {

	#' A sample from posterior parameters for checking model fit
	#'
	#' Return sampled counts for each year by group
	#'
	#' @param over If over = T, use negative binomial, otherwise use
	#' zero-inflated Poisson

	# Sample from model posterior
	mp <- sample_model_posterior_parameters(model)
	list2env(mp, .GlobalEnv); rm(mp)

	# Number of groups
	p <- data$P

	sims <- list()
	for(g in seq(p)) { # by group

		# Offset segment starts at first year
		start <- data$str[g]
		end <- data$end[g]
		toff <- data$off[g, ][start:end]

		# Initialize parameters
		# & set first time point
		lambda <- c(phi[g])
		theta <- c(0)
		oo <- c(data$counts[g, start])

		for(t in seq(2, end - start + 1)) { # by time

			lambda[t] <- lam(
				coef0, coef1,
				alp, bet, lambda,
				y = oo,
				grp = g, t = t
			)

			theta[t] <- tht(
				gam, eta,
				y = oo,
				grp = g, t = t
			)

			oo[t] <- gamlss.dist::rZIP(
				n = 1,
				mu = (toff[t] + 1) * lambda[t],
				sigma = theta[t]
			)

		}

		oo <- c(rep(0, start - 1), oo) # pad with 0s
		sims[[g]] <- oo

	}

	sims # return counts
}

posterior_forecast <- function(data, ftime, model, offset = "random") {

	#' A sample from posterior parameters for
	#' predictions of time series
	#'
	#' Given a model, make predictions based on a predefined timestep
	#'
	#' @param data Data as output by initial data processing step
	#' i.e. count_info.data.R
	#' @param ftime Number of years to predict
	#' @param model rStan model i.e. fit.data
	#' @param offset Offset type, either "random", "decrease" or "constant"

	#' "random" represents the last previous years
	#' "decrease" represents a 3% decrease per year
	#' "constant" represents the same as previous years

	# Sample from model posterior
	mp <- sample_model_posterior_parameters(model)
	list2env(mp, .GlobalEnv); rm(mp)

	# Number of groups
	p <- data$P

	forecast <- list()
	for(g in seq(p)) { # by group

		# Offset segment starts at first year
		start <- data$str[g]
		end <- data$end[g]
		all_toff <- data$off[g, ][start:end]

		# Generate offset segment
		len <- length(all_toff)
		if (offset == "random") {
			# by sampling past ftime of offsets
			toff <- sample(all_toff[(len-ftime):len], ftime, replace = TRUE)
		} else if (offset == "constant") {
			toff <- rep(all_toff[len], ftime)
		} else if (offset == "decreasing") {
			toff <- c(all_toff[len])
			for(i in 1:ftime) {
				toff <- c(toff, round(toff[i]*0.03, 0))
			}
		}

		# Initialize parameters
		# & set first time point
		oo <- data$counts[g, end] # final year's count

		lambda <- c(oo)
		theta <- c(0)
		co <- c(oo) # forecast

		for(t in 2:ftime) { # by time

			lambda[t] <- lam(
				coef0, coef1,
				alp, bet, lambda,
				y = oo,
				grp = g, t = t
			)

			theta[t] <- tht(
				gam, eta,
				y = oo,
				grp = g, t = t
			)

			co[t] <- gamlss.dist::rZIP(
				n = 1,
				mu = (toff[t] + 1) * lambda[t],
				sigma = theta[t]
			)

			oo[t] <- co[t] # current count becomes next expected count

		}

		forecast[[g]] <- co
	}

	forecast
}

# analysis3.r

log_chain_sampling <- function(fit, dir_model_folder) {

	# Filter for chains that did not mix
	badchain <- data.table(summary(fit)$summary)[Rhat > 1.1 | Rhat < 0.9]
	output <- paste0(dir_model_folder, "output/chain_sampling.txt")

	# Write warning output
	if (nrow(badchain) > 0) {

		sink(output)
		cat(
			"Chains not converged.
			Increase iterations in sampling in stan() function
			call in code/model.r.
			Do not interpret model results as parameter estimates are
			currently highly unstable."
		)
		sink()

	} else {

		sink(output)
		cat(
			"Chains have converged. Model results robust to posterior sampling."
		)
		sink()

	}

}

convert_data_to_df <- function(data) {

	print("----------- Convert data to df (cumulative sum from counts)")
	# Cumulative series for observed data
	cumm <- lapply(seq(data$P), function(ii) { # each group

		data.frame(
			index = 1:data$end[ii],                 # index (offset "year")
			value = data$counts[ii, ],              # count
			cml_value = cumsum(data$counts[ii, ]),  # cumulative
			off = data$off[ii, ],                   # tax. effort
			group = ii
		)

	}) %>% rbind.fill

	cumm$sim <- 0 # set sim to 0 to indicate that it is observed data
	cumm
}

convert_allsim_to_df <- function(allsim, data) {

	print("----------- Convert allsim to df (cumulative sum from counts)")

	# Cumulative series for simmed data
	cumsim <- lapply(seq(length(allsim)), function(jj) { # each sim

		lapply(seq(data$P), function(ii) { # each group

			data.frame(
				index = 1:data$end[ii],
				value = allsim[[jj]][[ii]],
				cml_value = cumsum(allsim[[jj]][[ii]]),
				off = data$off[ii, ],
				group = ii,
				sim = jj
			)

		}) %>% rbind.fill
	}) %>% rbind.fill

	cumsim
}

create_Z <- function(cum, cumsim, data_raw) {

	Z <- rbind(cum, cumsim) # combine obs/ sim
	Z$year <- Z$index + min(data_raw$year) - 1 # add original year

	Z
}

summarize_simulations_observed <- function(data, allsim) {

	cum <- convert_data_to_df(data)
	cumsim <- convert_allsim_to_df(allsim, data)
	Z <- create_Z(cum, cumsim, data_raw)

	# Cumulative count (last year): Simulated/sampled data from posterior
	print("----------- Summarize 80 CI for simulations")
	sum_y <- data.table(Z)[
		sim != 0 & index == max(index),
		list(
			med = median(cml_value),
			lower = quantile(cml_value, probs = 0.1),
			upper = quantile(cml_value, probs = 0.9)
		),
		by = "group"
	]

	# Cumulative count (last year): Observed data
	print("----------- Get maximum count for observed data")
	obs_count <- data.table(Z)[
		sim == 0 & index == max(index),  # sim == 0 is observed data
		list(count = cml_value),
		by = "group"
	]

	list(Z = Z, sum_y = sum_y, obs_count = obs_count)

}

extract_delta <- function(fit) {

	print("----------- Extract & summarize coefficients from delta")

	# outs$delta[, ,2] is the coefficient that estimates the long-term trend in
	# description rate, it's in log units, i.e. need to exponentiate it

	# where 0 means stable trend, positive means increasing description
	# through time and negative is decreasing...

	# `coef` is an array where
	# [posterior sample [1:N samples],
	# group number[1:N groups], coefficient[1:2]]

	coef <- rstan::extract(fit, par = "delta")[[1]]

	group_cf1 <- apply(coef, 1, function(i) i[, 1]) # intercept
	group_cf2 <- apply(coef, 1, function(i) i[, 2]) # coef * year

	# get mean and 80 CI of coefficient (representing slow down)
	cf2_ci80 <- data.frame( t(apply(
		group_cf2,
		1,
		quantile,
		probs = c(0.1, 0.9)
	)) )

	names(cf2_ci80) <- c("prob10", "prob90")

	cf2 <- cbind(data.frame(
		group = 1:nrow(group_cf2),
		slowdown = apply(group_cf2, 1, mean)
	), cf2_ci80)

	list(cf2 = cf2, group_cf1 = group_cf1, group_cf2 = group_cf2)

}

combine_results <- function(sum_y, obs_count, cf2, mapping) {

	# Compile results into table
	rows <- as.numeric(rownames(obs_count))
	matched <- match(rows, mapping[, 2])

	results <- data.table(
		group = mapping[matched, 2],
		groupname = mapping[matched, 1],

		observed_species = obs_count$count,

		expected_median = round(sum_y$med, 0),
		expected_CI_lower = round(sum_y$lower, 0),
		expected_CI_higher = round(sum_y$upper, 0),

		# long-term trend coef
		slowdown = round(signif(cf2$slowdown, 3), 4),
		slowdown_CI_lower = round(signif(cf2$prob10, 3), 4),
		slowdown_CI_higher = round(signif(cf2$prob90, 3), 4),

		row.names = NULL
	)

	results <- results[order(-slowdown)]

	results
}

prepare_plot1_2_data <- function(Z) {

	print("----------- Prepare plot 1/2 data - observed data")

	# Observed data
	obs <- data.table(Z)[sim == 0] # subset to observed series

	print("----------- Prepare plot 1/2 data - simulations")
	# Simulated data (sample 200 time series from each group) for plotting
	sims <- Z %>% filter(sim != 0) %>% # subset a sample of simmed series
		split( . , .$group) %>%   # group by group
		lapply( . , function(oo){ # for each group

			ids <- sample(unique(oo$sim), 200)
			oo[oo$sim %in% ids, ]

		}) %>% rbind.fill

	# Only plot sims that have
	# less that 4 times the max observed value (of all groups)
	# and with the max year (to remove duplicates)
	goodsims <- data.table(sims)[
		year == max(year) & cml_value < max(obs$cml_value) * 4,
		c("group", "sim")
	]

	sims <- inner_join(sims, goodsims, by = c("group", "sim"))

	list(sims = sims, obs = obs)
}

save_plot1 <- function(sims, obs, labels, dir_model_folder) {

	#-------------------
	# Plot #1
	#-------------------
	output1 = paste0(dir_model_folder, "output/cumulative_fit.pdf")
	output2 = paste0(dir_model_folder, "output/cumulative_fit.png")
	print(paste0("Plotting cumulative_fit.pdf"))

	# Plot cumulative counts
	P <- ggplot() +
		geom_path(
			data = sims,
			aes(x = year, y = cml_value, group = sim),
			col = "skyblue2", alpha = 0.1
		) +
		geom_path(data = obs, aes(x = year, y = cml_value)) +
		facet_wrap(~group, labeller = as_labeller(labels), scales = "fixed") +
		ylab("Number of species\n") +
		xlab("Year") + theme +
		scale_y_continuous(limits = c(0, 6000))

	ggsave(P, file = output1, width = 10, height = 6)
	ggsave(P, file = output2, width = 10, height = 6)

}

save_plot2 <- function(sims, obs, labels, dir_model_folder) {

	#-------------------
	# Plot #2
	#-------------------
	output = paste0(dir_model_folder, "output/count_fit.pdf")
	print(paste0("Plotting count_fit.pdf"))

	# Using the same data as Plot #1
	# Plot per year counts
	P <- ggplot() +
		geom_path(
			data = sims,
			aes(x = year, y = value, group = sim),
			col = "skyblue2", alpha = 0.1
		) +
		geom_path(data = obs, aes(x = year, y = value)) +
		facet_wrap(~group, labeller = as_labeller(labels), scales = "free_y") +
		ylab("Number of species") +
		xlab("Year") +
		theme

	ggsave(P, file = output, width = 10, height = 6)

}

prepare_plot3_data <- function(data, data_raw, group_cf1, group_cf2) {

	print("----------- Prepare plot 3 data - omega")

	# Prepare data

	# Calculate omega ("long term trend fit") for PLOTTING
	# note: initial code labelled "lambda",
	# now changed to "omega" (to clarify with authors)
	omega <- lapply(seq(data$P), function(ii) { # for each group

		cf1 <- group_cf1[ii, ]
		cf2 <- group_cf2[ii, ] # "long-term trend coefficient"

		time <- 1:data$end[ii]
		duration <- max(time) - rev(time)

		cpair <- lapply(1:length(cf1), function(kk) { # each coefficient pair

			d0 <- cf1[kk]
			d1 <- cf2[kk]
			om <- exp(d0 + d1 * time)

			cbind(time = duration, om, group = ii, sim = kk)

		})

		res <- data.frame(do.call(rbind, cpair))
		res

	}) %>% rbind.fill

	# Add original year back
	omega$year <- omega$time + min(data_raw$year)

	# Set up plotting data for long-term trends
	sims <- omega %>%
		split(., .$group) %>%
		lapply(., function(oo){            # for each group

			ids <- sample(unique(oo$sim), 200)
			oo[oo$sim %in% ids, ]

	}) %>% rbind.fill

	# Mean line per group
	om_mean <- data.table(sims)[,
		list(mean = mean(om)),
		by = c("group", "year")
	]

	list(sims = sims, om_mean = om_mean)

}

save_plot3 <- function(obs, sims, om_mean, labels, dir_model_folder) {

	#-------------------
	# Plot #3
	#-------------------

	output = paste0(dir_model_folder, "output/regression.pdf")
	print(paste0("Plotting regression.pdf "))

	# Plot long-term trends
	P <- ggplot() +
		geom_path(data = obs, aes(x = year, y = (value/(off+1)))) +
		geom_line(
			data = sims, aes(x = year, y = om, group = sim),
			col = "skyblue2", alpha = 0.1
		) +
		geom_line(data = om_mean, aes(x = year, y = mean), col = "royalblue") +
		facet_wrap(~group, labeller = as_labeller(labels), scales = "free_y") +
		ylab("Number of species") +
		xlab("Year") +
		theme

	ggsave(P, file = output, width = 10, height = 6)
}

convert_forecast_to_df <- function(data, data_raw, forecast) {

	print("----------- Convert forecast to df (cumulative sum from count)")

	myears <- ncol(data$counts)             # number of years used in modelling
	fyears <- length(forecast[[1]][[1]])    # number of forecast years
	min_year <- min(data_raw$year) # earliest year used in modelling
	index <- ((myears + 1):(myears + fyears)) + min_year - 1 # forecast years

	# Forecast coerce to data.frame from list of list and sum counts
	forsim <- lapply(seq(length(forecast)), function(jj) { # each simulation
	# note: there should be 1000 simulations

		lapply(seq(data$P), function(ii) { # each group

			data.frame(
				index = index,
				value = cumsum(forecast[[jj]][[ii]]), # sum the poisson counts
				group = ii,
				sim = jj
			)

		}) %>% rbind.fill
	}) %>% rbind.fill

	forsim

}

summarize_forecasts <- function(data, data_raw, forecast, obs) {

	# forecast coerced to data.frame from list of list and sum counts
	forsim <- convert_forecast_to_df(data, data_raw, forecast)

	print("----------- Summarize forecast results")
	# For each group and each sim, find the mean and CI of cumsums

	last_observed_count <- data.table(obs)[
		, list(cml_value = max(cml_value)), by = "group"
	]

	forsim <- data.table(forsim)

	fore_results <- forsim[,
		list(
			value = max(value), # highest value
			index = max(index)  # for the last year
			),
		by = c("group", "sim")
	][,
		list(
			fore_mu = round(mean(value), 0),
			fore_lower = round(quantile(value, 0.1), 0) ,
			fore_upper = round(quantile(value, 0.9), 0)
		),
		by = "group"
	]

	# Note: in original code but commented out
	# Add to observed count from last year
	# fore_results <- merge(fore_results, last_observed_count, by = "group")
	# fore_results$fore_mu <- fore_results$fore_mu + fore_results$cml_value
	# fore_results$fore_lower <- fore_results$fore_lower + fore_results$cml_value
	# fore_results$fore_upper <- fore_results$fore_upper + fore_results$cml_value
	# fore_results$cml_value <- NULL

	fore_results

}

output_results_csv <- function(results, forecast_results, dir_model_folder) {

	print("Generating output.csv table")

	# Merge to Results table

	final_results <- merge(results, forecast_results, by = "group")

	final_results <- final_results[order(-observed_species)]

	output <- paste0(dir_model_folder, "output/results.csv")
	write.csv(final_results, file = output, row.names = FALSE)

}


x1<-"trainResized"                                               // Training dataset
x2<-"testResized"                                                // Test dataset
setwd("C:/Users/Shubha/AppData/Local/Julia-0.3.0")
Y <- read.csv("trainLabels.csv")                                 // Training labels

 library(bmp)
 img<-read.bmp(file.path(getwd(),x1,"1.bmp"))                    // RGB to Grayscale conversion of "1.bmp"
 r<-0.299*img[,,1]
 g<-0.587*img[,,2]
 b<-0.114*img[,,3]
 img_grayscale<-r+g+b
 image(img_grayscale)
 image(img_grayscale,col=gray.colors(12))

for(i in1:6283)                                                  // Number of training examples is 6283
{img<-read.bmp(file.path(getwd(),x1,paste0(i,".bmp")))           // Reading each bitmap image from the training dataset
if(min(dim(img)==3))                                             // Go for RGB to Grayscale conversion if the image is 3D
{
r<-0.299*img[,,1]                                                // RGB to GrayScale Conversion
g<-0.587*img[,,2]
b<-0.114*img[,,3]
img_grayscale<-r+g+b
}
else
img_grayscale<-img
X[i,]<-img_grayscale                                             // Stack of all unidimensional images to be stored in 1 big matrix
}

Xtrain<-X[1:as.integer(dim(X)[1]*0.8),]
Ytrain<-Y[1:as.integer(dim(Y)[1]*0.8),]                          // Splitting the training dataset & labels in the 80:20 data
dim(Xtrain)
dim(Ytrain)

Xvalidate<-X[as.integer(dim(X)[1]*0.8):6283,]
Yvalidate<-Y[1:as.integer(dim(X)[1]*0.8),]
dim(Xvalidate)
dim(Yvalidate)


cat("Calculating likelihoods under different motif lengths...\n")
# Calculate likelihoods
rates_full$logLik1 <- dbinom(rates_full$num,
  rates_full$COUNT,
  rates_full$rel_prop1, log=T)

rates_full$logLik3 <- dbinom(rates_full$num,
  rates_full$COUNT,
  rates_full$rel_prop3, log=T)

rates_full$logLik5 <- dbinom(rates_full$num,
  rates_full$COUNT,
  rates_full$rel_prop5, log=T)

rates_full$logLik7 <- dbinom(rates_full$num,
  rates_full$COUNT,
  rates_full$rel_prop, log=T)

ra1<-rates_full %>%
  group_by(Category2) %>%
  summarise(L1=-2*sum(logLik1),
    L3=-2*sum(logLik3),
    L5=-2*sum(logLik5),
		L7=-2*sum(logLik7))

ra1a<-gather(ra1, model, log, L1:L7)

ra1a$k <- c(rep(1,9),
  c(rep(16,3), rep(12,3), rep(4,3)),
  c(rep(256,3), rep(192,3), rep(64,3)),
	c(rep(4096,3), rep(3072,3), rep(1024,3)))

ra1a$AIC <- 2*ra1a$k+ra1a$log

ra1c <- merge(ra1a, rates1, by="Category2")
# ra1c$BIC <- ra1c$k*log(ra1c$num1)+ra1c$log

ra1b <- gather(ra1c, stat, L, c(log, AIC))
levels(ra1b$model) <- c("1", "3", "5", "7")

levels(ra1b$stat) <- c("-2ln(L)", "AIC")
names(ra1b) <- c("Category", "Motif_Length", "k", "COUNT",
  "num1", "rel_prop", "Stat", "L")

# Plot AIC and -2log(L) for each category
cat("Plotting likelihood curves...\n")
ggplot(ra1b, aes(x=Motif_Length, y=L, group=Stat, colour=Stat))+
  scale_colour_brewer(palette="Set1")+
  geom_point()+
  geom_line()+
  facet_wrap(~Category, scales="free")+
  theme_bw()+
  xlab("Motif Length")+
  theme(axis.title.y=element_blank(),
    legend.title=element_blank())

ggsave("/net/bipolar/jedidiah/mutation/images/compare_AIC.png")

rf2<-rates_full %>%
  group_by(Category2, Seq3) %>%
  summarise(s3=-2*sum(logLik3), s5=-2*sum(logLik5)) %>%
  ungroup() %>%
  arrange(Category2, desc(s5)) %>%
  group_by(Category2) %>%
  mutate(D3_5=s5-s3,s3s=sum(s3)) %>%
  arrange(D3_5) %>%
  mutate(D3_5c=cumsum(D3_5),
    L=s3s+D3_5c,
    rk=rank(-L),
    rk2=max(rk)-rk+16*rk,
    rk3=rk2,
    gp="3>5")

rf3 <- rates_full %>%
  group_by(Category2, Seq5) %>%
  summarise(s5=-2*sum(logLik5), s7=-2*sum(logLik7)) %>%
  ungroup() %>%
  arrange(Category2, desc(s7)) %>%
  group_by(Category2) %>%
  mutate(D5_7=s7-s5,s5s=sum(s5)) %>%
  arrange(D5_7) %>%
  mutate(D5_7c=cumsum(D5_7),
    L=s5s+D5_7c,
    rk=rank(-L),
    rk2=max(rk)-rk+16*rk,
    rk3=min(rk2)+min(rk2)*rk2/max(rk2),
    gp="5>7")

names(rf3)[2] <- "Sequence"
names(rf2)[2] <- "Sequence"

rfc <- rbind(dplyr::select(rf2, Category2, Sequence, L, rk, rk2, rk3, gp),
  dplyr::select(rf3, Category2, Sequence, L, rk, rk2, rk3, gp))

write.table(ra1b, "/net/bipolar/jedidiah/mutation/ra1b.txt", col.names=T, row.names=F, quote=F, sep="\t")

l1ll <- ra1b %>%
  filter(Motif_Length %in% c("L1", "L3"), Stat=="log") %>%
  dplyr::mutate(Sequence=substr(Category, 1,1), rk=5, rk2=k,
    rk3=min(rk2)+min(rk2)*rk2/max(rk2), gp=Motif_Length) %>%
  dplyr::select(Category2=Category, Sequence, L, rk, rk2, rk3, gp)

rfc2 <- merge(rbind(l1ll, rfc), rates1, by="Category2")

rfc2$AIC <- 2*rfc2$rk2 + rfc2$L
rfc2$BIC <- rfc2$rk2*log(rfc2$num1) + rfc2$L

rfc3<-gather(rfc2, z=AIC:BIC)

ggplot(rfc3, aes(x=rk3, y=value, group=key, colour=key))+
  scale_x_continuous(expand = c(.15, .15))+
  scale_y_continuous(expand = c(.1, .1))+
  scale_colour_brewer(palette="Dark2")+
  geom_point(size=4, aes(alpha=0.4))+
  facet_wrap(~Category2, scales="free")+
  theme_bw()+
  ylab("-2log(L)")+
  theme(axis.title.x=element_blank(),
    axis.text.x=element_blank(),
    axis.title.y=element_text(size=16),
    axis.text.y=element_text(size=14),
    strip.text.x = element_text(size=16),
    legend.title=element_blank(),
    legend.text=element_text(size=16))

ggsave("/net/bipolar/jedidiah/mutation/images/compare_AIC-BIC_full.png",
  width=12, height=12)

ggplot(rfc2, aes(x=rk3, y=L))+
  scale_x_continuous(expand = c(.15, .15))+
  scale_y_continuous(expand = c(.1, .1))+
  scale_colour_brewer(palette="Set1")+
  geom_point(size=4, aes(colour=gp))+
  geom_line()+
  geom_text(size=6, angle=10,
    aes(label=ifelse(rk<5, as.character(Sequence), ''),
      hjust=rep(c(1,-0.5), length.out=length(Sequence)),
      vjust=0.5))+#rep(c(.5,-.5), length.out=length(Sequence))))+
  facet_wrap(~Category2, scales="free")+
  theme_bw()+
  ylab("-2log(L)")+
  theme(axis.title.x=element_blank(),
    axis.text.x=element_blank(),
    axis.title.y=element_text(size=16),
    axis.text.y=element_text(size=14),
    strip.text.x = element_text(size=16),
    legend.title=element_blank(),
    legend.text=element_text(size=16))

ggsave("/net/bipolar/jedidiah/mutation/images/compare_LL_full.png",
  width=12, height=12)