GAP_link_via_file.c

/****************************************************************************
**
*A  GAP_link_via_file.c         ANUPQ source                   Eamonn O'Brien
*A                                                             & Frank Celler
*A                                                           & Benedikt Rothe
**
*Y  Copyright 1995-1997,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
*Y  Copyright 1995-1997,  School of Mathematical Sciences, ANU,     Australia
**
*/

#include "pq_defs.h"
#include "pcp_vars.h"
#include "pga_vars.h"
#include "constants.h"
#include "global.h"
#include "pq_functions.h"
#include "menus.h"

#if defined(GAP_LINK_VIA_FILE)

/****************************************************************************
**
*F  start_GAP_file
**          write out initial information required for stabiliser calculation
**
*/
void start_GAP_file(FILE **GAP_input,
                    int ***auts,
                    struct pga_vars *pga,
                    struct pcp_vars *pcp)
{
   register int i;
   int nmr_soluble = pga->nmr_soluble;

   /* open "GAP_input" file                                               */
   *GAP_input = OpenSystemFile("GAP_input", "w+");

   if (!GAP4iostream) { /* this is necessary for GAP 4.2 compatibility    */
      fprintf(*GAP_input, "if not IsBound( PcGroupFpGroupNC ) then\n");
      fprintf(*GAP_input, "    PcGroupFpGroupNC := PcGroupFpGroup;\n");
      fprintf(*GAP_input, "fi;\n");
   }

   GAP_presentation(*GAP_input, pcp, 1);
#ifdef HAVE_GMP
   /* report the group and automorphism group order */
   fprintf(*GAP_input, "ANUPQsize := ");
   mpz_out_str(*GAP_input, 10, &(pga->aut_order));
   fprintf(*GAP_input, ";\n");
   fprintf(*GAP_input, "ANUPQagsize := ");
   fprintf(*GAP_input, "%d;;\n", pga->nmr_soluble);
#else
   fprintf(*GAP_input, "ANUPQsize := fail;;\nANUPQagsize := fail;;\n");
#endif

   /* write global variables                                              */
   fprintf(*GAP_input, "ANUPQglb := rec();;\n");
   fprintf(*GAP_input, "ANUPQglb.d := %d;;\n", pcp->ccbeg - 1);
   fprintf(*GAP_input, "ANUPQglb.F := GF(%d);;\n", pga->p);
   fprintf(*GAP_input, "ANUPQglb.one := One (ANUPQglb.F);;\n");
   fprintf(*GAP_input, "ANUPQglb.q := %d;;\n", pga->q);
   fprintf(*GAP_input, "ANUPQglb.s := %d;;\n", pga->s);
   fprintf(*GAP_input, "ANUPQglb.r := %d;;\n", pga->r);
   fprintf(*GAP_input, "ANUPQglb.agAutos := [];;\n");
   fprintf(*GAP_input, "ANUPQglb.glAutos := [];;\n");
   fprintf(*GAP_input, "ANUPQglb.genQ := [];;\n");

   /* write the generators <gendp> to file                                */
   for (i = 1; i <= nmr_soluble; ++i)
      write_GAP_matrix(
          *GAP_input, "ANUPQglb.agAutos", auts[i], pcp->ccbeg - 1, 1, i);


#ifdef DEBUG1
   printf("The relative orders are ");
   for (i = 1; i <= nmr_soluble; ++i)
      printf("%d, ", pga->relative[i]);
   printf("\n");
#endif

   fprintf(*GAP_input, "relativeOrders := [");
   if (nmr_soluble > 0) {
      for (i = 1; i < nmr_soluble; ++i)
         fprintf(*GAP_input, "%d, ", pga->relative[i]);
      fprintf(*GAP_input, "%d", pga->relative[nmr_soluble]);
   }
   fprintf(*GAP_input, "];\n");

   for (i = nmr_soluble + 1; i <= pga->m; ++i)
      write_GAP_matrix(*GAP_input,
                       "ANUPQglb.glAutos",
                       auts[i],
                       pcp->ccbeg - 1,
                       1,
                       i - nmr_soluble);
}


/****************************************************************************
**
*F  write_GAP_matrix
**                                     write out a matrix in a GAP input form
**
*/
void write_GAP_matrix(
    FILE *GAP_input, char *gen, int **A, int size, int start, int nr)
{
   int i, j;

   fprintf(GAP_input, "%s[%d] := [\n", gen, nr);
   for (i = start; i < start + size; ++i) {
      fprintf(GAP_input, "[");
      for (j = start; j < start + size - 1; ++j)
         fprintf(GAP_input, "%d, ", A[i][j]);
      if (i != start + size - 1)
         fprintf(GAP_input, "%d],\n", A[i][j]);
      else
         fprintf(GAP_input, "%d]] * ANUPQglb.one;;\n", A[i][j]);
   }
}


/****************************************************************************
**
*F  insoluble_stab_gens
**          calculate the stabiliser of the supplied representative using GAP
**
*/
void insoluble_stab_gens(int rep,
                         int orbit_length,
                         struct pga_vars *pga,
                         struct pcp_vars *pcp)
{
   FILE *GAP_rep;
   char *path, *command;
   char c;
   int index;
   int *subset;
   int **S;

   /* append the commands to compute the stabilizer                       */
   GAP_rep = OpenFile("GAP_rep", "w+");

   S = label_to_subgroup(&index, &subset, rep, pga);
   GAP_factorise_subgroup(GAP_rep, S, index, subset, pga, pcp);
   free_matrix(S, pga->s, 0);
   free_vector(subset, 0);
   if (!GAP4iostream) {
      fprintf(GAP_rep, "LoadPackage(\"autpgrp\", \"1.5\");\n");
      fprintf(GAP_rep, "if TestPackageAvailability(");
      fprintf(GAP_rep, "\"anupq\", \"3.1\") <> true then\n");
      fprintf(GAP_rep, "  ANUPQData := rec(tmpdir := DirectoryCurrent());\n");
      fprintf(GAP_rep, "  DeclareInfoClass(\"InfoANUPQ\");\n");
      fprintf(GAP_rep, "  DeclareGlobalFunction(");
      fprintf(GAP_rep, "\"PqStabiliserOfAllowableSubgroup\");\n");
      fprintf(GAP_rep, "  ReadPackage(\"anupq\", \"lib/anustab.gi\");\n");
      fprintf(GAP_rep, "fi;\n");
      fprintf(GAP_rep, "SetInfoLevel(InfoANUPQ, 2);\n");
   }
   fprintf(GAP_rep, "PqStabiliserOfAllowableSubgroup( ANUPQglb, F,\n");
   fprintf(GAP_rep, "    gens, relativeOrders, ANUPQsize, ANUPQagsize );\n");

   CloseFile(GAP_rep);

   if (GAP4iostream) {
      printf("GAP, please compute stabiliser!\n");

      /* skip a comment                                                    */
      while ((c = getchar()) == ' ')
         ;
      if (c == '#') {
         while ((c = getchar()) != '\n')
            ;
      }

      /* we expect a line: "pq, stabiliser is ready.\n"                    */
      if (c == 'p')
         putchar(c);
      while ((c = getchar()) != '\n')
         putchar(c);
      putchar(c);
   } else {
      /* try to find gap                                                   */
      if ((path = (char *)getenv("ANUPQ_GAP_EXEC")) == NULL)
#if defined(ANUPQ_GAP_EXEC)
         path = ANUPQ_GAP_EXEC;
#else
         path = "gap";
#endif
      command = (char *)malloc(strlen(path) + 200);
      strcpy(command, path);
      strcat(command, " -r -q -A GAP_input < GAP_rep");

      /* inform the user that we are about to call GAP                     */
      if (isatty(0))
         printf("Now calling GAP to compute stabiliser...\n");
      unlink("LINK_output");

/* compute the stabiliser of the orbit representative                */
#ifdef HAVE_WORKING_VFORK
      if (vsystem(command) != 0)
#else
      if (system(command) != 0)
#endif
      {
         printf("Error in system call to GAP\n");
         exit(FAILURE);
      }
   }

   CloseFile(OpenFile("LINK_output", "r"));

   unlink("GAP_rep");
}

#endif