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

Выпуск № 619
от 01.04.2008, 03:05

Вопрос № 129.094

Помогите пожалуйста решить очень простую задачку: http://img213.imageshack.us/img213/2528/formlnom8ch3.jpg (ссылка на картинку с формулой, описание там-же, т.к. там всего несколько слов). Точнее даже не решить, а исправить то, что я написал, см. приложение. Оно должно быть написано именно так, без массивов и прочих усложенений, только простые переменные и цикл с параметром. Мне кажется что написал эту программу неправильно. И нужнен ли в данном случае ввод данных пользователя, например начало последовательности или что-то подобное. Напишите пожалуйста правильную программу. (я бы и сам разобрался, но это срочно нужно, времени нет) Приложение: Program Proga; var f,f1,f2,i,s: integer; Begin f:=0; f1:=1; s:=1; Write(F:4,F1:4); For i:=2 to 15 do begin f2:=f1+f; Write(F2:4); S:=s+f2; f:=f1; f1:=f2; end; Writeln; Writeln('Сумма=',s:6); end.

Отправлен: 26.03.2008, 03:46 Вопрос задал: Upgrader (статус: 6-ой класс) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Upgrader! Программа в приложении. Я так понял, что формулу можно интерпретировать таким образом: an-1 = an/(n+1) => an = an-1*(n+1) Удачи! Приложение: var an, summ : extended; i, n : integer; begin WriteLn('Input N:'); ReadLn(n); an := 1; summ := an; WriteLn('a1 = ',an:20:0); for i := 2 to N do begin an := (i+1)*an; summ := summ + an; WriteLn('a',i,' = ',an:20:0); end; WriteLn('Summa: ',summ:20:0); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.03.2008, 09:10 Оценка за ответ: 5 Комментарий оценки: Да, это то что и нужно. Спасибо :)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Upgrader! Ваш код я,честно говоря, не понял. Если я все правильно понял в формуле и задании, то пришел к следующим выводам. Перепишем последовательность в виде А(n)=A(n-1)*(n+1); И код будет выглядеть так: Uses crt; var n:integer;a,sum:longint; begin clrscr; a:=1;sum:=1; for n:=2 to 11 do begin a:=a*(n+1); sum:=sum+a; end; writeln('sum=',sum); readln end. При n>11 значение суммы выходит за пределы типа Longint и следует либо ограничиться n=11, либо при for n:=2 to 15 do нужно использовать вещественный тип Double и вывод writeln('sum=',sum:15:0); [ можно было бы привести пример. Все-таки в условии задачи сказано, что необходимо найти сумму первых 15... ] ----- ∙ Отр едактировал: Николай Владимирович / Н.В. (Профессионал) ∙ Дата редактирования: 26.03.2008, 11:52

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 26.03.2008, 11:08 Оценка за ответ: 5 Комментарий оценки: То что нужно! Спасибо :)

Вопрос № 129.104

Пусть задан текст,за которым следует точка.Поменяйте все строчные латинские буквы,которые встречается в тексте,на прописные.

Отправлен: 26.03.2008, 07:19 Вопрос задала: Лиманская Юлия Вадимовна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Лиманская Юлия Вадимовна! Для перевода строчных латинских букв в прописные в Паскале есть функция UpCase(ch). С помощью этой функции все символы из диапазона ['a'..'z'] превращаются в ['A'..'Z'], причем все остальные символы не изменяются. Код в приложении.Текст я задал для наглядности в в программе, переделайте как вам удобно. Приложение: uses crt; var s:string; i:integer; begin clrscr; s:='Acfd SjhuyREW.'; write(s); readln; writeln; for i:=1 to length(s)-1 do s[i]:=Upcase(s[i]); write(s); readln end.

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

Вопрос № 129.145

Дано число N в десяточной системе исчесления. Нужно подсчитать сколько одиниц есть в запесе етого числа в двоичной системе исчесления. Ограничение: 0 <= N < 10^251. Буду благодарен!!!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, ПАВЛО! В приложении программа, которая считает количество битов содержащих единицу. Всего для преддставления максимального N нужно 834 бита. Вопросы по программе задавайте в мини-форум. Удачи! Приложение: uses crt; const z=1000; var a,b:array[0..z]of byte; c:char; d,e:integer; begin {обнуляем массив} for e:=0 to z do a[e]:=0; repeat {вводим символ} c:=ReadKey; {проверяем цифра ли это} if (c>='0')and(c<='9')then begin {цифра - выводим} write(c); {в дополнительном массиве будет текущее число умноженное на 2} for e:=z downto 1 do b[e]:=a[e-1]; {в основном массиве будет текущее число умноженное на 8} for e:=z downto 3 do begin a[e]:=a[e-3]; a[e-3]:=0; end; {суммируем два массива итого текущее число умноженное на 10(8+2)} for e:=1 to z do inc(a[e],b[e]); {в младший разряд записываем введенную цифру} a[0]:=ord(c)-ord('0'); {и корректируем, приводя все к 2-ой системе} for e:=1 to z-1 do begin {перенос в старшие разряды} inc(a[e],(a[e-1]div 2)); {остаток 0 или 1} a[e-1]:=a[e-1]mod 2; end; end; until c=chr(13);{пока не нажата клавиша ВВОД - продолжаем} writeln; {считаем количество бит содержащих 1 в заданом двоичном представлении числа} d:=0; for e:=0 to z do inc(d,a[e]); writeln('Единиц всего:=':10,d:4); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 129.164

Здравствуйте, уважаемые эксперты! Вот тут задача: n человек выстраиваются в круг, начинают счёт по часовой стрелке и при этом каждого k-го человека удаляют из круга ;), становятся обратно в круги, и так дальше. По задающимся числам n и k определите номер человека (1, 2, 3, 4, ...), который остаётся последним. 10 3 4 Подскажите мне пожалуйста мою ошибку в задача. Код в приложении. Условие задачи приведено в более человеколюбивый вид. ----- ∙ Отредактировал: sir henry (Академик) ∙ Дата редактирования: 26.03.2008, 14:51 Приложение: Var arr: Array[1..100] Of Integer; i, j, n, k, s, ans: Integer; Begin ReadLn(n, k); s := 0; ans := 0; For i := 1 To 100 Do Begin arr[i] := 3; End; For i := 1 To n Do Begin arr[i] := 1; End; i := 0; Repeat Repeat Inc(i, k); If (arr[i] = 1) Then Begin arr[i] := 0; End; If (arr[i] = 0) Then Begin Inc(i); End; s := 0; Until (arr[i] = 3); Dec(k, n); For j := 1 To n Do Begin Inc(s, arr[j]); End; Until (s = 1); i := 1; While (arr[i] = 0) Do Begin Inc(i); Inc(ans); End; WriteLn(ans); ReadLn; End.

Отправлен: 26.03.2008, 14:27 Вопрос задал: Хощенко Артём Владимирович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Хощенко Артём Владимирович! Из всех известных способов решения так называемой задачи Джозефуса Вы выбрали самый сложный, с помощью линейных массивов. Предлагаю Вам способ решения этой задачи с использованием для хранения информации об элементах и их количестве строки. В строке легко удалять элементы, следить за их количеством, т.е. за длиной строки. Код в приложении. Приложение: uses crt; var n,k,i:integer; s:string; begin clrscr; write('n=');readln(n); write('k=');readln(k); for i:=1 to n do s:=s+chr(i); {вводим символы индексов в строку} i:=1; repeat i:=i+k-1; while i>n do i:=i-n; {определяем очередной элемент} delete(s,i,1); {и удаляем его из строки} n:=length(s); {устанавливаем новую длину строки} until n<=1; writeln(ord(s[n]));{выводим индекс оставшегося элемента} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 26.03.2008, 16:24 Оценка за ответ: 5 Комментарий оценки: а по-другому?

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хощенко Артём Владимирович! Вариант с ипользованием линейных массивов. Удачи! Приложение: var a:array[1..99]of integer; i,j,k,n:integer; begin {вводим количество} repeat write('N:'); readln(n); until (n>1)and(n<100); {вводим счетчик} repeat write('K:'); readln(k); until (k>0)and(k<n); {раставляем всех по кругу} for i:=1 to n do a[i]:=i; {начальное значение} i:=0; repeat {вычисляем новое значение} i:=1+(i+k-1)mod n; {удаляем человека из круга} dec(n); for j:=i to n do a[j]:=a[j+1]; {выводим результат хода} for j:=1 to n do write(a[j]); writeln; {корректируем указатель} dec(i); until n=1; {выводим результат} writeln(a[1]); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 26.03.2008, 17:45 Оценка за ответ: 5 Комментарий оценки: Спасибо большое!

Вопрос № 129.173

Помогите мне решыть такие задачи! ПОЖАЛУЙСТА!!!!!!!!!!!!!!!!... Задача 1 Ваша задача - определить или делится данное число на 11. Входные данные В единой строке записанное единое число N (1 <= n). Число имеет не больше тысяче знаков. Исходные данные Вам нужно вывести “Yes” - если число делится на 11, и “No” - в противном случае. Задача 2 Последовательность чисел a1, a2, ... an называется супер последовательностью, если выполняются следующие условия: *0 < a1 < a2 < ... < an *ни одно из чисел не является суммой двух или больше других чисел Входные данные В единой строке записанное число N (1 <= n <= 50), дальше задано N чисел, каждое из которых не меньше 1 и не больше 1000. Исходные данные Вам необходимо вывести “Yes” - если дано супер последовательность, “No” - в противном случае. Задача 3 Над строчкой 01 выполним следующие операции: *Скопируем в конец строчки самого себя (получим 0101) *Во второй половине строки все 0 изменим на 1, а все 1 на 0 (получим 0110) Над строчкой 0110 выполним те самые операции. Получим 01101001. И т.д.Таким образом получим бесконечную строчку нулей и единиц.Ваша задача - найти n-тий символ такой строчки. Входные данные В единой строке записанное единое число N (1 <= N <= 2000000000). Исходные данные Единый символ, который будет на N-И позиции. БУДУ ОЧЕНЬ БЛАГОДАРЕН.

Отправлен: 26.03.2008, 15:03 Вопрос задал: ПАВЛО (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Marked One Здравствуйте, ПАВЛО! Ответ на первую задачу в приложении. Приложение: var num:integer; begin Write('Введите число: '); readLn(num); if (num<1) then WriteLn('Ошибка! Num<1!') else begin if ((num div 11)*11)=num then writeln('Yes') else writeln('No'); end; readln(num); end.

Ответ отправил: Marked One (статус: 9-ый класс) Ответ отправлен: 26.03.2008, 16:38

Отвечает: Зенченко Константин Николаевич Здравствуйте, ПАВЛО! Все задачи в приложении. Первая задача: ограничевается количеством вводимых знаков, и не независима от длины строки. Вторая задача: перебирает все возможные варианты сумм, поэтому работает очень долго. Третья задача: при проверке выяснилось, что количество операций отрицания соответсвует количеству бит в двоичной форме представления числа "N-1". Вот и вся закономерность, также можно считать, что запись "01" равна записи "0"+ NOT ("0"). Удачи! Приложение: {первая задача} uses crt; var a,b,c:integer; d:char; begin write('Enter N:'); a:=0;{знаковая сумма} b:=0;{счетчик знаков} c:=1;{знако переодичный коэфициент} repeat d:=ReadKey; if (d>='0')and(d<='9')then begin write(d);{выводим цифрру} a:=a+c*(ord(d)-ord('0'));{знакопереодически суммуруем цифры} c:=-c;{меняем знак} inc(b);{увеличиваем счетчик} end; {пока не ВВОД или меньше предела} until (d=chr(13))or(b=1000); writeln; {выводим результат} writeln('Result:',(a mod 11)=0); end. {вторая задача} var a,c:array[1..50]of integer; b,d:boolean; i,j,n,s,x,y,z:integer; begin {вводим размер} repeat write('N:'); readln(n); until (n>0)and(n<51); {вводим значения} for i:=1 to n do repeat {с контролем диапазона} write('a[',i:2,']='); readln(a[i]); until (a[i]>1)and(a[i]<1000); {пока супур последовательность} b:=true; {проверяем первое условие} for i:=1 to n-1 do b:=b and(a[i]<a[i+1]); {проверяем второе условие} for i:=n downto 3 do begin for x:=1 to i do c[i-x]:=1; repeat z:=1; d:=true; {для массива перестановок} for x:=1 to i-2 do for y:=x+1 to i-1 do d:=d and (c[x]<>c[y]); {если все цифры разные} if d and b then for x:=i-1 downto 2 do begin s:=0; {для контроля} write(a[i]:4,':='); for y:=1 to x do begin inc(s,a[i-c[y]]); {для контроля} write(a[i-c[y]]:4); end; b:=b and (s<>a[i]); writeln(b); end; {для массива перестановок} inc(c[z]); {коррекция массива перестановок} while c[z]=i do begin c[z]:=1; inc(z); inc(c[z]); end; until (z=i)or not( b); end; writeln('result:',b); end. {третья задача} uses crt; const n=2000; var a,i,j,k:integer; z:array[0..n]of boolean; function check(x:integer):boolean; var y:integer; begin {проверяем условие} if (k<32)and(x>0) then begin inc(k); {увеличиваем счетчик бит} if (x mod 2)=1 then {если 1 то операция отрицания} check:=not(check(x div 2)) else {иначе прямой вызов} check:=check(x div 2) end else {конечное значение} check:=false; end; begin z[0]:=false;{начальное значение последовательности} j:=1;{количество элементов последовательности} while j<n do begin {формируем последовательность в цикле} for i:=0 to j-1 do begin z[i+j]:=not(z[i]);{новый элемент} k:=0;{только для функции:check} write((i+j):7,z[i+j]:7,check(i+j):7);{выводим результат} readln; end; {умножаем на 2} inc(j,j); end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 28.03.2008, 20:21 Оценка за ответ: 4 Комментарий оценки: первая прога почемута не работает, а у второй : лимит часу 1с. Надеюсь что Ви скинете рабочие варианты.

Вопрос № 129.198

Помогите пожалуйста решить задачку : Составить программу, печатающую слова из файла SLOVA.TXT в перевернутом виде. Результаты работы программы записать в файл OWRAT.TXT.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, MUSIC! Программа в приложении. Удачи! Приложение: function conv(s:string):string; var i : integer; s1 : string; begin s1 := ''; for i := length(s) downto 1 do s1 := s1 + s[i]; conv := s1; end; var f, f1 : text; s : string; begin Assign(f, 'SLOVA.TXT'); Reset(f); Assign(f1,'OWRAT.TXT'); ReWrite(f1); while not(EOF(f)) do begin readln(f, s); WriteLn(f1, conv(s)); end; Close(f); Close(f1); ReadLn; end.

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.03.2008, 18:28 Оценка за ответ: 5

Вопрос № 129.208

Уважаемые эксперты!Помогите решить задачу: После поступления в ВУЗ о студентах собрана информация: фамилия, нуждается ли в общежитии, стаж, работал ли учителем, что окончил, какой язык изучал. Составить программу, определяющую сколько человек нужда-ются в общежитии. Описать, используя структуру данных запись, почтовую сортировку (город, улица, дом, квартира, кому, ценность). Составить программу, опреде-ляющую сколько посылок отправлено в г.Самару. Спасибо.

Отправлен: 26.03.2008, 19:32 Вопрос задала: Юлия правда (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Юлия правда! Во первых задач оказалось две, но они однотипные. По сложности они очень простые, только писанины много. Я писал наспех, не особенно подбирая слова, английский вперемежку с рязанским. Поэтому вы прчешите текстовую нагрузку, а сам код нормальный, работает, я проверял при небольших размерах списков. Код в приложении.Еще тип записываемых данных должен соответствовать типу поля. Если тип String, то текст(в том числе и цифры), если тип byte или integer, то только числа. Приложение: Задача 1. uses crt; type student=record {тип запись с полями по условию} fam:string[20]; obsch:string[20]; stag:byte; rabuch:string[20]; uchzav:string[20]; lang:string[20]; end; var sp:array[1..50]of student;{массив записей, или список} n,i,kol:integer; begin clrscr; write('Razmer zapisi: ');readln(n); for i:=1 to n do begin write('zapis ',i,': '); write('familia: ');readln(sp[i].fam); write('Nuzdaetsa v obsch: ');readln(sp[i].obsch);{yes,no} write('ctag: ');readln(sp[i].stag); write('rabotal uchitelem: ');readln(sp[i].rabuch); write('uchebnoe zavedenie: ');readln(sp[i].uchzav); write('language: ');readln(sp[i].lang); end; kol:=0; for i:=1 to n do if sp[i].obsch='yes'then begin kol:=kol+1; end; writeln; writeln('V obschegitii nuzdajutsa ',kol,' chelovek(a)'); readln end. Задача 2.//все также uses crt; type pochta=record gor:string[20]; ulica:string[20]; dom:byte; kvart:byte; fam:string[20]; cena:integer end; var sp:array[1..50]of pochta; n,i,kol:integer; begin clrscr; write('Razmer zapisi: ');readln(n); for i:=1 to n do begin write('zapis ',i,': '); write('gorod: ');readln(sp[i].gor); {Samara и другие} write('ulica: ');readln(sp[i].ulica); write('dom: ');readln(sp[i].dom); write('kvartira: ');readln(sp[i].kvart); write('familia: ');readln(sp[i].fam); write('cennost: ');readln(sp[i].cena); end; kol:=0; for i:=1 to n do if sp[i].gor='Samara'then begin kol:=kol+1; end; writeln; writeln('V Samaru otpravleno ',kol,' posylok'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 26.03.2008, 22:52 Оценка за ответ: 5 Комментарий оценки: Спасибо большое,вы мне очень помогли. :)

Вопрос № 129.212

Здравствуйте. В общем нужна помощь, есть массив записи с датами (три типа записи, день (1..31), месяц(1..12) и год (integer)), вводится сегодняшняя дата, нужно определить какие даты из массива уже прошли, а какие ещё нет. Вывести те которые уже прошли... Буду благодарен за алгоритм или текст программы...

Отправлен: 26.03.2008, 20:06 Вопрос задал: Зыков Николай Павлович (статус: 1-ый класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Шемет Станислав Васильевич Здравствуйте, Зыков Николай Павлович! Программа в приложении Удачи !!! Приложение: const n=5; Type Tdate=record Day:byte; Monce:byte; Year:Word; End; Var Date:Tdate; M:array[1..n] of Tdate; I:integer; Procedure Read_Date; Begin Writeln('Zapolnite masiv'); For i:=1 to n do Begin Write('Day: '); Readln(Date.day); Write('Monce: '); Readln(Date.monce); Write('Year: '); Readln(Date.Year); m[i]:=Date; Writeln; end; Writeln('Vvedite Datu'); Write('Day: '); Readln(Date.day); Write('Monce: '); Readln(Date.monce); Write('Year: '); Readln(Date.Year); end; Begin Read_Date; For i:=1 to n do If (m[i].Year<Date.Year) And ((m[i].year<date.year) or (m[i].monce<Date.monce)) And ((M[i].Year<Date.Year) or(m[i].Monce<Date.monce) or (m[i].day<Date.day)) then Begin Writeln('Year: ',M[i].Year); Writeln('Monce: ',m[i].Monce); Writeln('Day: ',m[i].day); end; Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 5-ый класс) Ответ отправлен: 26.03.2008, 20:55

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Зыков Николай Павлович! Полностью писать программу не буду - она, вроде, несложная. Расскажу как решать: Для хранения будем использовать такую структуру: type TDate = record { тип Дата }         day : byte; { день }         month : byte; { месяц }         year : integer; { год }      end; В полях day, month я использую тип byte, т.к. их значения не превышают 255. Массив будет объявляться так: const N = 100; { максимальное кол-во элементов массива } var mas : array[1..N] of TDate; Вначале программы необходимо считать количество вводимых дат и сохранить его в какую-нибудь переменную. Именно столько дат в массиве надо будет проверять. Далее считываете это количество дат (цикл for). И считываете еще одну дату (сегодняшний день). Теперь циклом for проверяете все элементы массива с текущей датой. Пусть текущая дата у Вас сохранена в переменной currdate, тогда условие проверки будет такое if currdate.year < mas[i].year then   { этот день еще не прошел } else begin   if surrdate.year = mas[i].year then   begin     if currdate.month < mas[i].month then       { этот день еще не прошел }     else     begin  &nbs p;    if currday.month = mas[i].month then       begin         if currdate.day < mas[i].day then           {этот день еще не прошел}         else           if currdate.day = mas[i].day then             {этот день - сегодня}           else             { этот день прошел (год, месяц одинаковые, но день больше)}       end       else        { этот день прошел (текущий год равен, но месяц больше) }     end;   end   else   { этот день прошел (текущий год больше) } end; Удобно будет это записать в функцию и таким образом проверять. Если будут проблемы с реализацией, пишите. Удачи!

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ICQ: 420720 ---- Ответ отправлен: 26.03.2008, 21:03

Отвечает: Пупорев Юрий Борисович Здравствуйте, Зыков Николай Павлович! Полный код программы в прложении. Комментарии минимальные, т.к. вроде все ясно. Приложение: uses crt; type data=record {тип запись с полями по условию} day:1..31; month:1..12; year:integer; end; var sp:array[1..50] of data; {список дат-массив} n,i,g,m,d:integer; begin clrscr; write('Razmer spiska:');readln(n); for i:=1 to n do begin {заполняем список} write('Zapis ',i,':'); write('year:');readln(sp[i].year); write('month:');readln(sp[i].month); write('day:');readln(sp[i].day); end; writeln; writeln('Vvedite tekushyu datu:'); write('god: ');readln(g); write('mesiac: ');readln(m); write('chislo: ');readln(d); writeln; writeln('Daty, kotorye proshli:'); for i:=1 to n do {определяем условия, при которых дата } begin {уже прошла} if (sp[i].year<g) or((sp[i].year=g)and(sp[i].month<m)) or((sp[i].year=g)and(sp[i].month=m)and(sp[i].day<d)) then writeln(sp[i].day,'.',sp[i].month,'.',sp[i].year); end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 26.03.2008, 23:42

Вопрос № 129.214

Пожалуйста найдите ошибку. Не производится сортировка массива.Нужно только исправить. Сама задача. Дан список учеников класса и отметки каждого из учеников за выполнение двух контрольных работ. Требуется: подсчитать число учеников, выполнивших первую работу на 5; подсчитать число учеников, выполнивших обе работы на 5. Упорядочить список учеников по среднему баллу за обе контрольные работы. код программы и модуля перенесён в приложение. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 26.03.2008, 20:35 Приложение: Модуль unit sort_mas; interface const n=3; m=10; type mas=array[1..n,1..m] of real; procedure sort(var x:mas); implementation procedure sort; var l,c:real; i,j:integer; begin repeat l:=0; for j:=1 to m-1 do begin if x[3,j]>x[i,j+1] then begin for i:=1 to n do begin c:=x[i,j]; x[i,j]:=x[i,j+1]; x[i,j+1]:=c; end; l:=1; end; end; until l=0; end; end. Программа program jimm0b; uses crt, sort_mas; const n=3; m=10; type mas=array[1..n,1..m] of real; procedure view(x:mas); var i,j:integer; begin for i:=1 to 2 do begin for j:=1 to m do write(x[i,j]:5); writeln; end; end; procedure create_random(var x:mas); var i,j:integer; begin for i:=1 to 2 do for j:=1 to m do x[i,j]:=random(4)+2; end; procedure create (var x:mas); var i,j:integer; begin clrscr; For i:=1 to n do for j:=1 to m do begin write('vvedite A[',i,';',j,']='); readln(x[i,j]); end; end; var A:mas; Ch,i,j,l1,k:integer; l,c:real; begin clrscr; randomize; writeln('1-vvod mas'); writeln('2-random'); writeln; repeat write('vvedite #pynkta'); readln(ch); case ch of 1:Create(a); 2:create_random(a); else writeln('povtorite vvod'); end; until (ch=1) or (ch=2); clrscr; view(a); writeln('ishodny mas'); For j:=1 to m do begin if a[1,j]=5 then inc(k); end; for j:=1 to m do begin if (a[1,j]=5) and (a[2,j]=5) then inc(l1); end; writeln; writeln(k:5,l1:3); for j:=1 to m do begin a[3,j]:=((a[1,j]+a[2,j])/2); write(a[3,j]:3);end; sort(a); write(a[3,j]:3); readkey; end.

Отправлен: 26.03.2008, 20:29 Вопрос задал: Муратов Дмитрий Анатольевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Муратов Дмитрий Анатольевич! При ответе на вопрос №128005 я посоветовал вам применить иассив записей, в котором очень удлбно объединять различные типы, и кроме оценок можно вводить фамилии учеников, их класс, школу и т.д. В этом отношении двумерные массивы позволяют вводить данные только одного типа. Но раз уж массивы, значит массивы. Уважаю за упорство, сам такой. Я переделал вашу процедуру сортировки и подремонтировал сам модуль, а также программу. В программе создание процедур, которые используются только один раз я считаю нецелесообразно, иначе их тоже надо вынести в модуль. Но это все на ваше усмотрение.Принцип сортировки: определяем среднее от суммы оценок в строке 2 и строке 3 и сортируем массив по возрастанию методом обмена(или пузырька). Результат деления вроде бы Real, но т.к. мы его не определяем, а только сравниваем, на типе это никак не сказывается. Массив я сделал размерностью [1..3,1..n]. В первую строчку я ввел номера учеников, чтобы результаты сортировки были нагляднее. Во второй и третьей строчках-оценки. Взял от 3 до 5, двоешникам у нас не место, они только количество пятерок уменьшают и результат при небольших n может некрасиво выглядеть(с нолями). В приложении привожу модуль(как его оформлять вы видимо знаете, если что, то я описал его в ответе на вопрос 128005), саму программу, а также программу без модуля на всякий случай, вдруг что-то не заработает, так можно ошибку найти. Если что-то не пойдет, не ругайте меня на форуме, у меня временно нет туда доступа, лучше напишите личное сообшение, все проблемы решим. Пожалуй все. Удачи! Приложение: 1.Модуль. unit Sort_mas; interface type mas=array[1..3,1..30]of byte; procedure Sort(n:integer;var a:mas); implementation procedure Sort(n:integer;var a:mas); var i,j,k,x:integer; begin for j:=1 to n-1 do for k:=1 to n-1 do if ((a[2,k]+a[3,k])/2)>((a[2,k+1]+a[3,k+1])/2) then begin for i:=1 to 3 do begin x:=a[i,k]; a[i,k]:=a[i,k+1]; a[i,k+1]:=x; end; end; end; end. 2.Программа uses crt,Sort_mas; var a:mas; n,i,j,kol1,kol2:integer; begin clrscr; randomize; Write('Kolchestvo uchenikov=');readln(n); for i:=1 to 3 do begin for j:=1 to n do begin a[i,j]:=random(3)+3; a[1,j]:=j; write(a[i,j]:3); end; writeln; end; readln; Sort(n,a); writeln('Uporiadochenny massiv:'); for i:=1 to 3 do begin for j:=1 to n do begin write(a[i,j]:3); end; writeln; end; readln; kol1:=0; for j:=1 to n do if a[2,j]=5 then begin kol1:=kol1+1; end; writeln('Pervaia rabota na 5 = ',kol1,' uchenikov'); kol2:=0; for j:=1 to n do if (a[2,j]=5)and(a[3,j]=5) then begin kol2:=kol2+1; end; writeln('Obe raboty na 5 = ',kol2,' uchenikov'); readln end. 3. Программа без модуля. uses crt; var a:array[1..3,1..30]of byte; n,i,j,k,x,kol1,kol2:integer; begin clrscr; randomize; Write('Kolchestvo uchenikov=');readln(n); for i:=1 to 3 do begin for j:=1 to n do begin a[i,j]:=random(3)+3; a[1,j]:=j; write(a[i,j]:3); end; writeln; end; readln; for j:=1 to n-1 do for k:=1 to n-1 do if ((a[2,k]+a[3,k])/2)>((a[2,k+1]+a[3,k+1])/2) then begin for i:=1 to 3 do begin x:=a[i,k]; a[i,k]:=a[i,k+1]; a[i,k+1]:=x; end; end; writeln('Uporiadochenny massiv:'); for i:=1 to 3 do begin for j:=1 to n do begin write(a[i,j]:3); end; writeln; end; readln; kol1:=0; for j:=1 to n do if a[2,j]=5 then begin kol1:=kol1+1; end; writeln('Pervaia rabota na 5 = ',kol1,' uchenikov'); kol2:=0; for j:=1 to n do if (a[2,j]=5)and(a[3,j]=5) then begin kol2:=kol2+1; end; writeln('Obe raboty na 5 = ',kol2,' uchenikov'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Студент) Ответ отправлен: 27.03.2008, 10:00 Оценка за ответ: 5 Комментарий оценки: Спасибо!!!!!!!! Теперь я получил что хотел. Со строками я просто не разбираюсь в массивах мне понятнее

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