/* glplan3.c (l_gener) */

/*----------------------------------------------------------------------
-- Copyright (C) 2000, 2001, 2002 Andrew Makhorin <mao@mai2.rcnet.ru>,
--               Department for Applied Informatics, Moscow Aviation
--               Institute, Moscow, Russia. All rights reserved.
--
-- This file is a part of GLPK (GNU Linear Programming Kit).
--
-- GLPK is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- GLPK is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
-- License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GLPK; see the file COPYING. If not, write to the Free
-- Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
----------------------------------------------------------------------*/

#include <errno.h>
#include <stdio.h>
#include <string.h>
#include "glplang.h"
#include "glpmat.h"

#define error print

/*----------------------------------------------------------------------
-- gener_name - generate plain row/column name.
--
-- This routine generates a plain name for the given row (1 <= k <= m)
-- or column (m+1 <= k <= m+n) and returns a pointer to static buffer
-- which contains the generated name in the following form:
--
--    "spar[item-1,...,item-n]"
--
-- where spar is a name of the corresponding array (of model variables
-- or constraints), item-1, ..., item-n are names of the corresponding
-- subscripts. If variable/column is a scalar, the name doesn't include
-- subscript list and square brackets. */

char *gener_name(struct prob *prob, int k)
{     static char name[255+1];
      int len, t;
      insist(1 <= k && k <= prob->m+prob->n);
      /* determine expected name length */
      len = strlen(prob->spar[k]->name);
      if (prob->spar[k]->dim > 0)
      {  len++;
         for (t = 0; t < prob->spar[k]->dim; t++)
         {  if (t > 0) len++;
            len += strlen(prob->memb[k]->item[t]->name);
         }
         len++;
      }
      /* if the name is expected too long, generate something easier */
      if (len > 255)
      {  if (k <= prob->m)
            sprintf(name, "((row %d))", k);
         else
            sprintf(name, "((col %d))", k - prob->m);
         goto done;
      }
      /* generate the name */
      strcpy(name, prob->spar[k]->name);
      if (prob->spar[k]->dim > 0)
      {  strcat(name, "[");
         for (t = 0; t < prob->spar[k]->dim; t++)
         {  if (t > 0) strcat(name, ",");
            strcat(name, prob->memb[k]->item[t]->name);
         }
         strcat(name, "]");
      }
      insist((int)strlen(name) == len);
done: return name;
}

/*----------------------------------------------------------------------
-- stack_size - determine stack size for symbolic computation.
--
-- This routine determines the stack size (i.e. number of intermidiate
-- results) which is needed for symbolic computation of the given model
-- expression specified by the parameter expr. */

int stack_size(EXPR *expr)
{     CODE *code;
      int size = 0, top = 0;
      insist(expr != NULL);
      for (code = expr->head; code != NULL; code = code->next)
      {  switch (code->op)
         {  case C_CON: top++; break;
            case C_VAR: top++; break;
            case C_NEG:        break;
            case C_ADD: top--; break;
            case C_SUB: top--; break;
            case C_MUL: top--; break;
            case C_DIV: top--; break;
            default:    insist(code->op != code->op);
         }
         insist(top >= 1);
         if (size < top) size = top;
      }
      insist(top == 1);
      return size;
}

/*----------------------------------------------------------------------
-- create_prob - create data structure for LP/MIP problem generator.
--
-- This routine obtains data from the main data structures in order to
-- create a data structure used by the LP/MIP problem generator. */

struct prob *create_prob(void)
{     struct prob *prob;
      AVLNODE *node; SPAR *spar; MEMB *memb;
      int m, n, size, j, k;
      /* determine number of rows (constraints), assign sequential
         numbers to rows, and determine required stack size */
      m = 0;
      size = 0;
      for (node = next_node(pdb->tree, NULL); node != NULL;
           node = next_node(pdb->tree, node))
      {  if (node->type == 'C')
         {  spar = node->link;
            for (memb = spar->first; memb != NULL; memb = memb->next)
            {  CONS *cons = memb->link;
               int temp;
               cons->seqn = ++m;
               temp = stack_size(cons->expr);
               if (size < temp) size = temp;
            }
         }
      }
      /* determine number of columns (variables) and assign sequential
         numbers to columns */
      n = 0;
      for (node = next_node(pdb->tree, NULL); node != NULL;
           node = next_node(pdb->tree, node))
      {  if (node->type == 'V')
         {  spar = node->link;
            for (memb = spar->first; memb != NULL; memb = memb->next)
            {  VAR *var = memb->link;
               var->seqn = ++n;
            }
         }
      }
      /* create the data structure */
      prob = umalloc(sizeof(struct prob));
      prob->m = m;
      prob->n = n;
      prob->size = size;
      prob->spar = ucalloc(1+m+n, sizeof(SPAR *));
      prob->memb = ucalloc(1+m+n, sizeof(MEMB *));
      prob->obj_dir = pdb->obj_dir;
      if (pdb->obj_spar == NULL)
         prob->obj_row = 0;
      else
         prob->obj_row = ((CONS *)pdb->obj_memb->link)->seqn;
      prob->pool = create_pool(sizeof(struct elem));
      prob->stack = ucalloc(1+size, sizeof(struct elem *));
      prob->work = ucalloc(1+n, sizeof(double));
      for (j = 0; j <= n; j++) prob->work[j] = 0.0;
      /* build row (constraint) list */
      k = 0;
      for (node = next_node(pdb->tree, NULL); node != NULL;
           node = next_node(pdb->tree, node))
      {  if (node->type == 'C')
         {  spar = node->link;
            for (memb = spar->first; memb != NULL; memb = memb->next)
            {  k++;
               prob->spar[k] = spar;
               prob->memb[k] = memb;
            }
         }
      }
      /* build column (variable) list */
      for (node = next_node(pdb->tree, NULL); node != NULL;
           node = next_node(pdb->tree, node))
      {  if (node->type == 'V')
         {  spar = node->link;
            for (memb = spar->first; memb != NULL; memb = memb->next)
            {  k++;
               prob->spar[k] = spar;
               prob->memb[k] = memb;
            }
         }
      }
      insist(k == m + n);
      return prob;
}

/*----------------------------------------------------------------------
-- erase_form - delete linear form.
--
-- This routine deletes linear form which is specified by the initial
-- pointer row. All form elements are returned to the memory pool. */

void erase_form(struct prob *prob, struct elem *row)
{     struct elem *e;
      while (row != NULL)
      {  e = row;
         row = e->next;
         free_atom(prob->pool, e);
      }
      return;
}

/*----------------------------------------------------------------------
-- build_form - build linear form for given row (constraint).
--
-- This routine symbolically computes linear form for i-th row (model
-- constraint) and returns a pointer to the beginning of the computed
-- linear form. This form is a linked list, where elements are either
-- linear term or constant term. If error occurs, the routine returns
-- NULL. The calling routine should use the erase_form routine in order
-- to delete the built linear form. */

struct elem *build_form(struct prob *prob, int i)
{     CONS *cons; CODE *code;
      int m = prob->m , n = prob->n, top;
      struct elem **stack = prob->stack, *e, *x, *y;
      double *work = prob->work;
      insist(1 <= i && i <= m);
      cons = prob->memb[i]->link;
      /* compute associated expression using push-down machine */
      top = 0;
      for (code = cons->expr->head; code != NULL; code = code->next)
      {  switch (code->op)
         {  case C_CON:
               /* model constant */
               e = get_atom(prob->pool);
               e->j = 0;
               e->val = code->arg.con;
               e->next = NULL;
               stack[++top] = e;
               break;
            case C_VAR:
               /* model variable */
               e = get_atom(prob->pool);
               e->j = ((VAR *)code->arg.var.memb->link)->seqn;
               insist(0 <= e->j && e->j <= n);
               e->val = 1.0;
               e->next = NULL;
               stack[++top] = e;
               break;
            case C_NEG:
               /* unary minus */
               for (e = stack[top]; e != NULL; e = e->next)
                  e->val = - e->val;
               break;
            case C_SUB:
               /* subtraction */
               for (e = stack[top]; e != NULL; e = e->next)
                  e->val = - e->val;
               /* no break */
            case C_ADD:
               /* addition */
               y = stack[top--];
               x = stack[top--];
               /* work := x */
               for (e = x; e != NULL; e = e->next)
                  work[e->j] = e->val;
               /* work := work + y */
               for (e = y; e != NULL; e = e->next)
                  work[e->j] += e->val;
               /* update existing elements of x */
               for (e = x; e != NULL; e = e->next)
                  e->val = work[e->j], work[e->j] = 0.0;
               /* add new non-zero elements to x */
               for (e = y; e != NULL; e = e->next)
               {  if (work[e->j] != 0.0)
                  {  struct elem *ee = get_atom(prob->pool);
                     ee->j = e->j;
                     ee->val = work[e->j], work[e->j] = 0.0;
                     ee->next = x, x = ee;
                  }
               }
               /* now all elements of work are zero */
               erase_form(prob, y);
               stack[++top] = x;
               break;
            case C_MUL:
               /* multiplication */
               y = stack[top--];
               x = stack[top--];
               if (x->j == 0 && x->next == NULL)
               {  /* the first multiplicand is scalar */
                  for (e = y; e != NULL; e = e->next) e->val *= x->val;
                  erase_form(prob, x);
                  stack[++top] = y;
               }
               else if (y->j == 0 && y->next == NULL)
               {  /* the second multiplicand is scalar */
                  for (e = x; e != NULL; e = e->next) e->val *= y->val;
                  erase_form(prob, y);
                  stack[++top] = x;
               }
               else
err:           {  /* both multiplicands are linear form */
                  error("build_form: non-linear constraint `%s' detecte"
                     "d", gener_name(prob, i));
                  return NULL;
               }
               break;
            case C_DIV:
               /* division */
               y = stack[top--];
               x = stack[top--];
               /* the divisor should be scalar */
               if (!(y->j == 0 && y->next == NULL)) goto err;
               /* the divisor should be non-zero */
               if (y->val == 0.0)
               {  error("build_form: zero divide occured on processing "
                     "constraint `%s'", gener_name(prob, i));
                  return NULL;
               }
               for (e = x; e != NULL; e = e->next) e->val /= y->val;
               erase_form(prob, y);
               stack[++top] = x;
               break;
            default:
               insist(code->op != code->op);
         }
      }
      /* resultant linear form is on top of the stack */
      insist(top == 1);
      return prob->stack[1];
}

/*----------------------------------------------------------------------
-- delete_prob - delete data structure for LP/MIP problem generator.
--
-- This routine deletes the data structure (used by the LP/MIP problem
-- generates) freeing all the memory allocated to this object. */

void delete_prob(struct prob *prob)
{     ufree(prob->spar);
      ufree(prob->memb);
      delete_pool(prob->pool);
      ufree(prob->stack);
      ufree(prob->work);
      ufree(prob);
      return;
}

/*----------------------------------------------------------------------
-- gener_lp - generate LP/MIP problem in plain text format.
--
-- This routine generates LP/MIP problem using data from the main data
-- structures of the language processor. The result is written to the
-- text file whose name is the character string fname. This routine may
-- be used as an example for writing problem generators based on the
-- GLPK/L language. Output produced by the routine may be also used for
-- model debugging purposes.
--
-- If no error occured, the routine returns zero. Otherwise the routine
-- returns non-zero. */

int gener_lp(char *fname)
{     FILE *fp;
      struct prob *prob = NULL;
      MAT *A = NULL;
      double *rhs = NULL;
      int m, n, i, j;
      print("gener_lp: write generated problem to `%s'...", fname);
      /* open the output text file */
      fp = fopen(fname, "w");
      if (fp == NULL)
      {  error("gener_lp: can't create `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      fprintf(fp, "Generated LP/MIP problem\n");
      fprintf(fp, "\n");
      /* create auxiliary data structure */
      prob = create_prob();
      m = prob->m;
      n = prob->n;
      /* build the constraint matrix (this matrix is needed in order to
         output constraint in column-wise format, because the main data
         structures provide only row-wise accessing) */
      /* build the right-hand side vector; i-th element of this vector
         is the constant term of i-th constraint (with opposite sign) */
      A = create_mat(m == 0 ? 1 : m, n == 0 ? 1 : n);
      rhs = ucalloc(1+m, sizeof(double));
      for (i = 1; i <= m; i++)
      {  struct elem *form, *e;
         form = build_form(prob, i);
         if (form == NULL) goto fail;
         for (e = form; e != NULL; e = e->next)
         {  if (e->j == 0)
               rhs[i] = - e->val;
            else
               new_elem(A, i, e->j, e->val);
         }
         erase_form(prob, form);
      }
      sort_mat(A);
      /* print general information */
      fprintf(fp, "%-12s%s\n", "Problem:", pdb->model_name);
      fprintf(fp, "%-12s%d\n", "Rows:", m);
      fprintf(fp, "%-12s%d\n", "Columns:", n);
      fprintf(fp, "%-12s%d\n", "Non-zeros:", count_nz(A, 0));
      fprintf(fp, "%-12s", "Objective:");
      if (prob->obj_row == 0)
         fprintf(fp, "(undefined)\n");
      else
         fprintf(fp, "%s (%s)\n", gener_name(prob, prob->obj_row),
            prob->obj_dir == '-' ? "MINimization" :
            prob->obj_dir == '+' ? "MAXimization" : "???");
      /* print rows (constraints) */
      fprintf(fp, "\n");
      fprintf(fp, "****** ROWS (CONSTRAINTS) ******\n");
      for (i = 1; i <= m; i++)
      {  CONS *cons = prob->memb[i]->link; ELEM *e;
         char *name = gener_name(prob, i);
         fprintf(fp, "\n");
         fprintf(fp, "row %d: ", i);
         switch (cons->type)
         {  case 'F':
               fprintf(fp, "%s\n", name);
               if (rhs[i] != 0.0)
                  fprintf(fp, "   %.12g (constant term)\n", - rhs[i]);
               break;
            case 'L':
               fprintf(fp, "%s >= %.12g\n", name, cons->lb + rhs[i]);
               break;
            case 'U':
               fprintf(fp, "%s <= %.12g\n", name, cons->ub + rhs[i]);
               break;
            case 'D':
               fprintf(fp, "%.12g <= %s <= %.12g\n",
                  cons->lb + rhs[i], name, cons->ub + rhs[i]);
               break;
            case 'S':
               fprintf(fp, "%s = %.12g\n", name, cons->lb + rhs[i]);
               break;
            default:
               insist(cons->type != cons->type);
         }
         /* print linear terms in row-wise format */
         for (e = A->row[i]; e != NULL; e = e->row)
            fprintf(fp, "   %.12g * %s\n",
               e->val, gener_name(prob, m + e->j));
      }
      /* print columns (variables) */
      fprintf(fp, "\n");
      fprintf(fp, "****** COLUMNS (VARIABLES) ******\n");
      for (j = 1; j <= n; j++)
      {  VAR *var = prob->memb[m+j]->link; ELEM *e;
         char *name = gener_name(prob, m+j);
         char *kind;
         fprintf(fp, "\n");
         fprintf(fp, "col %d: ", j);
         kind = (var->kind ? " (integer)" : "");
         switch (var->type)
         {  case 'F':
               fprintf(fp, "%s%s\n", name, kind);
               break;
            case 'L':
               fprintf(fp, "%s >= %.12g%s\n", name, var->lb, kind);
               break;
            case 'U':
               fprintf(fp, "%s <= %.12g%s\n", name, var->ub, kind);
               break;
            case 'D':
               fprintf(fp, "%.12g <= %s <= %.12g%s\n",
                  var->lb, name, var->ub, kind);
               break;
            case 'S':
               fprintf(fp, "%s = %.12g%s\n", name, var->lb, kind);
               break;
            default:
               insist(var->type != var->type);
         }
         /* print linear terms in column-wise format */
         for (e = A->col[j]; e != NULL; e = e->col)
            fprintf(fp, "   %s ... %.12g\n",
               gener_name(prob, e->i), e->val);
      }
      /* finish output */
      fprintf(fp, "\n");
      fprintf(fp, "End of output\n");
      fflush(fp);
      if (ferror(fp))
      {  error("gener_lp: can't write to `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      fclose(fp);
      delete_prob(prob);
      delete_mat(A);
      ufree(rhs);
      return 0;
fail: /* an error occurred */
      error("gener_lp: generating impossible due to error");
      if (fp != NULL) fclose(fp);
      if (prob != NULL) delete_prob(prob);
      if (A != NULL) delete_mat(A);
      if (rhs != NULL) ufree(rhs);
      return 1;
}

/* eof */
