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

Выпуск № 709
от 26.10.2008, 13:05

Вопрос № 147.856

Здраствуйте,помогите пожалуйста с задачей: Заполнить массив из 10 элементов случайными числами в интервале [1..100],разделить его на 2 части и отсортировать первую часть - по возрастанию,а вторую - по убыванию. Заранее вам огромное спасибо!

Отправлен: 20.10.2008, 14:30 Вопрос задала: Evela (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шичко Игорь Здравствуйте, Evela! Примерный алгоритм: Определяем позиции середины и сортируем установленным алгоритмом каждую часть по отдельности. Т.е. от 1 до середины и от середины +1 до конца. Примерный код - в приложении. Приложение: var massiv: array [1..10] of integer; i, temp: integer; search: boolean; begin for i:= 1 to 10 do massiv[i]:= Round(Random(100)); search:= True; while search do begin search:= false; for i:= 1 to (Round(Length(massiv) / 2) - 1) do begin if massiv[i]> massiv[i+ 1] then begin temp:= massiv[i+1]; massiv[i+1]:= massiv[i]; massiv[i]:= temp; search:= True; end; end; end; search:= True; while search do begin search:= false; for i:= (Round(Length(massiv)/2)+ 1) to Length(massiv) - 1 do begin if massiv[i]< massiv[i+ 1] then begin temp:= massiv[i+1]; massiv[i+1]:= massiv[i]; massiv[i]:= temp; search:= True; end; end; end; for i:= 1 to 10 do write(massiv[i]:10); end;

Ответ отправил: Шичко Игорь (статус: Студент) Ответ отправлен: 20.10.2008, 15:08 Оценка за ответ: 5

Отвечает: Чабаненко Владислав Дмитриевич Здравствуйте, Evela! Вот пример программы. Комментарии в приложении. Насчёт inc(a[j],a[j+1]); a[j+1]:=a[j]-a[j+1]; dec(a[j],a[j+1]); - это мы меняем так местами элементы a[j] и a[j+1], т.е. надо знать, чтобы поменять две переменные a и b (числовые) без дополнительных переменных: a:=a+b; b:=a-b; a:=a-b; (a=4; b=18; -> a=22; b=18; -> a=22; b=4; -> a=18; b=4) УДАЧИ Приложение: var i,j:integer; a:array[1..10]of integer; begin for i:=1 to 10 do begin randomize; a[i]:=random(100)+1; end; writeln('Ishodnij massiv:'); for i:=1 to 10 do {Заполняем исходный массив случайными числами} write(a[i],' '); writeln; writeln; for i:=1 to 4 do {Первую половину упорядочиваем по возрастанию-пузырьком} for j:=1 to 4 do If a[j]<a[j+1] then begin {То что я уже описывал } inc(a[j],a[j+1]); a[j+1]:=a[j]-a[j+1]; dec(a[j],a[j+1]); end; for i:=6 to 9 do {Вторую половину упорядочиваем по возрастанию-тоже пузырьком} for j:=6 to 9 do If a[j]>a[j+1] then begin inc(a[j],a[j+1]); a[j+1]:=a[j]-a[j+1]; dec(a[j],a[j+1]); end; for i:=1 to 10 do {Выводим полученный массив} write(a[i],' ');

Ответ отправил: Чабаненко Владислав Дмитриевич (статус: Заблокирован) Ответ отправлен: 20.10.2008, 16:10 Оценка за ответ: 5

Вопрос № 147.882

Пожалуйста, помогите решить задачку. Разложить заданное натуральное число на простые множители, желательно с комментариями.

Отправлен: 20.10.2008, 18:29 Вопрос задал: Морозов Артём Сергеевич (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Морозов Артём Сергеевич! Программа в приложении. Вопросы задавайте в мини-форум. Удачи! Приложение: var a,b:integer; c,d:string; {функция определения простого числа} function P(z:integer):boolean; begin repeat dec(z); until (b mod z)=0; P:= not(z=1); end; begin {вводим натуральное число больше минимального простого} repeat write('Enter A:'); readln(a); until a>2; {начинаем работу} b:=2; str(a,d); c:=d + ':='; {цикл поиска множителей} repeat {поиск простого числа} while P(b)do inc(b); {проверяем делитель} if (a mod b)=0 then begin {преобразовываем в строку делитель и добавлем в результат} str(b,d); c:=c+ d; a:=a div b; {если есть ещё множители добавляем знак} if a>=b then c:=c+' * '; end else {это не делитель, переходим на следующий} inc(b); until a<b; {выводим результат} writeln(c); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 20.10.2008, 19:37

Отвечает: Verena Здравствуйте, Морозов Артём Сергеевич! Вот другой вариант, очень простой алгоритм. Рассматривается сначала деление на 2, а затем на все по порядку нечётные числа. Когда квадрат делителя превысит число - рассмотрение потеряет смысл и цикл завершится. Остальное, думаю, ясно из комментариев. Удачи! Код: Var n, p: word; begin readln (n); {Считываем число} p:= 2; {Проверяем делимость на 2} if n=1 then {Если число=1 - выходим} writeln (n) else begin while (n mod 2 = 0) do {Пока число делится на 2} begin writeln (p); {Выводим делитель} n:= n div 2;{Делим число на делитель} end; if n<>1 then {Если не доделилось} begin p:=3; {Рассматриваем делитель 3 и далее все нечётные} while (p*p <= n) do {Пок а квадрат делителя меньше числа} begin if n mod p = 0 then {Если делится} begin writeln (p); {Выводим} n:= n div p; {Делим} p:= p-2; {Сохраняем текущий делитель (далее он наращивается)} end; p:= p+2; {Переходим на следующий} end; writeln (n); {Выводим оставшееся} end; end; End. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.10.2008, 19:45 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!!!!!!!!

Отвечает: Чабаненко Владислав Дмитриевич Здравствуйте, Морозов Артём Сергеевич! Принимайте программу, комментарии см. ниже, если возникнут вопросы - обращайтесь. УДАЧИ!!! Приложение: var i,f,n,z,k:integer; a:array[1..1000]of integer; function del(h:integer):integer; {функция проверяет является ли число простым} var i,k:integer; begin k:=0; for i:=1 to h do If h mod i = 0 then inc(k); del:=k; end; begin randomize; n:=random(1000)+2; {генерируем число от 2 до 1001 можно и вводить числа read(n)} f:=1; for i:=1 to n do {от 1 до n находим простые числа и записываем их в массив} If del(i)=2 then begin a[f]:=i; inc(f); end; z:=n; {заводим дополнительную переменную и присваеваем ей n см. дальше} f:=1; k:=0; write(n,' = '); {начинаем вывод} while z<>1 do {работаем с циклом пока z<>1} begin k:=0; while (z mod a[f] = 0)and(z<>0) do {пока число нами данное делится на одно из простых чисел цикл работает - потом переходит к другому простому числу} begin z:=z div a[f]; {делим нацело наше число на простое - получаем целую часть} case z of 1:write(a[f]); {если наше число равно один, то выводим без * в конце, иначе со знаком *} 2..1000:write(a[f],'*'); end; end; inc(f); {увеличиваем игдекс в массиве простых чисел} end;

Ответ отправил: Чабаненко Владислав Дмитриевич (статус: Заблокирован) Ответ отправлен: 20.10.2008, 19:54

Вопрос № 147.907

и вот еще,пожалуйста..просто пожалуйста...:Дан файл Assort,содержащий сведения об игрушках,указывается название игрушки,ее стоимость в рублях и возрастные границы (например:игрушка может предназначаться для детей от 2 до 5 лет). Определить стоимоть самого дорогого конструктра

Отправлен: 20.10.2008, 21:12 Вопрос задала: Еленка (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Еленка! Предполагаю, работа с типизированным файлом. Описываем запись следующего вида: Код: Type Toy = record {Запись} name: string [50]; {Название} price: word; {Цена} LowAge: byte; {Нижняя граница возраста} HighAge: byte; {Верхняя граница возраста} end; И задаём фал данного типа (типа Toy). Читаем из него записи по одному и сравниваем цены на конструкторы. Точка отсчёта - цена = -1, такой цены или меньшей не может реально встретиться, поэтому если она останется отрицательной, значит конструкторы в файле не описаны. Программа будет работать только с файлом записей данного вида. Код в приложении. Удачи! Приложение: Type Toy = record {Запись} name: string [50]; {Название} price: word; {Цена} LowAge: byte; {Нижняя граница возраста} HighAge: byte; {Верхняя граница возраста} end; Var f: file of Toy; {Типизированный файл} z: Toy; fname: string; maxPrice: integer; begin readln (fname); {Ввод имени файла} assign (f, fname); {Ассоциируем переменную с файлом на диске. Вместо fname можно написать 'Assort', если имя файла постоянно, тогда ввод не нужен} reset (f); {Открываем файл для чтения} maxPrice:= -1; {Устанавливаем нмаксимум на отрицательное число, посольку отрицательной цены не может быть} while not eof(f) do {Пока не конец файла} begin read (f, z); {Считываем запись} if (z.name='Konstruktor') and (z.price>maxPrice) then maxPrice:= z.price; {Если это конструктор и его цена больше - перезапоминаем} end; if maxPrice<0 then writeln ('Net konstruktorov') {Если цена осталась отрицательной - конструкторов не встретилось} else writeln ('Price: ', maxPrice); {Иначе выводим результат} close (f); {Закрываем файл} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.10.2008, 21:31

Вопрос № 147.911

Здравствуйте, уважаемые эксперты! Прошу помочь с решением задачи: Дана строка, состоящая из групп нулей и единиц. Каждая группа отделяется от другой одним или несколькими пробелами. Найти количество групп с пятью символами. Под группами нулей и единиц имеются в виду группы, состоящие из либо одних нулей, либо одних единиц. Например: 0000 11111 000 11 Написала функцию, которая находит количество групп с 5 символами, но как-то коряво получилось. Подскажите, пожалуйста, что исправить или предложите свои варианты. А особенно интересует, какую функцию следует написать для проверки на то, что в группу входят только нули или единицы Заранее,спасибо Приложение: function FindGroup(Str: string): integer; var n,Count,i: integer; begin n:=0; Count:=0; for i:=1 to Length(Str) do begin if (Str[i]='0') or (Str[i]='1') then inc(n); if Str[i]=' ' then begin if n=5 then begin inc(Count); n:=0; end else n:=0; end; end; if (Str[Length(Str)]='0') or(Str[Length(Str)]='1') or(Str[Length(Str)]=' ') then begin if n=5 then inc(Count); end; Result:=Count; end;

Отправлен: 20.10.2008, 21:29 Вопрос задала: Gerta (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Gerta! Я сильно не вникал в Ваш код, не люблю разбираться в чужих кодах, тем более он неверный, Вы немного не с того начали. Я предлагаю сначала сделать логическую функцию, которая ропределяет все ли символы в группе одинаковые, а потом, пробегая по строке ,просматривать все группы и считать те, длина которых = 5 и они состоят из одинаковых символов. Код с пояснениями в приложении. Думаю легко разберетесь. Успехов! Приложение: uses crt; var s,s1:string; i,n,zn:integer; function OdZn(a:string):boolean; {функция определяет все ли символы одинаковые} var i,k:integer; begin k:=0; for i:=2 to length(a) do if a[i]=a[i-1] then inc(k); {если одинаковый считаем} if k=Length(a)-1 then OdZn:=true {если все одинаковые - истина} else OdZn:=false; end; function KolGr(a:string):integer; {подсчет количества групп} var n:integer; begin s:=s+' '; {добавим пробел в конец строки для удобства} while pos(' ',s)>0 do delete(s,pos(' ',s),1);{удалим лишние пробелы (если два пробела подряд, 1 удаляем))} n:=0; while pos(' ',s)>0 do {пока в строке есть пробелы} begin s1:=copy(s,1,pos(' ',s)-1); {смотрим очередное "слово"} if (length(s1)=5) and OdZn(s1) then inc(n); {если его длина = 5 и состоит из одинаковых символов, то считаем} delete(s,1,pos(' ',s)); {удаляем просмотренное "слово"} end; KolGr:=n; {значение функции} end; begin clrscr; repeat write('s=');readln(s); zn:=0; {проверяем правильность ввода(должны быть 0 1 и пробел)} for i:=1 to length(s) do if not (s[i] in ['0','1',' ']) then begin writeln('Neverno vvedena stroka! Povtorite vvod!'); zn:=1; break; end; until zn=0; write('Kolichestvo grupp=',KolGr(s)); {вывод значения функции} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.10.2008, 09:55 Оценка за ответ: 5 Комментарий оценки: Спасибо за помощь

Вопрос № 147.918

Дорогие эксперты помогите пожалуйста найти ошибку и исправить.... Когда я задаю точки (1,0),(2,0),(3,0),(4,0) должно вывести среднее расстояние 1,666 но в чём то ошибка((код в приложении, вот сама задача: Дано множество точек плокости. Найти среднее расстояние мужду точками. Указать пары точек, расстояние между которыми больше среднего. Приложение: uses crt; var x:array[1..100,1..100] of real; a:array[1..100] of longint; b:array[1..100] of longint; c,n:integer; i,j:integer; z,y:real; begin clrscr; readln(n); for i:=1 to n do begin a[i]:=random(10); b[i]:=random(10); write(a[i]:5,b[i]:5); writeln; end; for i:=1 to n do for j:=0 to n-1 do begin x[i,j]:=sqrt((sqr (a[i]-a[j]))+(sqr(b[i]-b[j]))); {Считаем расстояние между i-ой и j-ой точками} end; y:=0; for i:=1 to n do for j:=1 to n do write(x[i,j]:5); for i:=1 to n do for j:=1 to n do y:=(y+x[i,j]); writeln('y=',y); z:=y/(n*n); writeln('z=',z); for i:=1 to n do for j:=1 to n do if (x[i,j]<z) and (i<>j) then {Выбираем точки, расстояния между которыми нас удовлетворяют, исключая совпадающие.} writeln ('(', a[i], ',', b[i], ') - (', a[j], ',', b[j], ')'); readln; end.

Отправлен: 20.10.2008, 21:50 Вопрос задал: S K A L T (статус: 1-ый класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Шичко Игорь Здравствуйте, S K A L T ! Ваша основная ошибка заключается в том, что при нахождении среднего расстояния Вы делите на общее число элементов, а нужно делить на количество ненулевых элементов. Примерный код - в приложении. Приложение: var x:array[1..100,1..100] of real; a:array[1..100] of longint; b:array[1..100] of longint; c,n, kol:integer; i,j:integer; z,y:real; temp1, temp2: string; begin //clrscr; readln(n); for i:=1 to n do begin a[i]:=random(10); b[i]:=random(10); write(a[i]:10, b[i]:10); writeln; end; for i:=1 to n do for j:=1 to n-i do x[j+i,i]:=sqrt((sqr (a[i]-a[i+j]))+(sqr(b[i]-b[i+j]))); y:=0; kol:= 0; for i:=1 to n do for j:=1 to n do begin if x[j,i] > 0 then begin Str(j, temp1); Str(i, temp2); writeln('Между точками номер ' + temp1 + ' и ' + temp2); writeln(x[j,i]:10:2); end; end; for i:=1 to n do for j:=1 to n do begin if x[i,j] > 0 then begin y:=(y+x[i,j]); kol:= kol + 1; end; end; writeln; writeln('y=',y:10:2); z:=y/kol; writeln('z=',z:10:2); writeln('Точки выше среднего:'); for i:=1 to n do for j:=1 to n do begin if x[j,i] > z then begin Str(j, temp1); Str(i, temp2); writeln('Между точками ' + temp1 + ' и ' + temp2); writeln(x[j,i]:10:2); end; end; readln; end.

Ответ отправил: Шичко Игорь (статус: Студент) Ответ отправлен: 21.10.2008, 10:16 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, S K A L T ! Программа в приложении. В программе исключены повторные вычисления отрезков, т.е. учитывается только один раз отрезок между точками АВ и исключается отрезок ВА. Генератор случайных чисел не сбрасывал (randomize;). вопросы по программе задавайте в мини-форум. Удачи! Приложение: var x:array[1..100,1..100]of real; a,b:array[1..100]of integer; i,j,n:integer; z:real; begin {вводим количество точек} repeat write('Enter N:');readln(n); until (n>1)and(n<101); {генерируем координаты точек и выводим их значения} for i:=1 to n do begin a[i]:=random(100); b[i]:=random(100); writeln('Point ',i:2,':=',a[i]:3,':',b[i]:3); end; {считаем растояние между точками и общее} z:=0; for i:=1 to n-1 do for j:=i+1 to n do begin x[i,j]:=sqrt(sqr(a[i]-a[j])+sqr(b[i]-b[j])); z:=z+x[i,j]; end; {выводим общее растояние и среднее} writeln('All range:',z:10:5); z:=2*z/(n*(n-1)); writeln('midle range:',z:10:5); {выводим точки растояние между которыми больше среднего} for i:=1 to n-1 do for j:=i+1 to n do if x[i,j]>z then writeln(a[i]:3,'-',b[i]:2,' : ',a[j]:2,'-',b[j]:2,':=',x[i,j]:10:5); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 21.10.2008, 12:55 Оценка за ответ: 5

Вопрос № 147.956

Здравствуйте...вынужденна обратиться за помощью... помогите, пожалуйста написать программки..думаю, труда особо не составит, заранее благодарю... осуществить циклический сдвиг последовательности заданной в файле до превого положительного элемента перевернуть последовательноть ( с конца на начало) проверить последовательность на предмет возрастания, убывания домножить все числа последовательноста ее максимальный элемнт Даны 2 числовые последоватльности а)увеличить вторую на среднее арифметическое первой б) вывести все элементы 1 посл-ти, которых нет во2 в) поэлементно сложить две последовательности

Отправлен: 21.10.2008, 04:43 Вопрос задала: Vampi (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Чабаненко Владислав Дмитриевич Здравствуйте, Vampi! (Замечание: "проверить последовательность на предмет возрастания, убывания" - начальную или перевёрнутую последовательность, я описал перевёрнутую, если надо исправить - пишите). Посылаю Вам ответ на первый вопрос, см. приложение, если что непонятно - спрашивайте. Удачи! Приложение: var i,max,k,n:integer; a,b:array[1..1000]of integer; begin reset(input,'input.txt'); rewrite(output,'output.txt'); randomize; i:=1; while not eof do begin read(a[i]); inc(i); end; k:=i-1; n:=k; write('Nachalnaya: '); for i:=1 to n do write(a[i],' '); writeln; i:=1; while (a[i]<=0)and(i<k) do inc(i); k:=i-1; for i:=1 to k do b[k-i+1]:=a[i]; i:=1; for i:=k+1 to n do b[i]:=a[i]; i:=1; while (b[i]<b[i+1])and(i<k) do inc(i); If i=k then begin write('Posledovatelnostj - vozrastajushaya: '); for i:=1 to k do write(b[i],' '); writeln; end; i:=1; while (b[i]>b[i+1])and(i<k) do inc(i); If i=k then begin write('Posledovatelnostj - ubivajushaya: '); for i:=1 to k do write(b[i],' '); writeln; end; max:=b[1]; for i:=2 to k do If b[i]>max then max:=b[i]; for i:=1 to k do b[i]:=b[i]*max; write('Okonchateljnaya: '); for i:=1 to n do write(b[i],' ');

Ответ отправил: Чабаненко Владислав Дмитриевич (статус: Заблокирован) Ответ отправлен: 21.10.2008, 19:19

Отвечает: Пупорев Юрий Борисович Здравствуйте, Vampi! Решения задач с пояснениями в приложении. Приложение: {осуществить циклический сдвиг последовательности заданной в файле до превого положительного элемента В папке с программой создайте текстовый файл, у меня он назван posl. Введите в файл числа в строку через пробел, вначале несколько отрицательных, потом положительное, потом любые в перемежку, сохраните файл.} uses crt; var f:text; {переменная для работы с файлом} a:array[1..1000] of integer;{} n,i,j,x:integer; begin clrscr; assign(f,'posl.txt'); {связываем переменную с именем файла} reset(f); {открываем его для чтения} n:=0; while not eof(f) do begin inc(n); {увеличиваем счетчик на 1} read(f,a[n]); {читаем числа в массив} end; writeln('Ishodnyj massiv:'); For i:=1 to n do write(a[i],' '); {выводим массив на экран} writeln; for i:=1 to n do if a[1]<=0 then {если первое число меньше ноля} begin x:=a[1]; {заплминаем его} for j:=1 to n-1 do {от 1 до предпоследнего элемента} a[j]:=a[j+1]; {присваиваем текущему элементу значение следующего} a[n]:=x; {первый элемент ставим последним} end; writeln('Resultat sdviga:'); For i:=1 to n do write(a[i],' '); readln end. {перевернуть последовательноть ( с конца на начало)} uses crt; const n=15; var a:array[1..n] of integer; i,x:integer; begin clrscr; randomize; writeln('Ishodnyj massiv:'); for i:=1 to n do begin a[i]:=random(20); write(a[i],' '); end; writeln; for i:=1 to n div 2 do {от начала до середины массива} begin x:=a[i]; {запоминаем очередное число} a[i]:=a[n-i+1]; {присваиваем его позиции значение симметричного ему элемента } a[n-i+1]:=x; {тому элементу присваиваем значение текущего элемента} end; writeln('Izmenennyj massiv:'); for i:=1 to n do write(a[i],' '); readln end. {проверить последовательность на предмет возрастания, убывания} uses crt; const n=10; var a:array[1..n] of integer; i,v,u:integer; begin clrscr; writeln('Vvedite ',n,' elementov massiva:'); for i:=1 to n do read(a[i]); {вводим в строку через пробел элементы массива} readln; v:=0;u:=0; for i:=2 to n do begin if a[i]>=a[i-1] then inc(v); {если возрастает} if v=n-1 then writeln('Posledovatelnost vozrastaet!'); if a[i]<=a[i-1] then inc(u); {если убывает} if u=n-1 then writeln('Posledovatelnost ubyvaet!'); end; if (v<n-1)and(u<n-1) then writeln('Posledovatelnost ne otsortirovana!'); readln end. {домножить все числа последовательноста ее максимальный элемнт} uses crt; const n=10; var a:array[1..n] of integer; i,max:integer; begin clrscr; randomize; writeln('Ishodnyj massiv:'); max:=-maxint; {принимаем за максимальный самыо маленькое число типа integer} for i:=1 to n do begin a[i]:=random(20)+1; {генерируем число} if a[i]>max then max:=a[i]; {если больше максимального, то оно максимальное} write(a[i],' '); end; writeln; writeln('Izmenennyj massiv:'); for i:=1 to n do begin a[i]:=a[i]*max; {умножаем все элементы массива на максимальное} write(a[i],' '); end; readln end. {Даны 2 числовые последоватльности а)увеличить вторую на среднее арифметическое первой б) вывести все элементы 1 посл-ти, которых нет во2 в) поэлементно сложить две последовательности} uses crt; const n=10; var a,b:array[1..n] of integer; c:array[1..n] of real; i,j,k:integer; sr:real; begin clrscr; randomize; writeln('Massiv A:'); sr:=0; for i:=1 to n do begin a[i]:=random(15)-5; sr:=sr+a[i]; {считаем сумму} write(a[i],' '); end; sr:=sr/n; {считаем среднее} writeln; writeln('Srednee arifmeticheskoe=',sr:0:2); writeln; writeln('Massiv B:'); for i:=1 to n do begin b[i]:=random(15)-5; write(b[i],' '); end; writeln; writeln; writeln('Massiv C:'); for i:=1 to n do begin c[i]:=b[i]+sr; {увеличиваем элементы массива В на ср. арифм. массива А} write(c[i]:6:2); end; writeln; writeln; writeln('Elementy massiva A, kotoryh net v massive B:'); for i:=1 to n do begin k:=0; for j:=1 to n do if a[i]<> b[j] then inc(k); {если элемент не равен, считаем} if k=n then write(a[i],' '); {если не равен ни одному, выводим} end; writeln; writeln; writeln('Poelementnoe slozenie massivov A, B:'); for i:=1 to n do begin a[i]:=a[i]+b[i]; {складываем элементы} write(a[i],' '); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.10.2008, 08:36

Вопрос № 147.957

Здравствуйте Уважаемые эксперты! Помогите пожалуйста решить такую задачу. Известны результаты анкетирования ста человек. Анкета состоит из 150 пунктов, анкета состоит из 150 пунктов, на которые предлагалось ответить утвердительно, отрицательно или "нет определенного мнения по данному вопросу". Напечатайте номера тех пунктов анкеты, на которые были получены только утвердительные и только отрицательные ответы всех опрошенных (если,конечно, такие пункты есть). Как я уже разобрался это будет матрица 100x150, которая будет заполнена значениями -1,1,0 (-1-отрицательно, 1-утвердительно, 0-нет определенного мнения по данному вопросу). Заранее благодарен за рассмотреннее данной задачи.

Отправлен: 21.10.2008, 05:29 Вопрос задал: Kensay (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Kensay! Ответы на анкету генерируются автоматически, а так как нельзя предсказать результаты, то в программе есть строчки для проверки работы. © Цитата: {фальсифицируем результаты опроса} for i:=1 to 100 do a[i,5]:= 1; for i:=1 to 100 do a[i,9]:=-1; Удачи! Приложение: var a:array[1..100,1..150]of integer; i,j:integer; b:boolean; begin {генерируем ответы на вопросы} randomize; for i:=1 to 100 do for j:=1 to 150 do a[i,j]:=random(3)-1; {фальсифицируем результаты опроса} for i:=1 to 100 do a[i,5]:= 1; for i:=1 to 100 do a[i,9]:=-1; {выводим результаты} for j:=1 to 150 do begin b:=true;{пока все положительные} for i:=1 to 100 do if a[i,j]<=0 then b:=false; if b then writeln('answer',j:3,' only positive'); b:=true;{пока все отрицательные} for i:=1 to 100 do if a[i,j]>=0 then b:=false; if b then writeln('answer',j:3,' only negative'); end; writeln('Stop'); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 21.10.2008, 15:17

Отвечает: Шичко Игорь Здравствуйте, Kensay! Строки - это анкеты, столбцы - это пункты анкеты. В алгоритме нужно пробегать по столбцу, предварительно установив флажки. При отсутствии переключения - заносить в массив номеров столбцов. Примерный код - в приложении. Приложение: var i, j, temp, kol_1, kol_2: integer; priznak_1, priznak_2: boolean; mas: array[1..100, 1..150] of integer; mas_norm_1, mas_norm_2: array [1..150] of integer; begin kol_1:= 0; kol_2:= 0; for i:= 1 to 100 do for j:= 1 to 150 do begin temp:= (i+j) div 10; {просто как нибудь формируем массив} if temp = 0 then mas[i,j]:= temp; if (temp > 0) and (temp < 6) then mas[i,j]:= 1; if (temp > 5) then mas[i,j]:= -1; end; for j:= 1 to 150 do begin priznak_1:= True; {флаг положительных элементов} priznak_2:= True; {флаг отрицательных элементов} for i:= 1 to 100 do begin if mas[i, j] <= 0 then priznak_1:= False; if mas[i, j] >= 0 then priznak_2:= False; end; if priznak_1 then begin kol_1:= kol_1 + 1; mas_norm_1[kol_1]:= j; {массив номеров положительных столбцов} end; if priznak_2 then begin kol_2:= kol_2 + 1; mas_norm_2[kol_2]:= j; {массив номеров отрицательных столбцов} end; end; for i:= 1 to 150 do if mas_norm_1[i] > 0 then write(mas_norm_1[i]); for i:= 1 to 150 do if mas_norm_2[i] > 0 then write(mas_norm_1[i]); end.

Ответ отправил: Шичко Игорь (статус: Студент) Ответ отправлен: 21.10.2008, 16:09

Отвечает: Шипулин Кирилл Владимирович Здравствуйте, Kensay! я реализовал программу с помощью одномерного массива, задача в приложении Ответ неверный, т.к. нужно найти воросы анкеты, на которые ответили 100 человек одинаково. В ответе эксперта проверяется ответы только одного человека, на все вопросы. -------- ∙ Отредактировал: Зенченко Константин Николаевич, Профессор ∙ Дата редактирования: 21.10.2008, 18:22 (время московское) Приложение: program vopros; type massiv=array[1..150] of integer; var a:massiv;i:integer; begin for i:=1 to 150 do begin writeln('wedi massiv : '); readln(a[i]); end; for i:=1 to 150 do if a[i]=-1 then writeln('net : ',i); for i:=1 to 150 do if a[i]=1 then writeln('da : ',i); readln; end.

Ответ отправил: Шипулин Кирилл Владимирович (статус: 2-ой класс) Ответ отправлен: 21.10.2008, 17:15

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.7 от 25.10.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru