ТурбоПаскаль помощь нужна

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

Новая тема

Автор

Поиск в теме:

Lamagro

SexBlogs.Name

С нами с 13.10.03
Сообщения: 3159
Рейтинг: 962

Добавлено: 24/12/08 в 07:57

цитата

Знакомая попросила, турбопаскаль не помню, последний раз в институте.
Если кто нить волокет, может поможете?

Цитата:

переставить столбцы таблицы так,чтобы в заданной строке сначала стояли отрицательные,потом нули,потом положительные
числа.порядок их следования сохранить.

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

Код:

uses crt;
const maxstr=50;maxstolb=50;
type TInt=integer;
TChar=char;
TBool=boolean;
TMas=array[1..maxstr,1..maxstolb] of TInt;
TFiler=file of TInt;

procedure IOError(io:integer;var err:TBool);
begin
if io<>0 then begin
writeln('Nekorrektnoe znachenie.');
Err:=true;
readkey;
end
else Err:=false;
end;

procedure obrabot(n1,m1:TInt;var a1:TMas;var log1:TBool);
var z,i1,j1,k1:TInt;
begin
if (n1<1) or (m1<1) or (n1>maxstr) or (m1>maxstolb) then log1:=false
else begin
log1:=true;
for i1:=1 to m1 do begin
for j1:=1 to n1 do begin
for k1:=1 to n1-1 do begin
z:=0;
if (a1[i1,k1]>0) and ((a1[i1,k1+1]=0) or (a1[i1,k1+1]<0)) then
begin
z:=a1[i1,k1];
a1[i1,k1]:=a1[i1,k1+1];
a1[i1,k1+1]:=z;
end;
if (a1[i1,k1]=0) and (a1[i1,k1+1]<0) then
begin
z:=a1[i1,k1];
a1[i1,k1]:=a1[i1,k1+1];
a1[i1,k1+1]:=z;
end;
end;
end;
end;
end;
end;

var n,m,j,i:TInt;
l,v:TChar;
log,lo,error,logo:TBool;
a:TMas;
f:TFiler;
begin
clrscr;
log:=true;
repeat
repeat
clrscr;
writeln('vvedite kol-vo strok massiva 0<n<=',maxstr:4,'.');
{$I-}
readln(n);
{$I+}
IOError(IOResult,Error);
until error = false;

repeat
clrscr;
writeln('vvedite kol-vo stolbcov massiva0<m<=',maxstolb:4,'.');
{$I-}
readln(m);
{$I+}
IOError(IOResult,Error);
until error = false;

if (n<1) or (m<1) or (n>maxstr) or (m>maxstolb) then log:=false
else log:=true;
until log;
log:=false;
repeat
clrscr;
writeln('Nazchmite odnu iz sleduyuschih klavish,chtoby vypolnit sleduyuschie deystviya.');
writeln;
writeln('<<t>>,chtoby zapolnit massiv');
writeln('<<o>>,chtoby obrabotat massiv');
writeln('<<s>>,chtoby posmotret tekuschee sostoyanie massiva');
writeln('<<r>>,chtoby vyvesti rezultat obrabotki');
writeln('<<e>>,chtoby vyity iz programmy');
readln(l);
clrscr;
randomize;
case l of
't': begin
writeln('kak vy hotite zapolnit massiv:vruchnuyu(1),ili predostavit delo sluchayu(2),');
readln(v);
if v='2' then begin
log:=true;
for i:=1 to n do begin
writeln;
for j:=1 to m do begin
a[i,j]:=random(100)-50;
end;
end;
end
else if v='1' then begin
log:=true;
writeln('vvodite elementy massiva');
for i:=1 to n do begin
writeln;
for j:=1 to m do begin
repeat
{$I-}
read(a[i,j]);
{$I+}
IOError(IOResult,Error);
until Error=false;
end;
end;
end
end;

'o': begin
obrabot(n,m,a,lo);
if lo then
writeln('massiv obrabotan')
else
writeln('Tablica pusta.');
readln;
end;
's': begin
if log=true then begin
for i:=1 to n do begin
writeln;
for j:=1 to m do write(a[i,j]:4);
end;
readln;
end
else begin
writeln('vy ne zapolnili massiv!');
writeln('nazchmite <<t>>!');
readln;
end;
end;

'r': begin
if lo=true then begin
writeln('otsortirovannyi massiv:');
for i:=1 to n do begin
writeln;
for j:=1 to m do write(a[i,j]:4);
end;
readln;
end
else
write('Tablica pusta.');
readkey;
end;

end;
until l='e';
end.

Submit your blog to the sex blogs list. PR=3 Quickly approve! 10 posts min. Ping every 6 hour!

_s_[sov]

php

С нами с 09.10.06
Сообщения: 3706
Рейтинг: 2410

Добавлено: 24/12/08 в 20:23

цитата

сильно мне задача напомнила наш экзамен на 1 курсе... задачу нада было решать на листочке без компа, вот тут секаса было много. по сабжу, ТС стукнись, был ряд похожих задач из универа(поищу если что)..

IPhosters.com - любые решения для Вас (виртуалы от $4.99, vps от $11.99, дедики от $95)

borgivan

С нами с 13.11.06
Сообщения: 777
Рейтинг: 418

Добавлено: 25/12/08 в 01:08

цитата

Сейчас очень занят, не смогу выдать готовую прогу (может завтра утром асилю), дам пару советов. ИМХО, сейчас написал ты много ненужного. Тут же важен сам алгоритм, почему бы не создать массив при обьявлении переменных? Хотя помоему в паскале так нельзя делать... память, епт. Во вторых тебе надо две функции, первая переставляет столбцы M и N у массива, в качестве параметров передается массив, номера переставляемых строк, число столбцов и число строк. И ещё одна функция , которая упорядочевает строку по возрастанию, в качестве параметров передается массив, номер строки, число столбцов и число строк. Что с ними делать догадался ?

Если нет, то упорядочиваешь по возрастанию нужную строку к примеру методом пузырьков. Но меняешь местами не только элементы строки, но и столбцы , соответствующие этим элементам. Всё, пока ничем большим не смогу помочь !

Lamagro

SexBlogs.Name

С нами с 13.10.03
Сообщения: 3159
Рейтинг: 962

Добавлено: 25/12/08 в 14:21

цитата

спасибо ребята!
2_s_[sov] счас стукну

2borgivan
спасибо коллега! если бы ты осилил было бы очень заебись, так как я вообще ни в зуб ногой в паскале, последний раз его трогал в 1994...

Submit your blog to the sex blogs list. PR=3 Quickly approve! 10 posts min. Ping every 6 hour!

Lamagro

SexBlogs.Name

С нами с 13.10.03
Сообщения: 3159
Рейтинг: 962

Добавлено: 26/12/08 в 12:03

цитата

Ну, что я могу сказать мучали мы её с s_sovом вчера, точнее я он мучил, а я рядом маячил

получилось вот что:

Код:

program pascal;
uses crt;
var c,i,j,tmp:integer;
var arr:array[1..4,1..4] of integer;
begin
clrscr;
for i:=1 to 4 do
for j:=1 to 4 do
arr[i,j]:=random(10)-5;
for i:=4-1 downto 1 do {n - размер массива arr[]}
for j:=1 to i do
if arr[i,j]>arr[i,j+1] then begin
tmp:= arr[i,j];
arr[i,j]:= arr[i,j+1];
arr[i,j+1]:= tmp;
end;
write('вывод значений arr[]: ');
for i:=1 to 4 do
begin
for j:=1 to 4 do
write(arr[i,j],' ');
writeln;
end;
readln(arr[i,j]);

end.

как-то работает, но как-то нетак

Submit your blog to the sex blogs list. PR=3 Quickly approve! 10 posts min. Ping every 6 hour!

borgivan

С нами с 13.11.06
Сообщения: 777
Рейтинг: 418

Добавлено: 26/12/08 в 13:36

цитата

Код:

program SortMatrixByRow;

uses
Crt;

const
N = 10; {Column number}
M = 20; {Row number}

type
Matrix = array[0..M, 0..N] of Integer;

function MatrixInit(var varMatrix: Matrix): Integer;

var
i, j: Integer;

begin
Randomize;
for i := 0 to N-1 do
for j := 0 to M-1 do begin
varMatrix[i,j] := 50 - Random(100);
if random(5) = 2 then varMatrix[i,j] := 0;
end;
end;

function MatrixShow(var varMatrix: Matrix; x: Integer): Integer;

var
i, j: Integer;

begin
for i := 0 to N-1 do begin
if ((x = i+1) or (x = i)) and (i > 0) and (i < N-1) then WriteLn;
for j := 0 to M-1 do begin
Write(varMatrix[i,j]:3, ' ');
end;
WriteLn;
end;
WriteLn;
end;

function MatrixChangeColumns(var varMatrix: Matrix; x, y: Integer): Integer;

var
i, j, Temp: Integer;

begin
for i := 0 to N-1 do begin
Temp := varMatrix[i, x-1];
varMatrix[i, x-1] := varMatrix[i, y-1];
varMatrix[i, y-1] := Temp;
end;
end;

function MatrixSortByRow(var varMatrix: Matrix; x: Integer): Integer;
begin
{Вот здесь делай сортировку}
end;

var
initMatrix: Matrix;
x, y: Integer;

begin

ClrScr;
MatrixInit(initMatrix);
WriteLn('The initial array:');
matrixShow(initMatrix, 0);
Write('Insert tne number of row to sort by (from 1 to ', N, '): ');
ReadLn(x);
if (x > M) or (x <= 0) then WriteLn('Error in row indexes!')
else begin
MatrixSortByRow(initMatrix, x);
MatrixShow(initMatrix, x);
end;

end.

Там сортировка не доделална... а остальное вроде пашет

Lamagro

SexBlogs.Name

С нами с 13.10.03
Сообщения: 3159
Рейтинг: 962

Добавлено: 26/12/08 в 14:20

цитата

ошибку кажет

Код:

begin

ClrScr;
MatrixInit(initMatrix); <- Error 122 Invalid variable reference
WriteLn('The initial array:');
matrixShow(initMatrix, 0);
Write('Insert tne number of row to sort by (from 1 to ', N, '): ');
ReadLn(x);
if (x > M) or (x <= 0) then WriteLn('Error in row indexes!')
else begin
MatrixSortByRow(initMatrix, x);
MatrixShow(initMatrix, x);
end;

end.

Submit your blog to the sex blogs list. PR=3 Quickly approve! 10 posts min. Ping every 6 hour!

borgivan

С нами с 13.11.06
Сообщения: 777
Рейтинг: 418

Добавлено: 26/12/08 в 19:13

цитата

Lamagro писал:

ошибку кажет

Ей богу, гдето что то проебал, либо нетакой паскаль стоит !