[PIF85]

Здравствуйте!
Не могли бы Вы написать функцию расстановки коэффициентов в уравнениях хим. реакций. Нужно как один из модулей моей будущей программы (не коммерческая). Для меня это сложно, да и в математических методах слаб. Знаю только, что это можно сделать методом Гаусса-Жордана. Буду очень благодарен за любую помощь.
Спасибо Всем!

[Lost_Fish]

Сперва распроси Гауса-Жордана поподробнее о его методе потом с этим методом сюда

[PIF85]

Сообщение от Lost_Fish

Сперва распроси Гауса-Жордана поподробнее о его методе потом с этим методом сюда

Очень смешно. У меня с математикой проблемы, а у Вас с русским языком ("распроси" пишется с двумя "с")

[lmikle]

Че-то я не понимаю, кому помощь-то нужна???
Здесь форум программистов, а не математиков. Если нужна помощь, то предоставьте теорию (хотя бы ссылку на адекватную статью).

ЗЫ. Последнее китайское предупреждение.

[cotseec]

Перефразирую...
разберитесь с методом Гаусса-Жордана, составьте алгоритм, попробуйте реализовать в Delphi, если последнее не получается, то с кусками кода сюда, если никак даже с первым шагом, то сюда, ну или ждите того, кто знает этот метод

а то получается: "мне надо сделать класс, проводящий ЦОС, приходящего с квадратичного фильтра, мне сказали, что БПФ не подходит (кстати, объясните почему), а нужны 3К преобразования с учетом корреляционной составляющей" (фраза содержит явный бред), а потом непонимание, почему никто "не хочет" помочь

[PIF85]

Нашел в интернете алгоритм ( а точнее код) расстановки коэффициентов в уравнениях химических реакций методом Гаусса-Жордана (как я понял это метод решения систем линейных уравнений). Опять-таки, то, что смог понять из этого кода, так это то, что сначала создается матрица элементов (чисел), затем матрица преобразуется в систему линейных уравнений, которые решаются и из этих уравнений находятся коэффициенты для всех веществ хим. реакции. Проблеме в том, что код написан (как я понял) на С++. Мне и в паскалевском коде такой сложности трудно ориентироваться, а тут тем более.

Код:

/*** Решение уравнений методом Гаусса - Жордана ***/
#include <math.h>
#define GAUSS_ACCURACY 0.0000001
#define GAUSS_OK 0
#define GAUSS_NOSOL 1
#define GAUSS_MANYSOL 2

/*********************************************/
/* Функция решения систем линейных уравнений */
/* методом Гаусса - Жордана                  */
/* (C) 2002 Восков Алексей                   */
/* версия 2.1                                */
/*********************************************/
/* ВХОДНЫЕ ДАННЫЕ */
/* a[20][20] - Матрица для хранения системы a[y][x]
	       последний столбец - для хранения св. члена
	       св. член - в правой части
   n - число неизвестных
   u - число уравнений
   ВЫХОДНЫЕ ДАННЫЕ
   x[20] - массив для хранения корней системы

   в случае нормального выполнения задачи функция
   возвращает 0, в случае неразрешимости 1
   в случае бесконечного числа решений 2 */
int gauss(double a[20][20], int n, int u, double x[20])
{
	int i, j, k;        /* Счетчики циклов */
	int sn;             /* Номер строки */
	double d;           /* Коэффициент домножения или модуль наиб. эл. */

	/*** Проверка u и n ***/
	if (n > u) return 2;

	/*** Приведение к диагональному виду ***/
	for (j = 0; j < n; j++)
	{
		/* а) поиск строки с наибольшим по модулю элементом */
		d = fabs(a[j][j]); sn = j;
		for (i = j; i < u; i++)
			if (fabs(a[i][j]) > d)
			{
				d = fabs(a[i][j]);
				sn = i;
			}

		/* б) перенос строки на надлежащее место */
		for (k = 0; k <= n; k++)
		{
			d = a[sn][k];
			a[sn][k] = a[j][k];
			a[j][k] = d;
		}

		/* в) деление ведущего ур-я на главный элемент */
		d = a[j][j];

		if (d)
			for (k = 0; k <= n; k++) a[j][k] /= d;
		else
			for (k = 0; k <= n; k++) a[j][k] = 0;

		/* г) вычитание данной строки из всех остальных */
		/*    с домножением на коэффициент */
		for (i = 0; i < u; i++)
		{
			if (i == j) continue;  /* Не трогаем вычит. строку */
			d = -a[i][j];
			for (k = 0; k <= n; k++) /* Вычитание */
				a[i][k] += a[j][k] * d;
		}
	}

	/*** Вычисление корней ***/
	/* а) проверка системы на разрешимость */
	if (u > n)
	{
		for (i = n; i < u; i++)
		{
			k = 0;
			for (j = 0; j < n; j++)
				if (fabs(a[i][j]) > GAUSS_ACCURACY) k = 1;
			if (k == 0 && fabs(a[i][n]) > GAUSS_ACCURACY) return 1;
		}
	}

	/* б) поиск корней */
	for (i = 0; i < n; i++)
	{
		x[i] = -a[i][n];
		if (a[i][i] != 1) /** Обработка ошибок **/
		{ if (x[i])
			return GAUSS_NOSOL; /* Решений нет */
		  else
			return GAUSS_MANYSOL; /* Бесконечно много решений */
		}
		if (fabs(x[i]) < GAUSS_ACCURACY) x[i] = 0; /* Обнуление слишком малых знач. */
	}
	return GAUSS_OK; /* Нормальное завершение работы */
}

Собственно ссылка на описание метода:
http://ru.wikipedia.org/wiki/%D0%9C%D0%B5%D1%82%D0%BE%D0%B4_%D0%93%D0%B0%D1%83% D1%81%D1%81%D0%B0_%E2%80%94_%D0%96%D0%BE%D1%80%D0% B4%D0%B0%D0%BD%D0%B0
Выкладываю программу которая основана на этом принципе расстановки коэффициентов. Для примера, можно уравнять реакцию: NaCl+H2SO4+KMnO4=Cl2+MnSO4+Na2SO4+K2SO4+H2O
c_urav.zip
Буду благодарен за перевод кода на Delphi и если возможно, подробное пояснения кода.
Спасибо Всем большое!

[angvelem]

Примерно так:

Код:

{*** Решение уравнений методом Гаусса - Жордана ***}
unit GausJordan;

interface

type
  TInMatr		= array[0..19] of array[0..19] of Double;
  TOutMatr		= array[0..19] of Double;

const
  GAUSS_ACCURACY	= 0.0000001;
  GAUSS_OK		= 0;
  GAUSS_NOSOL		= 1;
  GAUSS_MANYSOL		= 2;

function gauss(a : TInMatr; n, u : Integer; var x : TOutMatr) : Integer;

implementation

{********************************************* 
 * Функция решения систем линейных уравнений * 
 * методом Гаусса - Жордана                  * 
 * (C) 2002 Восков Алексей                   * 
 * версия 2.1                                * 
 *********************************************}
// ВХОДНЫЕ ДАННЫЕ
{  a[20][20] - Матрица для хранения системы a[y][x] 
           последний столбец - для хранения св. члена 
           св. член - в правой части 
   n - число неизвестных    
   u - число уравнений    
   ВЫХОДНЫЕ ДАННЫЕ    
   x[20] - массив для хранения корней системы      
   в случае нормального выполнения задачи функция возвращает 0, 
   в случае неразрешимости 1   в случае бесконечного числа решений 2 }

function gauss(a : TInMatr; n, u : Integer; var x : TOutMatr) : Integer;
var 
  i, j, k : Integer;		// Счетчики циклов
  sn      : Integer;		// Номер строки
  d       : Double;		// Коэффициент домножения или модуль наиб. эл.
begin  
  Result := GAUSS_OK;		// Нормальное завершение работы
  
  //*** Проверка u и n ***
  if n > u then
  begin
    Result := GAUSS_MANYSOL;
    Exit;
  end;
  
  //*** Приведение к диагональному виду ***
  for j := 0 to n - 1 do
  begin         
    // а) поиск строки с наибольшим по модулю элементом
    d  := Abs(a[j][j]);
    sn := j;

    for i := j to u - 1 do
      if Abs(a[i][j]) > d then
      begin
        d  := Abs(a[i][j]);
        sn := i;
      end;
       
    // б) перенос строки на надлежащее место
    for k := 0 to n do
    begin
      d := a[sn][k];
      a[sn][k] := a[j][k];
      a[j][k]  := d;
    end;
     
    // в) деление ведущего ур-я на главный элемент
    d := a[j][j];
     
    if d > 0 then
      for k := 0 to n do
        a[j][k] := a[j][k] / d
    else
      for k := 0 to n do
        a[j][k] := 0;
       
    // г) вычитание данной строки из всех остальных
    //    с домножением на коэффициент
    for i := 0 to u - 1 do
    begin
      if i = j then
        Continue;			// Не трогаем вычит. строку
      d := -a[i][j];

      for k := 0 to n do		// Вычитание
        a[i][k] := a[i][k] + a[j][k] * d;
    end;
  end;

  //*** Вычисление корней ***
  // а) проверка системы на разрешимость
  if u > n then
  begin
    for i := n to u - 1 do
    begin
      k := 0;
      for j := 0 to n - 1 do
        if Abs(a[i][j]) > GAUSS_ACCURACY then
          k := 1;
 
      if (k = 0) and (Abs(a[i][n]) > GAUSS_ACCURACY) then
      begin
        Result := GAUSS_NOSOL;
        Exit;
      end;
    end;
  end;
   
  // б) поиск корней
  for i := 0 to n - 1 do
  begin
    x[i] := -a[i][n];

    if a[i][i] <> 1 then		// Обработка ошибок
    begin
      if x[i] > 0 then
      begin
        Result := GAUSS_NOSOL;		// Решений нет
        Exit;
      end
      else
      begin
        Result := GAUSS_MANYSOL;	// Бесконечно много решений
        Exit;
      end;
    end;

    if Abs(x[i]) < GAUSS_ACCURACY then
      x[i] := 0;			// Обнуление слишком малых знач.
  end;
end;

end.

[PIF85]

Спасибо большое за перевод кода. Не сочтите за наглость, не могли бы перевести еще один модуль программы на язык Делфи. Эти оба модуля исходники программы которую выкладывал выше (с_urav).

[PIF85]

Вот код:

Код:

/*** ПОДКЛЮЧАЕМЫЕ ФАЙЛЫ ***/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "gauss2.inc"
/********** КОНСТАНТЫ **********/
#define ACCURACY GAUSS_ACCURACY
#define ERR_MANYSOL "Реакцию можно уравнять бесконечным числом способов"
#define ERR_NOSOL "Эту реакцию нельзя уравнять"
#define ERR_EQU "Неверное использование '='"
#define ERR_PLUS "Неверное использование '+'"
#define ERR_SYNT "Синтаксическая ошибка"
#define ERR_WRONGEL "Элемент %c%c не может быть уравнен"
#define ERR_CHARGE "Нарушен закон сохранения заряда"
#define ERR_MANYELEM "Слишком много элементов"
#define ERR_MANYCOMP "Слишком много соединений"
#define ERR_MANYBR "Слишком много скобок"
#define ERR_SYNTBR "Неправильное использование скобок"
/********** ОБЪЯВЛЕНИЯ ФУНКЦИЙ **********/
double rou(double x);
char cmpzero(double x);
/********** СТРУКТУРЫ **********/
struct composition /* Структура для хранения формулы вещества */
{
	char name[64];   /* Название соединения */
	int charge;      /* Заряд иона */
};
struct brackets /* Структура для хранения координат скобок */
{
	unsigned char open_sign; /* Символ открытой скобки */
	unsigned char close_sign; /* Символ закрытой скобки */
	int open_pos;        /* Позиция открывающей скобки */
	int close_pos;       /* Позиция закрывающей скобки */
	double index;        /* Индекс при скобке */
};
/********** ОСНОВНАЯ ФУНКЦИЯ **********/
/*  Эта функция осуществляет уравнивание
    уравнения реакции. Формат ввода указан
    в начале этого листинга.
    char *in  - входная строка
    char *res - выходная строка
    Функция возвращает 0 в случае успеха
                     и 1 в случае ошибки 
    В выходной строке записано либо уравненное
    уравнение, либо текстовое сообщение с
    описанием ошибки */

/*** Макросы при функции c_urav ***/
/* Вывод на печать строк */
#define PRINT(fmt, arg) {sprintf(buf, fmt, arg); \
                         strcat(res, buf);}
#define LPRINT(arg) {sprintf(buf, arg);\
                     strcat(res, buf);}
/* Вывод сообщения об ошибке на экран
   и завершение работы программы */
#define errmessage(txt) {sprintf(res,"%s",txt); return 1;}
int c_urav(char *in, char *res)
{	char buf[100];               /* Буфер для печати */
	char eq[256];                /* Буфер для уравнения */
	struct composition comp[20]; /* Формулы соединений */
	char elem[60] = {0};	     /* Массив для хранения знаков эл.*/
				     /* 2 знака на каждый элемент */
	char ce[3]={0};	             /* Знак текущего хим. элемента */
	double a[20][20] = {0};      /* Матрица для хранения системы ур-ий*/
	double x[20];                /* Матрица для хранения коэфф. */
	int ncomp; /* (Число соединений в уравнении) - 1 */
	int nelem; /* (Число элементов в соединении) - 1 */

	struct brackets br[4] =      /* Массив для хранения параметров скобок */
	{'[',']',-1,-1,1,
	 '(',')',-1,-1,1,
	 '*',13,-1,-1,1,
	 '{','}',-1,-1,1};

	double ta, tb;          /* Временные переменные */
	char *cptr;
	int i, j, k;            /* Счетчики циклов */
	unsigned char c, c1;    /* Символьные переменные */
	double ii;              /* Индекс перед элементом */
	int n;                  /* Номер элемента и пр. */

	/***** I. ОБРАБОТКА ИСХОДНЫХ ДАННЫХ *****/
	res[0] = 0;
	for (i = 0, j = 0; i < strlen(in); i++)
		if (in[i] != ' ') eq[j++] = in[i];
	eq[j] = 0;	
	/***** II. РАЗБИВКА СТРОКИ НА СОЕДИНЕНИЯ ***/
	i = -1; /* Позиция в уравнении */
	j = 0;  /* Позиция в формуле соединения */
	k = 0;  /* Число знаков равенства */
	n = 1;  /* Режим работы
		  0 выключить разбивку
		  1 включить разбивку */
	ncomp = 0; /* Номер анализируемого соединения */
	do
	{
		c = eq[++i];
		if (c == '{') n = 0;
		if (c == '}') n = 1;
		if ( (c == '+' && n) || c == '=')
		{
			if (c == '=') k++;
			comp[ncomp++].name[j] = 0;
			j = 0;
		}
		else
			comp[ncomp].name[j++] = c;
	}
	while (c);
	if (!n) errmessage(ERR_SYNT);
	/***** III. ЭЛЕМЕНТАРНЫЙ СИНТАКСИЧЕСКИЙ КОНТРОЛЬ *****/
	if (ncomp > 19) errmessage(ERR_MANYCOMP);
	if (k != 1) /* Должен быть 1 знак '=' */
		errmessage(ERR_EQU);

	for (i = 0; i <= ncomp; i++)
	{
		c = comp[i].name[0];
		if (c == 0) /* Не должно быть 2 '+' подряд */
			errmessage(ERR_PLUS);
		if ( !(c >= 'A' && c <= 'Z') && c != 'e' && c != '(' && c != ')' && c != '[' && c != ']')
			errmessage(ERR_SYNT);
	}
	/***** IV. СИНТАКСИЧЕСКИЙ АНАЛИЗ БРУТТО - ФОРМУЛЫ СОЕДИНЕНИЙ ***/
	nelem = -1;
	for (i = 0; i <= ncomp; i++)
	{
		/*** Анализ формулы на содержание скобок ***/
		for (j = 0; j <= 3; j++) /* Сброс массива с коорд. скобок */
		{	br[j].open_pos = -1;
			br[j].close_pos = -1;}

		for (j = 0; j <= strlen(comp[i].name); j++) /* Поиск скобок */
		{
			c = comp[i].name[j];
			for (k = 0; k <= 3; k++)
			{
				if (c == br[k].open_sign) /* Открывающие скобки */
				{ if (br[k].open_pos != -1) errmessage(ERR_MANYBR);
				  br[k].open_pos = j;
				  if (k == 2) /* Звёздочка */
				  {	  br[2].close_pos = strlen(comp[i].name) + 1;
					  br[2].index = strtod(&comp[i].name[j + 1],&cptr);
					  if (br[k].index == 0) br[k].index = 1;}
				}

				if (c == br[k].close_sign) /* Закрывающие скобки */
				{       if (br[k].close_pos != -1) errmessage(ERR_MANYBR);
					br[k].close_pos = j;
					br[k].index = strtod(&comp[i].name[j + 1],&cptr);
					if (br[k].index == 0) br[k].index = 1;}
			}
		}
		/* Проверка синтаксиса скобок */
		for (k = 0; k <= 3; k++)
			if ((br[k].open_pos == -1 && br[k].close_pos != -1)||(br[k].open_pos > br[k].close_pos)) errmessage(ERR_SYNTBR);
		/* Выделение электрического заряда */
		if (br[3].open_pos != -1 && br[3].close_pos != -1)
		{	/* Выделение абсолютного значения */
			comp[i].charge = strtol(&comp[i].name[br[3].open_pos + 1], &cptr, 10);
			/* Обработка знака */
			c = comp[i].name[br[3].close_pos - 1];
			if ((c == '-' || c == '+') && comp[i].charge == 0) comp[i].charge = 1;
			if (c == '-') comp[i].charge = -comp[i].charge;
		}
		else comp[i].charge = 0;
		/* Реакция на признак электрона */
		if (comp[i].name[0] == 'e')
		{	comp[i].charge = -1;
			continue;}
		/* Синтаксический разбор по элементам */
		for (j = 0; j <= strlen(comp[i].name); j++)
		{
			/* Первый символ элемента */
			c = comp[i].name[j];
			if (c < 'A' || c > 'Z') continue;
			ce[0] = c;
			/* Попытка обнаружить второй символ элемента */
			c1 = comp[i].name[j + 1];
			ce[1] = (c1 < 'a' || c1 > 'z') ? 32 : c1;

			/* Выделение индекса */
			if (ce[1] == 32)
				ii = strtod(&comp[i].name[j + 1], &cptr);
			else
				ii = strtod(&comp[i].name[j + 2], &cptr);

			if (ii == 0) ii = 1; /* В случае отсутствия числа */
					     /* индекс - 1*/

			/* Согласование индекса со скобками */
			for (k = 0; k <= 2; k++)
				if (j > br[k].open_pos && j < br[k].close_pos) ii *= br[k].index;

			/* Занесение нового элемента в строку */
			if (strstr(elem, ce) == NULL)
			{	strcat(elem, ce);
				nelem++; }
			/* Вычисление номера элемента и занесение индекса в матрицу */
			n = (strstr(elem, ce) - &elem[0]) / 2;
			a[n][i] += ii;
		}
	}
	if (nelem > 19) errmessage(ERR_MANYELEM); /* Не слишком ли много элементов? */

	/***** V. КАЖДЫЙ ЭЛЕМЕНТ ДОЛЖЕН БЫТЬ В ОБЕИХ ЧАСТЯХ УРАВНЕНИЯ *****/
	for (i = 0; i <= nelem; i++)
	{
		n = 0;
		for (j = 0; j <= ncomp; j++) if (a[i][j]) n++;
		if (n < 2)
		{
			sprintf(res, ERR_WRONGEL, elem[i * 2], elem[i * 2 + 1]);
			return 1;
		}
	}
	/***** VI. ПРОВЕРКА ЗАКОНА СОХРАНЕНИЯ ЗАРЯДА
		   ПЕРЕНОС ЗАРЯДОВ В ОБЩУЮ МАТРИЦУ   ***/
	n = 0;
	for (i = 0; i <= ncomp; i++)
	{
		a[nelem + 1][i] = comp[i].charge;
		if (comp[i].charge) n++;
	}
	if (n == 1) errmessage (ERR_CHARGE);/* Если только 1 заряж. частица */
	if (n) nelem++;                     /* Расширение границ матрицы */

	/***** VII. ПРИМЕНЕНИЕ МЕТОДА ГАУССА *****/
	i = gauss(a, ncomp, nelem + 1, x);
	if (i == GAUSS_NOSOL) errmessage(ERR_NOSOL);
	if (i == GAUSS_MANYSOL) errmessage(ERR_MANYSOL);
	x[ncomp] = 1;
	/***** VIII. ПРИВЕДЕНИЕ КОРНЕЙ К ЦЕЛОЧИСЛЕННОМУ ВИДУ *****/
	for (i = 1; i <= 1000; i++)
	{
		/* Проверка коэфф i на пригодность */
		k = 1;
		for (j = 0; j <= ncomp; j++)
		{
			ta = x[j] * (double)i;
			tb = rou(ta) - ta;
			if (cmpzero(tb)) {k = 0; break;}
		}
		/* Собственно домножение */
		if (k == 1)
		{
		for (j = 0; j <= ncomp; j++) x[j] *= (double)i;
			break;
		}
	}
   /***** IX. ВЫВОД ОТВЕТА *****/
   /* Соединения с отриц. коэффициентами - продукты
      с положительными - исходные */
   if (x[0] < 0) k = -1; else k = 1;
   for (i = 0; i <= ncomp; i++) x[i] *= k;

   /* а) Вывод исходных веществ */
   j = 0; /* Если 0 - вещ-во не встречалось */
   for (i = 0; i <= ncomp; i++)
   {
    /* Вывод соединения i с коэффициентом */
    if (x[i] <= 0) continue;
    if (i > 0 && j) PRINT("%s", " + "); /* Вывод знака - разделителя */
    j++;
    if (cmpzero(x[i] - 1.0)) PRINT("%.0f ",x[i]);
    PRINT("%s",comp[i].name);
   }
   PRINT("%s", " = "); /* Вывод знака равенства */
   /* б) Вывод продуктов */
   j = 0; /* Если 0 - вещ-во не встречалось */
   for (i = 0; i <= ncomp; i++)
   {
    /* Вывод соединения i с коэффициентом */
    if (x[i] >= 0) continue;
    if (i > 0 && j) LPRINT(" + "); /* Вывод знака - разделителя */
    j++;
    if (cmpzero(-x[i] - 1.0)) PRINT("%.0f ",-x[i]);
    PRINT("%s",comp[i].name);
   }
   return 0;
}
/********** ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ **********/
/* Функция округляет число по математическим законам:
   3.6 = 4  -3.6 = - 4   3.1 = 3   -3.1 = 3 */
double rou(double x)
{
 double c, d;
 d = modf(x, &c);
 if (fabs(d) < 0.5) return c;
 if (x < 0) return c - 1.0;
 if (x > 0) return c + 1.0;
}
/* Сравнение числа с нулем с точностью ACCURACY */
/* 0 - если 0
   1 - если не 0 */
char cmpzero(double x)
{
	return (fabs(x) > ACCURACY);
}

Спасибо!

[YVitaliy]

Держи. Сделал, потому что самому было интересно. И, может быть, пригодится когда
Перезалил аттач. Передвинул 1 End немного, поставил несколько индексов,
уменьшил размер матрицы..

[PIF85]

Сообщение от YVitaliy

Держи. Сделал, потому что самому было интересно. И, может быть, пригодится когда

Спасибо ограмное Вам, Вы даже мне программу уже собрали. Буду изучать код, а потом DLL сделаю. А вы химией не увлекаетесь случайно?

[angvelem]

Мне уже можно и не делать.

[YVitaliy]

Сообщение от angvelem

Замечено несколько ошибок.

Попробовал исправить. Аттач перезалил. Но будет лучше, если из указать, а то я явные вещи попропускал

P.S Нет, к сожалению, химией не увлекаюсь. Хотя в универе КР на отлично писал (в частности, по органической химии)

[angvelem]

Пытаюсь разобраться.

[angvelem]

Сообщение от YVitaliy

Попробовал исправить. Аттач перезалил. Но будет лучше, если из указать, а то я явные вещи попропускал

Выбрал время посмотрел перезалитый аттач. Явных ошибок нет, только остались неиспользуемые переменные, да парочка неопределённых возвращаемых функциями значений.
Добавлю и свой вариант, пусть ТС сам разбирается, что к чему.

Хм, заметил ошибку. В последний момент добавил в юнит UravProc.pas функцию Format использующую wvsprintf и забыл, что она не работает с дробными числами. Немного изменил код с учётом этого.

Обновил вложение.

chemistry.rar 8.6Кб