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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.12.2008, 13:58   #1
kissa
Новичок
Джуниор
 
Регистрация: 18.12.2008
Сообщений: 1
По умолчанию помогите с лабораторными на паскале.

не понимаю как сделать программы. а в среду последний срок сдачи......
kissa вне форума Ответить с цитированием
Старый 18.12.2008, 15:30   #2
danekne
Форумчанин
 
Регистрация: 12.02.2007
Сообщений: 360
По умолчанию

пост - не в том разделе! А скорее даже не в том форуме. Тут раздела "телепатия" нету!
danekne вне форума Ответить с цитированием
Старый 19.12.2008, 00:50   #3
lexus_ilia
Студентик :)
Пользователь
 
Аватар для lexus_ilia
 
Регистрация: 29.09.2008
Сообщений: 84
По умолчанию

товарищ danekne имел ввиду, что мы не сможем вам помочь до тех пор, пока вы не уточните задание
lexus_ilia вне форума Ответить с цитированием
Старый 19.12.2008, 00:57   #4
Киря
 
Регистрация: 18.12.2008
Сообщений: 4
По умолчанию

Помогите написать блок схему плиз я вроде програму написал а с блок схемой проблемы:Использовать процедуру sort_File,составить программу сортировки текстового файла с размещением строк в пределах каждой странице в алфовитном порядке по последними слову строки.
Unit lol;
interface
procedure sort_file(var f:text; r:boolean);
implementation
procedure sort_file;
var f1,f2:text;b1,b2,b,s:string;i,i1,i2 ,p:boolean; k:integer;
function moreless(x,y:string; ort:boolean):boolean;
begin
if ort=true then moreless:=(x<y)
else moreless:=(x>=y); end;
procedure readstr(var t:text; var buf:string; var big:boolean);
var s:string;
begin s:=buf;
readln(t,buf);
if buf=s then big:=false
else big:=moreless(buf,s,r);
end;
procedure writestr(var t:text; buf:string; var int:boolean);
begin
if not int then writeln(f,buf);
if EOF(t) then int:=true; end;
begin{sort_file}
ASSIGN(f1,'1.txt');
ASSIGN(f2,'2.txt');
repeat
reset(f);
rewrite(f1);
rewrite(f2);
k:=1;
readln(f,b);
writeln(f1,b);
while not EOF(f) do begin
readstr(f,b,i);
if i then k:=k+1;
if (odd(k)) then writeln(f1,b)
else writeln(f2,b);end;
p:=r; i1:=false; i2:=false;
if k>1 then begin
rewrite(f);
reset(f1);
reset(f2);
readln(f1,b1);
readln(f2,b2);
if moreless(b1,b2,p) then writestr(f1,b1,i1)
else writestr( f2,b2,i2);
repeat
if moreless(b1,b2,p) then
if not EOF(f1) then begin readstr(f1,b1,i1);
if i1 then p:=not p; i1:=false; end
else if not EOF(f2) then begin
readstr(f2,b2,i2);
if i2 then p:=not p; i2:=false; end
else p:=not p;
if moreless(b1,b2,p) then writestr(f1,b1,i1)
else writestr(f2,b2,i2)
until (i1 and i2);
end
until (k<=2);
close(f); close(f1);close(f2);
erase(f1); erase(f2);
end;end.
Киря вне форума Ответить с цитированием
Старый 20.12.2008, 11:13   #5
кася
Пользователь
 
Регистрация: 27.04.2008
Сообщений: 13
По умолчанию

Здравствуйте, программа открывается , но при введении чисел выкидывает, что не дели на ноль. Я не знаю как это исправить.Подскажите пожалуйята.
3). Решение системы линейных уравнений методом Гаусса.
Program GAUSSA;
USES
Crt;
Const
MaxSize=5;
type matrix=array[1...MaxSize,1..MaxSize] of real;
type vector=array[1..MaxSize] of real;
function Gauss(a:matrix;b:vector; var x:vector;n:integer):integer;
var
I,j,s,k:integer;
k1,k2:real;
t:real;
c:char;
fMove:Boolean;
begin
Writeln(‘Vvedite x[i]’)
Readln;
for k:=1 to n-1 do
begin
for i:=k+1 to n do
If a[I,i-1]<>0 then
begin
k1:=a[k,k};
k2:=a[I,k];
for i:=1 to n do
a[I,j]:=k1*a[I,j}-k2*a[k,j];
b[i]:=k1*b[i]-k2*b[k];
end;
for i:=k+1 to n do
begin
If a[I,i]=0 then
begin
s:=i+1;
While (s<=n) and (a[s,i]=0) do s:=s+1;
If (s<=n) then
begin
for j:=1 to n do
begin
t:=a[I,j];
a[I,j]:=a[s,j];
a[s,j]:=t;
end;
t:=b[i];
B[i]:=b[s];
b[s]:=t;
end;
else begin
Gauss:=0;
Exit;
end;
end;
end;
x[n]:=b[n]/a[n,n];
for i:=n-1 downto 1 do
begin
x[i]:=b[i];
for j:=n downto i+1 do begin x[i]:=x[i]-a[I,j]*x[j];
x[i]:=x[i]/a[i,i];
end;
Gauss:=1;
end;
var
a:matrix;
b,x:vector;
n,i,j:integer;
c:char;
Begin
Clrscr;
n:=2;
For i:=1 to n do
For j:=1 to ndo
Readln(a[i,j];
For I:=1 to n do
Readln(b[i]);
If (Gauss(a,b,x,n)=1) then begin
Write (‘res=’);
For i:=1 to n do write(‘ ‘,x[i]:0:2);
Writeln;
end else writeln(‘net Res’);
C:=Readkey;
end.
кася вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите Помогите Пожалуйста Решить Одну Задачку в Паскале!!! VisTBacK Помощь студентам 6 19.09.2008 13:44
Помогите в Паскале Saaashka Помощь студентам 1 17.06.2008 10:51
Прошу помощи с лабораторными Dj Reason Помощь студентам 0 29.05.2008 21:37