From 747627088a9a1ed6f4a7dcaf327f439ad3ebc3a7 Mon Sep 17 00:00:00 2001 From: stla Date: Tue, 13 Aug 2024 01:01:11 +0200 Subject: [PATCH] essaiHLQcombination --- R/HallLittlewood.R | 4 +- inst/essais/essai-HLQcombination.R | 89 +++++++++++++++++++++++++++++ inst/essais/essai-HLQcombination2.R | 89 +++++++++++++++++++++++++++++ 3 files changed, 180 insertions(+), 2 deletions(-) create mode 100644 inst/essais/essai-HLQcombination.R create mode 100644 inst/essais/essai-HLQcombination2.R diff --git a/R/HallLittlewood.R b/R/HallLittlewood.R index 7a8962c..273b50a 100644 --- a/R/HallLittlewood.R +++ b/R/HallLittlewood.R @@ -178,14 +178,14 @@ HallLittlewoodP <- function(n, lambda) { hlp } -phi_r <- function(r) { +.phi_r <- function(r) { t <- qlone(1L) Reduce(`*`, lapply(seq_len(r), function(i) (1L-t^i))) } b <- function(lambda) { m <- vapply(unique(lambda), function(i) sum(lambda == i), integer(1L)) - Reduce(`*`, lapply(m, phi_r)) + Reduce(`*`, lapply(m, .phi_r)) } #' @title Hall-Littlewood polynomial diff --git a/inst/essais/essai-HLQcombination.R b/inst/essais/essai-HLQcombination.R new file mode 100644 index 0000000..9aaec1b --- /dev/null +++ b/inst/essais/essai-HLQcombination.R @@ -0,0 +1,89 @@ +## the `ms[lambda]` polynomial in the Hall-Littlewood Q-polynomials basis +#' @importFrom qspray isQzero +#' @noRd +msPolynomialInHLQbasis <- function(lambda) { + weight <- sum(lambda) + msCombos <- msPolynomialsInSchurBasis(weight) + lambdasAsStrings <- names(msCombos) + lambdas <- lapply(lambdasAsStrings, fromPartitionAsString) + lambdaAsString <- partitionAsString(lambda) + msCombo <- msCombos[[lambdaAsString]] + musAsStrings <- names(msCombo) + hlpCombos <- lapply(musAsStrings, function(muAsString) { + mu <- fromPartitionAsString(muAsString) + r <- msCombo[muAsString] + lapply(lambdas, function(kappa) { + rOQ <- r * KostkaFoulkesPolynomial(mu, kappa) / b(kappa) + rOQ + }) + }) + out <- Reduce( + function(combo1, combo2) { + mapply( + `+`, + combo1, combo2 + ) + }, + hlpCombos + ) + #out <- lapply(out, function(rOQ) rOQ@numerator) + names(out) <- lambdasAsStrings + return(out) + Filter(Negate(isQzero), out) +} + +## the `Qspray` polynomial in the Hall-Littlewood Q-polynomials basis +#' @importFrom methods new +#' @importFrom qspray MSPcombination orderedQspray isQzero +#' @importFrom symbolicQspray Qzero +#' @importFrom ratioOfQsprays as.ratioOfQsprays +#' @noRd +HLQcombination <- function(Qspray) { + fullMsCombo <- MSPcombination(Qspray, check = FALSE) + lambdas <- lapply(fullMsCombo, `[[`, "lambda") + finalQspray <- Qzero() + unitRatioOfQsprays <- as.ratioOfQsprays(1L) + for(lambda in lambdas) { + hlpCombo <- msPolynomialInHLQbasis(lambda) + kappas <- lapply(names(hlpCombo), fromPartitionAsString) + msCombo <- fullMsCombo[[partitionAsString(lambda)]] + sprays <- lapply(kappas, function(kappa) { + new( + "symbolicQspray", + powers = list(kappa), + coeffs = list(unitRatioOfQsprays) + ) + }) + names(sprays) <- names(hlpCombo) + spray <- as.ratioOfQsprays(0L) #Qzero() + for(kappa in names(hlpCombo)) { + coeff <- hlpCombo[[kappa]] + if(TRUE){#!isQzero(coeff)) { + spray <- spray + coeff * sprays[[kappa]] + } + } + finalQspray <- finalQspray + msCombo[["coeff"]]*spray + } + finalQspray <- orderedQspray(finalQspray) + powers <- finalQspray@powers + coeffs <- finalQspray@coeffs + combo <- mapply( + function(lambda, coeff) { + qspray <- coeff#@numerator + list("coeff" = qspray, "lambda" = lambda) + }, + powers, coeffs, + SIMPLIFY = FALSE, USE.NAMES = FALSE + ) + names(combo) <- + vapply(powers, partitionAsString, character(1L), USE.NAMES = FALSE) + combo +} + + + +p <- JackPol(3, c(2, 1), alpha = "2") +co <- HLQcombination(p) + +x <- qlone(1) +HallLittlewoodPol(3, c(2,1), "Q") * co[["[2, 1]"]]$coeff + HallLittlewoodPol(3, c(1,1,1), "Q") * co[["[1, 1, 1]"]]$coeff \ No newline at end of file diff --git a/inst/essais/essai-HLQcombination2.R b/inst/essais/essai-HLQcombination2.R new file mode 100644 index 0000000..9aaec1b --- /dev/null +++ b/inst/essais/essai-HLQcombination2.R @@ -0,0 +1,89 @@ +## the `ms[lambda]` polynomial in the Hall-Littlewood Q-polynomials basis +#' @importFrom qspray isQzero +#' @noRd +msPolynomialInHLQbasis <- function(lambda) { + weight <- sum(lambda) + msCombos <- msPolynomialsInSchurBasis(weight) + lambdasAsStrings <- names(msCombos) + lambdas <- lapply(lambdasAsStrings, fromPartitionAsString) + lambdaAsString <- partitionAsString(lambda) + msCombo <- msCombos[[lambdaAsString]] + musAsStrings <- names(msCombo) + hlpCombos <- lapply(musAsStrings, function(muAsString) { + mu <- fromPartitionAsString(muAsString) + r <- msCombo[muAsString] + lapply(lambdas, function(kappa) { + rOQ <- r * KostkaFoulkesPolynomial(mu, kappa) / b(kappa) + rOQ + }) + }) + out <- Reduce( + function(combo1, combo2) { + mapply( + `+`, + combo1, combo2 + ) + }, + hlpCombos + ) + #out <- lapply(out, function(rOQ) rOQ@numerator) + names(out) <- lambdasAsStrings + return(out) + Filter(Negate(isQzero), out) +} + +## the `Qspray` polynomial in the Hall-Littlewood Q-polynomials basis +#' @importFrom methods new +#' @importFrom qspray MSPcombination orderedQspray isQzero +#' @importFrom symbolicQspray Qzero +#' @importFrom ratioOfQsprays as.ratioOfQsprays +#' @noRd +HLQcombination <- function(Qspray) { + fullMsCombo <- MSPcombination(Qspray, check = FALSE) + lambdas <- lapply(fullMsCombo, `[[`, "lambda") + finalQspray <- Qzero() + unitRatioOfQsprays <- as.ratioOfQsprays(1L) + for(lambda in lambdas) { + hlpCombo <- msPolynomialInHLQbasis(lambda) + kappas <- lapply(names(hlpCombo), fromPartitionAsString) + msCombo <- fullMsCombo[[partitionAsString(lambda)]] + sprays <- lapply(kappas, function(kappa) { + new( + "symbolicQspray", + powers = list(kappa), + coeffs = list(unitRatioOfQsprays) + ) + }) + names(sprays) <- names(hlpCombo) + spray <- as.ratioOfQsprays(0L) #Qzero() + for(kappa in names(hlpCombo)) { + coeff <- hlpCombo[[kappa]] + if(TRUE){#!isQzero(coeff)) { + spray <- spray + coeff * sprays[[kappa]] + } + } + finalQspray <- finalQspray + msCombo[["coeff"]]*spray + } + finalQspray <- orderedQspray(finalQspray) + powers <- finalQspray@powers + coeffs <- finalQspray@coeffs + combo <- mapply( + function(lambda, coeff) { + qspray <- coeff#@numerator + list("coeff" = qspray, "lambda" = lambda) + }, + powers, coeffs, + SIMPLIFY = FALSE, USE.NAMES = FALSE + ) + names(combo) <- + vapply(powers, partitionAsString, character(1L), USE.NAMES = FALSE) + combo +} + + + +p <- JackPol(3, c(2, 1), alpha = "2") +co <- HLQcombination(p) + +x <- qlone(1) +HallLittlewoodPol(3, c(2,1), "Q") * co[["[2, 1]"]]$coeff + HallLittlewoodPol(3, c(1,1,1), "Q") * co[["[1, 1, 1]"]]$coeff \ No newline at end of file