R/converters.R

In DistributionalDDA: Distributional Data Analysis in Bayes Spaces

#### as.BDataSplines ---------------------------------------------------------
#' Convert distributional data to a spline representation
#'
#' Returns a dataset of densities represented by zero-integral B-spline (ZB-spline)
#' coefficients in a [BDataSplines] object. The spline representation is the compact
#' form used for computation (PCA, distances, inner products). The conversion relies on
#' a [BayesSpaceBasis] that is either taken from the object or supplied via `basis`.
#'
#' @note When converting from densities, log-densities or PDFs, the spline coefficients
#'   are the L2 projection onto the (non-orthonormal) ZB-spline basis: they solve the
#'   normal equations `S c = <f, zeta>` with the Gram matrix `S = getMetricTensor(basis)`
#'   (see [getMetricTensor]). The inner products `<f, zeta>` are estimated by Monte-Carlo
#'   integration over the reference-measure sample, so the coefficients carry a small
#'   sampling error that decreases as the sample size grows.
#'
#' @param X a dataset of densities/distributions in any form
#' @param ... further arguments passed to the method supporting conversion
#' @param basis "BayesSpaceBasis" object to use
#'
#' @return A distributional data container of class [`BDataSplines`].
#' @seealso [as.BDataDensities], [BayesSpaceBasis], [getMetricTensor]
#' @export
#' @family BayesSpaceConverters
#' @examples
#' X = BDataDensities(list(\(x) x, \(x) x^2),basis=B2Unif01Basis5)
#' as.BDataSplines(X)
#' as.BDataSplines(as.BDataSplines(X))
#' as.BDataSplines(as.BDataLogDensities(X))
#' \donttest{as.BDataSplines(BDataSamples(replicate(10,runif(100),simplify=FALSE),basis=B2Unif01Basis5))}
as.BDataSplines = function(X,...) UseMethod("as.BDataSplines",X)


# #' @describeIn as.BDataSplines method for BDataSplines
# #' @export
# #' @method as.BDataSplines BDataSplines
# #'
# as.BDataSplines.BDataSplines = function(X,...,basis) {
#     if( !missing(basis) && getBayesSpaceBasis(X) != basis )
#         return(BDataSplines(X,...,basis=basis))
#     else
#         X
# }

# There is a second somewhere else in the code
# ' @describeIn as.BDataSplines method for BDataGeneral
# ' #' @export
# ' @method as.BDataSplines BDataGeneral
# as.BDataSplines.BDataGeneral = function(X,...,basis=getBayesSpaceBasis(X)) {
#  # TODO: Check for transposition.
#  BDataSplines( t(sapply(X,getSplineCoefs,basis=basis)),
#                  basis=basis)
# }

#' @describeIn as.BDataSplines method for BDataLogDensities
#' @export
#' @method as.BDataSplines BDataLogDensities
as.BDataSplines.BDataLogDensities = function(X,...,basis=getBayesSpaceBasis(X)) {
  # TODO: Check for transposition.
  BDataSplines( t(sapply(X,.SplineCoefsFromLogDensity,basis=basis)),
                  basis=basis)
}

#' @describeIn as.BDataSplines method for BDataLogPDFs
#' @export
#' @method as.BDataSplines BDataLogPDFs
as.BDataSplines.BDataLogPDFs = function(X,...,basis=getBayesSpaceBasis(X)) {
  as.BDataSplines(as.BDataLogDensities(X),...,basis=basis)
}

#' @describeIn as.BDataSplines method for BDataPDFs
#' @export
#' @method as.BDataSplines BDataPDFs
as.BDataSplines.BDataPDFs = function(X,...,basis=getBayesSpaceBasis(X)) {
  as.BDataSplines(as.BDataLogDensities(X),...,basis=basis)
}


#' @describeIn as.BDataSplines method for BDataDensities
#' @export
#' @method as.BDataSplines BDataDensities
as.BDataSplines.BDataDensities = function(X,...,basis=getBayesSpaceBasis(X)) {
  # TODO: Check for transposition.
  BDataSplines( t(sapply(X,.SplineCoefsFromDensity,basis=basis)),
                  basis=basis)
}

#' @describeIn as.BDataSplines method for BDataSplines, eventually reprojects if basis given
#' @export
#' @method as.BDataSplines BDataSplines
as.BDataSplines.BDataSplines = function(X,...,basis=getBayesSpaceBasis(X)) {
    if( hasSameBayesSpaceBasis(basis,X) )
        X
    else
        ## wrap the reprojected coefficients back into a BDataSplines so a basis
        ## change returns a classed object, not a bare matrix (consumers such as
        ## scalarProduct reproject internally and need the class).
        BDataSplines(reproject(X,basis=basis),basis=basis)
}

#' @describeIn as.BDataSplines method for BDataSamples
#' @export
#' @method as.BDataSplines BDataSamples
as.BDataSplines.BDataSamples = function(X,...,basis=getBayesSpaceBasis(X)) {
    x=t(sapply(X,FisherScoringEstimation,basis=basis))
    reportIfNot( is.matrix(x),myx=x)
    BDataSplines(x, basis=basis)

}

#' #' @describeIn as.BDataSplines method for BDataSamples
#' #' @export
#' #' @method as.BDataSplines BDataSamples
#' as.BDataSplines.BDataSamples = function(X,...,basis=getBayesSpaceBasis(X)) {
#'     x=t(sapply(X,FisherScoringEstimation,basis=basis))
#'     reportIfNot( is.matrix(x),myx=x)
#'     BDataSplines(x, basis=basis)
#' }



#' @describeIn as.BDataSplines method for BDataGeneral
#' @export
#' @method as.BDataSplines BDataGeneral
as.BDataSplines.BDataGeneral = function(X,...,basis=getBayesSpaceBasis(X)) {
    XX=lapply(X,as.BDataSplines,basis=basis)
    Len = lapply(XX,nrow)
    if( any(Len!=1) )
        stop("as.BDataSplines.BDataGeneral: item(s) ",Len!=1," have ", Len , "elements. Should be one.")
    BDataSplines(t(simplify2array(XX,higher=FALSE,except=NULL)), basis=basis)
}

#' @describeIn as.BDataSplines method for function interpreted as
#'     density with respect to the reference measure.
#' @export
#' @method as.BDataSplines function
as.BDataSplines.function = function(X,...,basis=getBayesSpaceBasis(X)) {
    BDataSplines( .SplineCoefsFromDensity(X,basis=basis),
                  basis=basis)
}

#' @describeIn as.BDataSplines method for function interpreted as
#'     density with respect to the reference measure. (TODO: Uses a
#'     very crude heuristic to estimate the log density)
#' @export
#' @method as.BDataSplines histogram
as.BDataSplines.histogram = function(X,...,basis=getBayesSpaceBasis(X)) {
    as.BDataSplines(as.BDataLogDensities(as.BDataHistograms(list(X),...,basis=basis)))
}


#' @export
#' @describeIn as.BDataSplines the distributions corresponding to the basis
#'             elements.
#' @method as.BDataSplines BayesSpaceBasis
as.BDataSplines.BayesSpaceBasis <- function(X,...) {
  BDataSplines(as.matrix(diag(getDimension(X))),basis=X,...)
}


#### END as.BDataSplines ---------------------------------------------------


#### as.BDataFrequencyHistograms -----------------------------------------------
#' Converts to a BDataFrequencyHistograms
#'
#' Only samples and BDataFrequencyHistograms themselfs can be
#' effectively converted to histograms, because all other representations
#' lack information on the certainty
#'
#' @param X an object representing a dataset
#' @param breaks the breaks parameters of the [hist] function for R
#' @param ... further generic paramters for [hist]
#' @param basis the BayesSpaceBasis marking the BayesSpace and that
#'     shall be use for if a BayesSpaceBasis is needed for an
#'     operation.
#'
#' @returns a BDataFrequencyHistograms object representing the same dataset
#' @family BayesSpaceConverters
#' @export
#'
#' @examples
#' Xsamples = BDataSamples(lapply(1:10,function(i) runif(100)),basis=B2Unif01Basis5)
#' Xhist    = as.BDataFrequencyHistograms(Xsamples)
#'
as.BDataFrequencyHistograms = function(X,...) UseMethod("as.BDataFrequencyHistograms",X)


#' @describeIn as.BDataFrequencyHistograms method for BDataUnivariateSamples
#' @importFrom graphics hist
#' @export
#' @method as.BDataFrequencyHistograms BDataUnivariateSamples
as.BDataFrequencyHistograms.BDataUnivariateSamples = function(X, breaks="Sturges", ...,basis=getBayesSpaceBasis(X)) {
  if(is(breaks, "character")) {
    x = unlist(unclass(X))
    x = c(range(x), sample(x, size=median(sapply(X, length))))
    breaks = graphics::hist(x, breaks=breaks, plot = FALSE, ...)$breaks
  }
  matrixCounts = sapply(X, function(x)graphics::hist(x, breaks=breaks, plot = FALSE,...)$counts) |> t()
  return(BDataFrequencyHistograms(matrixCounts, breaks, basis=as.BayesSpaceBasis(basis)))
                                        # TODO: for the moment, this function just feeds forward `basis` to the constructor
                                        #    without operating with it. This has possibly to change.
}


#' Build a distributional dataset as histograms from a list
#'
#' Constructor for a distributional data set of class "BDataFrequencyHistograms"
#' out of a list of either precalculated histograms or of numeric vectors.
#'
#' @param X "list" of histograms or of numeric vectors
#' @param breaks breaks to be used; if `X` is a list of numeric vectors, it admits
#' the same possibilities as the same argument of [graphics::hist()]
#' @param basis "BayesSpaceBasis" object to use
#' @param ... further arguments passed to [graphics::hist()]
#'
#' @return A distributional data container of class [`BDataFrequencyHistograms`].
#' @export
#' @family BDataHistograms
#' @method as.BDataFrequencyHistograms list
#' @importFrom methods is
#' @importFrom stats runif
#' @importFrom stats median
#' @examples
#' x = lapply(rep(1000,4), runif)
#' as.BDataFrequencyHistograms(x, breaks="Sturges",basis=B2Unif01Basis5)
as.BDataFrequencyHistograms.list = function(X, breaks, basis,...) {    # TODO: the basis should provide info from the support and this should be exploited here
    # case the list contains histograms
    if(all(sapply(X,is, "histogram"))) {
    # warning("list of base `graphics::hist()` objects found: assuming same breaks everywhere") # This is checked not warned
        matrixCounts = sapply(X, function(x)x$counts) |> t() # transpose
        breakList =  lapply(X, function(x)x$breaks)
        if( missing(breaks) || is.null(breaks) )
            breaks= breakList[[1]]
        if( !all(sapply(breakList, function(x) all(x==breaks))) )
            stop("incompatible `breaks` provided")
                            # case the list contains vectors of data
    } else if(all(sapply(X,is, "numeric"))) {
    # warning("list of numeric values found: assuming these are vectors of values everywhere")
    if(missing(breaks)) breaks = "Sturges"
    if(is(breaks, "character")) {
      x = unlist(X)
      x = c(range(x), sample(x, size=median(sapply(X, length))))
      breaks = graphics::hist(x, breaks=breaks, plot = FALSE, ...)$breaks
    }
    matrixCounts = sapply(X, function(x) graphics::hist(x, breaks=breaks, plot = FALSE,...)$counts) |> t()
  } else {
      stop("List is neither histograms nor data:",
           paste0(sapply(X,class), collapse=",")
      )
  }
  basis = getBayesSpaceBasis(basis)
  return(BDataFrequencyHistograms(matrixCounts, breaks, basis=basis))
  # TODO: for the moment, this function just feeds forward `basis` to
                                        #    the constructor without
                                        #    operating with it. This
                                        #    has possibly to change.
                                        #    Reasonable operation:
                                        #    check that it is a basis,
                                        #    check that supports
                                        #    match.
}

#### as.BDataHistograms

#' Represent data as a BDataHistogram (BDataDensityHistogram or BDataFrequencyHistogram
#'
#' The function tries to guess whether its datasets, distributions,
#' Histograms,...
#'
#' @param X a list of objects (or single object) that is a numeric
#'     sample, a histogram (with or without a counts), or a BData
#'     object
#' @param ... further arguments to [graphics::hist]
#' @param breaks the common breaks. If the data is provided as
#'     histograms it should already be provide with these breaks
#' @param basis the BayesSpaceBasis to be used in the resulting
#'     BayesSpace, if required
#' @param nsim the number of points to simulate if the data is
#'     provided as a distribution. If NULL no simulation is done.
#' @param seed the seed to used if data is simulated (use with care)
#'
#' @returns either a BDataFrequencyHistograms (if counts are
#'     availalbe) , or a BDataDensityHistograms object if only
#'     densities are known
#'
#' @family BayesSpaceConverters
#' @export
#'
#' @examples
#' myBreaks = seq(0,1,by=0.2)
#' as.BDataHistograms(replicate(10,runif(100),simplify=FALSE),
#'                    breaks=myBreaks,basis=B2Unif01Basis5)
#'
as.BDataHistograms = function(X,...) UseMethod("as.BDataHistograms",X)

#' @export
#' @describeIn as.BDataHistograms method for lists of possibly heterogenious data
#' @method as.BDataHistograms list
as.BDataHistograms.list = function(X,...,breaks=NULL,basis=NULL,nsim=NULL,seed=NULL) {
    if( is.null(basis) ) {
        basis = getBayesSpaceBasis(X[sapply(X,is,"BData")][[1]])
    }
    if( is.null(breaks) ) {
        breaks = X[sapply(X,is,"histogram")][[1]]$breaks
    }
    if( !is.null(seed) ) {
        # oState = .Random.seed
        set.seed(seed)
    }
    XX = lapply(X,toHistogram,breaks=breaks,nsim=nsim)
    # if( !is.null(seed) ) {
    #     # .Random.seed <<- oState # it is not allowed by CRAN policies to change .Random.seed
    # }
    hasFreq = all(sapply(XX,function(x) !is.null(x$counts)))
    if( hasFreq ) {
        BDataFrequencyHistograms(t(sapply(XX,function(x) x$counts)),breaks=breaks,basis=basis)
    } else {
        BDataDensityHistograms(t(sapply(XX,function(x) x$density)),breaks=breaks,basis=basis)
    }
}

#' @export
#' @describeIn as.BDataHistograms checks breaks if given
#' @method as.BDataHistograms BDataHistograms
as.BDataHistograms.BDataHistograms = function(X,...,breaks=NULL,basis=NULL,nsim=NULL,seed=NULL) {
    if(!is.null(breaks)  && !is.character(breaks) && !identical(attr(X,"breaks"),breaks))
        stop("Expected breaks ",breaks," but got ",attr(X,"breaks"))
    if( is.null(basis) ) {
        X
    } else {
        structure(X,basis=basis)
    }
}


#' @export
#' @describeIn as.BDataHistograms checks breaks if given
#' @method as.BDataHistograms histogram
as.BDataHistograms.histogram = function(X,...,breaks=NULL,basis,nsim=NULL,seed=NULL) {
    as.BDataHistograms(list(X),...,breaks=breaks,basis=basis,nsim=nsim,seed=seed)
}


#' @describeIn as.BDataHistograms identity converter
#' @method as.BDataHistograms BDataFrequencyHistograms
#' @export
as.BDataHistograms.BDataFrequencyHistograms = function(X,...) X

#' @describeIn as.BDataHistograms identity converter
#' @method as.BDataHistograms BDataDensityHistograms
#' @export
as.BDataHistograms.BDataDensityHistograms = function(X,...) X

#' Convert something to a histogram
#'
#' The function tries to convert anything it gets to a histogram
#'
#' @param X the single data representing the histogram.
#' @param breaks the breaks of the histogram. Most methods only work
#'     if given explicitly.
#' @param ... further arguments to the [graphics::hist] if called
#' @param nsim number of datapoints to be simulated. If null, no
#'     simulation will take place.
#' @param seed if not null the given seed will be used in case of a
#'     simulation and will be added as an attribute to the result
#'     (use with care).
#'
#' @returns a histogram object, either with or without a counts
#'     element, depending on whether count data is availabel
#'     (e.g. through simulation.)
#'
#' @family BayesSpaceConverters
#' @export
#' @examples
#' myBreaks = seq(0,1,by=0.2)
#' toHistogram(runif(100),breaks=myBreaks)
#' toHistogram(hist(runif(100),plot=FALSE,breaks=myBreaks),breaks=myBreaks)
#' toHistogram(BDataSamples(list(runif(100)),basis=B2Unif01Basis5),
#'             breaks=myBreaks)
#'
toHistogram = function(X,breaks,...,nsim=NULL,seed=NULL) UseMethod("toHistogram",X)
#' @export
#' @describeIn toHistogram method computing the histogram from a sample
toHistogram.numeric = function(X,breaks,...,nsim=NULL,seed=NULL) {
    hist(x=X,breaks=breaks,...,plot=FALSE)
}

#' @export
#' @describeIn toHistogram checks that the breaks fit and returns the
#'     histogram if they do.
#' @method toHistogram histogram
toHistogram.histogram = function(X,breaks=NULL,...,nsim=NULL,seed=NULL) {
    if(!is.null(breaks)  && !is.character(breaks) && !identical(X$breaks,breaks))
        stop("Expected breaks ",breaks," but got ",X$breaks)
    X
}

#' @export
#' @describeIn toHistogram checks that the breaks of the single
#'     histogram fit and returns the histogram if they do.
#' @method toHistogram BDataHistograms
toHistogram.BDataHistograms = function(X,breaks,...,nsim=NULL,seed=NULL
                                       ) {
    if( numberOfCases(X) != 1 ) {
        stop("toHistogram.BDataHistograms: Expected 1 case, but got",numberOfCases(X), "in BDataHistograms object")
    }
    toHistogram(X[[1]],breaks=breaks,...,nsim=nsim,seed=seed)
}

#' @export
#' @describeIn toHistogram computes the histogram with the given
#'     breaks from the dataset.
#' @method toHistogram BDataUnivariateSamples
toHistogram.BDataUnivariateSamples = function(X,breaks,...,nsim=NULL,seed=NULL) {
    if( numberOfCases(X) != 1 ) {
        stop("toHistogram.BData: Expected 1 case, but got",numberOfCases(X), "in ",class(X), "object")
    }
    hist(x=X[[1]],breaks=breaks,...,plot=FALSE)
}


#' @export
#' @describeIn toHistogram (not yet implemented) if nsim given,
#'     simulates a dataset from the distribution and computes a
#'     histogram from it, otherwise ...
#' @method toHistogram BData
toHistogram.BData = function(X,breaks,...,nsim=NULL,seed=NULL
                             ) {
    if( numberOfCases(X) != 1 ) {
        stop("toHistogram.BData: Expected 1 case, but got",numberOfCases(X), "in ",class(X), "object")
    }
    if( is.null(nsim) )
        stop("Simulation required but not requested in toHistogram.BData")
    structure(toHistogram(simulate(X,nsim=nsim,seed=seed,...),
                breaks=breaks),seed=seed)
}


#### as.BDataDensityHistograms -----------------------------------------------
#' Convert to a BDataDensityHistograms dataset
#'
#' Density histograms do not require count information, but provide
#' density information about the relative density in the bars.
#'
#' @param X the object to be converted to a BDataDensityHistorams dataset
#' @param ... further parameters for the method called
#' @param breaks a numerical vector of the histogram breaks to be used
#' @param basis the BayesSpaceBasis to be used for the resulting object
#' @returns a BDataDensityHistograms object
#' @seealso [as.BDataDensityHistograms.list]
#' @family BDataHistograms
#' @family BayesSpaceConverters
#' @export
#'
#' @examples
#' s = BDataSamples(list(rnorm(300), rnorm(300,1)), basis=B2N01Basis5)
#' as.BDataDensityHistograms(s)
#'
as.BDataDensityHistograms = function(X,...) UseMethod("as.BDataDensityHistograms",X)

#' Build a distributional dataset as density histograms from a list
#'
#' Constructor for a distributional data set of class "BDataDensityHistograms"
#' out of a list of either precalculated histograms or of numeric vectors.
#'
#' @param X "list" of histograms or of numeric vectors
#' @param breaks breaks to be used; if `X` is a list of numeric vectors, it admits, Minimum and Maximum should fit to the support of ReferenceMeasure.
#' the same possibilities as the same argument of [graphics::hist()]
#' @param basis "BayesSpaceBasis" object to use
#' @param ... further arguments passed to [graphics::hist()]
#'
#' @return A distributional data container of class [`BDataDensityHistograms`].
#' @export
#' @family BDataHistograms
#' @method as.BDataDensityHistograms list
#' @examples
#' x = lapply(rep(1000,4), runif)
#' (bddh = as.BDataDensityHistograms(x, breaks="Sturges", basis=B2Unif01Basis5) )
#' (bdfh = as.BDataFrequencyHistograms(x, breaks="Sturges", basis=B2Unif01Basis5) )
#' as.BDataDensityHistograms(bdfh)
as.BDataDensityHistograms.list = function(X, breaks, basis,...){
  as.BDataFrequencyHistograms(X, breaks=breaks, basis=basis,...) |> as.BDataDensityHistograms()
}



#' @export
#' @method as.BDataDensityHistograms BDataFrequencyHistograms
#'
# fixed for uneven spacing of breaks
as.BDataDensityHistograms.BDataFrequencyHistograms = function(X, ...,basis=getBayesSpaceBasis(X))  {
    H = unclass(X)/rowSums(unclass(X))
    breaks = getBreaks(X)
    BDataDensityHistograms(H%*%diag(1/diff(breaks)),
                           breaks=breaks,
                           basis=basis,...)
}


#' @export
#' @importFrom graphics hist
#' @method as.BDataDensityHistograms BDataUnivariateSamples
#' @describeIn as.BDataDensityHistograms method for samples computing the histogram
as.BDataDensityHistograms.BDataUnivariateSamples = function(X,...,breaks="Sturges",basis=getBayesSpaceBasis(X)) {
    if(is(breaks, "character")) {
        # the breaks should be forced to cover the support?
       x = unlist(unclass(X))
       x = c(range(x), sample(x, size=median(sapply(X, length))))
       breaks = graphics::hist(x, breaks=breaks, plot = FALSE, ...)$breaks
    }
    Hs = t(sapply(X,function(x) graphics::hist(x,breaks=breaks,plot=FALSE,...)$density))
    BDataDensityHistograms(Hs,breaks=breaks,basis=basis)
}




## as.BayesSpaceBasis
#' Finds a BayesSpaceBasis representation of the object
#'
#' @param x the object to be converted
#' @param ... further parameters to methods
#'
#' @returns a [BayesSpaceBasis] object
#' @export
#'
#' @seealso [BayesSpaceBasis]
#' @examples
#' as.BayesSpaceBasis(B2Unif01Basis5)
#' as.BayesSpaceBasis(B2Unif01)
#'
as.BayesSpaceBasis = function(x,...) UseMethod("as.BayesSpaceBasis",x)
#' @describeIn as.BayesSpaceBasis returns x
#' @export
as.BayesSpaceBasis.BayesSpaceBasis = function(x,...) x
#' @describeIn as.BayesSpaceBasis Calls 'BayesSpaceBasis(x,...)' to create an appropriate basis
#' @export
as.BayesSpaceBasis.BayesSpace = function(x,...) getBayesSpaceBasis(x,...)

### Start as.BDataDensities

#' Converts to a BDataDensities object
#'
#' This represents BayesSpace data by a list of density functions, i.e. one density
#' (with respect to the reference measure) per observation. Use this representation to
#' inspect or plot the distributions as densities; for computation (PCA, distances)
#' convert further to splines with [as.BDataSplines].
#'
#' @param x the data to be converted
#' @param ... generic arguments potentially used by methods, e.g. to
#'     define a method of computation.
#' @param basis the BayesSpaceBasis to be assigned to the
#'     object. Necessary if non can be infered from the information
#'     presented to the function.
#' @param method a character string defining the method of computation
#'     of the density form the data. "Fisher" stands for Fisher
#'     scoring and tries to fit an exponential family model given by
#'     the subspace of the BayesSpace. It might fail for certain
#'     datasets. See [FisherScoringEstimation] for further method
#'     parameters. "kde" stands for kernel density estimation. See
#'     [kdeDensity] for further possible parameters.
#' @param background the valued for the density outside of the interval.
#' @param dmu the Lebesgue density of the reference measure.
#' @returns A BDataDensities object (densities w.r.t. the reference measure).
#' @family BayesSpaceConverters
#' @export
#' @seealso [.DensityFromHist]
#' @family BDataDensities
#'
#' @examples
#' X = BDataLogDensities(list(sin,cos),basis=B2Unif01Basis5)
#' as.BDataDensities(X)
#'
as.BDataDensities <- function(x,...) UseMethod("as.BDataDensities",x)

#' @describeIn as.BDataDensities method for the class itself das nothing
#' @export
#' @method as.BDataDensities BDataDensities
#'
as.BDataDensities.BDataDensities <- function(x,...) x

#' @describeIn as.BDataDensities constructs the projected functions
#' @export
#' @method as.BDataDensities BDataSplines
#'
as.BDataDensities.BDataSplines <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataDensities(Exp(apply(x,1,coef2function,basis=basis)),
                 basis=basis)
}

#' @describeIn as.BDataDensities calls [BDataDensities.BDataLogDensities]
#' @export
#' @method as.BDataDensities BDataLogDensities
#'
as.BDataDensities.BDataLogDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataDensities(x,...,basis=basis)
}

#' @describeIn as.BDataDensities divides PDFs by PDF of reference measure
#' @export
#' @method as.BDataDensities BDataPDFs
#'
as.BDataDensities.BDataPDFs <-
    function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataDensities(Div(unclass(x),getPDF(getReferenceMeasure(x))),...,basis=basis)
    }

#' @describeIn as.BDataDensities divides PDFs by PDF of reference measure
#' @export
#' @method as.BDataDensities BDataLogPDFs
#'
as.BDataDensities.BDataLogPDFs <-
    function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataDensities(Div(Exp(unclass(x)),getPDF(getReferenceMeasure(x))),...,basis=basis,closed=isClosed(x))
    }







#' @describeIn as.BDataDensities method for histograms (TODO: Uses a
#'     very crude heuristic to estimate the log density)
#' @export
#' @method as.BDataDensities BDataHistograms
#'
as.BDataDensities.BDataHistograms <- function(x,...,background=0.0,basis=getBayesSpaceBasis(x),dmu=getPDF(getReferenceMeasure(basis))) {
    BDataDensities(apply(x,1,.DensityFromHist,breaks=attr(x,"breaks"),
                         background=background,dmu=dmu),
                      basis=basis,...)
}




#' @describeIn as.BDataDensities constructs a density from the samples
#' @export
#' @method as.BDataDensities BDataSamples
#'
as.BDataDensities.BDataSamples <- function(x,...,
                                           method=c("Fisher","kde"),
                                           basis=getBayesSpaceBasis(x)) {
    method <- match.arg(method)
    switch(method,   ## TODO: these two implementations are questioned. REDO in helpers.R?
           Fisher = as.BDataDensities(as.BDataSplines(x,...)),
           kde =    as.BDataDensities(BDataPDFs(lapply(x,kdeDensity,...),basis=basis))
           )
}




### End as.BDataDensities


### Start as.BDataLogDensities
#' Converts to a BDataLogDensities object
#'
#' This represents BayesSpace data by a list of log-density functions (the logarithm of
#' the density with respect to the reference measure). Log-densities are the natural
#' representation for Bayes-space operations, where adding distributions corresponds to
#' adding their log-densities.
#'
#' @param x the object to be converted to a log density
#' @param ... further typically unused generic arguments (might be
#'     used for density inference methods)
#' @param basis the BayesSpaceBasis to be used if not availabel form
#'     the converted object.
#' @param method the method to compute the density, see
#'     [as.BDataDensities] for the availabel options.
#' @returns A BDataLogDensities object.
#' @family BayesSpaceConverters
#' @export
#' @family BDataLogDensities
#'
#' @examples
#' as.BDataLogDensities(list(sin,cos),basis=B2N01)
#'
as.BDataLogDensities <- function(x,...) UseMethod("as.BDataLogDensities",x)

#' @describeIn as.BDataLogDensities method for BDataDensities
#' @export
#' @method as.BDataLogDensities BDataDensities
#'
as.BDataLogDensities.BDataDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    if( !hasSameBayesSpaceBasis(x,basis) )
        x = BDataDensities(x,basis=basis)
    BDataLogDensities(lapply(x,Ln),basis=basis,...,closed=isClosed(x))
}

#' @describeIn as.BDataLogDensities method for BDataLogPDFs
#' @export
#' @method as.BDataLogDensities BDataLogPDFs
#'
as.BDataLogDensities.BDataLogPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataLogDensities(Sub(unclass(x),Ln(getPDF(getReferenceMeasure(x)))),basis=basis,...,closed=isClosed(x))
}

#' @describeIn as.BDataLogDensities method for BDataPDFs
#' @export
#' @method as.BDataLogDensities BDataPDFs
#'
as.BDataLogDensities.BDataPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataLogDensities(Ln(Div(unclass(x),getPDF(getReferenceMeasure(x)))),basis=basis,...,closed=isClosed(x))
}



#' @describeIn as.BDataLogDensities constructs the projected functions
#' @export
#' @method as.BDataLogDensities BDataSplines
#'
as.BDataLogDensities.BDataSplines <- function(x,...,basis=getBayesSpaceBasis(x)) {
    #as.BDataLogDensities(apply(x,1,coef2function,basis=basis),
    #             basis=basis)
  BDataLogDensities(apply(x,1,coef2function,basis=basis),
                                      basis=basis)
}

#' @describeIn as.BDataLogDensities calls [BDataLogDensities.BDataLogDensities]
#' @export
#' @method as.BDataLogDensities BDataLogDensities
#'
as.BDataLogDensities.BDataLogDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    if( missing(basis) || hasSameBayesSpaceBasis(x,basis) ) {
        x
    } else {
        BDataLogDensities(unclass(x),basis=basis)
    }
}

#' @describeIn as.BDataLogDensities constructs a density from the samples
#' @export
#' @method as.BDataLogDensities BDataSamples
#'
as.BDataLogDensities.BDataSamples <- function(x,...,
                                           method=c("Fisher","kde"),
                                           basis=getBayesSpaceBasis(x)) {
    method <- match.arg(method)
    switch(method,
           Fisher = as.BDataLogDensities(as.BDataSplines(x,...)),
           kde =    as.BDataLogDensities(BDataDensities(lapply(x,kdeDensity,...),basis=basis))
           )
}



#' @describeIn as.BDataLogDensities constructs a density from the samples
#' @export
#' @method as.BDataLogDensities list
#'
as.BDataLogDensities.list <- function(x,...,basis) {
    BDataLogDensities(x,basis=basis,...)
}

#' @describeIn as.BDataLogDensities constructs a density from the
#'     samples (TODO: Uses a very crude heuristic to estimate the log
#'     density)
#' @export
#' @method as.BDataLogDensities BDataHistograms
#'
as.BDataLogDensities.BDataHistograms <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataLogDensities(apply(x,1,.LogDensityFromHist,breaks=attr(x,"breaks")),
                      basis=basis,...)
}


### End as.BDataLogDensities

### start as.BDataPDFs
#' Converts to representations as Probability Density functions
#'
#' A probability density function or Lebesgue density of a measure can
#' only be computed for Lebesgue continuous distributions. As a dataset
#' of BayesSpace elements (BData) they can be encoded as
#' BDataPDFs objects. This function converts other
#' representations to this representation.
#'
#' @param x a BData object that shall be converted to probability
#'     density function (Lebesgue density representation)
#' @param basis the BayesSpaceBasis to be used with the new object
#' @param ... further parameters for generic use
#' @param method a character string defining the method of computation
#'     of the density form the data. "Fisher" stands for Fisher
#'     scoring and tries to fit an exponential family model given by
#'     the subspace of the BayesSpace. It might fail for certain
#'     datasets. See [FisherScoringEstimation] for further method
#'     parameters. "kde" stands for kernel density estimation. See
#'     [kdeDensity] for further possible parameters.

#' @param background the background density to be added in order to
#'     avoid 0 densities e.g. in case of histograms for empty classes
#'     or regions outside of the histogram breaks.
#'
#' @returns a BDataPDFs object
#'
#' @seealso [BDataPDFs]
#' @family BayesSpaceConverters
#' @export
#' @examples
#' X <- BDataDensities(list(\(x)(1),\(x)(x)),basis=B2N01Basis5)
#' Xpdfs = as.BDataPDFs(X)
#' Xpdfs
#' X1 = as.BDataPDFs(as.BDataLogDensities(X))
#' X2 = as.BDataPDFs(as.BDataLogPDFs(X))
#' X3 = as.BDataPDFs(Xpdfs)
#' set.seed(47)
#' Xs = BDataSamples(replicate(7,runif(200),simplify=FALSE),B2Unif01Basis5)
#' # X4 = as.BDataPDFs(Xs) # TODO
#' X5 = as.BDataPDFs(as.BDataFrequencyHistograms(Xs,breaks=seq(0,1,by=0.1)))
#' X6 = as.BDataPDFs(as.BDataDensityHistograms(Xs,breaks=seq(0,1,by=0.1)^2))
#' # plot(Xpdfs)
#'
as.BDataPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) UseMethod("as.BDataPDFs",x)

#' @describeIn as.BDataPDFs method for BDataDensities multiplies with
#'     reference measure density
#' @export
#' @method as.BDataPDFs BDataDensities
as.BDataPDFs.BDataDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataPDFs(Mul(unclass(x),getPDF(getReferenceMeasure(x))),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataPDFs method for BDataLogDensities exponentiates
#'     and multiplies with reference measure density
#' @export
#' @method as.BDataPDFs BDataLogDensities
as.BDataPDFs.BDataLogDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    reportIfNot(hasSameBayesSpace(x,basis),getBayesSpace(x),getBayesSpace(basis))
    BDataPDFs(Mul(Exp(unclass(x)),getPDF(getReferenceMeasure(x))),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataPDFs method for BDataLogPDFs exponentiates
#'     and multiplies with reference measure density
#' @export
#' @method as.BDataPDFs BDataLogPDFs
as.BDataPDFs.BDataLogPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) {
    reportIfNot(hasSameBayesSpace(x,basis),getBayesSpace(x),getBayesSpace(basis))
    BDataPDFs(Exp(unclass(x)),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataPDFs method for BDataPDFs possibly changes the basis
#' @export
#' @method as.BDataPDFs BDataPDFs
as.BDataPDFs.BDataPDFs <- function(x,...,basis) {
    if( missing(basis) || hasSameBayesSpaceBasis(x,basis))
        return(x)
    else
       return(BDataPDFs(unclass(x),...,basis=basis))
}

#' @describeIn as.BDataPDFs method for BDataDensityHistograms interprets histogram as density.
#' @export
#' @method as.BDataPDFs BDataDensityHistograms
as.BDataPDFs.BDataDensityHistograms <- function(x,...,background=0.0,basis=getBayesSpaceBasis(x)) {
    BDataPDFs(apply(x,1,.DensityFromHist,breaks=attr(x,"breaks"),
                         background=background),
                      basis=basis,...)
}

#' @describeIn as.BDataPDFs method for BDataFrequencyHistograms
#' @export
#' @method as.BDataPDFs BDataFrequencyHistograms
as.BDataPDFs.BDataFrequencyHistograms <- function(x,...,background=0.0,basis=getBayesSpaceBasis(x)) {
    as.BDataPDFs(as.BDataDensityHistograms(x),...,background=background,basis=basis)
}


#' @describeIn as.BDataPDFs method for BDataSamples
#' @export
#' @method as.BDataPDFs BDataSamples
#'
as.BDataPDFs.BDataSamples <- function(x,...,
                                           method=c("Fisher","kde"),
                                           basis=getBayesSpaceBasis(x)) {
    method <- match.arg(method)
    switch(method,
           Fisher = as.BDataPDFs(as.BDataDensities(x,...,method=method,basis=basis)),
           kde =    BDataPDFs(lapply(x,kdeDensity,...),basis=basis)
           )
}

#' @describeIn as.BDataPDFs method for BDataSplines
#' @export
#' @method as.BDataPDFs BDataSplines
#'
as.BDataPDFs.BDataSplines<- function(x,...,
                                     basis=getBayesSpaceBasis(x)) {
    as.BDataPDFs(as.BDataDensities(x),basis=basis,...)
}


### end as.BDataPDFs

### start as.BDataLogPDFs -------------------
#' Converts to representations as Log Probability Density functions
#'
#' A probability density function or Lebesgue density of a measure can
#' only be computed for Lebesgue continuous distributions. As a dataset
#' of BayesSpace elements (BData) they can be encoded as
#' BDataLogPDFs objects. This function converts other
#' representations to this representation.
#'
#' @param x a BData object that shall be converted to probability
#'     density function (Lebesgue density representation)
#' @param basis the BayesSpaceBasis to be used with the new object
#' @param ... further parameters for generic use
#' @param method a character string defining the method of computation
#'     of the density form the data. "Fisher" stands for Fisher
#'     scoring and tries to fit an exponential family model given by
#'     the subspace of the BayesSpace. It might fail for certain
#'     datasets. See [FisherScoringEstimation] for further method
#'     parameters. "kde" stands for kernel density estimation. See
#'     [kdeDensity] for further possible parameters.
#' @param background the background density to be added in order to
#'     avoid 0 densities e.g. in case of histograms for empty classes
#'     or regions outside of the histogram breaks.
#'
#' @returns a BDataLogPDFs object
#'
#' @seealso [BDataLogPDFs], [as.BDataPDFs]
#' @family BayesSpaceConverters
#' @export
#' @examples
#' X <- BDataDensities(list(\(x)(1),\(x)(x)),basis=B2N01Basis5)
#' Xlpdfs = as.BDataLogPDFs(X)
#' Xlpdfs
#' X1 = as.BDataLogPDFs(as.BDataLogDensities(X))
#' X2 = as.BDataLogPDFs(as.BDataLogPDFs(X))
#' X3 = as.BDataLogPDFs(Xlpdfs)
#' set.seed(47)
#' Xs = BDataSamples(replicate(7,runif(200),simplify=FALSE),B2Unif01Basis5)
#' X4 = as.BDataLogPDFs(Xs) # TODO
#' X5 = as.BDataLogPDFs(as.BDataFrequencyHistograms(Xs,breaks=seq(0,1,by=0.1)))
#' X6 = as.BDataLogPDFs(as.BDataDensityHistograms(Xs,breaks=seq(0,1,by=0.1)^2))
#' # plot(Xlpdfs)
#'
as.BDataLogPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) UseMethod("as.BDataLogPDFs",x)

#' @describeIn as.BDataLogPDFs method for BDataDensities multiplies with
#'     reference measure density
#' @export
#' @method as.BDataLogPDFs BDataDensities
as.BDataLogPDFs.BDataDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    BDataLogPDFs(Ln(Mul(unclass(x),getPDF(getReferenceMeasure(x)))),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataLogPDFs method for BDataLogDensities adds the
#'     log density of the reference measure
#' @export
#' @method as.BDataLogPDFs BDataLogDensities
as.BDataLogPDFs.BDataLogDensities <- function(x,...,basis=getBayesSpaceBasis(x)) {
    reportIfNot(hasSameBayesSpace(x,basis),getBayesSpace(x),getBayesSpace(basis))
    BDataLogPDFs(Add(unclass(x),Ln(getPDF(getReferenceMeasure(x)))),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataLogPDFs method for BDataSplines
#' @export
#' @method as.BDataLogPDFs BDataSplines
as.BDataLogPDFs.BDataSplines <- function(x,...,basis=getBayesSpaceBasis(x)) {
    as.BDataLogPDFs(as.BDataLogDensities(x),...,basis=basis)
}

#' @describeIn as.BDataLogPDFs method for BDataLogPDFs exponentiates
#'     and multiplies with reference measure density
#' @export
#' @method as.BDataLogPDFs BDataPDFs
as.BDataLogPDFs.BDataPDFs <- function(x,...,basis=getBayesSpaceBasis(x)) {
    reportIfNot(hasSameBayesSpace(x,basis),getBayesSpace(x),getBayesSpace(basis))
    BDataLogPDFs(Ln(unclass(x)),...,basis=basis,closed=isClosed(x))
}

#' @describeIn as.BDataLogPDFs method for BDataLogPDFs possibly changes the basis
#' @export
#' @method as.BDataLogPDFs BDataLogPDFs
as.BDataLogPDFs.BDataLogPDFs <- function(x,...,basis) {
    if( missing(basis) || hasSameBayesSpaceBasis(x,basis))
        return(x)
    else
       return(BDataLogPDFs(unclass(x),...,basis=basis))
}

#' @describeIn as.BDataLogPDFs method for BDataDensityHistograms interprets histogram as density.
#' @export
#' @method as.BDataLogPDFs BDataDensityHistograms
as.BDataLogPDFs.BDataDensityHistograms <- function(x,...,background=0.0,basis=getBayesSpaceBasis(x)) {
    as.BDataLogPDFs(BDataPDFs(apply(x,1,.DensityFromHist,breaks=attr(x,"breaks"),
                         background=background),
                      basis=basis,...))
}

#' @describeIn as.BDataLogPDFs method for BDataFrequencyHistograms
#' @export
#' @method as.BDataLogPDFs BDataFrequencyHistograms
as.BDataLogPDFs.BDataFrequencyHistograms <- function(x,...,background=0.0,basis=getBayesSpaceBasis(x)) {
    as.BDataLogPDFs(as.BDataDensityHistograms(x),...,background=background,basis=basis)
}


#' @describeIn as.BDataLogPDFs method for BDataSamples
#' @export
#' @method as.BDataLogPDFs BDataSamples
#'
as.BDataLogPDFs.BDataSamples<- function(x,...,
                                           method=c("Fisher","kde"),
                                           basis=getBayesSpaceBasis(x)) {
    method <- match.arg(method)
    switch(method,
           Fisher = as.BDataLogPDFs(as.BDataDensities(x,...,method=method,basis=basis)),
           kde =    as.BDataLogPDFs(BDataPDFs(lapply(x,kdeDensity,...),basis=basis))
           )
}


### end as.BDataLogPDFs

### as.BDataCDFs
## NOT EXPORTED (2026-06-12, P0.3#2 in TODO_documentation_review.md): this is a
## stub — no BDataCDFs class and no methods exist yet, so exporting it only
## documented a function that errors on every call. The generic stays because
## plots.R (as="CDF" branch) references it. TODO(team): implement the BDataCDFs
## class + converters, or drop the CDF plot branch.
# ' Converts to representations as Cummulative Distribution functions
# '
# ' A cummulative distribution function represents the probability of
# ' being lower or equal to a certain value.
# '
# ' TODO implement for various BDataTypes
# ' @export
# ' @param x a BData object that shall be converted to cummulative
# '     distribution function representation
# ' @param basis the BayesSpaceBasis to be used with the new object
# ' @param ... further parameters for generic use
# '  @param method a character string defining the method of computation
# '     of the CDF from an the representation
# ' @returns a BDataCDFs object
# ' @noRd
as.BDataCDFs <- function(x,...) UseMethod("as.BDataCDFs",x)
# ' @describeIn as.BDataCDFs method returning the object itself
# ' @method as.BDataCDFs BDataCDFs
# as.BDataCDFs.BDataCDFs <- function(x,...,basis=getBayesSpaceBasis(x)) {
 #   if( missing(basis) ) {
 #       return(x)
 #   }
 #   return( structure(x,basis=basis) )
#}



### start as.BDataSamples -------------------
#' Converts to representations as BDataSamples
#'
#' Convert any representation to "BDataSamples", most commonly
#' by simulating the data by means of [simulate.BData()].
#'
#' @param x a BData object that shall be converted to a collection of
#'   samples
#' @param basis the BayesSpaceBasis to be used with the new object
#' @param ... further parameters for generic use, in particular `nsim`
#' may be useful
#' @returns a BDataSamples object
#'
#' @seealso [simulate.BData]
#' @family BayesSpaceConverters
#' @export
as.BDataSamples = function(x,...) UseMethod("as.BDataSamples",x)


#' @describeIn as.BDataSamples for any "BData" object
#' @method as.BDataSamples BData
#' @export
as.BDataSamples.BData = function(x,...,basis=getBayesSpaceBasis(x)){
  BDataSamples(simulate(x), basis=basis)
}

#' @describeIn as.BDataSamples for "BDataSamples" object, as identity or
#' to change the basis
#' @method as.BDataSamples BDataSamples
#' @export
as.BDataSamples.BDataSamples = function(x,...,basis=getBayesSpaceBasis(x)){
  attr(x,"basis") = basis # TODO: we need a setBayesSpaceBasis()
  return(x)
}

#' @describeIn as.BDataSamples for "BDataUnivariateSamples" object, as identity or
#' to change the basis
#' @method as.BDataSamples BDataUnivariateSamples
#' @export
as.BDataSamples.BDataUnivariateSamples = function(x,...,basis=getBayesSpaceBasis(x)){
  attr(x,"basis") = basis
  return(x)
}


#### IDT functionality ========================

# will not work because compositions does not export gsi.org;
# cheaper to just copy it, as we are authors of both packages
#gsi.orig <- function(x,y=NULL){
#  a = attr(x,"orig")
#  if(is.null(y)) return(a)
#  b = attr(y,"orig")
#  if(is.null(a)) return(b)
#  return(a)
#}






#' Isometric default representations for BData objects
#'
#' The isometric default transform for BData objects is return as BDataSplines..
#'
#' @param x object to be transformed
#' @param ... extra parameters for generic functionality
#' @param orig object specifying the desired target representation for `x`
#'
#' @returns a BSpline representation of the Distributional data
#' @importFrom compositions idt
#' @importFrom compositions idtInv
#' @family BayesSpaceConverters
#' @export
#' @method idt BData
#' @examples
#' # BData densities
#' bdld = BDataLogDensities(list(\(x)(x^2-x^3), \(x)(sin(x*pi))), basis=B2Unif01Basis20)
#' plot(bdld, col=c(2,4))
#' coefs = as.BDataSplines(bdld)
#' mn = colMeans(coefs)
#' recasted = idtInv(mn, orig=bdld)
#' class(recasted)
#' f = as.function(recasted[[1]])
#' curve(f, add=TRUE)
#'
#' # BSpline coefficients
#' coefs=matrix(1:15,nrow=3)
#' bssplines=BDataSplines(coefs,B2Unif01Basis5)
#' cf = idt(bssplines)
#' mn = colMeans(cf)
#' idtInv(mn, orig=bssplines)
#'
idt.BData <- function(x,...){
  y = as.BDataSplines(x,...)
  attr(y,"orig") = x
  return(y)
}




#' @describeIn idt.BData invert representation of an object `x` according to the representation of `orig`
#' @export
#' @method idtInv BData
idtInv.BData <- function(x,orig=attr(x,"orig"),...) {
    fn = paste0("as.",class(orig)[1])
    # print("Does idtInv.BData")
  rgs = list(x=BDataSplines(x, basis=getBayesSpaceBasis(orig)), basis=getBayesSpaceBasis(orig))
  do.call(fn,rgs)
}

#' @describeIn idt.BData returns directly to splines
#' @export
#' @method idtInv BDataSplines
idtInv.BDataSplines <- function(x,orig=attr(x,"orig"),...){
  BDataSplines(x, basis=getBayesSpaceBasis(orig),...)
}