/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 423
от 16.07.2007, 18:05

Вопрос № 94.685

Пожалуйста,помогите решить задачи : 1. Даны два одномерных целочисленных массива А и В. Составить алгоритм, определяющий, можно ли путем перестановки элементов массива А получить массив В (алгоритмы сортировки использовать нельзя). 2. Дан одномерный массив целых чисел в диапазоне от –100 до 100, в котором есть повторяющиеся элементы. Составить алгоритм, определяющий, какой элемент встречается в массиве наиболее часто (алгоритмы сортировки использовать не рекомендуется, вводить дополнительные массивы не разрешается). Заранее спасибо! Swallow.

Отправлен: 10.07.2007, 23:58 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Gh0stik Здравствуйте, Ласточка! Вот привожу решение на вторую часть вопроса. const n=10; {количество элементов в массиве} var x:array [1..n] of integer; mx,mk,k,i,j:integer; begin randomize; for i:=1 to n do begin x[i]:=random(100)-random(100); {генерируем чисела из диапазона от –100 до 100} write(x[i]:5); end; mx:=x[1]; k:=0; mk:=1; for i:=1 to n-1 do begin for j:=2 to n do if x[i]=x[j] then begin inc(k); if k > mk then begin mx:=x[i];mk:=k;end; end; k:=0; end; writeln; writeln('?=',mx, 'count=',mk); {выводим элемент и сколько раз он встречается} end. Единственное, что хотелось бы уточнить, так это, то что программа будет выводить "первое" число по порядку, которое встречается максимальное число раз. (ведь таких чисел может быть и несколько) Для того, чтобы вывести "последние" число по порядку достаточно изменить условие: if k > mk then begin mx:=x[i];mk:=k;end; на if k >= mk then begin mx:=x[i];mk:=k;end; Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 11.07.2007, 00:30 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо!!Вы мне очень помогли

Отвечает: _killhunter_ Здравствуйте, Ласточка! Привожу решение 1-ой части вопроса. Алгоритм простой. Создаем дополнительный масссив F той-же длинны с флагами. Идем последовательно по массиву А и для каждого элемента ищем такой-же в массиве В, причем если находим на i-том месте, то делаем флаг F[i] := false и элемент B[i] больше в поиске не участвует. Приложение: const n=10; {количество элементов в массиве} var A,B : array[1..n] of integer; F : array[1..n] of boolean; i,j:integer; flag : boolean; BEGIN Randomize; for i := 1 to n do begin A[i] := random(100); B[i] := random(100); F[i] := true; end; {инициализировали массивы} flag := true; i := 1; While flag and (i<=n) do begin j := 1; While j<=n do begin if (A[i] = B[j])andF[j] then begin F[j] := false; j := n+1; end; inc(j); end; if j <> n+1 then flag := false; inc(i); end; if flag then writeln("можно") else writeln("нельзя"); END.

Ответ отправил: _killhunter_ (статус: 1-ый класс) Ответ отправлен: 11.07.2007, 11:15 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное за помощь!Безмерно благодарна.

Отвечает: mvp Здравствуйте, Ласточка! Ну, раз за дополнительные массивы по первому заданию ставят 5 :), и мини-форум не читают, то первое задание решается гораздо проще: найдите сумму разности эл-ов массивов. Если она равна 0, то можно: var A, B : Array[1..n] of ...; //инициализируем как-то массивы; sum := 0; for _:=1 to n do sum := sum + A[_] - B[_] ; if sum = 0 then { можно :) } --------- Моя совесть чиста - не бывшая в употреблении

Ответ отправил: mvp (статус: Студент) Ответ отправлен: 11.07.2007, 23:16 Оценка за ответ: 5 Комментарий оценки: Спасибо, mvp! Да у меня просто рука не поднимется поставить оценку ниже пятёрки, человеку, который не пожалел своего драгоценного времени и хоть как-то, в силу своих возможностей, ответил на мой вопрос. Такой уж я человечек.

Вопрос № 94.752

Пожалуйста,помогите решить три задачи: 1. Дан одномерный массив целых чисел. Найти количество чисел среди элементов массива, встречавшихся ровно 1 раз. 2. Дан одномерный массив. Поменять в нем порядок четных элементов на обратный. Пример: исходный массив – 2 5 3 7 4 6 4 5 9 преобразованный массив – 4 5 3 7 6 4 2 5 9 3. Дан одномерный массив целых чисел. Определить, есть ли в массиве последовательность идущих подряд элементов, сумма которых равна заданному числу. Если это возможно, то в наиболее упрощённом варианте и с пояснениями. Заранее большое спасибо. Swallow.

Отправлен: 11.07.2007, 12:28 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Gh0stik Здравствуйте, Ласточка! 1) Думаю что данная задача в особых комментариях не нуждается: const n=10; {количество элементов в массиве} var x:array [1..n] of integer; kol,k,i,j:integer; begin randomize; for i:=1 to n do begin x[i]:=random(100)-random(100); {генерируем чисела из диапазона от –100 до 100} write(x[i]:5); end; k:=0; kol:=0; for i:=1 to n do begin for j:=1 to n do if x[i]=x[j] then inc(k); if k=1 then inc(kol); k:=0; end; writeln; writeln('count=',kol); {выводим количество "одиноких" элементов} end. 2) Идея в том, что мы двигаемся в массиве с двух сторон навстречу и ищем четные элементы, как только их встречаем сразу же переставляем местами. Заканчиваем поиск и перестановку как только i > j. const n=9; {количество элементов в массиве} var x:array [1..n] of integer; k,i,j:integer; begin for i:=1 to n do begin write('x[',i,']='); readln(x[i]); {вводим элементы массива с клавиатуры} end; for i:=1 to n do write(x[i]:5); writeln; i:=1; j:=n; while i < j do begin while odd(x[i]) do inc(i); {находим индекс четного элемента начиная слева} while odd(x[j]) do dec(j); {находим индекс четного элемента начиная справа} k:=x[i]; x[i]:=x[j]; {переставляем их местами} x[j]:=k; inc(i); dec(j); end; for i:=1 to n do write(x[i]:5); {выводим полученный результат} readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 11.07.2007, 13:02 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо! Это как раз то, что я хотела. Спасибо, что учли мои пожелания относительно поянений в тексте решения.

Отвечает: Louken Здравствуйте, Ласточка! Решение первой и третьей задачи в приложении: Приложение: ========== Первая задача ========== program z1; uses Crt; const n = 10; {Количество элементов в массиве} var m: array[1..n] of integer; i,j,k: integer; b: boolean; begin ClrScr; {Вариант случайного заполнения массива} { Randomize; for i:=1 to n do begin m[i]:=Random(10)+1; Write(m[i]:4); end; Writeln;} {Вариант ручного заполнения массива} for i:=1 to n do begin Write('Vvedite chislo #',i,' = '); Readln(m[i]); end; Writeln; k:=0; {Пробегаем по всему массиву} for i:=1 to n do begin b:=false; for j:=2 to n do {Сравниваем каждый элемент с каждым} if (m[i]=m[j]) and (i<>j) then begin b:=true; Break; end; if not b then Inc(k); end; Writeln('Otvet = ',k); Readln; end. ========== Третья задача ========== program z3; uses Crt; const n = 10; {Количество элементов в массиве} var m: array[1..n] of integer; i,j,s,s1: integer; n1,n2: integer; {Номера начала и конца последовательности} b: boolean; begin ClrScr; Write('Vvedite summu: '); Readln(s); for i:=1 to n do begin Write('Vvedite chislo #',i,' = '); Readln(m[i]); end; Writeln; b:=false; {Пробегаем по всему массиву} for i:=1 to n do begin s1:=0; j:=i; {Находим сумму последовательности с началом от элемента с номером i} While (s1<>s) and (j<=n) do begin s1:=s1+m[j]; Inc(j); end; {Последовательность найдена. Завершаем работу цикла поиска} if s1=s then begin b:=true; n1:=i; n2:=j-1; Break; end; end; Writeln; if b then begin {Выводим эту последовательность} for i:=n1 to n2 do Write(m[i]:4); end else begin {Не нашлось такой последовательности} Writeln('Takoy posledovatelnosti net'); end; Readln; end.

Ответ отправил: Louken (статус: 10-ый класс) Ответ отправлен: 11.07.2007, 13:54 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо за помощь! В особенности, за развёрнутые комметрарии к решению. Это как раз то, что я хотела.

Отвечает: Дмитрий С. Здравствуйте, Ласточка! 1. var MS: array [1..k] of integer; // k <= 64; count, i: integer; mn: set of byte; begin // заполняем массив MS count := 0; mn := []; for i:=1 to k do if not (MS[i] in mn) then begin mn := mn + [MS[i]]; inc(count); end; end. Всего count элементов. --------- Наши программисты самые программистые программисты!..

Ответ отправил: Дмитрий С. (статус: 2-ой класс) Ответ отправлен: 14.07.2007, 15:41

Вопрос № 94.754

Help me, please!!! Вот задачки: 1. Известны данные о вместимости (в мегабайтах) и стоимости (в рублях) каждого из 22 типов жестких магнитных дисков (винчестеров). Напечатать наибольшую вместимость винчестеров, стоимость которых не превышает s рублей. Вывести номера типов таких винчестеров. 2. Даны 20 точек (x1,y1), (x2,y2), … (x20,y20). Рассмотрим всевозможные прямоугольники со сторонами, параллельными координатным осям с левой нижней и правой верхней или с левой верхней и правой нижней вершинами в этих точках. Найти и вывести координаты всех вершин прямоугольника, имеющего наименьшую площадь. 3. В области 10 районов. Заданы площади, засеваемые пшеницей (в гектарах), и средняя урожайность (в центнерах с гектара) в каждом районе. Определить количество пшеницы, собранное в области, и среднюю урожайность по области. Хотелось бы получить ответ в наиболее упрощённом варианте и с пояснениями. Всем, кто сможет хоть как-то помочь заранее очень благодарна. Swallow.

Отправлен: 11.07.2007, 12:36 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ласточка! Смотрите приложение. Удачи! Приложение: Задача 1 program q94754a; const n=22; var a:packed array[1..n,1..2]of integer; b:packed array[1..n]of string; c,i,j:integer; d:boolean; begin {вводим данные} for i:=1 to n do begin writeln('HDD',i); write('name:'); readln(b[i]); write('size:'); readln(a[i,1]); write('price:'); readln(a[i,2]); end; {вводим ограничение} write('input maximum:'); readln(c); {начинаем поиск} d:=false; for i:=1 to n do begin if a[i,2]<=c then if d then begin{начинаем поиск наибольшего} if a[i,1]>a[j,1] then j:=i; end else begin{нашли первый меньший ограничения} j:=i; d:=true; end; end; if d then for i:=1 to n do if a[j,1]=a[i,1] then{выводим все которые равны максимуму} writeln('size:',a[i,1],' name:',b[i]); end. Задача 2 program q94754b; const n=20; var a:packed array[1..n,1..2]of integer; d:packed array[1..190,1..3]of integer; b,i,j:integer; begin {вводим координаты} for i:=1 to n do begin write('input x',i); readln(a[i,1]); write('input y',i); readln(a[i,2]); end; {ищем все прямоугольники} b:=0; for i:=1 to n-1 do for j:=i+1 to n do if (a[i,1]<>a[j,1])and(a[i,2]<>a[j,2])then begin b:=b+1; d[b,1]:=i;{запоминаем индексы точек и площадь прямоугольников} d[b,2]:=j; d[b,3]:=abs(a[j,2]-a[i,2])*abs(a[i,1]-a[j,1]); end; writeln('kol-vo:',b); readln; {начинаем вывод коордтнат} if b>0 then begin i:=d[1,3]; {ищем наименьшую площадь} for j:=2 to b do if i>d[j,3] then i:=d[j,3]; {выводим координаты точек с наименьшей площадью} for j:=1 to b do if d[j,3]=i then writeln('a(',a[d[j,1],1]:2,',',a[d[j,1],2]:2,') b(',a[d[j,2],1]:2,',',a[d[j,2],2]:2,')'); end; end. Задача 3 program q94754c; var i:integer; a,b,c,d:real; begin c:=0; d:=0; for i:=1 to 10 do begin writeln('',i); write('size:'); readln(a); write('average:'); readln(b); c:=c+a*b;{востанавливаем кол-во зерна и суммируем} d:=d+a;{суммируем площадь} end; writeln('all:',c);{выводим кол-во зерна} writeln('average',c/d);{выводим среднее} end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Практикант) Ответ отправлен: 11.07.2007, 16:12 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо,Константин Николаевич! Попробую разобраться сейчас в ваших вариантах решения к задачам. Вы мне очень помогли! Спасибо)

Вопрос № 94.781

Уважаемые эксперты!! Проверьте, пожалуйста моё решение 2х задач(в приложении)… Что в них не так? Не могу понять, где ошибки допустила. А условия задач вот: 1. Дана непустая последовательность натуральных чисел, оканчивающаяся числом, являющимся факториалом некоторого натурального числа. Определить в этой последовательности порядковый номер числа, имеющего максимальную сумму цифр. 2. Дан одномерный массив целых двоичных чисел (число в двоичной записи представлено строкой). Не делая перевода в десятичную систему счисления, определить количество и номера элементов массива, кратных четырем. Надеюсь, поможете. Заранее большое спасибо! Swallow. Приложение: Во второй задаче Init точно правильный, я проверяла, а вот в процедуре Main ошибка, она находит не все нужные числа. Program Z_1; Uses Crt; Var n,maxsum:integer;k,imaxsum:byte; Function Check(n:integer):boolean; Var m:integer;k:byte; Begin m:=1;k:=1; While m<n do begin m:=m*k; inc(k); end; Check:=(m=n); End; Function Sum_tsifr(x:integer):integer; Var sum:integer; Begin sum:=0; While n<>0 do begin sum:=sum+n mod 10; n:=n div 10; end; Sum_tsifr:=sum; End; BEGIN ClrScr; readln(n); if not Check(n) then begin k:=0;maxsum:=-maxint; While not Check(n) do begin inc(k); if Sum_tsifr(n)>maxsum then begin maxsum:=Sum_tsifr(n); imaxsum:=k; end; readln(n); end; Writeln('Порядковый номер числа, имеющего мах сумму цифр: ',imaxsum); end else writeln('Empty'); readln; END. Program Z_2; Const n=15; Type mas=array[1..n]of string; Var a:mas; Procedure Init(var a:mas); var i,k,j:byte; Begin For i:=1 to n do begin a[i]:=''; for j:=1 to 5 do begin k:=random(2); if not ((a[i]='') and (k=0)) then a[i]:=a[i]+chr(ord('0')+k); end; if (a[i]='') then a[i]:='0'; end; End; Procedure Print(a:mas); Var i:byte; Begin For i:=1 to n do writeln(' ',a[i]); writeln; End; Procedure Main(a:mas); Var i,k:byte; Begin k:=0; For i:=1 to n do if (length(a[i])>=2)and(Pos('00',a[i])=length(a[i])-1) then begin write(i:4); inc(k); end; Writeln(' Kol-vo kr.4= ',k); End; BEGIN randomize; Init(a); Print(a); Main(a); readln; END.

Отправлен: 11.07.2007, 15:24 Вопрос задала: Ласточка (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Flynn Здравствуйте, Ласточка! Ошибка второй задачи в том, что процедуры POS выбырает у тебя не последние два нуля, а первые. И тогда если число будет 100100, оно не определяет его как делимое. Используй copy. Cо первой задачей подольше разбираться надо. Приложение: Procedure Main(a:mas); Var i,k:byte;j:string; Begin k:=0; For i:=1 to n do begin j:=copy(a[i],length(a[i])-1,2); writeln('j-',j); if (j='00') then writeln('delitsya'); if (length(a[i])>=2)and(Pos('00',a[i])=length(a[i])-1) then begin writeln(i:4); inc(k); end; end; Writeln(' Kol-vo kr.4= ',k); End;

Ответ отправил: Flynn (статус: 1-ый класс) Ответ отправлен: 11.07.2007, 16:13 Оценка за ответ: 4 Комментарий оценки: Большое спасибо за участие в разрешении моей проблемы. Попробую востользоваться вашими советами относительно второй задачи.

Отвечает: Louken Здравствуйте, Ласточка! Исправленное решение обоих задача в приложении: Приложение: ========== Первая задача ========== Program Z_1; Uses Crt; Function Check(n:longint {!!!}):boolean; Var m:longint; {!!!} k:byte; Begin m:=1; k:=2; {!!!} While m<n do begin m:=m*k; inc(k); end; Check:=(m=n); End; Function Sum_tsifr(n {!!!} :longint {!!!}):integer; Var sum:integer; Begin sum:=0; While n>0 do begin sum:=sum+n mod 10; n:=n div 10; end; Sum_tsifr:=sum; End; Var n: longint; maxsum, imaxsum: integer; k:byte; begin ClrScr; maxsum:=Low(maxsum); imaxsum:=-1; Readln(n); While not Check(n) do begin Inc(k); if Sum_tsifr(n)>maxsum then begin maxsum:=Sum_tsifr(n); imaxsum:=k; end; Readln(n); end; if imaxsum<>-1 then Writeln('Порядковый номер числа, имеющего мах сумму цифр: ',imaxsum) else writeln('Empty'); Readln; end. ========== Вторая задача ========== Program Z_2; uses Crt; Const n=15; Type mas=array[1..n]of string; Var a:mas; Procedure Init(var a:mas); var i,k,j:byte; Begin For i:=1 to n do begin a[i]:=''; for j:=1 to 5 do begin k:=random(2); if not ((a[i]='') and (k=0)) then a[i]:=a[i]+chr(ord('0')+k); end; if (a[i]='') then a[i]:='0'; end; End; Procedure Print(a:mas); Var i:byte; Begin For i:=1 to n do writeln(' ',a[i]); writeln; End; Procedure Main(a:mas); Var i,k:byte; Begin k:=0; For i:=1 to n do {!!!} if (Length(a[i])>=3) and (Copy(a[i], Length(a[i])-1, 2)='00') then { if (length(a[i])>=2) and (Pos('00',a[i])=length(a[i])-1) then} begin write(i:4); inc(k); end; Writeln; Writeln(' Kol-vo kr.4= ',k); End; BEGIN ClrScr; randomize; Init(a); Print(a); Main(a); readln; END.

Ответ отправил: Louken (статус: 10-ый класс) Ответ отправлен: 11.07.2007, 16:50

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ласточка! Правильное решение 1-ой задачи. Т.к. Дана непустая последовательность натуральных чисел, оканчивающаяся числом, являющимся факториалом т.е. последнее число(факториал) является элементом последовательности. Но его сумма цифр не учитывается. К примеру:210(3),340(7),510(6),720(9) ps: Function Sum_tsifr(x:integer):integer; зачем объявлять переменную и потом забыть о ней. Удачи! Приложение: Program Z_1; Uses Crt; Var n,maxsum:integer; k,imaxsum:byte; Function Check(n:integer):boolean; Var m:integer; k:byte; Begin m:=1; k:=1; While m<n do begin m:=m*k; inc(k); end; Check:=(m=n); End; Function Sum_tsifr(n:integer):integer; Var sum:integer; Begin sum:=0; While n<>0 do begin sum:=sum+n mod 10; n:=n div 10; end; Sum_tsifr:=sum; End; BEGIN ClrScr; k:=1; imaxsum:=1; maxsum:=-maxint; repeat write('number ',k,':'); readln(n); if Sum_tsifr(n)>maxsum then begin maxsum:=Sum_tsifr(n); imaxsum:=k; end; until Check(n); Writeln('Порядковый номер числа, имеющего мах сумму цифр: ',imaxsum); readln; END. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Практикант) Ответ отправлен: 12.07.2007, 10:51 Оценка за ответ: 5 Комментарий оценки: Да.. я что-то проглядела. Глупая ошибка, но самостоятельно я её найти почему-то не смогла. Огромное спасибо за ответы на мои вопросы!

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.53 beta от 09.07.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru