123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655(*****************************************************************************)(* *)(* Copyright (c) 2020-2021 Danny Willems <be.danny.willems@gmail.com> *)(* *)(* Permission is hereby granted, free of charge, to any person obtaining a *)(* copy of this software and associated documentation files (the "Software"),*)(* to deal in the Software without restriction, including without limitation *)(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)(* and/or sell copies of the Software, and to permit persons to whom the *)(* Software is furnished to do so, subject to the following conditions: *)(* *)(* The above copyright notice and this permission notice shall be included *)(* in all copies or substantial portions of the Software. *)(* *)(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)(* DEALINGS IN THE SOFTWARE. *)(* *)(*****************************************************************************)includeUtilstypenatural_with_infinity=Naturalofint|InfinitymoduletypeUNIVARIATE=sig(** The type of the polynomial coefficients. Can be a field or more generally
a ring. For the moment, it is restricted to prime fields.
*)typescalar(** Represents a polynomial *)typet(** Returns the polynomial [P(X) = 0] *)valzero:t(** Returns the polynomial [P(X) = 1] *)valone:t(** Returns the degree of the polynomial *)valdegree:t->natural_with_infinityvaldegree_int:t->int(** [have_same_degree P Q] returns [true] if [P] and [Q] have the same
degree
*)valhave_same_degree:t->t->bool(* (\** [shift_by_n P n] multiplies [P] by [X^n]. For instance,
* [P(X) = a_{0} + a_{1} X + ... + a_{m} X^m] will be transformed in
* [a_{0} X^{n} + a_{1} X^{n + 1} + ... a_{m} X^{n + m}].
* *\)
* val shift_by_n : t -> int -> t *)(** [get_dense_polynomial_coefficients P] returns the list of the
coefficients of P, including the null coefficients, in decreasing order
i.e. if P(X) = a_{0} + a_{1} X + ... + a_{n - 1} X^{n - 1}, the function
will return [a_{n - 1}, ..., a_{0}]
*)valget_dense_polynomial_coefficients:t->scalarlist(** [get_dense_polynomial_coefficients_with_degree P] returns the list of the
coefficients of P with the degree as a tuple, including the null
coefficients, in decreasing order
i.e. if P(X) = a_{0} + a_{1} X + ... + a_{n - 1} X^{n - 1}, the function
will return [(a_{n - 1}, n -1), ..., (a_{0}, 0)].
*)valget_dense_polynomial_coefficients_with_degree:t->(scalar*int)list(** [get_list_coefficients P] returns [(a_4,4), (a_2,2), (a_0,0)] if
P = a_4 X^4 + a_2 X^2 + a_0*)valget_list_coefficients:t->(scalar*int)list(** [evaluation P s] computes [P(s)]. Use Horner's method in O(n). *)valevaluation:t->scalar->scalar(** [constants s] returns the constant polynomial [P(X) = s] *)valconstants:scalar->t(** [add P Q] returns [P(X) + Q(X)] *)valadd:t->t->t(** [sub P Q] returns [P(X) - Q(X)] *)valsub:t->t->t(** [mult_by_scalar s P] returns [s*P(X)] *)valmult_by_scalar:scalar->t->t(** [is_null P] returns [true] iff [P(X) = 0] *)valis_null:t->bool(** [is_constant P] returns [true] iff [P(X) = s] for s scalar *)valis_constant:t->bool(** [opposite P] returns [-P(X)] *)valopposite:t->t(** [equal P Q] returns [true] iff [P(X) = Q(X)] on S *)valequal:t->t->bool(** [of_coefficients [(x_0, y_0) ; (x_1, y_1); ... ; (x_n ; y_n)]] builds the
polynomial Σ(a_i * X^i) as a type [t].
By default, the null coefficients will be removed as the internal
representation of polynomials is sparsed. However, a version with null
coefficients can be generated if required. It is not recommended to use
this possibility as it breaks an invariant of the type [t].
*)valof_coefficients:(scalar*int)list->t(** [lagrange_interpolation [(x_0, y_0) ; (x_1, y_1); ... ; (x_n ; y_n)]]
builds the unique polynomial P of degre n such that P(x_i) = y_i for i = 0...n
using the intermediate lagrange polynomials. [lagrange_interpolation_fft] can
be used in case of a FFT friendly scalar structure. It is supposed all x_i
are different.
*)vallagrange_interpolation:(scalar*scalar)list->t(** [even_polynomial P] returns the polynomial P_even containing only the even
coefficients of P *)valeven_polynomial:t->t(** [odd_polynomial P] returns the polynomial P_odd containing only the odd
coefficients of P *)valodd_polynomial:t->t(** [evaluate_fft_imperative ~domain P] evaluates P on the points given in the [domain].
The domain should be of the form [g^{i}] where [g] is a principal root of
unity. If the domain is of size [n], [g] must be a [n]-th principal root
of unity.
The degree of [P] can be smaller than the domain size. Larger polynomials
can also be used but the implementation is not the most memory efficient
yet and must be improved. The
complexity is in [O(n log(m))] where [n] is the domain size and [m] the
degree of the polynomial. When [m] is smaller than [n], the polynomial is
padded with zeroes to reach [n] coefficients.
The resulting list contains the evaluation points
[P(1), P(w), ..., P(w^{n - 1})].
*)valevaluation_fft:domain:scalararray->t->scalarlist(** [generate_random_polynomial n] returns a random polynomial of degree [n] *)valgenerate_random_polynomial:natural_with_infinity->t(** [get_highest_coefficient P] where [P(X) = a_n X^n + ... a_0] returns [a_n] *)valget_highest_coefficient:t->scalar(** [interpolation_fft ~domain [y_{0} ; y_{1} ;
... y_{n}]] computes the interpolation at the points [y_{0}, ..., y_{n}]
using FFT Cookey Tukey.
The domain should be of the form [g^{i}] where [g] is a principal root of
unity. If the domain is of size [n], [g] must be a [n]-th principal root
of unity.
The domain size must be exactly the same than the number of points. The
complexity is [O(n log(n))] where [n] is the domain size.
*)valinterpolation_fft:domain:scalararray->scalarlist->t(** [polynomial_multiplication P Q] computes the
product P(X).Q(X) *)valpolynomial_multiplication:t->t->t(** [polynomial_multiplication_fft ~domain P Q] computes the
product [P(X).Q(X)] using FFT.
The domain should be of the form [g^{i}] where [g] is a principal root of
unity. If the domain is of size [n], [g] must be a [n]-th principal root
of unity.
The degrees of [P] and [Q] can be different. The only condition is
[degree P + degree Q] should be smaller or equal to [n - 2] (i.e. the domain should
be big enough to compute [n - 1] points of [P * Q]).
*)valpolynomial_multiplication_fft:domain:scalararray->t->t->tvaleuclidian_division_opt:t->t->(t*t)option(** [extended_euclide P S] returns (GCD, U, V) the greatest common divisor of [P] and [S]
and the Bezout's coefficient:
[U P + V S = GCD] and [GCD] greatest coefficient is one
*)valextended_euclide:t->t->t*t*t(** Infix operator for [equal] *)val(=):t->t->bool(** Infix operator for [add] *)val(+):t->t->t(** Infix operator for [polynomial_multiplication] *)val(*):t->t->t(** Infix operator for [sub] *)val(-):t->t->tvalto_string:t->stringendmoduleDomainEvaluation(R:Bls12_381.Ff_sig.PRIME)=structtypet={size:int;generator:R.t;domain_values:R.tarray}letgenerate_domaingeneratorn=letrecauxpreviousacci=ifi=nthenList.revaccelseletcurrent=R.mulpreviousgeneratorinauxcurrent(current::acc)(i+1)inArray.of_list@@auxR.one[R.one]1letgeneratesizegenerator={size;generator;domain_values=generate_domaingeneratorsize}let_sized=d.sizelet_generatord=d.generatorletdomain_valuesd=d.domain_valuesend(* TODO: Functions should use DomainEvaluation *)letgenerate_evaluation_domain(typea)(moduleFp:Bls12_381.Ff_sig.PRIMEwithtypet=a)size(generator:a)=letmoduleD=DomainEvaluation(Fp)inletg=D.generatesizegeneratorinD.domain_valuesg(* TODO: this function should be part of DomainEvaluation. However, for the
moment, functions do not use this representation *)letinverse_domain_valuesdomain=letlength_domain=Array.lengthdomaininArray.initlength_domain(funi->ifi=0thendomain.(i)elsedomain.(length_domain-i))moduleMakeUnivariate(R:Bls12_381.Ff_sig.PRIME)=structtypescalar=R.t(* We encode the polynomials as a list with decreasing degree.
Invariants to respect for the type:
- all coefficients are non null.
- [a_n * X^n + ... a_1 X + a0] is encoded as [a_n ; ... ; a_1 ; a_0] with [a_i]
non zero for all [i], i.e. the monomials are given in decreasing order.
- the zero polynomial is represented as the empty list.
*)typet=(scalar*int)listletdegreep=matchpwith|[]->Infinity|[(e,0)]->ifR.is_zeroethenInfinityelseNatural0|_asl->Natural(snd(List.hdl))letdegree_intp=matchdegreepwithInfinity->-1|Naturaln->nlethave_same_degreepq=degreep=degreeq(* let shift_by_n p n =
* assert (n >= 1) ;
* List.map (fun (c, e) -> (c, e + n)) p *)letzero=[]letone=[(R.one,0)]letconstantsc=ifR.eqcR.zerothen[]else[(c,0)]letis_nullp=matchpwith[]->true|_->falseletis_constantp=matchpwith|[]->true|l->ifList.compare_length_withl1>0thenfalseelselet_,p=List.hdlinifp=0thentrueelsefalseletof_coefficientsl=(* check if the powers are all positive *)assert(List.for_all(fun(_e,power)->power>=0)l);(* Remove null coefficients *)letl=List.filter(fun(e,_power)->not(R.is_zeroe))lin(* sort by the power, higher power first *)letl=List.fast_sort(fun(_e1,power1)(_e2,power2)->Int.subpower2power1)linlletaddp1p2=letrecinneraccl1l2=match(l1,l2)with|[],l|l,[]->List.rev_appendaccl|l1,l2->lete1,p1=List.hdl1inlete2,p2=List.hdl2inifp1=p2&&R.is_zero(R.adde1e2)theninneracc(List.tll1)(List.tll2)elseifp1=p2theninner((R.adde1e2,p1)::acc)(List.tll1)(List.tll2)elseifp1>p2theninner((e1,p1)::acc)(List.tll1)l2elseinner((e2,p2)::acc)l1(List.tll2)inletl=inner[]p1p2inof_coefficientslletmult_by_scalarap=List.filter_map(fun(coef,power)->letc=R.mulcoefainifR.is_zerocthenNoneelseSome(c,power))pletoppositepoly=List.(rev(rev_map(fun(a,i)->(R.negatea,i))poly))letsubp1p2=letrecinneraccl1l2=match(l1,l2)with|[],l2->List.rev_appendacc(oppositel2)|l1,[]->List.rev_appendaccl1|l1,l2->lete1,p1=List.hdl1inlete2,p2=List.hdl2inifp1=p2&&R.is_zero(R.sube1e2)theninneracc(List.tll1)(List.tll2)elseifp1=p2theninner((R.sube1e2,p1)::acc)(List.tll1)(List.tll2)elseifp1>p2theninner((e1,p1)::acc)(List.tll1)l2elseinner((R.negatee2,p2)::acc)l1(List.tll2)inletl=inner[]p1p2inof_coefficientslletequalp1p2=ifList.compare_lengthsp1p2!=0thenfalseelseList.for_all2(fun(e1,n1)(e2,n2)->n1=n2&&R.eqe1e2)p1p2letget_list_coefficientsp=pletget_dense_polynomial_coefficientspolynomial=matchpolynomialwith|[]->[R.zero]|l->letl=List.revlinletrecto_denseacccurrent_il=matchlwith|[]->acc|(e,n)::xs->ifn=current_ithento_dense(e::acc)(current_i+1)xselseto_dense(R.zero::acc)(current_i+1)linto_dense[]0lletget_dense_polynomial_coefficients_with_degreepolynomial=letn=degree_intpolynomialinifn=-1then[(R.zero,0)]elseleth_list=get_dense_polynomial_coefficientspolynomialinletffold(acc,i)a=((a,i)::acc,i-1)inletres,_=List.fold_leftffold([],n)h_listinList.revresletevaluationpolynomialpoint=(* optimized_pow is used instead of Scalar.pow because Scalar.pow makes
evaluation slower than the standard Horner algorithm when dif_degree <= 4 is
involved.
TODO: use memoisation
*)letn=degree_intpolynomialinletoptimized_powx=function|0->R.one|1->x|2->R.squarex|3->R.(x*squarex)|4->R.(square(squarex))|n->R.powx(Z.of_intn)inletaux(acc,prec_i)(a,i)=letdif_degree=prec_i-iin(R.((acc*optimized_powpointdif_degree)+a),i)inletres,last_degree=List.fold_leftaux(R.zero,n)polynomialinR.(res*optimized_powpointlast_degree)letassert_no_duplicate_pointpoints=letpoints=List.mapfstpointsinletpoints_uniq=List.sort_uniq(fune1e2->ifR.eqe1e2then0else-1)pointsinassert(List.compare_lengthspointspoints_uniq=0)letintermediate_lagrange_interpolationx_iixs=List.fold_left(funacc(j,x_j)->ifi=jthenaccelsematchaccwith|[]->[]|acc->letacc_1=List.map(fun(e,p)->(e,p+1))accinletacc_2=mult_by_scalarx_j(of_coefficientsacc)inletacc=addacc_1(oppositeacc_2)inletscalar=R.inverse_exnR.(x_i+R.negatex_j)inletacc_final=mult_by_scalarscalaraccinacc_final)(constantsR.one)xsletlagrange_interpolationpoints=assert_no_duplicate_pointpoints;letindexed_points=List.mapi(funi(x_i,y_i)->(i,x_i,y_i))pointsinletevaluated_at=List.mapi(funi(x_i,_)->(i,x_i))pointsinList.fold_left(funacc(i,x_i,y_i)->letl_i=intermediate_lagrange_interpolationx_iievaluated_atinaddacc(mult_by_scalary_il_i))[]indexed_pointsleteven_polynomialpolynomial=matchpolynomialwith|[]->[]|l->List.filter(fun(_e,n)->nmod2=0)lletodd_polynomialpolynomial=matchpolynomialwith|[]->[]|l->List.filter(fun(_e,n)->nmod2=1)l(* assumes that len(domain) = len(output) *)letevaluation_fft_in_place~domainoutput=letn=Array.lengthoutputinletlogn=Z.log2(Z.of_intn)inletm=ref1infor_i=0tologn-1doletexponent=n/(2*!m)inletk=ref0inwhile!k<ndoforj=0to!m-1doletw=domain.(exponent*j)in(* odd *)letright=R.muloutput.(!k+j+!m)winoutput.(!k+j+!m)<-R.suboutput.(!k+j)right;output.(!k+j)<-R.addoutput.(!k+j)rightdone;k:=!k+(!m*2)done;m:=!m*2done;()letevaluation_fft~domainpolynomial=letopenUtilsinletn=degree_intpolynomial+1inletd=Array.lengthdomaininletlogd=Z.(log2(of_intd))inifis_nullpolynomialthenList.initd(fun_->R.zero)elseletdense_polynomial=get_dense_polynomial_coefficientspolynomialinletoutput=Array.of_list(List.revdense_polynomial)inletoutput=(* if the polynomial is too small, we pad with zeroes *)ifd>nthen(letoutput=Array.appendoutput(Array.make(d-n)R.zero)inreorg_coefficientsdlogdoutput;output(* if the polynomial is larger, we evaluate on the sub polynomials *))elseifn>dthen(letnext_power=next_power_of_twoninletlog_next_power=Z.log2(Z.of_intnext_power)inletoutput=Array.appendoutput(Array.make(next_power-n)R.zero)inletn=next_powerinreorg_coefficientsnext_powerlog_next_poweroutput;Array.initd(funi->letpoly=Array.suboutput(i*(n/d))(n/d)inletpoly=List.init(n/d)(funi->(poly.((n/d)-i-1),(n/d)-i-1))inletpoly=of_coefficientspolyin(* we may sum *)evaluationpolydomain.(0)))else(reorg_coefficientsdlogdoutput;output)inevaluation_fft_in_place~domainoutput;Array.to_listoutputletgenerate_random_polynomialdegree=letrecrandom_non_null()=letr=R.random()inifR.is_zerorthenrandom_non_null()elserinmatchdegreewith|Infinity->[]|Naturalnwhenn>=0->letcoefficients=List.initn(fun_i->R.random())inletcoefficients=(random_non_null(),n)::List.mapi(funic->(c,n-i-1))coefficientsinof_coefficientscoefficients|_->failwith"The degree must be positive"letget_highest_coefficientpolynomial=matchpolynomialwith[]->R.zero|(c,_e)::_->cletinterpolation_fft~domainpoints=letn=Array.lengthdomaininassert(List.compare_length_withpointsn=0);letn_z=Z.of_intninletlogn=Z.log2n_zin(* Points are in a list of size N. Let's define
points = [y_0, y_1, ... y_(N - 1)]
We build the polynomial [P(X) = y_(N - 1) X^(N - 1) + ... + y_1 X * y_0].
The resulting value is not necessarily of type [t] because it might not
respect the sparse representation as there might be some null
coefficients [y_i]. However, [evaluation_fft] gets the dense
polynomial in its body.
If all the points are zero, mult_by_scalar will take care of keeping the
invariant, see below.
*)letinverse_domain=inverse_domain_valuesdomaininletinverse_fft=Array.of_listpointsin(* We evaluate the resulting polynomial on the domain *)Utils.reorg_coefficientsnlogninverse_fft;evaluation_fft_in_place~domain:inverse_domaininverse_fft;letpolynomial,_=Array.fold_left(fun(acc,i)p->((p,i)::acc,i+1))([],0)inverse_fftin(* mult_by_scalar does use filter_map removing all the zero coefficients.
Therefore, we keep the invariant consisting of representing the zero
polynomial with an empty list
*)mult_by_scalar(R.inverse_exn(R.of_zn_z))polynomialletpolynomial_multiplicationpq=letmul_by_monom(scalar,int)p=List.map(fun(scalar_2,int_2)->(R.mulscalarscalar_2,int+int_2))pinList.fold_left(funaccmonom->addacc(mul_by_monommonomq))zeropletpolynomial_multiplication_fft~domainpq=ifis_nullp||is_nullqthenzeroelse(* Evaluate P on the domain -> eval_p contains N points where N is the
domain size. The resulting list contains the points P(w_i) where w_i
\in D
*)leteval_p=evaluation_fft~domainpin(* Evaluate Q on the domain -> eval_q contains N points where N is the
domain size. The resulting list contains the points Q(w_i) where w_i
\in D.
*)leteval_q=evaluation_fft~domainqin(* Contains N points, resulting of p(w_i) * q(w_i) where w_i \in D *)leteval_pq=List.(rev(rev_map2(funab->R.mulab)eval_peval_q))ininterpolation_fft~domaineval_pqleteuclidian_division_optab=ifis_nullbthenNoneelseletdeg_b=degree_intbinlethighest_coeff_b=get_highest_coefficientbinletrecauxqr=ifdegree_intr<deg_bthenSome(q,r)elseletdiff_degree=degree_intr-deg_binletrescale_factor=R.(get_highest_coefficientr/highest_coeff_b)inletto_sub=polynomial_multiplicationb[(rescale_factor,diff_degree)]inaux(addq[(rescale_factor,diff_degree)])(subrto_sub)inauxzeroaletextended_euclidepolynomial_1polynomial_2=letn_1=degree_intpolynomial_1andn_2=degree_intpolynomial_2inifn_1=-1&&n_2=-1then(zero,zero,zero)elseifn_1=-1thenletrescale_factor=R.inverse_exn@@get_highest_coefficientpolynomial_2in(mult_by_scalarrescale_factorpolynomial_2,zero,mult_by_scalarrescale_factorone)elseifn_2=-1thenletrescale_factor=R.inverse_exn@@get_highest_coefficientpolynomial_1in(mult_by_scalarrescale_factorpolynomial_1,mult_by_scalarrescale_factorone,zero)elseletrecauxpoly_1u_1v_1poly_2u_2v_2=letq,r=euclidian_division_optpoly_1poly_2|>Option.getinifis_nullrthen(poly_2,u_2,v_2)elseauxpoly_2u_2v_2r(subu_1(polynomial_multiplicationqu_2))(subv_1(polynomial_multiplicationqv_2))inletgcd,u,v=auxpolynomial_1onezeropolynomial_2zerooneinletrescale_factor=R.inverse_exn@@get_highest_coefficientgcdin(mult_by_scalarrescale_factorgcd,mult_by_scalarrescale_factoru,mult_by_scalarrescale_factorv)letto_stringp=letrecinnerl=matchlwith|[]->"0"|[(e,p)]->ifR.is_onee&&p=1thenPrintf.sprintf"X"elseifp=1thenPrintf.sprintf"%sX"(R.to_stringe)elseifp=0thenPrintf.sprintf"%s"(R.to_stringe)elseifR.is_oneethenPrintf.sprintf"X^%d"pelsePrintf.sprintf"%s X^%d"(R.to_stringe)p|(e,p)::tail->ifR.is_onee&&p=1thenPrintf.sprintf"X + %s"(innertail)elseifp=1thenPrintf.sprintf"%sX + %s"(R.to_stringe)(innertail)elseifp=0thenPrintf.sprintf"%s"(R.to_stringe)elseifR.is_oneethenPrintf.sprintf"X^%d + %s"p(innertail)elsePrintf.sprintf"%s X^%d + %s"(R.to_stringe)p(innertail)ininnerplet(=)=equallet(+)=addlet(*)=polynomial_multiplicationlet(-)=subend