> G> 1) была у меня задача на двумерные массивы.
> G> Вычеркнуть K строку и m столбец содержащие минимальное значение матрицы
> я так понимаю ячейку с минимальным значением
> G> A[1..N,1..M], записать в новую матрицу B[1..n-1,1..m-1].
> G> А как сделать то же самое используя только массив A?
> 1. Находишь ячейку min значение - [x,y]
> 2. Все столбцы (x+1..N) смещаешь влево
> 3. Все строки (y+1..M) смещаешь вверх
1) была у меня задача на двумерные массивы.
Вычеркнуть K строку и m столбец содержащие минимальное значение матрицы
A[1..N,1..M], записать в новую матрицу B[1..n-1,1..m-1]. Ниже код программы.
А как сделать то же самое используя только один массив A?
program Z_25;
const n=3;m=5;
var a:array[1..n,1..m] of integer;
b:array[1..n-1,1..m-1] of integer;
i,j:integer;
procedure vvod;
begin
writeln('vvedite matrizu ',n,'*',m);
for i:=1 to n do
begin
for j:=1 to m do
begin
read(a[i,j]);
end;
end;
end;
procedure obrabotka;
var min,Xi,Xj,Si,Sj:integer;
begin
min:=a[1,1];
Xi:=1;
Xj:=1;
for i:=1 to n do
for j:=1 to m do
if a[i,j]<min then
begin
Xi:=i;
Xj:=j;
min:=a[i,j];
end;
si:=0;
sj:=0;
for i:=1 to n do
begin
if Xi<>i then
for j:=1 to m do
if j<>Xj then b[i-si,j-sj]:=a[i,j]
else sj:=1
else si:=1;
sj:=0;
end;
end;
procedure vivod;
begin
for i:=1 to n-1 do
begin
writeln;
for j:=1 to m-1 do write(b[i,j]:3);
end;
end;
begin
vvod;
obrabotka;
vivod;
readln;
readln;
end.
>
> G> 2) Напечатать все натуральные четырехзначные числа, в десятичной записи
> G> которых нет одинаковых цифр.
> for i:=1000 to 9999 do
> if natur(i) then writeln(i); //функция вывода любая
> //функция natur проверяет простое число
> //или нет
> G> А как ее переделать чтоб она любое число проверяла на четырехзначность?
> Пусть x - проверяемое число
> x0:=x div 1000;
> if (1<=x0)and(x0<=9) then 4-хзачное
> G> Как эту строку сделать через множества -
> G> (r1<>r2)and(r1<>r3)and(r1<>r4)and(r2<>r3)and(r2<>r4)and(r3<>r4) then
> G> writeln(a[i])?
> Через множества пока не знаю, но могу предложить более интересное
> решение, чем простое сравнение.
> Путь существует r: array [1..4] of byte. Код:
>
> b:=True;
> for i:=1 to 3 do
> for j:=i+1 to 4 do b:=b and (r[i]<>r[j]);
> if b then подходит
> else не подходит;
Как сделать чтоб не прога искала числа, а пользовтель вводит ряд любых чисел
и из них прога выбирала натур четырехзначные числа,
в десятичной записи которых нет одинаковых цифр.
uses crt;
var
x:integer;
array_set:array[1..4] of byte;
uni:boolean;
i:byte;
n:integer;
function in_array_set(s:byte;i:byte):boolean;
{функция поможет нам определять уникальные последовательности}
var
j:byte;
begin
for j:=1 to 4 do
if (array_set[j]=s) and (j<>i) then begin
in_array_set:=true;
exit;
end;
in_array_set:=false;
end;
{---BEGIN---}
begin
x:=1000;
clrscr;
n:=0;
for x:=1000 to 9999 do begin
{а это практически сердце проги... выделение разрядов}
array_set[1]:=x div 1000;
array_set[2]:=(x-array_set[1]*1000) div 100;
array_set[3]:=(x-array_set[1]*1000-array_set[2]*100) div 10;
array_set[4]:=x mod 10;
uni:=true;
for i:=1 to 4 do
if in_array_set(array_set[i],i) then begin
uni:=false;
break;
end;
if uni then begin
writeln(x);
inc(n);
{ставим break на листинг (25 строк) }
if (n mod 25) = 0 then begin
writeln('Press any key to continue...');
ReadKey;
end;
end;
end;
writeln('n = ',n);
writeln('End. Press any key to exit...');
ReadKey;
end.
>
> G> 3) Как выделять по очередно из текстового файла все слова и проверять
> стоит
> G> ли у них на первой позиции 'А' или 'а'?
> 1. Создать множество раздилителей: [#32, '.', ',', .....]
> 2. Удалить все разделители с начала строки
> 3. Найти следующий разделитель i
> 4. Вырезать из строки подстроку s (слово) с 1 по i-1 символ
> 4,5. if s[1] in ['A', 'a'] then .....;
> 5. goto п.2
> G> Как подсчитать количество предложений через множества?
> Множества здесь нафиг нужны!
> Наиболее простой метод - подсчитать количество комбинаций
> 1. Точка в конце строки
> 2. Точка, пробел, заглавный символ
> Чтобы более крутой подбор написать надо долго мучиться
uses crt;
var
str,str_tmp:string;
n:integer;
function read_str_from_file(name_file:string):string;
{советую запомнить функцию... много где потом пригодиться}
var
f:text;
str,str_tmp:string;
exist_file:boolean;
begin
assign(f,name_file);
{$I+}
Reset(f);
str:='';
while not eof(f) do begin
readln(f,str_tmp);
str:=str+str_tmp;
if not eof(f) then str:=str+#13+#10;
end;
close(f);
{$I-}
exist_file:=(IOResult = 0) and (name_file <> '');
if exist_file then read_str_from_file:=str
else read_str_from_file:='';
end;
function pos_a(str:string):boolean;
begin
if (pos('a',str)=1) or (pos('A',str)=1) then pos_a:=true
else pos_a:=false;
end;
procedure find(str:string);
var
w:string;
begin
if (pos(' ',str)<>0) and (pos(#13+#10,str)<>0) then
if pos(' ',str) < pos(#13+#10,str) then w:=copy(str,0,pos(' ',str))
else w:=copy(str,0,pos(#13+#10,str))
else
if (pos(' ',str)<>0) and (pos(#13+#10,str)=0) then
w:=copy(str,0,pos(' ',str));
if (pos(' ',str)=0) and (pos(#13+#10,str)<>0) then
w:=copy(str,0,pos(#10+#13,str));
if (pos(' ',str)=0) and (pos(#13+#10,str)=0) then
w:=copy(str,0,length(str));
inc(n);
writeln(w);
end;
begin
clrscr;
n:=0;
str:=read_str_from_file('t.txt'); {Имя файла своё конечно )}
writeln('--------File:');
writeln(str);
writeln('--------Words:');
str_tmp:=str;
if pos_a(str_tmp) then find(str_tmp);
while pos(#13+#10,str_tmp)<>0 do begin
str_tmp:=copy(str_tmp,pos(#13+#10,str_tmp)+2,length(str_tmp)-pos(#13+#10,str_tmp));
if pos_a(str_tmp) then find(str_tmp);
end;
str_tmp:=str;
while pos(' ',str_tmp)<>0 do begin
str_tmp:=copy(str_tmp,pos(' ',str_tmp)+1,length(str_tmp)-pos('
',str_tmp));
if pos_a(str_tmp) then find(str_tmp);
end;
writeln('n = ',n);
ReadKey;
end.
трудночть в том что слова или предложения могут стоять слитно и
заканчиваться '!' , '?' , '.' , ','.
А вот как все это сделать через множества?
> G> 4) Дан файл целых чисел. Выбрать те, которые имеют единицы в 3 и 6
> двоичных
> G> разрядах и сформировать из них последовательность элементов,
> упорядоченную
> G> по возрастанию.
> x: byte;
> if ((x and $8)<>0) //$8 =0001000b
> and ((x and $40)<>0) //$40=1000000b
> then оно
> else не оно
> G> Записать ее в новый файл.
> Это просто :)
а на код можно посмотреть
Номер выпуска : 3870
Возраст листа : 445 (дней)
Количество подписчиков : 512
Адрес в архиве : http://subscribe.ru/archive/comp.soft.prog.prog/msg/278617
Получить правила : mailto:comp.soft.prog.prog-rules@subscribe.ru
Формат "дайджест" : mailto:comp.soft.prog.prog-digest@subscribe.ru
Формат "каждое письмо" : mailto:comp.soft.prog.prog-normal@subscribe.ru
Формат "читать с веба" : mailto:comp.soft.prog.prog-webonly@subscribe.ru
-*Информационный канал Subscribe.Ru
Подписан адрес:
Код этой рассылки: comp.soft.prog.prog
Написать в лист: mailto:comp.soft.prog.prog-list@subscribe.ru
Отписаться: mailto:comp.soft.prog.prog--unsub@subscribe.ru?subject=comp.soft.prog.prog
http://subscribe.ru/ http://subscribe.ru/feedback
