Привет Gift,
Friday, December 10, 2004, 5:46:34 PM, вы писали:
>> 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) смещаешь вверх
G> 1) была у меня задача на двумерные массивы.
G> Вычеркнуть K строку и m столбец содержащие минимальное значение матрицы
G> A[1..N,1..M], записать в новую матрицу B[1..n-1,1..m-1]. Ниже код программы.
G> А как сделать то же самое используя только один массив A?
G> procedure obrabotka;
G> var min,Xi,Xj,Si,Sj:integer;
G> begin
G> min:=a[1,1];
G> Xi:=1;
G> Xj:=1;
G> for i:=1 to n do
G> for j:=1 to m do
G> if a[i,j]<min then
G> begin
G> Xi:=i;
G> Xj:=j;
G> min:=a[i,j];
G> end;
(*
G> si:=0;
G> sj:=0;
G> for i:=1 to n do
G> begin
G> if Xi<>i then
G> for j:=1 to m do
G> if j<>Xj then b[i-si,j-sj]:=a[i,j]
G> else sj:=1
G> else si:=1;
G> sj:=0;
G> end;
*)
//Удаляем строку
for i:=Xi to n-1 do
for j:=1 to m do a[i,j]:=a[i+1,j];
//Удаляем столбец
for i:=1 to n-1 do
for j:=Xj to m-1 do a[i,j]:=a[i,j+1];
G> 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 не подходит;
G> Как сделать чтоб не прога искала числа, а пользовтель вводит ряд любых чисел
G> и из них прога выбирала натур четырехзначные числа,
G> в десятичной записи которых нет одинаковых цифр.
Создай массив числа юзеров и гони i по индексам массива:
for i:=0 to LenMax-1 do
begin
x:=UserValue[i];
.................
G> uses crt;
G> var
G> x:integer;
G> array_set:array[1..4] of byte;
G> uni:boolean;
G> i:byte;
G> n:integer;
G> function in_array_set(s:byte;i:byte):boolean;
G> {функция поможет нам определять уникальные последовательности}
G> var
G> j:byte;
G> begin
G> for j:=1 to 4 do
G> if (array_set[j]=s) and (j<>i) then begin
G> in_array_set:=true;
G> exit;
G> end;
G> in_array_set:=false;
G> end;
см. текст выше
function Unicale: Boolean;
var
i, j: Integer;
begin
Unicale:=True;
for i:=1 to 3 do
for j:=i+1 to 4 do Unicale:=Unicale and (array_set[i]<>array_set[j]);
end;
Функция вернёт True <=> array_set[i]<>array_set[j] при любых i, j i<>j
G> {---BEGIN---}
G> begin
G> x:=1000;
G> clrscr;
G> n:=0;
G> for x:=1000 to 9999 do begin
G> {а это практически сердце проги... выделение разрядов}
G> array_set[1]:=x div 1000;
G> array_set[2]:=(x-array_set[1]*1000) div 100;
G> array_set[3]:=(x-array_set[1]*1000-array_set[2]*100) div 10;
G> array_set[4]:=x mod 10;
(*
Можно проще
var y: Integer;
...........
array_set[1]:=x div 1000;
y:=x mod 1000;
array_set[2]:=y div 100;
y:=y mod 100;
array_set[3]:=y div 10;
array_set[4]:=y mod 10;
*)
(*
G> uni:=true;
G> for i:=1 to 4 do
G> if in_array_set(array_set[i],i) then begin
G> uni:=false;
G> break;
G> end;
*)
uni:=Unicale;
G> if uni then begin
G> writeln(x);
G> inc(n);
G> {ставим break на листинг (25 строк) }
G> if (n mod 25) = 0 then begin
G> writeln('Press any key to continue...');
G> ReadKey;
G> end;
G> end;
G> end;
G> writeln('n = ',n);
G> writeln('End. Press any key to exit...');
G> ReadKey;
G> 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. Точка, пробел, заглавный символ
>> Чтобы более крутой подбор написать надо долго мучиться
G> uses crt;
G> var
G> str,str_tmp:string;
G> n:integer;
G> function read_str_from_file(name_file:string):string;
G> {советую запомнить функцию... много где потом пригодиться}
G> var
G> f:text;
G> str,str_tmp:string;
G> exist_file:boolean;
G> begin
G> assign(f,name_file);
G> {$I+}
G> Reset(f);
G> str:='';
G> while not eof(f) do begin
G> readln(f,str_tmp);
G> str:=str+str_tmp;
В паскале есть ограничение string в 255 символов - большие файлы не сможешь
обрабатывать!!! Обрабатывай по одной строчке! Либо делать f: file of char и
считывать по одному символу, когда дойдешь до стоп-символа (тут могут и пригодится
множества: ch in StopChars, где const StopChars: set of Char = [#32, '.',
',', '!' и т.п.]) тогда получил слово (пример немного ниже)
G> if not eof(f) then str:=str+#13+#10;
G> end;
G> close(f);
G> {$I-}
G> exist_file:=(IOResult = 0) and (name_file <> '');
G> if exist_file then read_str_from_file:=str
G> else read_str_from_file:='';
G> end;
G> function pos_a(str:string):boolean;
G> begin
G> if (pos('a',str)=1) or (pos('A',str)=1) then pos_a:=true
G> else pos_a:=false;
Делай красивее:
pos_a:=(pos('a',str)=1)or(pos('A',str)=1);
G> end;
G> procedure find(str:string);
G> var
G> w:string;
G> begin
G> if (pos(' ',str)<>0) and (pos(#13+#10,str)<>0) then
G> if pos(' ',str) < pos(#13+#10,str)
G> then w:=copy(str,0,pos(' ',str))
G> else w:=copy(str,0,pos(#13+#10,str))
G> else
G> if (pos(' ',str)<>0) and (pos(#13+#10,str)=0) then
G> w:=copy(str,0,pos(' ',str));
G> if (pos(' ',str)=0) and (pos(#13+#10,str)<>0) then
G> w:=copy(str,0,pos(#10+#13,str));
G> if (pos(' ',str)=0) and (pos(#13+#10,str)=0) then
G> w:=copy(str,0,length(str)); ???
w:=str; Зачем так извращенно копировать строку
0-й символ - есть фактически длина строки, поэтому: Copy(str, 1, Len);
Слово выделил, а удалять кто его будет из строки. Лучше запустить
While str<>'' do и там выделять слова:
sword:='';
While str<>'' do
begin
if not (str[1] in StopChars)
then begin
sword:=sword+str[1];
Delete(str,1,1);
end
else begin
if sword<>'' then
begin
inc(n);
writeln(w);
end;
sword:='';
Delete(str,1,1);
end
end;
G> inc(n);
G> writeln(w);
G> end;
G> begin
G> clrscr;
G> n:=0;
G> str:=read_str_from_file('t.txt'); {Имя файла своё конечно )}
G> writeln('--------File:');
G> writeln(str);
G> writeln('--------Words:');
G> str_tmp:=str;
G> if pos_a(str_tmp) then find(str_tmp);
G> while pos(#13+#10,str_tmp)<>0 do begin
G>
G> str_tmp:=copy(str_tmp,pos(#13+#10,str_tmp)+2,length(str_tmp)-pos(#13+#10,str_tmp));
G> if pos_a(str_tmp) then find(str_tmp);
G> end;
G> str_tmp:=str;
G> while pos(' ',str_tmp)<>0 do begin
G> str_tmp:=copy(str_tmp,pos(' ',str_tmp)+1,length(str_tmp)-pos('
G> ',str_tmp));
G> if pos_a(str_tmp) then find(str_tmp);
G> end;
G> writeln('n = ',n);
G> ReadKey;
G> end.
G> трудночть в том что слова или предложения могут стоять слитно и
G> заканчиваться '!' , '?' , '.' , ','.
G> А вот как все это сделать через множества?
тип множества может быть только ординарный и однобайтовый (в Паскале),
то бишь Char или Byte, не совсем понятно для чего здесь множества
>> 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> Записать ее в новый файл.
>> Это просто :)
G> а на код можно посмотреть
Очень прошу применять форматирование текста, хотябы под каждым
begin'ом свой end, под then'ом else, а то читать чужой код очень
сложно. Надеюсь мои комментарии помогут :)
Афоризм напоследок: У меня не настолько хорошее зрение, чтобы рассматривать предложения
с маленькой зарплатой.
12 декабря 2004 г. 11:25:55
Просто студент
Eugene mailto:rav***@o*****.ru
Номер выпуска : 3875
Возраст листа : 447 (дней)
Количество подписчиков : 512
Адрес в архиве : http://subscribe.ru/archive/comp.soft.prog.prog/msg/279233
Получить правила : 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
