Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.04.2012, 10:54   #1
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию Есть три программы. Их нужно объеденить в одну, тоесть чтоб при запуске программы были пункты меню для каждой из программ

Помогите пожалуйста эти 3 программы обьеденить в одну, и, чтоб для каждой, соответсвенно были такие пункты меню: "Метод Гаусса", "Метод Крамера", "Метод отражения", и "Выход". Меню подойдет любое, хоть через case, мне главное чтоб вы мне помогли обьеденить это, а то я не умею, в паскале, увы, ноль.

Метод Гаусса:
Код:
Program Gauss;
Const
 Nmax=20;
type
 VectorType = ARRAY[1..Nmax] OF Real;
 MatrixType = ARRAY[1..Nmax] OF VectorType;
function Gauss(n:Byte;A:MatrixType;B:VectorType;var x:VectorType):boolean;
var
 i,j,k,iMax:Byte;
 tmp,Max,d:Real;
 v:VectorType;
begin
 for k:=1 to n-1 do
 begin
  Max:=Abs(A[k,k]);
  iMax:=k;
  for i:=k+1 to n do
   if Abs(A[i,k])>Max then
   begin
    Max:=Abs(A[i,k]);
    iMax:=i;
   end;
  IF Max=0 THEN
  begin
   Gauss:=false;
   Exit
  end;
 IF iMax<>k then
 begin
  Tmp:=B[k];
  B[k]:=B[iMax];
  B[iMax]:=Tmp;
  v:=A[k];
  A[k]:=A[iMax];
  A[iMax]:=v
 end;
 for i:=k+1 to n do
  begin
   d:=A[i,k]/A[k,k];
   for j:=k to n do
    A[i,j]:=A[i,j]-d*A[k,j];
    B[i]:=B[i]-d*B[k];
  end;
 end;
 if A[n,n]=0 then
 begin
  Gauss:=false;
  Exit
 end;
 { ObPATHblu XoD }
 X[n]:=B[n]/A[n,n];
 for i:=n-1 downto 1 do
 begin
  tmp:=B[i];
  for j:=i+1 to n do
   tmp:=tmp-A[i,j]*X[j];
  X[i]:=tmp/A[i,i]
 end;
 Gauss:=true
end;
var
 n,i,j:Byte;
 a:MatrixType;
 b,x:VectorType;
begin
 Write('Vvedite razmery matricy');
 READ(n);
 Writeln('Rasshirennaya matrica');
 for i:=1 to n do
 begin
  for j:=1 to n do
  begin
   write('A[' ,i, ',' ,j, ']=');
   readln(a[i,j]);
  end;
  Write('b[' ,i, ']=');
  readln(b[i]);
 end;
 if not Gauss(n,a,b,x) then
 begin
  Writeln('Matrica vyrozhdena');
  Halt;
 end;
 Writeln('Reshenie sistemy');
 for i:=1 to n do
 begin
  for j:=1 to n do
   b[i]:=b[i]-a[i,j]*x[j];
 Writeln(x[i]:12,' ',b[i]:12)
 end;
 readln
end.
Метод Крамера:
Код:
uses crt;
type
 Tmass=array[1..20] of real;
 Tmatrix=array[1..20] of Tmass;
procedure Per(k,n:integer;var a:Tmatrix;var p:integer);{перестановка строк если главный элемент = 0}
var z:Real;j,i:integer;
begin
z:=abs(a[k,k]);
i:=k;
p:=0;
for j:=k+1 to n do
  begin
   if abs(a[j,k])>z then{выбираем максимальный по модулю в данном столбце ниже}
    begin
     z:=abs(a[j,k]);
     i:=j;
     p:=p+1;{счетчик перестановок, при каждой перестановке меняется знак определителя}
    end;
  end;
if i>k then
for j:=k to n do
  begin
   z:=a[i,j];
   a[i,j]:=a[k,j];
   a[k,j]:=z;
  end;
end;
function Znak(p:integer):integer;{определение знака определителя}
begin
if p mod 2=0 then
Znak:=1 else Znak:=-1;
end;
procedure Opr(n:integer;a:tmatrix;var det:real);{вычисление опаределителя}
var k,i,j,p:integer;r:real;
begin
det:=1.0;
for k:=1 to n do
  begin
   if a[k,k]=0 then Per(k,n,a,p);{перестановка строк}
   det:=znak(p)*det*a[k,k];{вычисление определителя}
   for j:=k+1 to n do {пересчет коэффициентов}
    begin
      r:=a[j,k]/a[k,k];
      for i:=k to n do
       begin
        a[j,i]:=a[j,i]-r*a[k,i];
       end;
    end;
  end;
end;
var a:Tmatrix;{матрица коэффициентов исходная}
    c:array[1..20] of Tmatrix;{вспомогательные матрицы для вычисления корней}
    b,x:Tmass;{свободные члены, корни}
    det,det1:real;{определители}
    n,k,j,i:integer;
begin
clrscr;
write('Порядок системы n=');
readln(n);
writeln('Введите коэффициенты системы:');
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
readln;
writeln('Введите свободные члены:');
for i:=1 to n do
read(b[i]);
readln;
clrscr;
writeln('Расширенная матрица системы:');
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:7:2);
  write(b[i]:9:2);
  writeln;
 end;
Opr(n,a,det);{определитель системы исходной}
for i:=1 to n do
 begin
  for k:=1 to n do
   begin
    for j:=1 to n do{создаем вспомогательные матрицы, где i-товый столбец - свободные члены}
    c[i][k,j]:=a[k,j];
    c[i][k,i]:=b[k];
   end;
  Opr(n,c[i],det1);{определитедь вспомогательной матрицы}
  if(det=0)and(det1=0) then
    begin
     writeln('Система не определена!');
     readln;
     exit;
    end;
  if(det=0)and(det1<>0) then
    begin
     writeln('Система не имеет решений!');
     readln;
     exit;
    end;
  x[i]:=det1/det;{корень}
 end;
writeln('Корни сиcтемы:');
for i:=1 to n do
writeln('x',i,'=',x[i]:7:3);
readln
end.
afirat вне форума Ответить с цитированием
Старый 27.04.2012, 10:54   #2
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

И метод отражения:
Код:
program otragenie;
uses crt;
var a:array [0..10,0..10] of real;
b:array [1..10] of real;
i,j,k,n:integer;
y,f,l,d,c,e,ak,sk,bk:real;

begin
clrscr;
write ('Введите число уравнений '); read (n);
writeln ('Введите коэффициенты уравнений:');
for i:=1 to n do
for j:=1 to n do
begin
write ('a[',i,',',j,']?'); 
read (a[i,j]);
end;
writeln ('Введите свободные члены:');
for i:=1 to n do
begin
write ('b[',i,']'); read (a[i,0])
end;
for k:=1 to n do
begin
ak:=0;
for i:=k to n do
begin
ak:=ak+a[i,k]*a[i,k];
end;
sk:=(-1)*a[k,k]*sqrt(ak);
bk:=ak+a[k,k]*sk;
for i:=k to n do
begin
c:=0;
for j:=k to n do
begin
c:=c+a[j,i]*a[j,k]
end;
a[0,i]:=(c+sk*a[k,i])/bk;
end;
d:=0;
for j:=k to n do
begin
d:=d+a[j,0]*a[j,k]
end;
e:=(d+sk*a[k,0])/bk;
for i:=k to n do
begin
f:=a[i,k];
if i=k then f:=f+sk;
for j:=k to n do
begin
a[i,j]:=a[i,j]-a[0,j]*f
end;
a[i,0]:=a[i,0]-f*e
end;
end;
for k:=n downto 1 do
begin
l:=0;
for i:=k+1 to n do
begin
l:=l+a[k,i]*a[i,0]
end;
a[k,0]:=(a[k,0]-l)/a[k,k]
end;
writeln ('Результаты:');
for i:=1 to n do
begin
writeln ('x[',i,'] ',a[i,0]:10:4)
end;
writeln('Для выхода нажмите Enter');
readkey;
end.
afirat вне форума Ответить с цитированием
Старый 27.04.2012, 12:42   #3
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

Люди, ну помогите хоть кто-нибудь.. Мне это очень важно
afirat вне форума Ответить с цитированием
Старый 27.04.2012, 14:22   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

проще будет вместо каждой из программ написать соответствующую процедуру:
вместо Program Gauss; пишем
Код:
procedure Gauss;
.... <тут ЦЕЛИКОМ текст программы, только вместо END c точкой, точку исправляем на точку-запятую>....
END;

потом
procedure Krammer;
.... <тут ЦЕЛИКОМ текст программы, только вместо END c точкой, точку исправляем на точку-запятую>....
END;

procedure otragenie;
.... <тут ЦЕЛИКОМ текст программы, только вместо END c точкой, точку исправляем на точку-запятую>....
END;
потом пишете выдачу и вызов пунктов меню.
можно сделать банальный запрос номера
Код:
  WriteLn('Введите номер расчёта: 1- Гаусс, 2- Краммер, 3- метод отражения');
  Readln(Choice);
  case Choice od
    1: Gauss;
    2: Krammer;
    3: otragenie;
  end;
это можно завернуть в цикл, если нужно, чтобы пользователь мог вызвать один метод, потом другой, и т.д... тогда ещё один пункт в меню выбора добавить - "Выход" и по нему прерывать цикл...

а можете воспользоваться кодом (поиск по форуму) и будет нормальное меню, где пункты меню выделяются стрелочками управления курсором.. Это несложно...
Serge_Bliznykov вне форума Ответить с цитированием
Старый 27.04.2012, 14:39   #5
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

Мне впринципе подходит даже такое простенькое меню, которое Вы сдесь написали, но, увы, все это реализовать я не могу, не умею. У меня нулевой уровень паскаля. Не могли бы Вы мне помочь, т.е полностью все преобразовать (сделать процедуры из программ, и создать для них меню, как вы написали вообщем) ? А то я и понятия не имею как делать такое пусть и простое..
afirat вне форума Ответить с цитированием
Старый 27.04.2012, 15:18   #6
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,285
По умолчанию

Да уж
Проверьте работоспособность...

Для объединения не нужно знаний паскаля, только знание блокнота) (по крайней мере, после поста Serge_Bliznykov).
Вложения
Тип файла: txt pr1.txt (6.6 Кб, 129 просмотров)
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA на форуме Ответить с цитированием
Старый 27.04.2012, 15:42   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
А то я и понятия не имею как делать такое пусть и простое..
Э нет. так не пойдёт.

я вам написал что и как надо делать.
что именно не получается?! Заменить слово program на слово procedure ?! скопировать все три текста в одну программу ?
дописать ПОСЛЕ этих трёх подпрограмм (процедур) основную программу:
Код:
var Choice : integer;
begin
  WriteLn('Введите номер расчёта: 1- Гаусс, 2- Краммер, 3- метод отражения');
  Readln(Choice);
  case Choice od
    1: Gauss;
    2: Krammer;
    3: otragenie;
  end;
end.
??

Если Вы ничего делать не будете, так ничего и не получится!


пост BDA я проглядел.. ну что хочу сказать? повезло TC
Serge_Bliznykov вне форума Ответить с цитированием
Старый 27.04.2012, 18:35   #8
afirat
Пользователь
 
Регистрация: 19.04.2012
Сообщений: 32
По умолчанию

"повезло TC" что такое ТС?
Я теперь понял как это обьеденять, хоть чему-то научился. Спасибо!
afirat вне форума Ответить с цитированием
Старый 28.04.2012, 11:34   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от afirat
"повезло TC" что такое ТС?
TC - это Топик Стартер (тоже самое, что "Автор темы").
В данном случае - это Вы.

а повезло, потому что я бы Вас "мучил" до последнего, заставляя Вас сделать объединение исходников САМОСТОЯТЕЛЬНО (благо все шаги я расписал подробно)!

ну раз Вы разобрались, то и слава Богу!
Пожалуйста.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 28.04.2012, 12:39   #10
spinogryz_ua
Форумчанин
 
Аватар для spinogryz_ua
 
Регистрация: 14.01.2012
Сообщений: 150
По умолчанию

Тебе это случайно не для дескретной математики нужно?
spinogryz_ua вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Счетчик при запуске программы. Neitrosha Общие вопросы C/C++ 5 24.01.2012 16:50
Как сделать так чтоб при запуске программы сразу показывалась не одна форма а две либо больше? Jleksern Общие вопросы Delphi 4 19.01.2012 18:55
Как сохранить выделенные пункты в listbox чтоб при следующем открытии файла они опять были выделенны? Alexanrd Microsoft Office Excel 6 19.07.2011 12:34
Проблема при запуске программы Neo_AVE C++ Builder 0 04.05.2011 15:38
Какие программы нужно установить чтобы писать программы для телефонов nokia Кристинка89 Общие вопросы по Java, Java SE, Kotlin 2 17.02.2011 15:15