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

Выпуск № 648
от 28.05.2008, 07:05

Вопрос № 136.920

Уважаемые эксперты помогите пожалуйста в решении этой задачки - Дан одномерный массив числовых значений насчитывающий n элементов. Поменять местами элементы, стоящие на четных и нечетных местах : а(1) с а(2), а(3) с а(4) и т.д. n НЕ константа. При вводе нечетного количества чисел последнее число место не меняет. Количество элементов в массиве задается при включении программы.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Vinaction! Решение задачи в приложении. Приложение: uses crt; var a:array[1..50]of integer; n,i,x:integer; begin clrscr; write('n=');readln(n); Writeln('Ishodnyj massiv:'); for i:=1 to n do begin a[i]:=i; write(a[i],' '); end; writeln; i:=1; while i<=n-1 do begin x:=a[i]; {меняем местами два соседних элемента} a[i]:=a[i+1]; a[i+1]:=x; i:=i+2; {увеличиваем счетчик на два, переходим к следующей паре} end; writeln('Rezultat:'); for i:=1 to n do write(a[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 15.05.2008, 22:20 Оценка за ответ: 5 Комментарий оценки: Спасибо огромное!

Вопрос № 136.979

Дана степень натурального числа A. Найти ее показатель.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Raevil! Решение с небольшими пояснениями в приложении. Приложение: uses crt; var a,st,p,k:integer;{a-число, st-степень, р-показатель} begin clrscr; write('Vvedite A: ');readln(a); write('Vvedite A v stepeni p: ');readln(st); p:=0;k:=1; repeat k:=k*a; {пока k<st умножаем его на себя и считаем, сколько раз} p:=p+1; until k=st; writeln('p=',p); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 16.05.2008, 11:36

Отвечает: Denisss Здравствуйте, Raevil! Насколько я понимаю, по условию натуральным является только число А. Т.е. показатель степени и сама степень не обязазы таковыми являться (т.е. могут быть, например, вещественными). Т.е. если пользователь введет число А = 9 и его степень, равную 3, то p = 0,5 (число в степени 0,5 - это квадратный корень). Пример решения находится в приложении. Приложение: program q91719; uses Crt; var a: Integer; ap, p: real; begin {Очистка экрана} ClrScr; {Ввод данных} write('A = '); readln(a); write('A^P = '); readln(ap); {Определение показателя степени} p:= ln(ap)/ln(a); {Вывод результата} writeln('P = ', p:1:3); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 17.05.2008, 14:27

Вопрос № 136.980

В одномерном массиве заменить элементы средним арифметическим соседних элементов. Первый и последний элементы оставить без изменения. Характеристикой строки целочисленной матрицы назовем сумму ее положительных четных элементов. Переставляя строки заданной матрицы, расположить их в соответствии с ростом характеристик

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Raevil! Задача в приложении. Удачи!!! Приложение: const {Размер массива} N=10; var {Исходный массив} a: array [1..N] of integer; {Результат} b: array [1..N] of real; {Счетчик для For} i: integer; begin Write('Исходный массив: '); {Включаем генератор случайных чисел} randomize; {проходим по всему массиву для того чтобы заполнить его случайными числами} for i:=1 to N do begin {тек. эл. присваиваем случайное число из диапазона [-10; 9]} a[i]:=random(20)-10; {выводим его} write(a[i]:4); end; {Начинаем новую строку} writeln; write('Новый массив: '); {Первый эл. без изменений} b[1]:=a[1]; {Выводим его} write(b[1]:0:2, ' '); {Последний тоже без изменений} b[N]:=a[N]; {Проходим по массиву кроме первого и последнего элемента} for i:=2 to N-1 do begin {присваиваем текущему элементу среднее арифметическое} b[i]:=(a[i-1]+a[i+1])/2; {и выводим его} write(b[i]:0:2, ' '); end; {Выводим последний} write(b[n]:0:2); readln; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 15.05.2008, 20:32

Отвечает: Пупорев Юрий Борисович Здравствуйте, Raevil! Решение второй задачи с пояснениями в приложении. Приложение: uses crt; var a:array[1..20,1..20]of integer;{матрица} sum:array[1..20]of integer; {масив сумм} n,m,i,j,k,x:integer; begin clrscr; write('Kolichestvo strok= ');readln(n); write('Kolichestvo stolbcov= ');readln(m); randomize; Writeln('Matrica:'); {sozdanie i vyvod } for i:=1 to n do begin for j:=1 to m do begin a[i,j]:=random(10)-2; write(a[i,j]:4); end; writeln; end; readln; {podschet summ po strokam} for i:=1 to n do begin sum[i]:=0; for j:=1 to m do if(a[i,j]>0)and(a[i,j] mod 2=0) then begin sum[i]:=sum[i]+a[i,j]; end; end; {vstavka summy pervym stolbcom} for i:=1 to n do begin for j:=m downto 1 do {сдвигаем все столбцы на 1 впрво} a[i,j+1]:=a[i,j]; a[i,1]:=sum[i]; {вместо первого столбца вставляем суммы по строкам} end; {sortirovka strok po vozrastaniu v pervom stolbce} for i:=1 to n-1 do for k:=1 to n-1 do if a[k,1]>a[k+1,1] then {если в первом столбце возрастание} begin for j:=1 to m+1 do begin x:=a[k,j]; a[k,j]:=a[k+1,j]; {то переставляем во всех столбцах} a[k+1,j]:=x; end; end; {vyvod rezultata} writeln('Rezultat:'); for i:=1 to n do begin for j:=2 to m+1 do {выводим со сдвигом на 1 вправо} write(a[i,j]:4); writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 16.05.2008, 14:46

Вопрос № 136.986

Доброго времени суток эксперты. Помогите решить задачи: 1) Дана целочисленная матрица. Найти номер первой из строк, не содержащих ни одного положительного элемента. Проблема: Не получается вывести первую строку. В приложении дан мой листинг. 2) Имеются два типизированных файла, содержащие числа. Получить третий файл, в котором записаны сначала числа из первого, а затем из второго. Проблема: У меня есть сомнения в правильности моей программы, проверьте если не трудно. Если правильно, то можно ли как нить сжать ее, а то слишком большая. 3) Ко 2й задаче нужно сделать блок-схему, но тут у меня возникла загвоздка: Как в блок схеме отобразить команды assign reset close и части программ заключенные между ними. Заранее спасибо Приложение: 1) Задача 1 uses crt; const n=6;m=7; var Donald:array[1..n,1..m] of integer; k:array[1..n] of integer; i,j:byte; x:integer; procedure MikkiMous(var x:integer); {подсчет количества строк} var i,j:byte; {локальные переменные} begin for i:=1 to n do for j:=1 to m do if donald[i,j]<0 then inc(k[i]); {считаем количество <0 в строке} for i:=1 to n do {вывод количества элементов <0 в каждой строке} writeln(k[i]); for i:=1 to n do if k[i]=7 then writeln('stroka ',i) else writeln('Net strok'); end; begin clrscr; {основная программа} randomize; writeln('Matrix'); { Формирование массива} for i:=1 to n do for j:=1 to m do donald[i,j]:=random(26)-20; { -20;5} for i:=1 to n do begin {вывод матрицы} for j:=1 to m do write(donald[i,j]:5); writeln;end; mikkiMous(x); {вызов процедуры} readln; end. 2) Задача 2 uses crt; var f,t,g:file of integer; i,z:integer; a,b,c:array[1..100] of integer; begin clrscr; randomize; assign(f,'chisla.dat'); rewrite(f); for i:=1 to 10 do begin a[i]:=random(100); write(f,a[i]); end; close(f); assign(g,'chisla1.dat'); rewrite(g); for i:=1 to 10 do begin b[i]:=random(100); write(g,b[i]); end; close(g); assign(t,'chisla3.dat'); rewrite(t); for i:=1 to 10 do write(t,a[i]); for i:=1 to 10 do write(t,b[i]); close(t); reset(f); while not eof(f) do begin read(f,a[i]); write(a[i]:2,' '); end; writeln; reset(g); while not eof(g) do begin read(g,b[i]); write(b[i]:2,' '); end; writeln; close(g); reset(t); while not eof(t) do begin read(t,c[i]); write(c[i]:2,' '); end; writeln; close(t); repeat until keypressed; end.

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

Отвечает: SHERRY Здравствуйте, DaImeR! В приложении мой вариант решения первой задачи. Разбирайтесь.. Приложение: const n = 5; {из-за небольщой ленивости сделал матрицу квадратной. Думаю преобразовать задачу для стальных матриц у Вас не составит труда. На крайний случай - пишите в мини-форум} var ms: array [1..n, 1..n] of integer; {собственно массив} i,j,index, count: integer;{вспомогательные переменные} begin index := 0; {в этой переменной будет храниться номер искомой строки. Если строка найдена не будет, то выведется нуль} randomize; for i:=1 to n do {заполняем массив случайными числами и выводим на экран} begin for j:=1 to n do begin ms[i,j]:=random(7)-5; write(ms[i,j]:5); end; writeln; end; count:=0; {чтобы определить, что все элементы отрицательные - заведём счётчик} for i:=n downto 1 do {чтобы получить первую строку, связанную с условием - сделаем хитрость. Будем начинать поиск с последней строки матрицы} begin for j := 1 to n do if ms[i,j] < 0 then inc(count); {подсчитываем количество отрицательных элементов в строке} if count = n then index := i; {если все элементы отрицательные, то запоминаем номер строки в переменной index} count := 0; {обнуляем счётчик перед переходом на следующую строку} end; writeln; writeln(index); {выводим результат} readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 15.05.2008, 20:35 Оценка за ответ: 5

Вопрос № 137.036

Очень нужно код программы, которая выбирает из одного текстового файла неповторяющиеся строки и записывает в другой.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Pessimist! Решение с пояснениями в приложении. Не забудьте создать файл со строками по условию. Результат увидите в новом файле. Приложение: uses crt; var f,g:text; s,s1:array[1..100]of string; n,i,j:integer; begin clrscr; assign(f,'Stroki_1.txt');{связываем наш файл с переменной f и открываем для чтения} reset(f); assign(g,'Stroki_2.txt');{создаем второй файл для записи} rewrite(g); n:=0; while not eof(f)do begin n:=n+1; readln(f,s[n]); {считываем строки из файла в массив} end; s1:=s; {создаем клон массива} for i:=1 to n do for j:=1 to n do if (s[i]=s1[j])and(i<>j) then begin s[i]:=''; {если строки совпадают, делаем их пустыми (можно присвоить что угодно)} end; for i:=1 to n do if s[i]<>''then {если не пустые} begin writeln(g,s[i]); {записываем в файл} end; writeln('Fail Stroki_2 zapisan!'); readln; close(f); close(g); end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 16.05.2008, 20:24 Оценка за ответ: 5

Вопрос № 137.061

В одномерном целочисленном массиве подсчитать количество пар стоящих рядом элементов, кратных 3.

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

Отвечает: Delph Здравствуйте, Raevil! Программа в приложении. Делитель 3 обозначил константой, чтобы удобно было менять, если понадобится. Приложение: Program Pr137061; Uses CRT; Const N = 96; Divisor = 3; { нужный нам делитель } Var Arr: Array[1..N] of Integer; i, Sum: Integer; Begin ClrScr; TextColor(15); { инициализация генератора случайных чисел } Randomize; WriteLn('Исходный случайно заполненный массив:'); for i := 1 to N do begin Arr[i] := Random(100); { Выделяем числа, кратные трём, красным цветом } if Arr[i] mod Divisor = 0 then TextColor(12) else TextColor(15); Write(Arr[i]:4); if i mod 16 = 0 then WriteLn; end; TextColor(15); WriteLn; Sum := 0; for i := 1 to N - 1 do if (Arr[i] mod Divisor = 0) and (Arr[i+1] mod Divisor = 0) then inc(Sum); Write('В массиве ', Sum, ' пар рядом стоящих '); WriteLn('элементов, кратных ', Divisor, '.'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 16.05.2008, 13:47

Вопрос № 137.063

Просуммировать элементы квадратной матрицы размером 9´9, расположенные в нижней четверти, ограниченной диагоналями, включая диагонали.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Raevil! Решение задачи в приложении. Чтобы разобраться с алгоритмом выделения треугольника, нарисуйте на бумаге матрицу и сами определите этот алгоритм, используя размер матрицы, номера строк и столбцов. Приложение: uses crt; const n=9; var a:array[1..n,1..n]of integer; i,j,sum:integer; begin clrscr; randomize; Writeln('Matrica:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); write(a[i,j]:3); end; writeln; end; writeln; sum:=0; for i:=n div 2+1 to n do for j:=n-i+1 to i do sum:=sum+a[i,j]; writeln('sum=',sum); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 16.05.2008, 18:39

Вопрос № 137.075

Здравствуйте, уважаемые эксперты! Сегодня вот такая задача: Напишите функцию GCD(x, y) - наибольший общий делитель. в чём у меня ошибка? Приложение: Function GCD(x, y: Integer): Integer; Var gcd, i: Integer; Begin gcd := 0; For i := 1 To x Do Begin If ((x Mod i = 0) And (y Mod i = 0)) Then Begin gcd := i; End; End; GCD := gcd; End; Var x, y: Integer; Begin Write('Enter x, y: '); ReadLn(x, y); ans := GCD(x, y); WriteLn('GCD(', x, ', ', y, ') = ', GCD(x, y)); Readln; End.

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

Отвечает: Delph Здравствуйте, Хощенко Артём Владимирович! Вы объявляете функцию GCD и внутри неё переменную gcd. По правилам Pascal'я регистр букв не учитывается, т.е. большие и малые буквы считаются эквивалентными. Поэтому компилятор не сможет различить GCD и gcd. Собственно, внутренняя переменная Вам не нужна, поскольку имени функции внутри самой функции можно присваивать значение несколько раз. Если же Вы хотите использовать внутреннюю переменную, дайте ей любое другое имя. Кроме того у любых двух чисел единица будет общим делителем, поэтому первоночально результату следует присваивать 1, а цикл начинать с двойки. Ещё рекомендация: нужно выяснить, какое из двух чисел меньше по модулю, и считать цикл до меньшего числа. Исправленная функция в приложении. И ещё: в программе у Вас есть строка ans := GCD(x, y); - она совершенно лишняя, к тому же переменная ans нигде не определена, что вызывает ошибку на этапе компиляции. Приложение: Function GCD(x, y: Integer): Integer; Var r, i: Integer; Begin GCD := 1; if Abs(x) < Abs(y) then r := Abs(x) else r := Abs(y); For i := 2 To r Do Begin If ((x Mod i = 0) And (y Mod i = 0)) Then Begin gcd := i; End; End; End; --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 16.05.2008, 15:08 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хощенко Артём Владимирович! В Вашем коде поставил коментарии на не нужных строках. В принципе правильнее цикл организовывать по наименьшей из двух переменных. Ужачи! Приложение: Function GCD(x, y: Integer): Integer; Var {gcd,} i: Integer; Begin gcd := 0; For i := 1 To x Do Begin If ((x Mod i = 0) And (y Mod i = 0)) Then Begin gcd := i; End; End; { GCD := gcd;} End; Var x, y: Integer; Begin Write('Enter x, y: '); ReadLn(x, y); { ans := GCD(x, y);} WriteLn('GCD(', x, ', ', y, ') = ', GCD(x, y)); Readln; End. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Denisss Здравствуйте, Хощенко Артём Владимирович! Предлагаю решать поставленную задачу с помощью так называемого Алгоритма Евклида. Пример реализации находится в приложении. В Вашем случае, если пользователь, например, введет x = 32767 (максимальное значение для типа Integer), то программа произведет 65534 операций деления, что может потребовать достаточно большое время для вычисления НОД. Алгоритм Евклида позволяет сократить время вычисления в подобных случаях. Другие примеры реализации можно взять здесь: ru.wikipedia.org Успехов! Приложение: program Q137075; Function GCD(x, y: Integer): Integer; begin while ((x <> 0) and (y <> 0)) do if (x >= y) then x:= x mod y else y:= y mod x; GCD:= x + y; end; Var x, y: Integer; Begin Write('Enter x, y: '); ReadLn(x, y); WriteLn('GCD(', x, ', ', y, ') = ', GCD(x, y)); Readln; End. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 17.05.2008, 13:46 Оценка за ответ: 5 Комментарий оценки: Классно и оригинально!

Отвечает: Disasm Здравствуйте, Хощенко Артём Владимирович! Замечу две основные ошибки: 1. Лишний оператор присваивания в функции GCD. "GCD := gcd;", т.к. строчные и прописные буквы не различаются Подробнее здесь: http://pascal.guti.ru/syntax.html#1 2.а) Переменная ans не объявлена в программе. б) Зачем рузультат выводить через функцию GCD, если перед этим мы записали ее результат в переменной ans Исправленный листинг программы в приложении Приложение: Function GCD(x, y: Integer): Integer; Var i: Integer; Begin gcd := 0; For i := 1 To x Do Begin If ((x Mod i = 0) And (y Mod i = 0)) Then Begin gcd := i; End; End; End; Var x, y: Integer; ans : Integer; Begin Write('Enter x, y: '); ReadLn(x, y); ans := GCD(x, y); WriteLn('GCD(', x, ', ', y, ') = ',ans); Readln; End.

Ответ отправил: Disasm (статус: 2-ой класс) Ответ отправлен: 19.05.2008, 15:26 Оценка за ответ: 5

Вопрос № 137.139

Сберегательная касса начисляет 120% годовых, т.е. через год вклад увеличивается без участия вкладчика. Какой станет сумма равная К рубней, положенная в кассу на N лет?

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

Отвечает: -=Dr. Штопор=- Здравствуйте, Saske! Программка простая и лежит в приложении. З.Ы. А адрес сберкассы, где 120% дают, подскажете? ;) Приложение: program kassa; var v:real; i,N:byte BEGIN writeln('Сколько вложили?'); readln(v); for i:=1 to N do v:=v*2.2; writeln('Накопилось ',v); readln; end. --------- Tantum possumus, quantum scimus

Ответ отправил: -=Dr. Штопор=- (статус: 9-ый класс) Ответ отправлен: 16.05.2008, 21:42 Оценка за ответ: 5

Отвечает: Denisss Здравствуйте, Saske! Задачу можно решить и без циклов. for i:=1 to N do   v:=v*2.2; можно записать так: v:= v*2.2N как известно, xy = ey*ln(x) Получаем, что v*2.2N = v*eN*ln(2.2) Т.е. получаем выражение v:= v*exp(N*ln(2.2)); Удачи! Приложение: program Q137139; uses Crt; var v: Real; N: Integer; begin {Очистка экрана} ClrScr; {Запрашиваем у пользователя диапазон поиска} write('Сумма вклада: '); readln(v); write('На сколько лет?: '); readln(N); {Вычисляем сумму через N лет} v:= v * exp(N*ln(2.2)); {Вывод результата} writeln; writeln('Ответ: ', v:1:2, ' руб.'); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 17.05.2008, 13:16

Вопрос № 137.145

Уважаемые эксперты! Помогите решить следующую задачу: В каждой строчке текстового файла записано по одному слову. Найти N слов, содержащих наибольшее количество различных символов.

Отправлен: 16.05.2008, 21:37 Вопрос задал: Papan (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Papan! В данной задаче нужно сортировать слова по количеству символов. Поскольку эти два свойства разных типов, то удобнее всего объеденить их в запись, где у каждого элемнта два свойства: символы строки и их количество. Решение с комментариями в приложении. Приложение: uses crt; type Tstr=record {тип запись с полями символы и количество} str:string; kol:byte; end; var f:text; s:array[1..100]of Tstr; {массив записей} bf:Tstr; {буфер при сортировке записей} mn:set of char; {вспомогательное множество для нахождения неповторяющихся символов} n,k,i,j,r:integer; begin clrscr; assign(f,'text_1.txt');{заранее созданный файл строк(слов)} reset(f); {открываем для чтения} k:=0; while not eof(f) do begin k:=k+1; {считаем количество строк} readln(f,s[k].str); {записываем их в поле строки записи} end; for i:=1 to k do begin mn:=[];r:=0; {создаем пустое множество и обнуляем счетчик} for j:=1 to length(s[i].str) do {проходим по каждой строке} if not (s[i].str[j] in mn) then {если символа нет во множестве} begin r:=r+1; {считаем его} include(mn,s[i].str[j]);{и вставляем во множество} end; s[i].kol:=r; {результат записываем в поле количество} end; {сортируем запись по убыванию числа неповторяющихся символов } for i:=1 to k-1 do for j:=1 to k-1 do if s[j].kol<s[j+1].kol then begin bf:=s[j]; s[j]:=s[j+1]; s[j+1]:=bf; end; write('Vvedite chislo N<k:'); {вводим заданное число} readln(n); for i:=1 to n do {выводим первые N строк(слов)} writeln(s[i].str); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 17.05.2008, 13:37

Вопрос № 137.159

Еще раз салют вам,Дорогие Эксперты и умные люди. Помогите мне пожалуйста с курсовой работой,для нее нужно решить уравнение F(x)=(x-1)*(x-1)-exp(ln(0.5)*x) тремя методами: методом половинного деления, методом Ньютона (метод касательных) и методом простых итераций. Заранее вам огромное спаибо...

Отправлен: 17.05.2008, 00:13 Вопрос задал: Денисов Игорь Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 9)

Отвечает: Denisss Здравствуйте, Денисов Игорь Александрович! В приложении находятся примеры решения данного уравнения методом половинного деления и методом Ньютона (касательных). Информацию про методы я взял здесь: Высшая математика. Первый семестр. Комментарии к первому примеру: В примере N - количество итераций, необходимое для получения результата с точностью, равной eps. N расчитывается по формуле: N = |log2((b-a)/(2*eps))| Комментарии ко второму примеру: Fp(x) - это производная функции F(x). Если я правильно понял, то F(x) = (x-1)2 - 0,5x а ее производная, если я правильно посчитал F'(x) = 2*(x-1) - 0,5x*ln(0,5) Если я неправильно посчитал производную, то пересчитайте и измените функцию Fp(x) - я уже давно производных не считал, и боюсь, что где-нибудь мог допустить ошибку. Удачи! Приложение: ###### Метод половинного деления ###### program Q137159_1; {$N+} uses Crt; function F(const x: Double): Double; begin F:= (x-1)*(x-1)-exp(ln(0.5)*x); end; var a, b, c: Double; fa, fb, fc: Double; eps: Double; N: Integer; begin {ЋзЁбвЄ  нЄа ­ } ClrScr; {‡ Їа иЁў Ґ¬ г Ї®«м§®ў вҐ«п ¤Ё Ї §®­ Ї®ЁбЄ } writeln('‚ўҐ¤ЁвҐ ¤Ё Ї §®­ Ї®ЁбЄ  [a, b]:'); write('a = '); readln(a); write('b = '); readln(b); fa:= F(a); fb:= F(b); if (((fa < 0.0) and (fb < 0.0)) or ((fa > 0.0) and (fb > 0.0)) or (a >= b)) then begin writeln('‚л ўўҐ«Ё ­ҐўҐа­лҐ §­ зҐ­Ёп a Ё b'); readln; Halt(0); end; {‡ Їа иЁў Ґ¬ в®з­®бвм} write('’®з­®бвм Ї®ЁбЄ  = '); readln(eps); if (eps <= 0.0) then begin writeln('‚л ўўҐ«Ё ­ҐЇа ўЁ«м­®Ґ §­ зҐ­ЁҐ в®з­®бвЁ Ї®ЁбЄ !'); readln; Halt(0); end; N:= Round(abs(ln((b - a)/(2*eps))/ln(2))); c:= (a + b)/2; fc:= F(c); while ((fc <> 0.0) and (N > 0)) do begin Dec(N); if (((fa > 0.0) and (fc < 0.0)) or ((fa < 0.0) and (fc > 0.0))) then begin b:= c; fb:= fc; end else begin a:= c; fa:= fc; end; c:= (a + b)/2; fc:= F(c); end; {‚лў®¤ १г«мв в } writeln; writeln('x = ', c:1:6); writeln('F(x) = ', fc:1:6); {Ћ¦Ё¤ ­ЁҐ ­ ¦ вЁп Ї®«м§®ў вҐ«Ґ¬ «оЎ®© Є­®ЇЄЁ} WriteLn; WriteLn('Press any key...'); ReadLn; end. ###### Метод Ньютона (касательных) ###### program Q137159_2; {$N+} uses Crt; function Fp(const x: Double): Double; begin Fp:= 2*x - exp(ln(0.5)*x)*ln(0.5) - 2; end; function F(const x: Double): Double; begin F:= (x-1)*(x-1)-exp(ln(0.5)*x); end; var xi, xi1, fxi: Double; eps: Double; begin {Очистка экрана} ClrScr; {Запрашиваем у пользователя диапазон поиска} writeln('Введите начальное значение'); write('x0 = '); readln(xi); {Запрашиваем точность} write('Точность поиска = '); readln(eps); if (eps <= 0.0) then begin writeln('Вы ввели неправильное значение точности поиска!'); readln; Halt(0); end; fxi:= F(xi); xi1:= xi - fxi/Fp(xi); while ((fxi <> 0.0) and (abs(xi1 - xi) > eps)) do begin xi:= xi1; fxi:= F(xi); xi1:= xi - fxi/Fp(xi); end; {Вывод результата} writeln; writeln('x = ', xi:1:6); writeln('F(x) = ', fxi:1:6); {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 17.05.2008, 12:28 Оценка за ответ: 4

Вопрос № 137.169

Уважаемые эксперты. Помогите реализовать данну программу. Результаты переписи населения хранятся в файле, имеющую следующую структуру: Ф.И.О. жителя, его год рождения, пол, адрес местожительства (город), образование, количество детей, место работы. Написать программу, обрабатывающую эти сведения и позволяющую определить: средний возраст жителей (мужчины, женщины); Организовать поиск сведений о человеке по его фамилии и году рождения. Спасибо за помощь.

Отправлен: 17.05.2008, 06:07 Вопрос задал: Корчагин Петр Александрович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Корчагин Петр Александрович! Решение задачи с пояснениями в приложении. Думаю все должно быть понятно. Если что, пишите. Успехов! Приложение: uses crt; type Tperep=record {тип запись с полями по условию} fio:string[20]; god:word; pol:string[3]; gor:string[20]; obr:string[20]; kdt:byte; rab:string[20]; end; var sp:array[1..100]of Tperep; {массив записей-список} n,i,km,kz:integer; {km,kz – количество мужчин, женщин} srvm,srvz:real; {средний возраст мужчин, женщин} fm:string[20]; {переменная для ввода фамилии} gd:word; { переменная для ввода года} begin clrscr; write('Kolichestvo grazdan='); readln(n); for i:=1 to n do begin writeln('Grazdanin ',i); {вводим данные} write('F.I.O: ');readln(sp[i].fio);{в виде Popov L.K.} write('God rozdenia: ');readln(sp[i].god);{в виде 1958} write('Pol: ');readln(sp[i].pol); {vvodit muz ili zen} write('Gorod: ');readln(sp[i].gor); write('Obrazovanie: ');readln(sp[i].obr); write('Kolichestvo detej: ');readln(sp[i].kdt); write('Mesto raboty: ');readln(sp[i].rab); end; srvm:=0;srvz:=0;km:=0;kz:=0; {} for i:=1 to n do begin if sp[i].pol='muz' then {если мужчина} begin srvm:=srvm+(2008-sp[i].god); {вычитаем год рождения из текущего года} km:=km+1; {считаем количество} end else if sp[i].pol='zen' then {то же самое для женщин} begin srvz:=srvz+(2008-sp[i].god); kz:=kz+1; end; end; writeln; writeln('Srednij vozrast muzchin=',srvm/km:3:0,' zenshin=',srvz/kz:3:0); writeln; write('Familia:');readln(fm); {вводим фамилию и год рождения} write('god rozdenia:');readln(gd); for i:=1 to n do {Если начало строки fio до первого пробела (фамилия) совпадает с введенной фамилией и год совпадает то выводим данные} if (copy(sp[i].fio,1,pos(' ',sp[i].fio)-1)=fm)and(sp[i].god=gd) then begin write('Familia: ',sp[i].fio,' God: ',sp[i].god,' Pol: ',sp[i].pol,' Adres: ',sp[i].gor); writeln(' Obrazovanie: ',sp[i].obr,' Deti: ',sp[i].kdt,' Mesto raboty: ',sp[i].rab); writeln; end else writeln('Takogo grazdanina v spiske net!'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 17.05.2008, 11:10 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо

Вопрос № 137.191

Программа по теме : файловые типы данных. Нужно создать файл, заполнить его входными данными, и вывести результат на экран. Задание : Создать файл, который имеет данные о отправке поездов с Московского железнодорожного вокзала. Каждая запись файла состоит с номера поезда, станцыи назначения, часа отправки, времени в дороге и наличии билетов. Получить данные о времени отправки поездов в город X в временном интервале от часа А до часа В,а также наличие билетов на поезде с номером Y.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Solovey! Решение задачи с комментариями в приложении. Главное правильно вводить данные и запросы. Приложение: uses crt; type Trasp=record {тип запись с полями по условию} nom:word; stn:string[20]; otpr:string[20]; prd:string[20]; kbl:byte; end; var sp:array[1..100]of Trasp; {массив записей-расписание} f:file of Trasp; {типизированный файл записей} n,i,j:integer; {разные переменные, смотрите в тексте} ni,ki,gor:string[20]; nm:word; begin clrscr; assign(f,'raspisan.dat'); {создаем файл и открываем для записи} rewrite(f); write('Kolichestvo poezdov:'); {вводим данные в файл} readln(n); for i:=1 to n do begin writeln('Poezd ',i); write('Nomer poezda: ');readln(sp[i].nom); write('Stancia naznachenia: ');readln(sp[i].stn); write('Vremja otpravlenia: ');readln(sp[i].otpr);{типа 15:30} write('Vremja v puti: ');readln(sp[i].prd); write('Nalichie biletov: ');readln(sp[i].kbl); write(f,sp[i]); {собственно ввод в файл} end; close(f); {закрываем файл и открываем для чтения} reset(f); n:=0; while not eof(f) do begin n:=n+1; read(f,sp[n]); {считываем данные из файла в массив} end; close(f); writeln; write('Vvedite stanciu naznachenia: ');readln(gor); write('Vvedite nachalo intervala: ');readln(ni); {типа 12} write('Vvedite konec intervala: ');readln(ki); {типа 21} writeln; writeln('Vremja otpravlenia poezdov do ',sp[i].stn,' s ',ni,' do ',ki,' chasov:'); j:=0; for i:=1 to n do begin {если название совпадает и попадаем в интервал, то выводим время отправлния и считаем количество совпадений} if (sp[i].stn=gor)and(copy(sp[i].otpr,1,pos(':',sp[i].otpr)-1)>=ni) and(copy(sp[i].otpr,1,pos(':',sp[i].otpr)-1)<=ki)then begin writeln(sp[i].otpr); j:=j+1; end; end; {если количество совпадений=0, сообщаем об этом} if j=0 then writeln('Takih poezdov net!'); writeln; write('Vvedite nomer poezda: ');readln(nm); j:=0; for i:=1 to n do begin {то же самое} if sp[i].nom=nm then begin writeln('Kolichestvo biletov=',sp[i].kbl); j:=j+1; end; end; if j=0 then writeln('Takogo poezda net!'); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 17.05.2008, 21:40

Вопрос № 137.220

Здравствуйте! Не получается написать програмку для вычисления выражения y=a+b*n^x на строке "m:=pow(n,x)" выдаёт ошибку "type mismatch"... Приложение: program f; uses crt; var a,b,i,m:integer; p,x,n:real; y:longint; Function Pow(A,B:Real):Real; { Функция возведения в степень (A^B) } Var T:Real; Begin T := Abs(A); If A < 0 Then Pow := (-1)*Exp(B*Ln(T)) Else Pow := Exp(B*Ln(T)); End; begin writeln('Enter "a"'); readln(a); writeln('Enter "b"'); readln(b); writeln('Enter "n"'); readln(n); writeln('Enter "x"'); readln(x); m:=pow(n,x); y:=a+(b*m); writeln; writeln(y); end.

Отправлен: 17.05.2008, 16:16 Вопрос задал: Щербаков Евгений Николаевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Это естественно, т.к. m:integer, а pow(A,B):real; Кроме того нехорошо объявлять глобальные переменные a,b:integer; а потом эти же переменные использовать как параметры функции, причем другого типа.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 17.05.2008, 17:26 Оценка за ответ: 5 Комментарий оценки: спасибо! уже незамечаю элементарное...нужно пойти поспать...

Отвечает: Disasm Здравствуйте, Щербаков Евгений Николаевич! Функция Pow возращает переменную типа Real(Вещественный), а Вы пытаетесь ее присвоить типу Integer (целочисленные). Следует строку, где выдается ошибка "m:=pow(n,x)" заменить на "m:=Round((pow(n,x)));" Т.е. округлить до целых значение функции pow

Ответ отправил: Disasm (статус: 2-ой класс) Ответ отправлен: 19.05.2008, 11:23

Вопрос № 137.296

Здравствуйте! Нужна Ваша консультация. Где-то год назад я написал на Паскале неплохой калькулятор, который считает по-моему 18 математических операций. Программа то DOSовская, т.к. написана на Паскале, и я на одном диске с софтом случайно нашел програмку "TMT Pascal 3.50" - мне понравилось, что можно якобы взять этот код и скомпилировать на этой программе и получиться полноценная Win32 программа, сам я точно незнаю, т.к. я только начинающий программист и хочу узнать как это сделать, потому что у меня это не получаеться. Может кто-то из Вас знает как использовать эту программу? (компилировать то получаеться без проблем, а вот сделать win32 -приложение, почему-то никак) Коменты к программе TMT Pascal 3.50 в приложении. Надеюсь на Вашу помощь, спасибо!!! Приложение: TMT Pascal 3.50 С помощью компилятора TMT Pascal, Вы можете легко построить свои 32-битные приложения. Он поможет Вам вдохнуть новую жизнь в Ваши старые MS-DOS приложения и покажет Вам самый простой путь к созданию программ для Microsoft Windows' 95/98/Me/NT/2000/XP и IBM OS/2. Возьмите свои старые исходники на Turbo Pascal и без каких-либо модификаций просто перекомпилируйте их с помощью TMT Pascal Multi-Target Edition для получения 32-битных консольных Windows или OS/2 приложений. Забудьте о "Runtime Error 200" - ошибке, связанной с модулем CRT в Turbo Pascal и появляющейся на современных процессорах типа Pentium, Celeron, Pentium II и Pentium III.

Отправлен: 18.05.2008, 02:47 Вопрос задал: Sashka (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Sashka! В описании, которое Вы привели сказано "...для получения 32-битных консольных Windows или OS/2... Забудьте о "Runtime Error 200"". То есть, он позволяет собрать консольное приложение, но сделать окошко с его помощью никак не получится. Советую следующие варианты. I. Если нужно откомпилировать консольное приложение:    1. Используйте FreePascal. Этот проект очень быстро развивается, содержит огромное количество новых функций (по сравнению с Turbo Pascal).    2. Используйте Fix для TurboPascal. Он исправляет часть файлов для компиляции программ на новых процессорах (чтобы не было Runtime Error 200) II. Если нужно создать приложение с windows-окошками, то необходимо использовать среду для создания windows-приложений:    1. Lazarus. Это бесплатная среда разработки, базирующаяся на FreePascal и позволяющая создавать полноценные windows-приложения.    2. Turbo Delphi Explorer - бесплатный аналог Delphi.    3. Delphi. Пишу последней, т.к. она платная. Удачи!

Ответ отправил: Николай Владимирович / Н.В. (статус: Профессор) Россия, Москва WWW: nvsoft.org ---- Ответ отправлен: 18.05.2008, 19:05 Оценка за ответ: 5 Комментарий оценки: Спасибо! Насчет того, что окошко я не сделаю я знаю, просто ошибки иногда надоедают.

Вопрос № 137.316

Здраствуте уважаемые эксперты! Требуется ваша помощь, идо всё не успеваю сделать. Нужно реализовать через процедуры и функции такую программу: Сортировка по убыванию позитивных элементов вектора A(n). Благодарю за помощь!

Отправлен: 18.05.2008, 10:58 Вопрос задал: Щербаков Евгений Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Решение очень простое, все видно из кода, поэтому без комментариев. Код в приложении. Исправлено в соответствии с комментарием эксперта в мини-форуме. ----- ∙ Отредактировал: Николай Владимирович / Н.В. (Профессор) ∙ Дата редактирования: 18.05.2008, 18:45 Приложение: uses crt; var a:array[1..20]of real; n,i,j:integer; x:real; begin clrscr; randomize; write('n=');readln(n); writeln('Ishodnyj massiv:'); for i:=1 to n do begin a[i]:=random(10)+random-5; write(a[i]:6:2); end; readln; writeln; {otsortirovat polozitelnye elementy} writeln('Rezultat:'); for i:=1 to n do for j:=1 to n do if (a[i]>a[j])and(a[i]>0)and(a[j]>0) then begin x:=a[i];a[i]:=a[j];a[j]:=x; end; for i:=1 to n do write(a[i]:6:2); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 18.05.2008, 11:32 Оценка за ответ: 5

Вопрос № 137.403

Опять обращяюсь к вам :) Пытаюсь создать собственною библиотеку функций и процедур, большая часть програм заработала, а эта не хочет. в приложении есть праграмма для использования библиотеки mylib28 и кусок самой библиотеки с процедурами для выполнения этой программы. Так же в самой прогремме, выделеные коментарием, есть эти же процедуры, которые работают в программе. Прошу посмотреть переменые связывающие процедуры в библиотеке и прогремме, так как в них что то неладное. Приложение: program tam; uses crt,mylib28; var a:array[1..20]of real; n,i,j:integer; x:real; {procedure change(var k ,b:real); var t : real; begin t := k; k := b; b := t; end; procedure sort(a:array of real;n:integer); var i,j:integer; begin for i:=1 to n do for j:=1 to n do if (a[i]>a[j])and(a[i]>0)and(a[j]>0) then change(a[i],a[j]); end;} begin clrscr; writeln('Enter array length'); readln(n); writeln('Enter array'); for i:=1 to n do begin read(a[i]); end; readln; writeln; {otsortirovat polozitelnye elementy} writeln('Rezultat:'); sort(a,n); for i:=1 to n do writeln(a[i]:0:0); end. unit mylib28; interface procedure sort(a:array of real;var n:integer); implementation procedure sort(a:array of real;var n:integer); {сортировка, прога TAM} var i,j:integer; x:real; begin for i:=1 to n do for j:=1 to n do if (a[i]>a[j])and(a[i]>0)and(a[j]>0) then x:=a[i]; a[i]:=a[j]; a[j]:=x; end; end.

Отправлен: 18.05.2008, 20:16 Вопрос задал: Щербаков Евгений Николаевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Щербаков Евгений Николаевич! Подремонтировал Ваш модуль и программу. По модулю: При объявлении массива или матрицы в параметрах нельзя прямо указывать тип массва, нужно его сначала создать. В массиве входной параметр размерность массива, а сам массив и входной и выходной параметр, поэтому перед ним нужно писать Var. Раз уж Вы хотите выводить в программе целые числа, так лучше уж сразу объявить целый тип. В названии модуля и имени файла добавил букву m, в имени файла программы – p, чтобы отличать. Тексты модуля и программы в приложении. Приложение: Текст модуля: unit mylib28m; interface type Tmass=array[1..100] of integer; procedure sort(n:integer;var a:Tmass); implementation procedure sort(n:integer;var a:Tmass); var i,j:integer; x:integer; begin for i:=1 to n do for j:=1 to n do if (a[i]>a[j])and(a[i]>0)and(a[j]>0) then begin x:=a[i]; a[i]:=a[j]; a[j]:=x; end; end; end. Текст программы: program tam; uses crt,mylib28m; var a:Tmass; n,i,j:integer;{х-убрать} begin clrscr; write('Enter array length n='); read(n); (вводить в строку через пробел) readln; writeln('Enter array'); for i:=1 to n do begin read(a[i]); end; readln; writeln; {otsortirovat polozitelnye elementy} writeln('Rezultat:'); sort(n,a); for i:=1 to n do write(a[i],' '); {вывод в строку через пробел} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 18.05.2008, 21:12 Оценка за ответ: 5 Комментарий оценки: спасибо! через пол часика думаю займусь этой частью...

Вопрос № 137.548

Уважаемые эксперты! Помогите, пожалуйста, решить 3 задачи: 1. Составить программу, которая запрашивает числа с клавиатуры, признак окончания ввода 0 и выводит их в обратном порядке (с помощью рекурсии). 2. Составить программу перевода десятичного числа в а) двоичную запись ; б) q-ичную запись. (с помощью рекурсии). 3. Реализовать сортировку простым выбором в виде рекурсивной процедуры. Заранее огромное спасибо! Swallow.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ласточка! Первые две задачи в приложении, выполняются последовательно. Удачи! Приложение: var a,q:integer; {рекурсивная процедура первой задачи} procedure task1; var a:integer; begin readln(a); if a<>0 then begin task1; write(a:3); end; end; {рекурсивная процедура второй задачи} procedure task2(a,b:integer); begin if a>0 then begin task2(a div b,b); write(a mod b); end; end; begin {первая задача} writeln('Task 1:'); task1; writeln; {вторая задача} writeln('Task 2:'); write('Enter A:');readln(a); write('Enter Q:');readln(q); write(a:5,' to 2 :');task2(a,2); writeln; write(a:5,' to ',q:1,' :');task2(a,q); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: SHERRY Здравствуйте, Ласточка! Помогу чем смогу. Вот функция, которая вернёт значение целого десятеричного числа в двоичной системе исчисления. function ToBin(var x: integer): string; var rez: string; y: integer; begin rez := ''; y := x; Repeat if (y mod 2 = 0) then rez := '0' + rez else rez := '1' + rez; y := y div 2; Until y < 1; ToBin := rez; end; Вы знакомы с алгоритмом переведения числа в двоичную систему? Расскажу вкратце - думаю поймёте. Берётся число из десятеричной системы исчисления и делится на 2 до тех пор, пока делимое не станет меньше единицы. При этом, если при делении числа на 2 у нас имеется остаток, то в результат дописывается 1, если остаток равен нулю, то в результат дописывается нуль. По окончании, результирующая строка "переворачивается", т.е. записывается задом наперёд. По окончании, строка лишние нули слева могут убраться. Пример. Переведём в двоичную систему число 10 10 / 2 = 5 | 0 5 / 2 = 2.5 | 1 2 / 2 = 1 | 0 1 / 2 = 0.5 | 1 Получается "0101", переворачиваем и видим, что 10 (10) = 1010 (2) Результат хранится в строковом типе данных. Теперь с первой задачкой. Её можно бы оформить при помощи динамического списка, но т.к. с динамическими списками я всё ещё консенсус не нашёл, то сделал по другому: считываем числа до тех пор, пока не встретим нуль; пишем их в типизированный файл, а потом просто читаем файл, начиная с конца. Код в приложении. Удачи! Приложение: var f: file of integer; {файл целых чисел} i: integer; {переменная счётчик} procedure CreateData; {процедура заполнения файла числами} var a: integer; begin readln(a); {считываем число} if a <> 0 then {если число не нуль, то} begin write(f, a); {записываем его в файл} CreateData; {и обращаемся к процедуре повторно (рекурсивно)} end; end; procedure ViewFile; {процедура просмотра файла - действует по тому же принципу} var a: integer; begin seek(f, i); {помещаем указатель в конец файла} read(f, a); {считываем значение} write(a:5); {выводим на экран} dec(i); {сдвигаем счётчик на позицию назад (уменьшаем на единичку)} if i>=0 then ViewFile; {если мы всё ещё не достигли начала файла, то процедура повторяется} end; begin Assign(f, 'MyFile.dat'); {зададим файл на диске} Rewrite(f); {создаём файл (перезаписываем)} CreateData; {запускаем процедуру заполнения файла числами} i:=FileSize(f)-1; {счётчику присваиваем значение размера файла} ViewFile; {просматриваем файл} Close(f); {закрываем файл} readln; end. --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 9-ый класс) Ответ отправлен: 19.05.2008, 20:11

Отвечает: Denisss Здравствуйте, Ласточка! В приложении находится решение третьей задачи. Хочется немного добавить относительно задачи 2а. На самом деле, числа в компьютере и без того хранятся в двоичной форме, так что их особо переводить и не надо - нужно просто вывести эти числа без преобразования их в 10-ную систему счисления. Пример (основан на примере из ответа эксперта Зенченко Константин Николаевич): procedure task2a(const a: Integer); begin   if (a <> 0) then   begin     task2a(a shr 1);     write(a and 1);    end; end; Хочу заметить, что этот способ позволяет выводить и отрицательные числа. Успехов! Приложение: program q137548_3; uses Crt; const {Размерность массива} MASS_SIZE = 20; type Mass = array[1..MASS_SIZE] of Integer; {Процедура сортировки простым выбором} procedure sortSelect(var aMass: Mass; const m: Integer); var i, minv: Integer; begin {Ищем минимальное значение в массиве, начиная с элемента с индексом m} minv:= m; for i:= m+1 to MASS_SIZE do if (aMass[minv] > aMass[i]) then minv:= i; {Если нашли, то меняем его местами с элементом с индексом m} if (minv > m) then begin i:= aMass[m]; aMass[m]:= aMass[minv]; aMass[minv]:= i; end; {Переходим к следующему элементу} if (m < MASS_SIZE-1) then sortSelect(aMass, m+1); end; var m: Mass; i: Integer; begin {Очистка экрана} ClrScr; {Инициализация} Randomize; for i:= 1 to MASS_SIZE do begin m[i]:= Random(501) - 250; write(m[i]:4, ' '); end; writeln; {Сортировка и вывод} writeln; writeln('Sorted:'); sortSelect(m, 1); for i:= 1 to MASS_SIZE do write(m[i]:4, ' '); writeln; {Ожидание нажатия пользователем любой кнопки} WriteLn; WriteLn('Press any key...'); ReadLn; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 19.05.2008, 21:12

Вопрос № 137.571

1. В заданном массиве K(N,N) найдите суммы элементов в каждой строке и столбце. Сформируйте одномерные массивы, содержащие полученные суммы, и отсортируйте их по возрастанию. 2. Элемент матрицы назовем седловой точкой, если он является наименьшим в своей строке и одновременно наибольшим в своем столбце или, наоборот, является наибольшим в своей строке и наименьшим в своем столбце. Для заданной целой матрицы размером п  m напечатать индексы всех ее седловых точек. 3. Разместите во множестве 10 случайных чисел в пределах от 0 до 20. Выведите элементы построенного множества. 4. Напечатать простые числа от 2 до 100.

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

Отвечает: Николай Владимирович / Н.В. Здравствуйте, XaciH! Четвертая программа в приложении. Удачи! Приложение: function is_simple(p:integer):boolean; {определяет, является ли число простым} var i : integer; res : boolean; begin i := 2; res := true; while res and (i < p) do begin res := p mod i <> 0; inc(i); end; is_simple := res; end; var i : integer; begin i := 2; while i <= 100 do begin if is_simple(i) then WriteLn(i); inc(i); end; ReadLn; end.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, XaciH! Решение первой задачи в приложении. Приложение: Задача 1. uses crt; var a:array[1..20,1..20]of integer; b,c:array[1..20]of integer; n,i,j,sum,x:integer; begin clrscr; write('n= ');readln(n); randomize; Writeln('Matrica:');{создаем матрицу и одновременно считаем сумму в сироках} for i:=1 to n do begin sum:=0; for j:=1 to n do begin a[i,j]:=random(21)-10; sum:=sum+a[i,j]; write(a[i,j]:4); end; b[i]:=sum; {записываем их в массив} writeln; end; writeln; writeln('Massiv summ po strokam:');{выводим на экран} for i:=1 to n do write(b[i],' '); writeln; for j:=1 to n do {считаем суммы в столбцах} begin sum:=0; for i:=1 to n do begin sum:=sum+a[i,j]; end; c[j]:=sum; {записываем в массив} end; writeln; writeln('Massiv summ po stolbcam:'); {выводим на экран} for i:=1 to n do write(c[i],' '); writeln; for i:=1 to n-1 do {сортируем оба массива по возрастанию} for j:=1 to n-1 do begin if b[j]>b[j+1] then begin x:=b[j]; b[j]:=b[j+1]; b[j+1]:=x; end; if c[j]>c[j+1] then begin x:=c[j]; c[j]:=c[j+1]; c[j+1]:=x; end; end; writeln; writeln('Otsortirovannyj massiv po strokam:');{выводим их на экран} for i:=1 to n do write(b[i],' '); writeln; writeln; writeln('Otsortirovannyj massiv po stolbcam:'); for i:=1 to n do write(c[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 20.05.2008, 19:48

Вопрос № 137.598

1. В заданном массиве K(N,N) найдите суммы элементов в каждой строке и столбце. Сформируйте одномерные массивы, содержащие полученные суммы, и отсортируйте их по возрастанию. 2. Элемент матрицы назовем седловой точкой, если он является наименьшим в своей строке и одновременно наибольшим в своем столбце или, наоборот, является наибольшим в своей строке и наименьшим в своем столбце. Для заданной целой матрицы размером n * m напечатать индексы всех ее седловых точек. 3. Разместите во множестве 10 случайных чисел в пределах от 0 до 20. Выведите элементы построенного множества. 4. Напечатать простые числа от 2 до 100.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Balboa! Решение первой задачи в приложении. Приложение: Задача 1. uses crt; var a:array[1..20,1..20]of integer; b,c:array[1..20]of integer; n,i,j,sum,x:integer; begin clrscr; write('n= ');readln(n); randomize; Writeln('Matrica:');{создаем матрицу и одновременно считаем сумму в сироках} for i:=1 to n do begin sum:=0; for j:=1 to n do begin a[i,j]:=random(21)-10; sum:=sum+a[i,j]; write(a[i,j]:4); end; b[i]:=sum; {записываем их в массив} writeln; end; writeln; writeln('Massiv summ po strokam:');{выводим на экран} for i:=1 to n do write(b[i],' '); writeln; for j:=1 to n do {считаем суммы в столбцах} begin sum:=0; for i:=1 to n do begin sum:=sum+a[i,j]; end; c[j]:=sum; {записываем в массив} end; writeln; writeln('Massiv summ po stolbcam:'); {выводим на экран} for i:=1 to n do write(c[i],' '); writeln; for i:=1 to n-1 do {сортируем оба массива по возрастанию} for j:=1 to n-1 do begin if b[j]>b[j+1] then begin x:=b[j]; b[j]:=b[j+1]; b[j+1]:=x; end; if c[j]>c[j+1] then begin x:=c[j]; c[j]:=c[j+1]; c[j+1]:=x; end; end; writeln; writeln('Otsortirovannyj massiv po strokam:');{выводим их на экран} for i:=1 to n do write(b[i],' '); writeln; writeln; writeln('Otsortirovannyj massiv po stolbcam:'); for i:=1 to n do write(c[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 20.05.2008, 19:44 Оценка за ответ: 4

Отвечает: Николай Владимирович / Н.В. Здравствуйте, Balboa! Четвертая программа в приложении. Удачи! Приложение: function is_simple(p:integer):boolean; {определяет, является ли число простым} var i : integer; res : boolean; begin i := 2; res := true; while res and (i < p) do begin res := p mod i <> 0; inc(i); end; is_simple := res; end; var i : integer; begin i := 2; while i <= 100 do begin if is_simple(i) then WriteLn(i); inc(i); end; ReadLn; end.

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

Вопрос № 137.625

Уважаемые эксперты, я вообще не понимаю как это сделать. Помогите сформировать матрицу В из матрицы А, вычисляя элементы по следующей формуле: (в квадратных скобках индексы) (это система) | a[ij] - a[i(j+1)], i неравно n, j неравно n | b[ij] ={ a[ij] - a[(i+1)(n-j+1)], i неравно n, j=n | | a[ij] , i=n, j=n Заранее СПАСИБО

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Корчагин Петр Александрович! Указанная Вами система определена не полностью. т.к. условие i неравно n, j неравно n исключает случаи когда i=n. В приложении программа которая работает с условием любое i , j неравно n. Если если нужно другое условие обращайтесь в мини-форум. Удачи! Приложение: const n=4; var a,b:array [1..n,1..n]of integer; i,j:integer; begin {формируем массив А} randomize; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20); write(a[i,j]:4); end; writeln; end; writeln; {формируем массив В} for i:=1 to n do begin for j:=1 to n do begin if j=n then begin if i=n then b[i,j]:=a[i,j] else b[i,j]:=a[i,j]-a[i+1,n-j+1]; end else begin b[i,j]:=a[i,j]-a[i,j+1]; end; write(b[i,j]:4); end; writeln; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 137.655

Уважаемые эксперты помоги написать программки. Цикл. Одноклеточная амеба каждые 3 часа делиться на 2 клетки. Определить, сколько клеток будет через 3,6,9,12, …24 часа. Двумерный массив. Сформулировать квадратную матрицу 7х7 по заданному образцу 1*2 0 0 0 0 0 0 2*3 0 0 0 0 0 0 3*4 0 0 0 0 0 0 4*5 0 0 0 0 0 0 5*6 0 0 0 0 0 0 6*7 Строки. Строка содержит произвольный русский текст. Определить каких букв в нем больше: гласных или согласных. Подпрограмма. Дан одномерный массив, выполнить следующие действия: Создать массив четных чисел массива, если таких чисел нет, то вывести сообшение об этом. Указать наибольшую длину числовой оси, содержащую все элементы массива. Заменить все элементы массива, больше заданного Z, этим числом, подсчитать количество замен. Определить количество элементов массива, расположенных пред первым нулевым элементом.

Отправлен: 20.05.2008, 19:48 Вопрос задал: Львов Алексей Владимирович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Львов Алексей Владимирович ! Первые две задачи в приложении. Удачи! Приложение: const n=6; var a,b:integer; c:array[1..n,1..n]of integer; begin {1} a:=1; for b:=1 to 8 do begin a:=a*2;{считаем и выводим количество} writeln(b*3:5,a:5); end; {2} for a:=1 to n do begin for b:=1 to n do begin{формируем массив} c[a,b]:=ord(a=b)*b*(a+1); write(c[a,b]:3);{и выводим его} end; writeln; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Львов Алексей Владимирович ! По задаче 4. Поскольку подпрограммы используются один раз и только для решения конкретного массива, все переменные объявляем как глобальные, а процедуры и функции оформляем без формальных параметров. Код с пояснениями в приложении. Задача 3 очень простая, но лень писать.Порядок такой: Uses crt; Const gl=['А','а',...все гласные большие и маленькие]; Sgl=['Б','б',...все согласные]; Var s:string; I,kgl,ksgl:integer; Begin Clrscr; Write('s: ');readln(s); Kgl:=0;ksgl:=0; For i:=1 to length(s) do Begin If s[i] in gl then Begin Kgl:=kgl+1; End Else if s[i] in sgl then Begin Ksgl:=ksgl+1; End; End; If kgl>ksgl then writeln('glasnyh bolshe!') Else If ksgl>kgl then writeln('soglasnyh bolshe!') Else writeln(Porovnu!); Readln End. Приложение: Задача 4. uses crt; type Tmas=array[1..100]of integer; var a,b:Tmas; n,i,Z,k:integer; procedure Chet;{создание массива четных чисел} var m:integer; begin m:=0; for i:=1 to n do if a[i] mod 2=0 then {если число четное} begin m:=m+1; {считаем его} b[m]:=a[i]; {включаем в новый массив} end; if m=0 then writeln('Chetnyh elementov net!'); for i:=1 to m do write(b[i],' '); {выводим его на экран} writeln; end; function Dlina:integer; {определение длины числовой оси} var min,max:integer; begin min:=a[1];max:=a[1]; for i:=2 to n do begin if a[i]<min then min:=a[i] {находим максимальный} else if a[i]>max then max:=a[i]; {находим минимальный} end; Dlina:=max-min; {вычисляем длину} end; procedure Zam; {делаем замену по условию} begin k:=0; for i:=1 to n do if a[i]>Z then {если больше Z} begin k:=k+1; {считаем} a[i]:=Z; {заменяем} end; for i:=1 to n do write(a[i],' '); {выводим на экран} writeln; writeln('Kolichestvo zamen=',k); end; procedure Nul; {определяем количество элементов до нуля} begin i:=1;k:=0; while a[i]<>0 do {пока не ноль} begin k:=k+1; {считаем} i:=i+1; {переходим к следующему элементу} end; Writeln('Kolichestvo elementov do nulja=',k); end; begin {} clrscr; randomize; write('n=');readln(n); write('Z=');readln(Z); writeln('Ishodnyj massiv:'); for i:=1 to n do begin a[i]:=random(10); {формируем исходный массив} write(a[i],' '); end; writeln; writeln('Chetnyj massiv:'); Chet; {вызываем процедуру, делаем массив четных} writeln('Dlina=',Dlina); {выводим результат функции Dlina} writeln('Massiv s zamenami:'); Zam; { вызываем процедуру,делаем замены} Nul; { вызываем процедуру,выводим значение количества эл-тов до 0} readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Практикант) Ответ отправлен: 21.05.2008, 10:33

Вопрос № 137.684

Вводится число от 1 до 15. Вывести данное число, записанное в двоичной системе счисления (1, 10, 11, 100, 101, …., 1111); использовать Pascal turbo 7.0

Отправлен: 20.05.2008, 23:56 Вопрос задал: Бесчастнов егор Алекандрович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Verena Здравствуйте, Бесчастнов егор Алекандрович! Перевод числа в двоичную систему счисления (как и в любую другую, впрочем) производится постепенным делением на основание системы, т.е. на 2. Число формируется из остатков от этого деления в обратном порядке. Подробнее о системах счисления можно почитать в Википедии. Программно реализуем так: сохраняем остаток от деления введённого числа на два в строку, после чего обрезаем число на сохранённый разряд (целочисленно делим на 2). Когда число обнулится, мы можем либо инвертировать строку, чтобы получить двоичное представление, либо, если необходимо получить число в виде числа, с конца перевести его в число. Это возможно не всегда, поскольку полученное двоичное число может не поместиться в стандартный тип, но в данной задаче размерность строго ограничена, поэьтому привожу такой вариант. Решение в приложении. Удачи! Приложение: Var a, b, h, i: integer; s: string [4]; {Строка для двоичного представления числа} begin read (a); {Считываем число} if (a<0) or (a>15) then {Если не удовлетворяет условию} begin writeln ('Bad info'); {Сообщаем об ошибке} halt(1); {Выходим} end; b:=0; s:= ''; {Обнуляем} while (a<>0) do {Пока число не равно 0} begin h:= a mod 2; {Получаем остаток от деления на 2} a:= a div 2; {Обрезаем число на сохранённый разряд} s:= s+chr(h+48); {Дописываем в строку символьное представление цифры (цифра+48, т.к. код нуля в ascii = 48)} end; for i:=length(s) downto 1 do {В обратном порядке формируем из строки число} b:=b*10+(ord(s[i])-48); writeln (b); {Выводим его на экран} readln; {Ждём реакции} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 21.05.2008, 00:51 Оценка за ответ: 5 Комментарий оценки: всё понятно, спасибо!

Отвечает: Denisss Здравствуйте, Бесчастнов егор Алекандрович! В приложении находится пример вывода десятичного числа в двоичной системе счисления. Как Вы знаете, компьютер хранит числа в двоичной системе счисления. Именно на этом факте и основан пример. Функция shr выполняет сдвиг двоичного числа на указанное число разрядов вправо, выкидывая сдвинутые разряды и заполняя нулями указанное количество старших разрядов. Пример сдвига: 1011 -> (shr 1) -> 0101 Сдвиг числа на единицу вправо (shr 1) соответствует делению этого числа на 2 (div 2). Функция and выполняет побитовую логическую операцию И. Т.о., (and 1) дает, как результат, младший разряд числа. Пример: 1011 -> (and 1) -> 0001 1010 -> (and 1) -> 0000 Операция И в данном случае (and 1) равна остатку от деления числа на 2 (mod 2). Успехов! Приложение: program q137684; uses Crt; {Вывод числа в двоичной форме} procedure showBin(const A: Integer); begin {Если А = 0, то больше нечего выводить} if (A <> 0) then begin {Выводим следующие по старшинству разряды} showBin(A shr 1); {Выводим текущий разряд} write(A and 1); end; end; var A: Byte; begin {Очистка экрана} ClrScr; {Вводим число в десятичной форме} repeat write ('A [1..15] = '); readln(A); until ((A > 0) and (A < 16)); {Выводим число в двоичной форме} write('bin: '); showBin(A); {Даем пользователю возможность насладиться результатом} writeln; write('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 21.05.2008, 19:30

Вопрос № 137.700

Дано двузначное число. Является ли сумма его цифр двузначным числом. использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:10 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Артемий Тотктонада! Программа в приложении. Удачи! Приложение: var a:integer; begin {вводим только допустимое число} repeat write('Eneter A:'); readln(a); until (a>9)and(a<100); {выводим результат} write(((a mod 10)+(a div 10))>9); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 137.701

Среди четырёхзначных чисел выбрать те, у которых имеются три одинаковые цифры (например: 1311, 7779); использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:12 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Артемий Тотктонада! Проограмма в приложении. Удачи! Приложение: var a:array[0..9]of byte; b,c:integer; d:boolean; begin {перебираем все числа} for b:=1000 to 9999 do begin {сбрасываем массив цифр} for c:=0 to 9 do a[c]:=0; c:=b; {считаем цифры в числе} while c>0 do begin inc(a[c mod 10]); c:=c div 10; end; {Проверяем условие задачи} d:=false; for c:=0 to 9 do d:=d or (a[c]=3); {выводим результат} if d then begin write(b:6);readln;end; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Denisss Здравствуйте, Артемий Тотктонада! Пример см. в приложении. В примере реализован вывод всех четырех-значных чисел с тремя одинаковыми цифрами, но в неотсортированном виде. Если требуется также выводить и числа с четырьмя одинаковыми цифрами (где есть четыре одинаковых цифры, там всегда есть и три), то нужно просто удалить или закомментировать строчку "if (j <> i) then". Удачи! Приложение: program q137701; uses Crt; var i, j, n: Integer; outStr: array[1..4] of Char; begin {Очистка экрана} ClrScr; {Выводим первое четырех-значное число} write ('1000'); {Выводим остальные числа} for i:= 1 to 9 do begin for j:= 0 to 9 do {Числа с четырьмя одинаковыми цифрами не выводим} if (j <> i) then begin for n:= 4 downto 1 do begin {Сумма j+n может равняться 1 только при j = 0 и n = 1} {Если число трех-значное (первая цифра ноль), то его не выводим} if (j + n = 1) then continue; {Заполняем выводимую строку одинаковыми цифрами} fillChar(outStr, 4, Char(Ord('0') + i)); {Заменяем единственную отличающуюся цифру} outStr[n]:= Char(Ord('0') + j); {Выводим число} write (', ', outStr); end; end; end; {Даем пользователю возможность насладиться результатом} writeln; write('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 21.05.2008, 19:54

Вопрос № 137.702

Среди четырёхзначных чисел выбрать те, у которых все четыре цифры различны использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:13 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Артемий Тотктонада! Программа в приложении. Строка inc(d,ord(a[c]>0)) равносильна if a[c]>0 then inc(d); Удачи! Приложение: var a:array[0..9]of byte; b,c,d:integer; begin {перебираем все числа} for b:=1000 to 9999 do begin {сбрасываем массив цифр} for c:=0 to 9 do a[c]:=0; c:=b; {считаем цифры в числе} while c>0 do begin inc(a[c mod 10]); c:=c div 10; end; {считаем только те цифры которые различны} d:=0; for c:=0 to 9 do inc(d,ord(a[c]>0)); {выводим результат} if d=4 then begin write(b:6);readln;end; end; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 137.703

Найти сумму положительных кратных 7 чисел, меньших 100 использовать Pascal turbo 7.0

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

Отвечает: Delph Здравствуйте, Артемий Тотктонада! Программа в приложении. Желаю удачи! Приложение: Program Pr137703; Uses CRT; Var i, Sum: Integer; Begin ClrScr; Sum := 0; for i := 1 to 100 do if i mod 7 = 0 then Sum := Sum + i; WriteLn('Сумма чисел от 1 до 100, кратных 7, равна ', Sum); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 21.05.2008, 10:28

Отвечает: Denisss Здравствуйте, Артемий Тотктонада! Для нахождения данной суммы нет необходимости перебирать все положительные числа, меньших 100 (1..100). В приложении находится пример с двумя вариантами нахождения суммы, оба без полного перебора всех 100 чисел. Первый вариант заключается в переборе и сложении всех чисел кратных 7 из диапазона 7..100. Поясняю второй вариант более детально: Сумма всех положительных чисел, кратных 7, меньших 100 равно: 7 + 14 + 21 + ... + 98 что, в свою очередь, равно (1 + 2 + 3 + ... + 14)*7 Как видите, в скобках находится арифметическая прогрессия от 1 до 14 с шагом 1. Если подставить формулу нахождения суммы арифметической прогрессии, то получаем: 7*(1+14)*14/2 Если разделить 100 на 7, отбросив при этом дробную часть, то получим количество чисел, кратных семи, т.е. 14. i:= 100 div 7; summ:= 7*(1+i)*i div 2; Таким образом и получена формула суммы всех чисел, кратных семи. Удачи! Приложение: program q137701; uses Crt; var i, summ: Integer; begin {Очистка экрана} ClrScr; {######Вариант 1 ######} i:= 7; summ:= 0; while (i < 100) do begin {Прибавляем к сумме i} Inc(summ, i); {Увеличиваем i на 7} {Т.е. переходим к следующему числу, кратному 7} Inc(i, 7); end; {Выводим результат} writeln('summ = ', summ); {###### Вариант 2 ######} {Находим количество чисел, кратных 7} i:= 100 div 7; {Находим сумму с помощью функции арифметической прогрессии} summ:= (1+i)*i*7 div 2; {Выводим результат} writeln('summ = ', summ); {Даем пользователю возможность насладиться результатом} writeln; write('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 21.05.2008, 20:20

Вопрос № 137.704

Дан массив целых чисел из n элементов. Найти и вывести номера элементов, заканчивающихся цифрой 0. использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:15 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Delph Здравствуйте, Артемий Тотктонада! Программа в приложении. Желаю удачи! Приложение: Program Pr137704; Uses CRT; Const M = 16; Var Arr: Array[1..M] of Integer; i, Sum: Integer; Begin ClrScr; Randomize; Sum := 0; WriteLn('Исходный случайно заполненный массив'); for i := 1 to M do begin Arr[i] := Random(100); Write(Arr[i]: 4); end; WriteLn; WriteLn; WriteLn('Номера элементов, заканчивающихся на 0:'); for i := 1 to M do if (Arr[i] mod 10 = 0) then begin if Sum > 0 then Write(', '); Write(i); inc(Sum); end; WriteLn; WriteLn('Всего: ', Sum, ' элемент(ов).'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 21.05.2008, 10:22

Вопрос № 137.705

Дана квадратная матрица порядка M. Найти сумму элементов ее побочной диагонали использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:16 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Delph Здравствуйте, Артемий Тотктонада! Программа в приложении. Желаю удачи! Приложение: Program Pr137705; Uses CRT; Const M = 8; Var Matrix: Array[1..M, 1..M] of Integer; i, j, Sum: Integer; Begin ClrScr; Randomize; Sum := 0; WriteLn('Исходная случайно заполненная матрица:'); for i := 1 to M do begin for j := 1 to M do begin { Заполняем матрицу случайными числами от 0 до 99 } Matrix[i, j] := Random(100); Write(Matrix[i, j]: 5); end; { Прибавляем к Sum элемент, находящийся на побочной диагонали } Sum + Matrix[i, M - i + 1]; WriteLn; WriteLn; end; WriteLn('Сумма побочной диагонали равна ', Sum); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 21.05.2008, 10:11

Вопрос № 137.706

Дана строка. Вывести коды ее первого и последнего символа использовать Pascal turbo 7.0

Отправлен: 21.05.2008, 01:17 Вопрос задал: Артемий Тотктонада (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Delph Здравствуйте, Артемий Тотктонада! Программа в приложении. Удачи! Приложение: Program Pr137706; Uses CRT; Var str: String; ch: Byte; Begin ClrScr; Write('Введите строку: '); ReadLn(str); {получаем длину строки} ch := Ord(str[0]); if ch > 0 then begin WriteLn('Код первого символа строки: ', Ord(str[1])); WriteLn('Код последнего символа: ', Ord(str[ch])); end else WriteLn('Введена пустая строка!'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Практикант) Ответ отправлен: 21.05.2008, 09:54

Вопрос № 137.750

Помогите пожалуйста решить задачу. Суммировать вводимые числа. При вводе одного нуля вывести на экран сумму. При вводе двух нулей подряд закончить работу.

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, HelenaBC! Код с пояснениями в приложении. Удачи!!! Приложение: var {sum-сумма, b-число, c-вспомогательная переменная} sum, b, c: integer; {i-число вводимое пользователем, т.к. Integer не может хранить такие числа: 00, то сначало сохранаяем число в строку, а потом если это не 0 и не 00 перведим в Integer} i: string; begin {Цикл который прекратится когда будет введено 00} repeat {Обнуляем сумму} sum:=0; {бесконечный цикл в котором получаем числа и прибавляем их к сумме} while true do begin {получаем число} Write('Введите число: '); readln(i); {если введено 0 или 00, то выходим из цикла} if (i='0') or (i='00') then break; {Иначе преобразуем строку в число(число сохр. в b)} val(i, b, c); {И прибавляем к сумме} sum:=sum+b; end; {После цикла ввода проверяем если введен 0, то выводим сумму} if i='0' then begin Write('Сумма: '); Writeln(sum); end; {Конец главного цикла} until i='00'; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 21.05.2008, 21:21 Оценка за ответ: 5 Комментарий оценки: Спасибо большое, программа работает именно так как надо.

Вопрос № 137.771

Уважаемые эксперты. Как решить эту задачу. Знаю только, что используется функция NOD. Заранеее спасибо. Дана матрица А порядка n. Вычислить наибольший общий делитель для элементов каждой строки и столбца.

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

Отвечает: Denisss Здравствуйте, Корчагин Петр Александрович! В приложении находится пример вычисления НОД для строк и столбцов квадратной матрицы. PS Извините, что не смог ответить раньше - были некоторые проблемы, не позволявшие мне этого сделать ранее. Удачи! Приложение: program q137771; uses Crt; const {Максимальный размер квадратной матрицы} M_SIZE = 50; {Функция нахождения НОД из двух чисел} function nod(a, b: Integer): Integer; begin {Работаем только с положительными значениями a и b} a:= abs(a); b:= abs(b); while (a <> 0) and (b <> 0) do if (a >= b) then a:= a mod b else b:= b mod a; {Результат} nod:= a + b; end; var i, j, n: Byte; A: array[1..M_SIZE, 1..M_SIZE] of Integer; iNOD: Integer; begin {Очистка экрана} ClrScr; {Вводим размерность массива} repeat write('N = '); readln(n); until ((n > 0) and (n < 51)); {Заполнение массива} for i:= 1 to n do for j:= 1 to n do begin write('A[', i, ', ', j, '] = '); readln(A[i, j]); end; {Вычисление НОД} {Построчно} writeln('Stroki:'); for i:= 1 to n do begin iNOD:= A[i, 1]; for j:= 2 to n do iNOD:= nod(iNOD, A[i, j]); writeln(i, ': ', iNOD); end; {По столбцам} writeln('Stolbcy:'); for j:= 1 to n do begin iNOD:= A[1, j]; for i:= 2 to n do iNOD:= nod(iNOD, A[i, j]); writeln(j, ': ', iNOD); end; {Даем пользователю возможность насладиться результатом} writeln; write('Press any key...'); readln; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 27.05.2008, 19:57

Вопрос № 137.805

Уважаемые эксперты прошу помощи в решении задачи! В двумерном массиве случайных чисел от 1 до 100 отсортировать по возрастанию каждую строку. Заранее огромное спасибо!

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

Отвечает: Устинов С.Е. Здравствуйте, Marina korolyova! Текст программы в приложении. У меня эту задачу решают большинство учеников 10-го класса, поэтому думаю объяснения тут излишни. Удачи! Приложение: const n=10; m=15; var A:array[1..n,1..m] of integer; t,z,i,j:integer; begin {zapolnenie massiva} for i:=1 to n do for j:=1 to m do A[i,j]:=random(100)+1; {Sortirovka} for t:=1 to n do for i:=m-1 downto 1 do for j:=1 to i do if A[t,j]>A[t,j+1] then begin z:=A[t,j]; A[t,j]:=A[t,j+1]; A[t,j+1]:=z; end; {vivod massiva na ekran} for i:=1 to n do begin for j:=1 to m do write(A[i,j]:4); writeln; end; readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Профессионал) Украина, Славянск Организация: SlavComp WWW: Физико-математический факультет СГПУ ICQ: 4343069 ---- Ответ отправлен: 21.05.2008, 23:44

Вопрос № 137.808

Дорогие Эксперты! Найдите пожалуйста ошибки и пожалуйста исправте их, доведите до ума. P.S. Программа нужна именно в процедурном стиле. Текст задачи: Используя абстрактный базовый объект "фигура", разработанный самостоятельно, определить объект, описанный ниже. Предусмотреть следующие действия с экземплярами создаваемого объекта: ∙ динамическое создание объектов ∙ динамическое уничтожение объектов; ∙ изменение параметров объекта (цвет, размер, координаты и т.п.); ∙ определить периметр и площадь. Фигура: треугольник. Приложение: PRogram trangle; uses crt, graph; type my=object x,y,a,b,c,d,f,h,x1,y1:integer; color,color1:byte; r,q,z:real; dx,dy:integer; x2,y2,x3,y3:integer; s,p,l:real; procedure init; procedure move; procedure show; procedure hide; procedure Sp; procedure step; end; procedure my.init; begin x:=random(GetmaxX); y:=random(GetmaxY); color:=random(15)+1; writeln(x,y); end; procedure my.move; begin a:=x; b:=y; writeln('vvedite dliny osnovaniya'); readln(dx,dy); c:=x+dx; d:=y+dy; writeln('vvedite vershiny trangle'); readln(x1,y1); f:=x+x1; h:=y+y1; if (c<0) or (c>GetmaxX) then begin dx:=-dx; c:=x+dx; end; if (d<0) or (d>Getmaxy) then begin dy:=-dy; d:=y+dy; end; if (f<0) or (f>GetmaxX) then begin x1:=-x1; f:=x+x1; end; if (h<0) or (h>Getmaxy) then begin y1:=-y1; h:=y+y1; end; end; procedure my.show; begin putpixel(a,b,color); putpixel(c,d,color); putpixel(f,h,color); line(a,b,c,d); line(a,b,f,h); line(c,d,f,h); end; procedure my.hide; begin putpixel(a,b,0); putpixel(c,d,0); putpixel(f,h,0); end; procedure my.Sp; begin r:=sqrt(((a-f)*(a-f))+((b-h)*(b-h))); q:=sqrt(((a-c)*(a-c))+((b-d)*(b-d))); z:=sqrt(((f-c)*(f-c))+((h-d)*(h-d))); P:=r+q+z; l:=P/2; s:=sqrt(l*(l-r)*(l-q)*(l-z)); writeln('ploshad=',s,'perimetr=',P); end; Procedure my.step; begin init; move; Sp; hide; show; end; var ch:byte; gd,gm:integer; o:my; begin gd:=vga; gm:=vgahi; randomize; initGraph(Gd, Gm, ''); o.step; closegraph; repeat; writeln('1-picture'); writeln('2-Ploshad & perimetr'); writeln('3-delete'); writeln('4-quit'); writeln; writeln('vvedite pynkt meny'); readln(ch); case ch of 1:o.show; 2:o.Sp; 3:o.hide; end; until ch=4; readln; end.

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, meg17! В программе создаётся три объекта:oPoint, oLine и oFigure. Каждый из них наследует свойства и методы ранее определенных. вопросы в мини-форум. Удачи! Приложение: uses Graph,Crt; type { объект точка } oPoint=object xA,yA,pColor:integer;{наследуется всеми объектами} constructor Init; procedure Show;virtual;{для точки свой метод показатать} procedure Hide;virtual;{для точки свой метод спрятать} procedure Move(a,b:integer);{переместить} procedure Color(a:integer);{изменить цвет} end; { объект линия } oLine=object(oPoint) xB,yB,lAngle,Lsize:integer;{наследуется всеми объектами} constructor Init; procedure Show;virtual;{для линии свой метод показать} procedure Hide;virtual;{для линии свой метод спрятать} procedure Change;virtual;{для линии свой метод считать координаты} (* наследуется procedure Move(x,y:integer);{от объекта точка} procedure Color(a:integer);{от объекта точка} *) procedure Rotate(a:integer);{метод повернуть линию} procedure Size(a:integer);{метод изменить размер} end; { } oFigure=object(oLine) xC,yC:integer; constructor Init; procedure Show;virtual; procedure Hide;virtual; procedure Change;virtual; procedure Draw; (* наследуется procedure Move(x,y:integer);{от объекта точка} procedure Color(a:integer);{от объекта точка} procedure Rotate(a:integer);{от объекта линия} procedure Size(a:integer);{от объекта линия} *) end; { ОБЪЕКТ ТОЧКА } constructor oPoint.Init;{описываем точку, начальные значение} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; pColor:=15; oPoint.Show; end; procedure oPoint.Color;{меняем цвет точки} begin oPoint.Hide; pColor:=(16+pColor+a) mod 16; oPoint.Show; end; procedure oPoint.Move;{меняем положение точки} begin oPoint.Hide; xA:=xA+a; yA:=yA+b; oPoint.Show; end; procedure oPoint.Show;{показываем точку} begin PutPixel(xA,yA,pColor); end; procedure oPoint.Hide;{прячем точку} begin PutPixel(xA,yA,GetBkColor); end; { ОБХЕКТ ЛИНИЯ } constructor oLine.Init;{описываем линию:начальные значения} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; lAngle:=0; lSize:=50; pColor:=15; oLine.Show; end; procedure oLine.Rotate;{поворачиваем линию} begin oLine.Hide; lAngle:=(360+lAngle+a)mod 360; oLine.Show; end; procedure oline.Change;{пересчитываем координаты} begin xB:=xA+round(lSize*cos(2*pi*lAngle/360)); yB:=yA+round(lSize*sin(2*pi*lAngle/360)); end; procedure oLine.Show;{показываем линию} begin oLine.Change; SetColor(pColor); Line(xA,yA,xB,yB); end; procedure oLine.Hide;{прячем линию} begin SetColor(GetBkColor); Line(xA,yA,xB,yB); end; procedure oLine.Size;{меняем размер линии} begin oLine.Hide; lSize:=lSize+a; oLine.Show; end; { ОБЪЕКТ ТРЕУГОЛЬНИК } constructor oFigure.Init;{описываем труугольник: начальные значения} begin xA:=GetMaxX div 2; yA:=GetMaxY div 2; lSize:=100; lAngle:=10; pColor:=14; oFigure.Show; end; procedure oFigure.Show;{показываем фигуру} begin oFigure.Change; SetColor(pColor); oFigure.Draw; end; procedure oFigure.Draw;{рисуем фигуру} begin MoveTo(xA,yA); LineTo(xB,yB); LineTo(xC,yC); LineTo(xA,yA); end; procedure oFigure.Hide;{прячем фигуру} begin SetColor(GetBkColor); oFigure.Draw; end; procedure oFigure.Change;{пересчитываем координаты} begin xB:=xA+round(lSize*cos(2*pi*lAngle/360)); yB:=yA+round(lSize*sin(2*pi*lAngle/360)); xC:=xA+round(lSize*cos(2*pi*(lAngle-60)/360)); yC:=yA+round(lSize*sin(2*pi*(lAngle-60)/360)); end; var myTr:^oFigure; y:integer; d:char; begin y:=detect; InitGraph(y,y,''); if GraphResult<>grOk then halt(1); OutTextXY(0,0,'+,-size all; 2,4,6,8-location; 1,3-rotate; 7,9-color; 5-exit.'); d:=' '; New(myTr,Init); repeat myTr^.Hide; case d of '+','-':{меняем размер} myTr^.Size(ord(d='+')-ord(d='-')); '7','9':{меняем цвет} myTr^.Color(ord(d='9')-ord(d='7')); '4','6','8','2':{перемещаем фигуру} myTr^.Move(ord(d='6')-ord(d='4'), ord(d='2')-ord(d='8')); '3','1':{поворачиваем фигуру} myTr^.Rotate(ord(d='3')-ord(d='1')); end; myTr^.Show; d:=ReadKey; until d='5'; Dispose(myTr); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 27.05.2008, 00:52 Оценка за ответ: 5 Комментарий оценки: Большое спасибо!!! Я бы оценил на большее ваше решение, но увы выше пятёрки нельзя....

Вопрос № 137.809

Уважаемые эксперты помогите пожалуйста решить задачу. Вычислить значение интеграла f(x) dx от а до b методом прямоугольников, где n задает пользователь как количество разбиений [a, b] Заранее спасибо!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Marina korolyova! В приложении программа, которая ищет интеграл(Y=X) с заданой точностью. Вопросы задавайте в мини-форум. Удачи! Приложение: const e=0.00001; var a,b,c,h,i1,i2:real; n:integer; {сама функция} function F(x:real):real; begin F:=x; end; begin {вводим начальное значение} write('Enter A:');readln(a); {вводим конечное значениеВ, большее А} repeat write('Enter B:');readln(b); until b>a; {вводим число разбиений} repeat write('Enter N:');readln(n); until n>0; i2:=0; repeat {запоминаем предыдущее значение} i1:=i2; {считаем шаг для данного количества разбиения} h:=(b-a)/n; {тут будем считать интеграл} i2:=0; {начальное значение} c:=a; {все делаем в цикле} repeat i2:=i2+abs(F(c+h/2));{суммируем одну стoрону прямоугольника} c:=c+h;{переходим на следующую точку} until c>b; i2:=i2*h;{просуммированные строны умножаем на шаг} n:=n*2;{увеличиваем число разбиений в два раза} until abs(i1-i2)<=e;{продолжаем пока недостигнем нужной точности значения интегерала} writeln('integal:',i2:20:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

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