GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include"typedef.h"1/**************************************************************************\2@---------------------------------------------------------------------------3@---------------------------------------------------------------------------4@ FILE: short.c5@---------------------------------------------------------------------------6@---------------------------------------------------------------------------7@8\**************************************************************************/910#define EPS 0.0011112static int n, max, min, *vec, anzahl, con;13static int **grn; /* Gram matrix */14static int **ba; /* basis transformation matrix */15static double **mo, *ge;16static matrix_TYP *SV;17static int SV_size, SV_ext;18static int break_opt, f_opt, c_opt;192021static double scapr(i, j)22int i, j;23{24double r, *moi, *moj;25int l;2627r = grn[i][j];28moi = mo[i];29moj = mo[j];30for (l = 0; l <= j-1; ++l)31r -= ge[l] * moi[l] * moj[l];32if (ge[j] == 0)33{34printf("Error: found norm 0 vector\n");35exit(3);36}37r = r / ge[j];38return r;39}4041static double orth(i)42int i;43{44double r, *moi;45int l;4647r = grn[i][i];48moi = mo[i];49for (l = 0; l <= i-1; ++l)50r -= ge[l] * moi[l] * moi[l];51return r;52}5354/*---------------------------------------------------------*\55| makes model of the lattice (with same scalarproducts)56\*__________________________________________________________*/5758static void modellmachen(a, e)59int a, e;60{61int i, j;6263if (a == 0)64{65ge[0] = grn[0][0];66i = 1;67}68else69i = a;70while (i <= e)71{72for (j = 0; j < i; ++j)73mo[i][j] = scapr(i, j);74ge[i] = orth(i);75++i;76}77}7879static int iround(r)80double r;81{82int i;8384if (r >= 0)85i = (int)(2*r + 1) / 2;86else87i = -(int)(2*(-r) + 1) / 2;88return i;89}9091static void red(k, l)92int k, l;93{94double r, *mok, *mol;95int i, ir, *bak, *bal, *grnk, *grnl;9697r = mo[k][l];98if (2*r > 1.0 || 2*r < -1.0)99{100ir = iround(r);101mok = mo[k];102bak = ba[k];103grnk = grn[k];104mol = mo[l];105bal = ba[l];106grnl = grn[l];107for (i = 0; i < n; ++i)108{109mok[i] -= ir * mol[i];110bak[i] -= ir * bal[i];111grnk[i] -= ir * grnl[i];112}113for (i = 0; i < n; ++i)114grn[i][k] -= ir * grn[i][l];115}116}117118static int interchange(k)119int k;120{121int i, z, *zp;122123zp = ba[k];124ba[k] = ba[k-1];125ba[k-1] = zp;126127zp = grn[k];128grn[k] = grn[k-1];129grn[k-1] = zp;130131for (i = 0; i < n; ++i)132{133z = grn[i][k];134grn[i][k] = grn[i][k-1];135grn[i][k-1] = z;136}137if (k > 1)138return k-1;139else140return k;141}142143static void reduzieren(k)144int k;145{146int l;147148for (l = k-2; l >= 0; --l)149red(k, l);150}151152153/* prints the vector corresponding to vec */154/* in the model and its length */155156static void vecschr(m, d)157int m;158double d;159{160int i, j, entry;161int l;162int *v;163164l = iround(d);165if(l >= min)166{167anzahl++;168if(f_opt == TRUE)169break_opt = TRUE;170if(c_opt == TRUE)171return;172if(SV->rows == SV_size)173{174SV_size += SV_ext;175if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_size *sizeof(int *))) == 0)176exit(2);177}178if((v = (int *)malloc((n+1) *sizeof(int))) == 0)179exit(2);180for (i = 0; i < m; ++i)181{182v[i] = 0;183for (j = 0; j < m; ++j)184v[i] += vec[j] * ba[j][i];185}186v[m] = l;187SV->array.SZ[SV->rows] = v;188SV->rows++;189}190191}192193194/* recursion for finding shortest vectors */195196static void shrt(c, damage)197int c;198double damage;199{200double x, gec;201int i, j;202203if (c == -1)204{205for (i = 0; i < n && vec[i] == 0; ++i);206if (i == n)207con = 1;208else209{210vecschr(n, damage);211if(break_opt == TRUE)212return;213}214}215else216{217x = 0.0;218for (j = c+1; j < n; ++j)219x += vec[j] * mo[j][c];220i = -iround(x);221gec = ge[c];222if (gec*(x+i)*(x+i) + damage < max + EPS)223{224while ((gec*(x+i)*(x+i) + damage <= max + EPS) ||225(x + i <= 0))226++i;227--i;228while ((gec*(x+i)*(x+i) + damage < max + EPS) &&229con == 0)230{231vec[c] = i;232if(break_opt == TRUE)233return;234shrt(c-1, gec*(x+i)*(x+i) + damage);235--i;236}237}238}239}240241242243244/**************************************************************************\245@---------------------------------------------------------------------------246@ matrix_TYP *short_vectors(mat, length, lengthmin, find_opt, count_opt, anz)247@ matrix_TYP *mat;248@ int length, lengthmin, find_opt, count_opt, *anz;249@250@ The matrix mat must be a symmetric, positiv definite nxn-Matrix.251@ The function calculates all x in Z^n ( up to multiplication with -1) with252@253@ lengthmin <= n(x) <= length254@ where255@ n(x) := x * mat * x^{tr}.256@257@ In the pointer 'anz' the number of all these vectors is returned.258@ The vectors x are the rows of the returned matrix,259@ called 'SV' in the following.260@ So 'SV' is an integral matrix with 'anz' rows and 'n' columns.261@ For 'SV' n+1 columns are allocated. The last column contains the norm n(x).262@ Although n+1 columns are allocated, SV->cols = n.263@264@ If 'findoption == 1' the Algorithm stops,265@ if a vector of desired norm is found.266@ In this case the Matrix 'SV' has only one row.267@268@ If 'count_option == 1', shortest_vectors returns a zero-pointer,269@ only the number of found vectors is returned in the pointer 'anz'.270@271@ Warning: if 'mat' is not positiv definite, the function runs into an272@ infinite loop.273@274@---------------------------------------------------------------------------275@276\**************************************************************************/277matrix_TYP *short_vectors(mat, length, lengthmin, find_opt, count_opt, anz)278matrix_TYP *mat;279int length, lengthmin, find_opt, count_opt, *anz;280{281int i, j, ak, bk;282double de, cst = 0.75;283char c;284matrix_TYP *erg;285286extern matrix_TYP *init_mat();287288anzahl = 0;289con = 0;290n = mat->rows;291SV_ext = n * (n+1)/2;292break_opt = FALSE;293f_opt = find_opt;294c_opt = count_opt;295296SV = init_mat(1, n+1, "");297free(SV->array.SZ[0]);298SV->cols--;299SV->rows = 0;300if(f_opt == TRUE)301SV_ext = 1;302else303{304if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_ext *sizeof(int *))) == 0)305exit(2);306SV_size = SV_ext;307}308if ((grn = (int**)malloc(n * sizeof(int*))) == 0)309exit (2);310if ((ba = (int**)malloc(n * sizeof(int*))) == 0)311exit (2);312if ((mo = (double**)malloc(n * sizeof(double*))) == 0)313exit (2);314if ((ge = (double*)malloc(n * sizeof(double))) == 0)315exit (2);316if ((vec = (int*)malloc(n * sizeof(int))) == 0)317exit (2);318for (i = 0; i < n; ++i)319{320vec[i] = 0;321if ((grn[i] = (int*)malloc(n * sizeof(int))) == 0)322exit (2);323if ((ba[i] = (int*)malloc(n * sizeof(int))) == 0)324exit (2);325if ((mo[i] = (double*)malloc(n * sizeof(double))) == 0)326exit (2);327for (j = 0; j < n; ++j)328{329ba[i][j] = 0;330mo[i][j] = 0.0;331}332ba[i][i] = 1;333mo[i][i] = 1.0;334335/* read the Gram matrix (can be square or lower triangular) */336for (j = 0; j <= i; ++j)337{338grn[i][j] = mat->array.SZ[i][j];339grn[j][i] = grn[i][j];340}341}342max = length; /* read the maximal length of the vectors */343max *= mat->kgv;344min = lengthmin;345min *= mat->kgv;346347bk = 1;348while (bk < n)349{350ak = bk - 1;351modellmachen(ak, bk);352red(bk, bk-1);353if (ge[bk] < ((cst - mo[bk][bk-1]*mo[bk][bk-1]) * ge[bk-1]))354{355bk = interchange(bk);356modellmachen(bk-1, bk);357if (bk > 1)358--bk;359}360else361{362if (bk > 1)363reduzieren(bk);364++bk;365}366}367/* handel a special case, inserted 30/4/97 tilman */368if (n==1){369ge[0] = 1;370}371372shrt(n-1, 0.0); /* recursively calculate the vectors up to length max */373*anz = anzahl;374375for(i=0;i<n;i++)376{377free(grn[i]);378free(ba[i]);379free(mo[i]);380}381free(grn); free(ba); free(mo); free(ge); free(vec);382383erg = SV;384SV = NULL;385return(erg);386}387388389