Создать новый файл D из чисел, которые встречаются во всех трех файлах

@yurka17 · Регистрация: 12.10.2009

Author24 — интернет-сервис помощи студентам

Pascal

const
Length: word = 10;
MinRange: integer = -25;
MaxRange: integer = 25;
MaxLength = 255;
 
type
TArray = array [1..MaxLength] of integer;
 
procedure RandomIntToFile(wLength: word; iMin, iMax: integer; var fOut: Text);
var
i: integer;
begin
Randomize();
for i := 1 to wLength do
writeln(fOut, Random(iMax - iMin + 1) + iMin);
end;
 
procedure FileToArray(var aArray: TArray; wLength: word; var fIn: Text);
var
i: integer;
begin
for i := 1 to wLength do
readln(fIn, aArray[ i ]);
end;
 
procedure ArrayToFile(aArray: TArray; wLength: word; var fOut: Text);
var
i: integer;
begin
for i := 1 to wLength do
writeln(fOut, aArray[ i ]);
end;
 
procedure ArrayPrint(aArray: TArray; wLength: word);
var
i: integer;
begin
if (wLength = 0) then
writeln('empty')
else begin
for i := 1 to wLength do
write(aArray[ i ]:3, ' ');
writeln;
end;
end;
 
procedure ArrayUnion(a1, a2, a3: TArray; wLength: word; var aOut: TArray; var wOutLength: word);
var
i1, i2, i3, i4: integer;
b1, b2, b4: boolean;
begin
wOutLength := 0;
for i1 := 1 to wLength do
begin
b1 := False;
b2 := False;
for i2 := 1 to wLength do
begin
if (a1[i1] = a2[i2]) then
begin
b1 := True;
Break;
end;
end;
for i3 := 1 to wLength do
begin
if (a1[i1] = a3[i3]) then
begin
b2 := True;
Break;
end;
end;
b4 := False;
if (b1 and b2) then
begin
for i4 := 1 to wOutLength do
begin
if (a1[i1] = aOut[i4]) then
begin
b4 := True;
Break;
end;
end;
if (not b4) then
begin
Inc(wOutLength);
aOut[wOutLength] := a1[i1];
end;
end;
end;
end;
 
var
fA, fB, fC, fD: Text;
aA, aB, aC, aD: TArray;
waDLength: word;
begin
Assign(fA, 'a.dat');
Rewrite(fA);
Assign(fB, 'b.dat');
Rewrite(fB);
Assign(fC, 'c.dat');
Rewrite(fC);
Assign(fD, 'd.dat');
Rewrite(fD);
RandomIntToFile(Length, MinRange, MaxRange, fA);
RandomIntToFile(Length, MinRange, MaxRange, fB);
RandomIntToFile(Length, MinRange, MaxRange, fC);
Close(fA);
Close(fB);
Close(fC);
Reset(fA);
Reset(fB);
Reset(fC);
FileToArray(aA, Length, fA);
FileToArray(aB, Length, fB);
FileToArray(aC, Length, fC);
writeln('A:');
ArrayPrint(aA, Length);
writeln('B:');
ArrayPrint(aB, Length);
writeln('C:');
ArrayPrint(aC, Length);
ArrayUnion(aA, aB, aC, Length, aD, waDLength);
writeln('AxBxC:');
ArrayPrint(aD, waDLength);
ArrayToFile(aD, waDLength, fD);
Close(fD);
readln;
end.

почему всегда empty пишет ?

Добавлено через 2 минуты
Создать три файла: А,В,С из целых чисел. Создать новый файл D из чисел, которые встречаются во всех трех файлах. В файле D числа не должны повторяться.

вот задача

@Puporev · 15.12.2009, 21:08

Очень большой разброс значений от -25 до 25 и маленький размер массивов = 10. Поэтому нет совпадений по трем массивам. Напишите например так, или еще потренируйтесь с диапазоном и размером.

Pascal

uses crt;
const
Length: word = 10;
MaxLength = 255;
 
type
TArray = array [1..MaxLength] of integer;
 
procedure RandomIntToFile(wLength: word; r: integer; var fOut: Text);
var
i: integer;
begin
Randomize;
for i := 1 to wLength do
write(fOut, Random(r),' ');
end;
 
procedure FileToArray(var aArray: TArray; wLength: word; var fIn: Text);
var
i: integer;
begin
for i := 1 to wLength do
read(fIn, aArray[ i ]);
end;
 
procedure ArrayToFile(aArray: TArray; wLength: word; var fOut: Text);
var
i: integer;
begin
for i := 1 to wLength do
write(fOut, aArray[ i ],' ');
end;
 
procedure ArrayPrint(aArray: TArray; wLength: word);
var
i: integer;
begin
if (wLength = 0) then
writeln('empty')
else begin
for i := 1 to wLength do
write(aArray[ i ]:3, ' ');
writeln;
end;
end;
 
procedure ArrayUnion(a1, a2, a3: TArray; wLength: word; var aOut: TArray; var wOutLength: word);
var
i1, i2, i3, i4: integer;
b1, b2, b4: boolean;
begin
wOutLength := 0;
for i1 := 1 to wLength do
begin
b1 := False;
b2 := False;
for i2 := 1 to wLength do
begin
if (a1[i1] = a2[i2]) then
begin
b1 := True;
Break;
end;
end;
for i3 := 1 to wLength do
begin
if (a1[i1] = a3[i3]) then
begin
b2 := True;
Break;
end;
end;
b4 := False;
if (b1 and b2) then
begin
for i4 := 1 to wOutLength do
begin
if (a1[i1] = aOut[i4]) then
begin
b4 := True;
Break;
end;
end;
if (not b4) then
begin
Inc(wOutLength);
aOut[wOutLength] := a1[i1];
end;
end;
end;
end;
 
var
fA, fB, fC, fD: Text;
aA, aB, aC, aD: TArray;
waDLength: word;
begin
clrscr;
randomize;
Assign(fA, 'a.txt');
Rewrite(fA);
Assign(fB, 'b.txt');
Rewrite(fB);
Assign(fC, 'c.txt');
Rewrite(fC);
Assign(fD, 'd.txt');
Rewrite(fD);
RandomIntToFile(Length,10,fA);
RandomIntToFile(Length, 10, fB);
RandomIntToFile(Length, 10, fC);
Close(fA);
Close(fB);
Close(fC);
Reset(fA);
Reset(fB);
Reset(fC);
FileToArray(aA, Length, fA);
FileToArray(aB, Length, fB);
FileToArray(aC, Length, fC);
writeln('A:');
ArrayPrint(aA, Length);
writeln('B:');
ArrayPrint(aB, Length);
writeln('C:');
ArrayPrint(aC, Length);
ArrayUnion(aA, aB, aC, Length, aD, waDLength);
writeln('AxBxC:');
ArrayPrint(aD, waDLength);
ArrayToFile(aD, waDLength, fD);
Close(fD);
readln;
end.

@yurka17 · 15.12.2009, 21:21 **[ТС]**

там типы не совпадают тогда если так делать, не мог бы исправить если не сложно ?

Добавлено через 7 минут

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

Нужно в программе объявить реальный максимальный размер массива, например
aA, aB, aC, aD: array[1..100];

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

@Puporev · 15.12.2009, 22:24

yurka17, Ты отвечаешь на сообщение, которое я сразу удалил, а про исправленную программу вообще молчок. Вот когда сам напишешь хоть одну программу сам, вместо того, чтоб калечить чужие, вот тогда и вякать будешь.

@yurka17 0 / 0 / 0 Регистрация: 12.10.2009 Сообщений: 49
	15.12.2009, 21:21 [ТС]	3
	там типы не совпадают тогда если так делать, не мог бы исправить если не сложно ? Добавлено через 7 минут Сообщение от Puporev Нужно в программе объявить реальный максимальный размер массива, например aA, aB, aC, aD: array[1..100]; кстати еще есть кое какая просьба с процедурами , ты так такую сортировку сделал,меня препод чуть не убил )))) сказал переделывай , типо там можно гораздо проще без перемещений сделать 0

@Puporev Почетный модератор 64300 / 47595 / 32743 Регистрация: 18.05.2008 Сообщений: 115,181
	15.12.2009, 22:24	4
	yurka17, Ты отвечаешь на сообщение, которое я сразу удалил, а про исправленную программу вообще молчок. Вот когда сам напишешь хоть одну программу сам, вместо того, чтоб калечить чужие, вот тогда и вякать будешь. 0

Создать новый файл D из чисел, которые встречаются во всех трех файлах

Решение