(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* Name: MultivariateStirlingPolynomials` *)

(* Last update: 2013-10-24 *)

(* Author: Alfred Schreiber *)

(* Copyright: 
2005-2013 Alfred Schreiber. Permission is granted to distribute this file for any purpose except for inclusion in commercial software or program collections. This copyright notice must remain intact. *)

(* Summary: 
This package provides functions that generate the multivariate Stirling Polynomials described in the author's paper 'Multivariate Stirling Polynomials of the First and Second Kind' (November 2013) *)

(* Package Version: 1.0 *)

(* Mathematica Version: 7.0 or higher *)


BeginPackage["MultivariateStirlingPolynomials`", "Combinatorica`"]


X::usage ="X is the basis letter for the indeterminates."


MultivariateStirlingP1::usage = "MultivariateStirlingP1[n,k] returns the multivariate Stirling polynomial of the first kind in n-k+1 indeterminates."


MultivariateStirlingA::usage = "MultivariateStirlingA[n,k] returns the rational function that comes from dividing the multivariate Stirling polynomial of the first kind in n-k+1 indeterminates by X[1\!\(\*SuperscriptBox[\"]\", 
RowBox[{
RowBox[{\"2\", \"n\"}], \"-\", \"1\"}]]\)."


MultivariateStirlingP2::usage = "MultivariateStirlingP2[n,k] returns the multivariate Stirling polynomial of the second kind in n-k+1 indeterminates (= partial Bell polynomial)."


SetVariablesTo::usage = "SetVariablesTo[vars] generates a set of rules to be used via /. for replacing the default indeterminates X[1], X[2], X[3],... by var1, var2, var3,... in vars={var1,var2,var3,...}." 


SubIndexed::usage = "SubIndexed[m] is a rule set that converts via /. the indeterminates X[1],...,X[m] into \!\(\*SubscriptBox[\"X\", \"1\"]\),...,\!\(\*SubscriptBox[\"X\", \"m\"]\)."


AssociateBellPolynomial::usage="AssociateBellPolynomial[n,k] returns the partial Bell polynomial in n-k+1 indeterminates with 0 substituted in place of X[1]."


LahPolynomial::usage = "LahPolynomial[n,k] returns the multivariate Lah polynomial in n-k+1 indeterminates."


CauchyPolynomial::usage = "CauchyPolynomial[n,k] returns the multivariate Cauchy polynomial in n-k+1 indeterminates."


Begin["`Private`"]


PartitionSet[n_Integer,k_Integer]:=Select[Partitions[n,n],Length[#]==k&]


PartitionListToType[p_List]:=Module[{ptf={},pset=Union[p]},
Do[AppendTo[ptf,{pset[[i]],Count[p,pset[[i]]]}],{i,1,Length[pset]}];ptf]


NumberOfElements[s_List]:=Module[{t1=Table[{i,1},{i,1,Length[s]}],t2=Table[{i,2},{i,1,Length[s]}]},
Extract[s,t1].Extract[s,t2]]


NumberOfBlocks[s_List]:=Plus@@Extract[s,Table[{i,2},{i,1,Length[s]}]]


NumberOfBlockPermutations[s_List]:=Module[{rtab=Extract[s,Table[{i,2},{i,1,Length[s]}]]},
Times@@Factorial[rtab]]


NumberOfElementPermutations[ps_List]:=Module[{t1=Table[{i,1},{i,1,Length[ps]}],t2=Table[{i,2},{i,1,Length[ps]}]},
Times@@(Factorial[Extract[ps,t1]]^Extract[ps,t2])]


StirlingFunction[ps_List]:=Module[{r1,k,n},
If[Cases[ps,{1,_}]=={},r1=0,r1=Extract[ps,{1,2}]];
n=NumberOfBlocks[ps]+1;
k=2n-1-NumberOfElements[ps];
(-1)^(n-1-r1)*(2n-2-r1)!*r1!/((k-1)!*NumberOfBlockPermutations[ps]*NumberOfElementPermutations[ps])]


SubsetFunction[ps_List]:=Factorial[NumberOfElements[ps]]/(NumberOfBlockPermutations[ps]*NumberOfElementPermutations[ps])


PartitionToMonomial[ps_List]:=Module[{n=NumberOfElements[ps],XList},XList=ps/.{j_Integer,r_Integer}:>(Array[X,n][[j]])^r;
Times@@XList]


(* EXPORTED FUNCTIONS *)


MultivariateStirlingP1[n_Integer,k_Integer]:=Module[{ps=Map[PartitionListToType,PartitionSet[2n-1-k,n-1]]},Map[StirlingFunction,ps].Map[PartitionToMonomial,ps]]


MultivariateStirlingA[n_Integer,k_Integer]:=Expand[MultivariateStirlingP1[n,k]/X[1]^(2n-1)]


MultivariateStirlingP2[n_Integer,k_Integer]:=Module[{pss=Map[PartitionListToType,PartitionSet[n,k]]},Map[SubsetFunction,pss].Map[PartitionToMonomial,pss]]


SetVariablesTo[vars_List]:=Module[{xtab},
Unprotect[X];
xtab=Table[X[j]-> vars[[j]],{j,1,Length[vars]}];
Protect[X];
xtab]


SubIndexed[m_Integer]:=SetVariablesTo[Table[Subscript[X, j],{j,1,m}]]


AssociateBellPolynomial[n_Integer,k_Integer]:=MultivariateStirlingP2[n,k]/.SetVariablesTo[{0}]


LahPolynomial[n_Integer,k_Integer]:=MultivariateStirlingP2[n,k]/.SetVariablesTo[Table[j!X[j],{j,1,n-k+1}]]


CauchyPolynomial[n_Integer,k_Integer]:=MultivariateStirlingP2[n,k]/.SetVariablesTo[Table[(j-1)!X[j],{j,1,n-k+1}]]


End[ ]


Protect[X]


EndPackage[ ]
