GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
/***** This file contains routines for lattice reduction and the1calculation of shortest vectors *****/2#include "typedef.h"34/*********************************************************************\5| changes v according to the transformation matrix T, i.e. v := T*v6\*********************************************************************/7static void change(v, nv, T, n)8int **v, nv, **T, n;9{10int i, j, k, **w, *wi, *Ti, *vi, *vj, fac;1112if ((w = (int**)malloc(nv * sizeof(int*))) == 0)13exit (2);14for (i = 0; i < nv; ++i)15{16if ((w[i] = (int*)malloc(n * sizeof(int))) == 0)17exit (2);18wi = w[i];19for (j = 0; j < n; ++j)20wi[j] = 0;21}22for (i = 0; i < nv; ++i)23{24wi = w[i];25Ti = T[i];26for (j = 0; j < nv; ++j)27{28if ((fac = Ti[j]) != 0)29{30vj = v[j];31for (k = 0; k < n; ++k)32wi[k] += fac * vj[k];33}34}35}36for (i = 0; i < nv; ++i)37{38vi = v[i];39wi = w[i];40for (j = 0; j < n; ++j)41vi[j] = wi[j];42free(wi);43}44free(w);45}4647/**********************************************************************\48| LLL-reduction of the positive semidefinite49| Gram-matrix F with transformation matrix T50\**********************************************************************/51static int lll(F, T, dim)52int **F, **T, dim;53{54int **gram, i, j, m, l, rank, *ptmp, tmp;55double **mu, *B;5657/* the weights */58if ((B = (double*)malloc(dim * sizeof(double))) == 0)59exit (2);60/* the model matrix */61if ((mu = (double**)malloc(dim * sizeof(double*))) == 0)62exit (2);63/* F is copied on gram and remains unchanged */64if ((gram = (int**)malloc(dim * sizeof(int*))) == 0)65exit (2);66for (i = 0; i < dim; ++i)67{68if ((mu[i] = (double*)malloc(dim * sizeof(double))) == 0)69exit (2);70if ((gram[i] = (int*)malloc(dim * sizeof(int))) == 0)71exit (2);72for (j = 0; j < dim; ++j)73{74T[i][j] = 0;75mu[i][j] = 0.0;76gram[i][j] = F[i][j];77}78T[i][i] = 1;79mu[i][i] = 1.0;80}81/* the first basis-vector should not have norm 0 */82for (i = 0; i < dim && gram[i][i] == 0; ++i);83if (i == dim)84return(0);85else if (i > 0)86{87ptmp = gram[i];88gram[i] = gram[0];89gram[0] = ptmp;90for (j = 0; j < dim; ++j)91{92tmp = gram[j][i];93gram[j][i] = gram[j][0];94gram[j][0] = tmp;95}96T[0][0] = 0;97T[0][i] = 1;98T[i][i] = 0;99T[i][0] = 1;100}101rank = dim;102initialize(0, mu, B, gram);103if (dim > 1)104initialize(1, mu, B, gram);105/* recursively go through the matrix */106m = 1;107l = 0;108while (m < rank)109m = red(&m, &l, gram, T, mu, B, dim, &rank);110free(B);111for (i = 0; i < dim; ++i)112{113free(mu[i]);114free(gram[i]);115}116free(mu);117free(gram);118return(rank);119}120121/**********************************************************************\122| initialization of the model123\**********************************************************************/124static void initialize(i, mu, B, gram)125int i, **gram;126double **mu, *B;127{128int j, k;129double muh, *mui, *muj;130131B[i] = (double)gram[i][i];132mui = mu[i];133for (j = 0; j < i; ++j)134{135muh = (double)gram[i][j];136muj = mu[j];137for (k = 0; k < j; ++k)138muh -= B[k] * mui[k] * muj[k];139muh /= B[j];140B[i] -= B[j] * muh * muh;141mui[j] = muh;142}143}144145/**********************************************************************\146| pair-reduction with vectors m and l,147| changes Gram-matrix, transformation matrix and model appropriately148\**********************************************************************/149static int red(m, l, gram, T, mu, B, dim, rank)150int *m, *l, **gram, **T, dim, *rank;151double **mu, *B;152{153double r;154int j, ir, *ptmp, jump, *Tm, *Tl, *gramm, *graml;155156jump = 0;157r = mu[*m][*l];158if (r > 0.5 || r < -0.5)159{160ir = iround(r);161Tm = T[*m];162Tl = T[*l];163gramm = gram[*m];164graml = gram[*l];165for (j = 0; j < dim; ++j)166{167Tm[j] -= ir * Tl[j];168gramm[j] -= ir * graml[j];169}170for (j = 0; j < dim; ++j)171gram[j][*m] -= ir * gram[j][*l];172initialize(*m, mu, B, gram);173}174gramm = gram[*m];175for (j = 0; j < *rank && gramm[j] == 0; ++j);176if (j == *rank)177{178ptmp = T[*m];179T[*m] = T[*rank-1];180T[*rank-1] = ptmp;181for (j = 0; j < dim; ++j)182{183gram[*m][j] = gram[*rank-1][j];184gram[*rank-1][j] = 0;185}186for (j = 0; j < dim; ++j)187{188gram[j][*m] = gram[j][*rank-1];189gram[j][*rank-1] = 0;190}191*rank -= 1;192if (*m < *rank)193{194initialize(*m, mu, B, gram);195*l = *m-1;196jump = 1;197}198else199jump = 1;200}201if (*l == *m-1 && jump == 0)202check(B, m, l, gram, T, mu, dim, rank);203else if (jump == 0)204decrease(m, l, gram, mu, B, rank);205return(*m);206}207208/**********************************************************************\209| check the LLL-condition210\**********************************************************************/211static void check(B, m, l, gram, T, mu, dim, rank)212int *m, *l, **gram, **T, dim, *rank;213double *B, **mu;214{215if (B[*m] < (LLL_CONST - mu[*m][*m-1]*mu[*m][*m-1]) * B[*m-1])216interchange(m, l, gram, T, mu, B, dim);217else218{219*l = *m-1;220decrease(m, l, gram, mu, B, rank);221}222}223224/**********************************************************************\225| go back in the recursion and change the model226\**********************************************************************/227static void decrease(m, l, gram, mu, B, rank)228int *m, *l, **gram, *rank;229double **mu, *B;230{231*l -= 1;232if (*l < 0)233{234*m += 1;235if (*m < *rank)236{237*l = *m-1;238initialize(*m, mu, B, gram);239}240}241}242243/**********************************************************************\244| interchange the vectors nr. m and m-1245| and change the model appropriately246\**********************************************************************/247static void interchange(m, l, gram, T, mu, B, dim)248int *m, *l, **gram, **T, dim;249double **mu, *B;250{251int i, tmp, *ptmp;252/* these variables weren't used at all, delete 02/12/97253double Mu, b; */254255ptmp = T[*m];256T[*m] = T[*m-1];257T[*m-1] = ptmp;258ptmp = gram[*m];259gram[*m] = gram[*m-1];260gram[*m-1] = ptmp;261for (i = 0; i < dim; ++i)262{263tmp = gram[i][*m];264gram[i][*m] = gram[i][*m-1];265gram[i][*m-1] = tmp;266}267initialize(*m-1, mu, B, gram);268if (*m > 1)269{270*m -= 1;271*l = *m-1;272}273else274{275initialize(*m, mu, B, gram);276*l = *m-1;277}278}279280/**********************************************************************\281| rounds x to an integer282\**********************************************************************/283static int iround(x)284double x;285{286if (x >= 0)287return((int)(2.0*x + 1.0) / 2);288else289return(-((int)(-2.0*x + 1.0) / 2));290}291292293