GAP 4.8.9 installation with standard packages -- copy to your CoCalc project to get it
#include"typedef.h"1/**************************************************************************\2@---------------------------------------------------------------------------3@---------------------------------------------------------------------------4@ FILE: rest_short.c5@---------------------------------------------------------------------------6@---------------------------------------------------------------------------7@8\**************************************************************************/910#define EPS 0.0011112static int n, min, *vec, anzahl;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;19static int *rv;20static double *rvd, rk, max;212223static double scapr(i, j)24int i, j;25{26double r, *moi, *moj;27int l;2829r = grn[i][j];30moi = mo[i];31moj = mo[j];32for (l = 0; l <= j-1; ++l)33r -= ge[l] * moi[l] * moj[l];34if (ge[j] == 0)35{36printf("Error: found norm 0 vector\n");37exit(3);38}39r = r / ge[j];40return r;41}4243static double orth(i)44int i;45{46double r, *moi;47int l;4849r = grn[i][i];50moi = mo[i];51for (l = 0; l <= i-1; ++l)52r -= ge[l] * moi[l] * moi[l];53return r;54}5556/*---------------------------------------------------------*\57| makes model of the lattice (with same scalarproducts)58\*__________________________________________________________*/5960static void modellmachen(a, e)61int a, e;62{63int i, j;6465if (a == 0)66{67ge[0] = grn[0][0];68i = 1;69}70else71i = a;72while (i <= e)73{74for (j = 0; j < i; ++j)75mo[i][j] = scapr(i, j);76ge[i] = orth(i);77++i;78}79}8081static int iround(r)82double r;83{84int i;8586if (r >= 0)87i = (int)(2*r + 1) / 2;88else89i = -(int)(2*(-r) + 1) / 2;90return i;91}9293static void red(k, l)94int k, l;95{96double r, *mok, *mol;97int i, ir, *bak, *bal, *grnk, *grnl;9899r = mo[k][l];100if (2*r > 1.0 || 2*r < -1.0)101{102ir = iround(r);103mok = mo[k];104bak = ba[k];105grnk = grn[k];106mol = mo[l];107bal = ba[l];108grnl = grn[l];109for (i = 0; i < n; ++i)110{111mok[i] -= ir * mol[i];112bak[i] -= ir * bal[i];113grnk[i] -= ir * grnl[i];114}115rv[l] += ir * rv[k];116for (i = 0; i < n; ++i)117grn[i][k] -= ir * grn[i][l];118}119}120121static int interchange(k)122int k;123{124int i, z, *zp;125126zp = ba[k];127ba[k] = ba[k-1];128ba[k-1] = zp;129130z = rv[k];131rv[k] = rv[k-1];132rv[k-1] = z;133134zp = grn[k];135grn[k] = grn[k-1];136grn[k-1] = zp;137138for (i = 0; i < n; ++i)139{140z = grn[i][k];141grn[i][k] = grn[i][k-1];142grn[i][k-1] = z;143}144if (k > 1)145return k-1;146else147return k;148}149150static void reduzieren(k)151int k;152{153int l;154155for (l = k-2; l >= 0; --l)156red(k, l);157}158159160/* prints the vector corresponding to vec */161/* in the model and its length */162163static void vecschr(m, d)164int m;165double d;166{167int i, j, entry;168int l;169int *v;170171l = iround(d);172if(l >= min)173{174anzahl++;175if(f_opt == TRUE)176break_opt = TRUE;177if(c_opt == TRUE)178return;179if(SV->rows == SV_size)180{181SV_size += SV_ext;182if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_size *sizeof(int *))) == 0)183exit(2);184}185if((v = (int *)malloc((n+1) *sizeof(int))) == 0)186exit(2);187for (i = 0; i < m; ++i)188{189v[i] = 0;190for (j = 0; j < m; ++j)191v[i] += vec[j] * ba[j][i];192}193v[m] = l;194SV->array.SZ[SV->rows] = v;195SV->rows++;196}197}198199200/* recursion for finding shortest vectors */201202static void shrt(c, damage)203int c;204double damage;205{206double x, gec;207int i, j;208209if (c == -1)210{211vecschr(n, damage);212if(break_opt == TRUE)213return;214}215else216{217x = 0.0;218for (j = c+1; j < n; ++j)219x += (vec[j] -rvd[j]) * mo[j][c];220x -= rvd[c];221i = -iround(x);222gec = ge[c];223if (gec*(x+i)*(x+i) + damage < max + EPS)224{225while ((gec*(x+i)*(x+i) + damage <= max + EPS) ||226(x + i <= 0))227++i;228--i;229while ((gec*(x+i)*(x+i) + damage < max + EPS))230{231vec[c] = i;232if(break_opt == TRUE)233return;234shrt(c-1, gec*(x+i)*(x+i) + damage);235--i;236}237}238}239}240241242243244245246/**************************************************************************\247@---------------------------------------------------------------------------248matrix_TYP *short_vectors(mat, length, lengthmin, find_opt, count_opt, anz)249matrix_TYP *mat;250int length, lengthmin, find_opt, count_opt, *anz;251252@ matrix_TYP *rest_short(mat, restvec, rkgv, zaehler, nenner,253@ find_opt, count_opt, anz)254@ matrix_TYP *mat;255@ int *restvec, rkgv;256@ int zaehler, nenner, find_opt, count_opt, *anz;257@258@ The matrix mat must be a symmetric, positiv definite nxn-Matrix.259@ The function calculates all x in Z^n with260@261@ lengthmin <= n(x - 1/rkgv * restvec) <= length262@ where263@ n(y) := y * mat * y^{tr}.264@265@ In the pointer 'anz' the number of all these vectors is returned.266@ The vectors x are the rows of the returned matrix, called 'SV' in the267@ following.268@ So 'SV' is an integral matrix with 'anz' rows and 'n' columns.269@ For 'SV' n+1 columns are allocated. The last column contains the norm n(x).270@ Although n+1 columns are allocated, SV->cols = n.271@272@ If 'findoption == 1' the Algorithm stops,273@ if a vector of desired norm is found.274@ In this case the Matrix 'SV' has only one row.275@276@ If 'count_option == 1', shortest_vectors returns a zero-pointer,277@ only the number of found vectors is returned in the pointer 'anz'.278@279@ Warning: if 'mat' is not positiv definite, the function runs into an280@ infinite loop.281@282@---------------------------------------------------------------------------283@284\**************************************************************************/285matrix_TYP *rest_short(mat, restvec, rkgv, zaehler, nenner, find_opt, count_opt, anz)286matrix_TYP *mat;287int *restvec, rkgv;288int zaehler, nenner, find_opt, count_opt, *anz;289{290int i, j, ak, bk;291double de, cst = 0.75;292char c;293matrix_TYP *erg;294295extern matrix_TYP *init_mat();296297anzahl = 0;298n = mat->rows;299SV_ext = n * (n+1)/2;300break_opt = FALSE;301f_opt = find_opt;302c_opt = count_opt;303304SV = init_mat(1, n+1, "");305free(SV->array.SZ[0]);306SV->cols--;307SV->rows = 0;308if(f_opt == TRUE)309SV_ext = 1;310else311{312if((SV->array.SZ = (int **)realloc(SV->array.SZ, SV_ext *sizeof(int *))) == 0)313exit(2);314SV_size = SV_ext;315}316if ((grn = (int**)malloc(n * sizeof(int*))) == 0)317exit (2);318if ((ba = (int**)malloc(n * sizeof(int*))) == 0)319exit (2);320if ((mo = (double**)malloc(n * sizeof(double*))) == 0)321exit (2);322if ((ge = (double*)malloc(n * sizeof(double))) == 0)323exit (2);324if ((vec = (int*)malloc(n * sizeof(int))) == 0)325exit (2);326if ((rv = (int*)malloc(n * sizeof(int))) == 0)327exit (2);328if ((rvd = (double*)malloc(n * sizeof(double))) == 0)329exit (2);330for (i = 0; i < n; ++i)331{332vec[i] = 0;333rv[i] = restvec[i];334if ((grn[i] = (int*)malloc(n * sizeof(int))) == 0)335exit (2);336if ((ba[i] = (int*)malloc(n * sizeof(int))) == 0)337exit (2);338if ((mo[i] = (double*)malloc(n * sizeof(double))) == 0)339exit (2);340for (j = 0; j < n; ++j)341{342ba[i][j] = 0;343mo[i][j] = 0.0;344}345ba[i][i] = 1;346mo[i][i] = 1.0;347348/* read the Gram matrix (can be square or lower triangular) */349for (j = 0; j <= i; ++j)350{351grn[i][j] = mat->array.SZ[i][j];352grn[j][i] = grn[i][j];353}354}355rk = ((double) rkgv);356max = (double) zaehler; /* read the maximal length of the vectors */357max *= ((double) mat->kgv);358if(nenner != 0)359max = max /((double) nenner);360min = 0;361362bk = 1;363while (bk < n)364{365ak = bk - 1;366modellmachen(ak, bk);367red(bk, bk-1);368if (ge[bk] < ((cst - mo[bk][bk-1]*mo[bk][bk-1]) * ge[bk-1]))369{370bk = interchange(bk);371modellmachen(bk-1, bk);372if (bk > 1)373--bk;374}375else376{377if (bk > 1)378reduzieren(bk);379++bk;380}381}382for(i=0;i<n;i++)383rvd[i] = ((double) rv[i])/rk;384385shrt(n-1, 0.0); /* recursively calculate the vectors up to length max */386*anz = anzahl;387388for(i=0;i<n;i++)389{390free(grn[i]);391free(ba[i]);392free(mo[i]);393}394free(grn); free(ba); free(mo); free(ge); free(vec);395free(rv); free(rvd);396397erg = SV;398SV = NULL;399return(erg);400}401402403