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

Выпуск № 593
от 05.03.2008, 13:05

Вопрос № 125.256

Многоуважаемые эксперты. помогите решить задачу по приниципу работы с целыми числами: Дано натуральное число n. Проверить будут ли все цифры числа различными. Заранее БОЛЬШОЕ спасибо!!!

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Dreamss! Программа в приложении. В массиве считаются количество цифр, если все цифры различны то максимальное значение будет 1, поэтому при уменьшении счетчиков на 1 и их суммировании, результат будет равен 0, если любая цифра повторяется результат суммирования будет больше 0. Удачи! Приложение: var i:integer; a:array[0..9]of integer; begin {чистим массив индексов} for i:=0 to 9 do a[i]:=0; {вводим число} write('enter number:');readln(i); {считаем цифры} while i>0 do begin inc(a[i mod 10]); i:=i div 10; end; {уменьшаем счетчики на 1} for i:=0 to 9 do if a[i]>0 then dec(a[i]); {суммируем все счетчики} for i:=1 to 9 do a[0]:=a[0]+a[i]; {проверяем результат} if a[0]=0 then writeln('Yes') else writeln('No'); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Gh0stik Здравствуйте, Dreamss! На самом деле есть и более элегантный способ решения этой задачи (без использования массивов и счётчиков): var n,c:integer;     dg:set of 0..9;     f:boolean; begin   dg:=[]; {множество в котором хранятся цифры числа}   f:=true;   write('Input n=');readln(n);   while n>0 do   begin     c:=n mod 10;     {выделяем последнюю цифру числа}     if not (c in dg) {если цифры "с" еще нет в множестве}        then dg:=dg+[c] {то добавляем ее}        else begin f:=false; break;end; {иначе заканчиваем цикл}     n:=n div 10;   end;   writeln(f); {выводим TRUE, если все цифры разные и FALSE в противном случае} end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 28.02.2008, 17:05 Оценка за ответ: 5 Комментарий оценки: Толково!

Вопрос № 125.259

Многоуважаемые эксперты, помогите решить несколько задач на одномерные массивы: 1) Дана последовательность натуральных чисел а1, а2, … аn. Создать массив из четных чисел этой последовательности. Если таких чисел нет, то вывести сообщение о данном факте. 2) Даны действительные числа a1, a2, … , an. Среди них есть положительные и отрицательные. Заменить нулями те числа, величина которых по модулю больше максимального числа (|ai| > max{a1, a2, … , an}). 3) Дана последовательность целых чисел. Найти количество различных чисел в этой последовательности. Заранее ОГРОМНОЕ спасибо!!!

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

Отвечает: Delph Здравствуйте, Dreamss! В приложении - решение третьей Вашей задачи. Подсчитать количество разных чисел содержится в массиве будет проще, если массив для начала отсортировать. Неважно - по возрастанию или убыванию, главное, чтобы одинаковые числа оказались рядом. А потом считаем, сколько раз при прохождении массива происходит скачок на новое значение. Приложение: Program Pr125259_3; Const N = 64; Var Count, i, j, r: Integer; Arr: Array[1..N] of Integer; Begin Randomize; { Формируем и отображаем последовательность чисел } WriteLn('Последовательность чисел: '); for i := 1 to N do begin Arr[i] := Random(100); Write(Arr[i]: 4); if i mod 16 = 0 then WriteLn; { разбиваем на несколько строк } end; WriteLn; { Сортируем по возрастанию } for i := 1 to N - 1 do for j := i + 1 to N do if Arr[j] < Arr[i] then begin r := Arr[i]; Arr[i] := Arr[j]; Arr[j] := r; end; { А теперь считаем, сколько у нас разных чисел } Count := 1; {хотя бы одно число у нас должно быть} for i := 2 to N do if Arr[i] <> Arr[i - 1] then inc(Count); WriteLn('Найдено: ', Count, ' различных чисел'); ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 28.02.2008, 14:42 Оценка за ответ: 5 Комментарий оценки: Спасибо за подробное решение! Очень хороший вариант!

Отвечает: Шемет Станіслав Васильович Здравствуйте, Dreamss! В первой задачи вместо: if (m[i] and 1)=0 then можно поставить if (m[i] mod 2)=0 then просто первое быстрее работает. Алгоритм работы 2 задачи: 1)заполняем случайными числами массив. 2)Начинаем поиск максимального элемента. 3)Поиск чисел которые по модулю больше максимального числа Алгоритм работы 3 задачи: 1)заполняем случайными числами массив 2) сортируем массив(неважно по возрастанию или по спаданию). 3)переменную temp делаем ровной первому елементу масива а переменая count ровна 1. Теперь в цикле будем проходить весь массив и смотреть равен ли текущий элемент массива переменной temp если нет то: 1)Увеличиваем на 1 переменную count 2)Переменную temp прировняем к значению текучего значения массива. Приложение: const n=10; Var M:array[1..n] of integer; Mnew:array[1..n] of integer; i:integer; Chet:word; begin chet:=0; For i:=1 to n do m[i]:=random(200); for i:=1 to n do if (m[i] and 1)=0 then Begin inc(chet); Mnew[chet]:=m[i]; end; if chet>0 then for i:=1 to chet do write(mnew[i],#32) else Writeln('Нету'); Readln; end. ----------------------------------------------------------------- const n=5; VAr m:array[1..n] of integer; Max:integer; i:integer; Begin Randomize; For i:=1 to n do Begin m[i]:=random(200); Dec(m[i],random(128)); end; (*Поиск максимально числа*) Max:=m[1]; For i:=1 to n do if max<m[i] then max:=m[i]; (*Поиск чисел которые по модулю больше максимального числа*) for i:=1 to n do if abs(m[i])>max then M[i]:=0; for i:=1 to n do Write(m[i],#32); Readln; end. ------------------------------------------------------------------ const n=10; Var Count:word; M:array[1..n] of integer; I:word; Temp:integer; B:boolean; Procedure Sort; Begin (*Процедура сортировки массива *) Repeat b:=true; for i:=1 to n-1 do if m[i]<m[i+1] then Begin temp:=m[i]; m[i]:=m[i+1]; m[i+1]:=temp; b:=false; end; until b; end; Begin for i:=1 to n do m[i]:=random(255); (*---------------------------------*) sort; (*---------------------------------*) (*А здесь будем считать скоко есть разных элементов в массиве*) temp:=m[1]; count:=1; for i:=1 to n do if temp<>m[i] then Begin inc(count); temp:=m[i]; end; (*----------------------------------*) Writeln(count); Readln; end. ---------------------------------------------------------------- --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 28.02.2008, 16:08 Оценка за ответ: 5

Вопрос № 125.260

Многоуважаемые эксперты, помогите решить пару задач на двумерные массивы: 1) Сформировать квадратную матрицу порядка n по заданному образцу: 1 1 1 ... 1 1 1 1 0 0 ... 0 0 1 1 0 0 ... 0 0 1 ... ... ... ... ... ... ... 1 0 0 ... 0 0 1 1 1 1 ... 1 1 1 2) Дана действительная квадратная матрица порядка N (N - нечетное), все элементы которой различны. Найти наибольший элемент среди стоящих на главной и побочной диагоналях и поменять его местами с элементом, стоящим на пересечении этих диагоналей. Заранее ПРЕМНОГО благодарен!!!

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

Отвечает: Delph Здравствуйте, Dreamss! В приложении - самый простой, хотя и не самый эффективный пример решения первой из Ваших задач. Сначала весь массив заполняется единицами, потом внутренняя его часть - нулями. Приложение: Program Pr125260_1; Const N = 20; Var i, j: Integer; Arr: Array[1..N, 1..N] of Integer; Begin { Формируем и отображаем последовательность чисел } for i := 1 to N do for j := 1 to N do Arr[i, j] := 1; for i := 2 to N - 1 do for j := 2 to N - 1 do Arr[i, j] := 0; WriteLn('Последовательность чисел: '); for i := 1 to N do begin for j := 1 to N do Write(Arr[i, j]: 2); WriteLn; end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 28.02.2008, 15:10 Оценка за ответ: 5 Комментарий оценки: Спасибо, как обычно, очень хорошее решение!

Отвечает: Зенченко Константин Николаевич Здравствуйте, Dreamss! Задачи в приложении, выполняются последовательно. Как вариант: for x:=1 to 9 do begin for y:=1 to 9 do begin a[x,y]:=ord(((x mod 8)=1)or((y mod 8)=1)); write(a[x,y]:1:0); end; writeln; end; Удачи! Приложение: var a:array[1..9,1..9]of real; b:real; i,x,y,n:integer; begin { задача I } {формируем матрицу и выводим} for x:=1 to 9 do begin for y:=1 to 9 do begin if ((x mod 8)=1)or((y mod 8)=1)then a[x,y]:=1 else a[x,y]:=0; write(a[x,y]:1:0); end; writeln; end; readln; { задача II } {вводим не четное число} repeat write('Enter N:');readln(n); until (n>0)and((n mod 2)=1)and(n<10); randomize; {формируем матрицу и выводим} for x:=1 to n do begin for y:=1 to n do begin a[x,y]:=random(10000)/1000; write(a[x,y]:8:4); end; writeln; end; readln; {настраиваемся на матрицу для поиска} x:=1; y:=1; {поиск максимального значения} for i:=1 to n do begin {на главной диагонали} if a[i,i]>a[x,y] then begin x:=i; y:=i; end; {на побочной диагонали} if a[i,n-i+1]>a[x,y] then begin x:=i; y:=n-i+1; end; end; {меняем местами} b:=a[x,y]; a[x,y]:=a[(n div 2)+1,(n div 2)+1]; a[(n div 2)+1,(n div 2)+1]:=b; {выводим} for x:=1 to n do begin for y:=1 to n do write(a[x,y]:8:4); writeln; end; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Gh0stik Здравствуйте, Dreamss! Еще один экзотический способ решения первой задачи: const n=10; var x:array [1..n,1..n] of byte;     i,j:integer; begin   fillchar(x,sizeof(x),0); {заполняем массив нулями}   for i:=1 to n do   begin     x[i,1]:=1; x[1,i]:=1; x[n,i]:=1; x[i,n]:=1; {элементы стоящие на границах делаем равными 1.}   end;   {выводим получившуюся матрицу}   for i:=1 to n do   begin     for j:=1 to n do write(x[i,j]:2);     writeln;   end; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 28.02.2008, 17:33 Оценка за ответ: 5 Комментарий оценки: Спасибо за оригинальный способ решения! Всё работает!

Вопрос № 125.261

Многоуважаемые эксперты, помогите решить задачу, используя процедуру: Найти все натуральные n-значные числа, цифры в которых образуют строго возрастающую последовательность (например, 1234, 5789). Заранее говорю Вам: "Большое спасибо!!!"

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

Отвечает: Delph Здравствуйте, Dreamss! Задачка просто решается при использовании рекурсии (когда процедура или функция вызывает сама себя). Единственная проблема состоит в том, что вывод программы не умещается на экран, поэтому я сразу направил вывод в текстовый файл Result.txt. Приложение: Program Pr125261; Var f: TextFile; procedure NextNmb(Nmb: Integer; str: String); var s: String; i: Integer; begin if Nmb < 9 then begin for i := Nmb + 1 to 9 do begin s := str + CHR(i + ORD('0')); WriteLn(f, s); NextNmb(i, s); end; end; end; Begin Assign(f, 'Result.txt'); ReWrite(f); NextNmb(0, ''); Close(f); End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 28.02.2008, 13:39 Оценка за ответ: 5 Комментарий оценки: Спасибо, Delph! Только вот, Paskal выдает ошибку при объявлении переменной f. Говорит, что индентификатор TextFile не зарегистрирован. Что делать?

Отвечает: Зенченко Константин Николаевич Здравствуйте, Dreamss! Программа в приложении. Вводите количество знаков и получаете результат. Удачи! Приложение: var i:longint; n:integer; procedure Check(z:longint;x,y:integer); begin while (x<y)and(z>0) do begin y:=x;{запоминаем предыдущую цифру} x:=z mod 10;{получаем последнюю цифру} z:=z div 10;{следующее число без последней цифры} end; {проверяем условие: -просмотрели все цифры; -последняя цифра меньше предыдущей} if (z=0)and(x<y) then write(i:10); end; begin {вводим кол-во знаков} repeat write('N:');readln(n); until (n>0)and(n<10); {первое число будет 10^n} i:=round(exp(ln(10)*(n-1))); repeat {вызываем процедуру с параметрами: -контролируемое число без последней цифры; -последняя цифра; -последняя цифра + 1 = всегда больше} Check(i div 10,i mod 10,1+i mod 10); {следующее число} inc(i); {повторять пока I < 10^N} until i=round(exp(ln(10)*n)); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 125.280

Вот тут две задачки. При их решении можно использовать только условный оператор, цикл For, логические операции And, Or, Not (можно и Xor) и переменные двух типов (Integer и Boolean). В первой нельзя использовать циклы: 1. Даны координаты четырёх точек A, B, C, D на координатной прямой. Не применяя циклов, определите длину пересечения отрезков AB и СD. Если отрезки не пересекаются выведите "0". 2. Распечатайте трёхзначные числа в порядке возрастания суммы цифр. Максимальная сумма чисел в трёхзначном числе 27 (999) а минимальная 1 (100), т. е. нужно завести дополнительный цикл от 1 до 27.

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

Отвечает: Gh0stik Здравствуйте, Хощенко Артём Владимирович! Вот на мой взгляд "маленькое пушистенькое" решение второй задачи: var i,a,b:integer; begin   for i:=1 to 27 do     for a:=1 to 9 do     for b:=0 to 9 do      if ((i-a-b) div 10=0) and (i>=a+b)       then write(a,b,i-a-b,' '); end. P.S. Разобраться я думаю будет не сложно... :о) Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 28.02.2008, 23:32 Оценка за ответ: 5

Отвечает: Костя Симанович Здравствуйте, Хощенко Артём Владимирович! В приложении еще один вариант. Если устроит. Приложение: program war2; var i, j : integer; {счетчик} x, y, z : integer; {соответсвенно первое, второе и третье число} w : integer; {введенное число} s : integer; {сумма чисел} pr, pr1 : integer; {промежуточное значение} begin for j := 1 to 27 do begin for i:= 100 to 999 do begin w := i; z := w mod 10; {последняя цифра (еденицы)} w := w div 10; {это же число без последней цифры} y := w mod 10; {предпоследняя цифра (десятки)} x := w div 10; {последняя цифра (сотни)} s := z+y+x; if s = j then writeln('Число =', i, ' Сумма элементов = ', s); end; end; readln; end.

Ответ отправил: Костя Симанович (статус: 1-ый класс) Ответ отправлен: 29.02.2008, 16:34

Отвечает: Зенченко Константин Николаевич Здравствуйте, Хощенко Артём Владимирович! Первая задача в приложении. Я использовал цикл с постусловием только для ввода координат, но его можно заменить на IF условие THEN GOTO метка. Удачи! Приложение: label equAB,equABC,equABCD; var a,b,c,d,e:integer; begin {вводим координаты точек на прямой} write('A:');readln(a); {цикл с постусловием можно заменить на аналог:} repeat{equAB:} write('B:');readln(b); until a<>b;{if a<>b then goto equAB} repeat write('C:');readln(c); until (a<>c)and(b<>c); repeat write('D:');readln(d); until (a<>d)and(b<>d)and(c<>d); {жаль, что функции нельзя использовать e=(1*ord((a-c)*(b-c)<0)+2*ord((a-d)*(b-d)<0)+ 4*ord((c-a)*(d-a)<0)+8*ord((c-b)*(d-b)<0)) пришлось всё расписывать через условия } e:=0; {проверяем лежит ли точка С на отрезке АВ} if (a-c)*(b-c)<0 then inc(e,1); {проверяем лежит ли точка D на отрезке АВ} if (a-d)*(b-d)<0 then inc(e,2); {проверяем лежит ли точка А на отрезке СD} if (c-a)*(d-a)<0 then inc(e,4); {проверяем лежит ли точка В на отрезке СD} if (c-b)*(d-b)<0 then inc(e,8); {использован опрератор CASE, чтобы не расписывать IF THEN ELSE IF THEN ELSE . . .} case e of 3 :e:=c-d;{вариант acdb, когда отрезок СD полностью лежит на отрезке AB} 5 :e:=a-c;{вариант dacb} 6 :e:=a-d;{cadb} 9 :e:=b-c;{acbd} 10:e:=b-d;{cbda} 12:e:=a-b;{вариант cabd, когда отрезок AB полность лежит на отрезке СD} end; {аналог функции ABS} if e<0 then e:=-1*e; {выводим результат} writeln(e); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

Ответ отправил: Зенченко Константин Николаевич (статус: Профессионал) Украина, Киев Тел.: +380958380164 Адрес: Украина г.Киев ---- Ответ отправлен: 29.02.2008, 18:41 Оценка за ответ: 5 Комментарий оценки: Я циклов, кроме Фор не знаю, поэтому не могли бы вы сами заменить все циклы на условные операторы? Я боюсь, что испорчу всё решение.

Вопрос № 125.293

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

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

Отвечает: Gh0stik Здравствуйте, Lordthief! Вот Вам две такие задачи (олимпиадные), которые решаются используя "жадный" алгоритм. Задача Chief Шеф всегда уделяет всем посетителям равные промежутки времени (например, каждому по пять минут); чтобы попасть на прием, следует заранее записаться у секретаря. При записи посетитель указывает (единственный) интервал времени, задаваемый парой [Ai; Bi] (начальный и конечный моменты, когда он согласен ЗАХОДИТЬ на прием). Ai и Bi - целые числа, означающие количество интервалов приема, прошедших от начала рабочего дня Шефа. Помогите секретарю обрабатывать собранные записи и составлять график приема. Технические условия: Вы вводите количество посетителей (2<=N<=50000), дальше идут N групп,в каждой из которых по два числа Аi и Bi, 0<=Ai<=Bi<=2N. Числа вводятся с клавиатуры через пробел. Вы выводите на экран 1 (если установить график приема можно) или 0 (если нельзя); если ответ положителен (1), последовательность чисел-номеров посетителей в порядке, как они попадают на прием. Все числа выводятся через пробел. Если нужно, чтобы в какой-то момент никто не заходил на прием, следует выводить -1. Примеры: Ввод:3 1 2 0 1 2 2 Вывод: 1 2 1 3 Ввод:3 1 2 1 2 1 2 Вывод:0 Ввод:3 1 2 1 2 2 4 Вывод:1 -1 2 1 3 Задача Chief2 Перед праздниками Шеф получает очень много приглашений на торжественные заседания. Чтобы лучше планировать свое время, Шеф ввёл правило, чтобы в каждом i-ом приглашении был чётко указан отрезок времени заседания [ai; bi]. Кроме того, Шеф устанавливает каждому заседанию “важность” ci. Шеф не любит половинчатых решений, поэтому или находится на заседании всё указанное время, или не приходит на него вовсе. Между посещениями заседаний должен быть хотя б ы минимальный перерыв, т.е. Шеф может успеть на j-е (по списку приглашений) после i-го, если и только если aj > bi. Напишите программу, помогающую Шефу посетить заседания с как можно большей суммарной важностью. Если возможны разные наборы с одинаковой максимальной суммарной важностью, выбрать тот, где меньше суммарная длина заседаний. Технические условия. Программа читает с клавиатуры сначала количество заседаний N, где 2<= N <= 5 000, затем N троек (ai, bi, ci). Гарантированно, что 0 <= ai < bi < 109, все ci натуральные и их сумма не превышает 109. Программа должна вывести на экран через пробел суммарную важность и суммарную длительность выбранных заседаний. Примеры Вход 3 1 5 3 4 9 4 6 11 2 Выход 5 9 Вход 3 1 5 3 5 9 5 6 11 2 Выход 5 4 Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 28.02.2008, 19:02

Вопрос № 125.294

Уважаемые эксперты помогите решить задачу : "Дан файл, число компонент которого кратно четырем. Файл состоит из целых чисел не равных нулю, число положительных компонент файла равно числу отрицательных. Преобразовать файл так, чтобы два положительных числа чередовались с двумя отрицательными."

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

Отвечает: Шемет Станіслав Васильович Здравствуйте, Sacss! Вот вам программа которая находиться в приложении. Приложение: const n=1000; var f:text; F1:text; i,j:longint; MAx,min:array[1..n] of integer; Buf:longint; Procedure Read_Data; Begin i:=0; j:=0; Repeat Readln(f,buf); if buf>0 then Begin inc(i); Max[i]:=buf; end else Begin Inc(j); min[j]:=buf; end; until eof(f); end; begin assign(f,'D:in.txt'); Assign(f1,'D:OutPut.txt'); Rewrite(f1); Reset(f); Read_Data; for i:=i downto 1 do Begin buf:=Max[i]; J:=min[i]; Writeln(f1,buf); Writeln(f1,j); end; Close(f); Close(f1); end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 28.02.2008, 18:51 Оценка за ответ: 5 Комментарий оценки: огромное спасибо Станіслав Васильович, программа работает!

Отвечает: Denisss Здравствуйте, Sacss! В приложении находится пример с использованием односвязного списка вместо массива. Пример подробно закомментирован. Удачи! Приложение: program q125294; uses Crt; type {Указатель на элемент односвязного списка} PElem = ^TElem; {Элемент односвязного списка} TElem = packed record {Значение} Value: LongInt; {Указатель на следующий элемент} Next: PElem; end; {Функция добавление нового элемента в конец списка} function AddElem(var eLast: PElem; const aValue: LongInt): PElem; var pe: PElem; begin {Получаем память под элемент} GetMem(pe, sizeof(TElem)); {Присваиваем значение} pe^.Value:= aValue; {Добавляем в конец списка} if (eLast <> nil) then begin eLast^.Next:= pe; pe^.Next:= nil; end; {Возвращаем конец списка} AddElem:= pe; end; var F: Text; i: LongInt; pHead, pLast, nHead, nLast, pe: PElem; begin {Очистка экрана} ClrScr; {Инициализация} pHead:= nil; nHead:= nil; pLast:= nil; nLast:= nil; {Открываем файл на чтение} Assign(F, 'file.txt'); Reset(F); {Чтение файла} while not EOF(F) do begin ReadLn(F, i); {Проверка на положительность} if (i > 0) then begin {Добавление в список положительных чисел} pLast:= AddElem(pLast, i); {Если список еще не существует, создаем его} if (pHead = nil) then pHead:= pLast; end else begin {Добавление в список отрицательных чисел} nLast:= AddElem(nLast, i); {Если список еще не существует, создаем его} if (nHead = nil) then nHead:= nLast; end; end; {Закрываем файл} Close(F); {Открываем файл на запись} Assign(F, 'file1.txt'); Rewrite(F); {Перебор элементов списка} while (pHead <> nil) do begin {Запись в файл двух положительных элементов} {Первый} pe:= pHead; {Записываем элемент в файл} WriteLn(F, pe^.Value); {Переходим к следующему элементу} pHead:= pe^.Next; {Высвобождаем память} FreeMem(pe, sizeof(TElem)); {Второй} pe:= pHead; pHead:= pe^.Next; WriteLn(F, pe^.Value); FreeMem(pe, sizeof(TElem)); {Запись в файл двух отрицательных элементов} {Первый} pe:= nHead; nHead:= pe^.Next; WriteLn(F, pe^.Value); FreeMem(pe, sizeof(TElem)); {Второй} pe:= nHead; nHead:= pe^.Next; WriteLn(F, pe^.Value); FreeMem(pe, sizeof(TElem)); end; {Закрываем файл} Close(F); end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ---- Ответ отправлен: 02.03.2008, 13:04 Оценка за ответ: 5

Вопрос № 125.313

Доброе время суток...помогите пожалуйста написать простенькие програмки в турбо паскале( тема: оператор цикла с параметром т.е FOR)... 1)Каждая бактерия делится на две в течение одной минуты.В начальный момент была 1, сколько их станет через 15 мин ? 2)Напечатать таблицу перевода растояний из дюймов в сантиметры)1дюйм=2,54см). От 1 до 50 дюймов все данные расположить в два столбца(один столбец дюймы, второй см)...

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

Отвечает: Зенченко Константин Николаевич Здравствуйте, Danilka! Программа последовательно выполняет обе задачи. Во второй задаче вывод организован таким образом, чтобы таблица была видна полностью. Удачи! Приложение: var i,j:longint; begin { задача I} {в цикле считаем} j:=1; for i:=1 to 15 do j:=j*2; {выводим результат} writeln('Count:',j); readln; { задача II} {в цикле выводим таблицу} for i:=1 to 50 do write((i*2.54):11:2,i:5); readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Шемет Станіслав Васильович Здравствуйте, Danilka! Первая программа: Var i:byte; x:word; begin x:=1; for i:=2 to 15 do x:=x*2; Writeln(x); Readln; end. Вторая: const n=2.54; VAr D:byte; Begin for d:=1 to 50 do Writeln(d,'Дюймов ','=',d*n,'cм'); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 28.02.2008, 23:35 Оценка за ответ: 5

Вопрос № 125.317

Помогите пожалуйста решить несложные школьные задачки в турбо паскале (по теме: оператор цикла с параметром т.е FOR)... 1)Вычислить сумарную площадь десяти квадратов, сторона первого квадрата 2см, каждого следующего на 1см больше. 2)Найти сумму чисел от 1 до 100, подсчитать кол-во чисел чётных и нечётных. Найти отдельно сумму чётныйх и нечётных чисел. 3) Найти сороковой член ряда фенебаче(или как то там)... Заранее спасиьо...

Отправлен: 28.02.2008, 19:53 Вопрос задал: Danilka (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Tribak Здравствуйте, Danilka! program www; const n=4; var i,l,s:integer; begin l:=1; s:=0; for i:=1 to n do begin s:=s+l*l; l:=l+1; end; writeln(s); readln; end. 2)program www; const n=100; var s_chet,s_nechet, s,i,chet,nechet:integer; begin for i:=1 to n do begin if odd(i) then begin chet:=chet+1; s_chet:=s_chet+i; end else begin nechet:=nechet+1; s_nechet:=s_nechet+i; end; s:=s+i; end; writeln('chentih chisel= ',chet); writeln('symma chetnih chisel=',s_chet); writeln('nechentih chisel= ',nechet); writeln('symma nechetnih chisel=',s_nechet); writeln('Obshaya Symma= ',s); readln; end.

Ответ отправил: Tribak (статус: 8-ой класс) Ответ отправлен: 28.02.2008, 20:25 Оценка за ответ: 4

Отвечает: Костя Симанович Здравствуйте, Danilka! По вычислению ряда Фибоначчи могу предложить следующее решение. В приложении. Приложение: program fibonachi; label m1; var n,v,w,r,i,Y:longint; begin writeln('Вычисления ряда чисел Фибоначчи.'); writeln('Число Фибоначчи Fn равно сумме двух предыдущих'); writeln('чисел Fn-1 Fn-2.'); writeln('Ряд чисел Фибоначчи имеет вид: 0;1;1;2;3;5;8;13,21;...'); writeln('Введите порядковы номер n числа Фибоначчи:'); writeln('n=1,2,3,4,5,...'); write('n='); read(n); if n=1 then writeln('Число Фибоначчи с номером n=1: F1=0.'); if n=2 then writeln('Число Фибоначчи с номером n=2: F2=1.'); if n<=2 then goto m1; w:=0; v:=1; i:=2; while i<n do begin r:=v+w; w:=v; v:=r; i:=i+1; end; writeln('Число Фибоначчи с заданным номером ', n, ' равно: Fn=', v); m1: writeln('Для выхода из программы введите число 1.'); readln(y); end.

Ответ отправил: Костя Симанович (статус: 1-ый класс) Ответ отправлен: 28.02.2008, 21:11 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, Danilka! Все 3-и задачи в приложении. Программа выполняет их последовательно. ps:числа Фибоначчи Удачи! Приложение: var d,e,i:integer; a,b,c:longint; begin { задача I } a:=0; for i:=2 to 11 do a:=a+ i*i; writeln(a); readln; { задача II } a:=0; b:=0; c:=0; d:=0; e:=0; for i:=1 to 100 do begin if (i mod 2)=1 then begin inc(b,i); inc(d); end else begin inc(e); inc(c,i); end; inc(a,i); end; writeln('вся:',a:23); writeln('нечет: ',b:10,d:10); writeln('чет: ',c:12,e:10); readln; { задача III } a:=1; b:=0; for i:=1 to 39 do begin write(a:10); c:=b; b:=a; a:=b+c; end; write(a:10); end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Шемет Станіслав Васильович Здравствуйте, Danilka! В 3примере первый элемент ряда Фибоначчи равен 1, второй 2, третий 3,четвертый 5,.... Приложение: Var i:byte; s:word; Begin s:=0; For i:=2 to 11 do s:=s+i*i; writeln(s); Readln; end. ----------------------------------------------------------- const n=100; VAr S,S1,s2,c1,c2:word; I:byte; Begin s:=0; s1:=0; s2:=0; c1:=0; c2:=0; For i:=1 to n do s:=s+i; for i:=1 to n do if i mod 2 =0 then begin s1:=s+i; inc(c1); end; For i:=1 to n do if i mod 2 <>0 then begin inc(c2); s2:=s2+i; end; Writeln('кол-во чисел чётных ',c1); Writeln('кол-во чисел нечётных ',c2); Writeln('суммa чётных ',s1); Writeln(сумму нечётных ',s2); Readln; end. ----------------------------------------------------------------- var X,y:Real; i:byte; Begin x:=1; y:=2; for i:=3 to 39 do Begin x:=x+y; y:=x+y; end; Writeln(x); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 29.02.2008, 00:06 Оценка за ответ: 5

Вопрос № 125.353

Уважаемые эксперты помогите решить задачу : "Дана матрица. Упорядочить ее строки по не убыванию сумм элементов строк."

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

Отвечает: Delph Здравствуйте, Sacss! В приложении решение Вашей задачи. Если захотите что-либо уточнить, пишите в минифорум. Приложение: Program Pr125353; Const N = 10; { Размерность матрицы. Для простоты матрица квадратная } Var Matrix : Array[1..N, 1..N] of Integer; { Наша матрица } SumVekt: Array[1..N] of Integer; { Вектор сумм строк } i, j, k, r: Integer; Begin Randomize; WriteLn('Исходная матрица с указанием сумм по каждой строке:'); for i := 1 to N do begin SumVekt[i] := 0; for j := 1 to N do begin Matrix[i, j] := Random(100); { заполняем ячейку матрицы } Write(Matrix[i, j]: 3); { отображаем ячейку на экране } { И сразу прибавляем ячейку к сумме строки } SumVekt[i] := SumVekt[i] + Matrix[i, j]; end; { Отображаем сумму строки } WriteLn(' ==> ', SumVekt[i]: 4); end; WriteLn; { Сортируем строки матрицы по возрастанию их сумм } for i := 1 to N - 1 do for j := i + 1 to N do if SumVekt[j] < SumVekt[i] then begin for k := 1 to N do begin r := Matrix[i, k]; Matrix[i, k] := Matrix[j, k]; Matrix[j, k] := r; end; r := SumVekt[i]; SumVekt[i] := SumVekt[j]; SumVekt[j] := r; end; WriteLn('Матрица после сортировки:'); for i := 1 to N do begin for j := 1 to N do Write(Matrix[i, j]: 3); WriteLn(' ==> ', SumVekt[i]: 4); end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 29.02.2008, 09:05 Оценка за ответ: 5

Вопрос № 125.404

Уважаемые эксперты,пытаюсь освоить turbo paskal по самоучителю Попова В.Б.,скажите,что здесь не правильно. program Tutor1; var A,B/Summa:intrger; begin Write(2); Readln(A); Write(2); Readln(B); Summa:=A+B; Write(4); end.

Отправлен: 29.02.2008, 11:34 Вопрос задал: Brodjaga (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Delph Здравствуйте, Brodjaga! Во первых - Вы не используете значение переменной Summa при последнем операторе Write. Во вторых, в самом конце программы имеет смысл поставить ReadLn, чтобы программа дала Вам возможность посмотреть на результат вычислений. Исправленный вариант в приложении. После того, как программа отобразит сумму, для её окончания достаточно нажать Enter. Исправлено по просьбе автора ответа. ----- ∙ Отредактировал: Зенченко Константин Николаевич (Профессионал) ∙ Дата редактирования: 29.02.2008, 12:00 Приложение: program Prog1; var a, b, Summa: Integer; begin Write('a = '); ReadLn(a); Write('b = '); ReadLn(b); Summa := a + b; WriteLn('Summa = ', Summa); ReadLn; end. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 29.02.2008, 11:47

Отвечает: Зенченко Константин Николаевич Здравствуйте, Brodjaga! A,B/,Summa:intreger; Удачи! --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Отвечает: Шемет Станіслав Васильович Здравствуйте, Brodjaga! program Tutor1; var A,B/Summa:intrger;(*вместо єтой строки надо написать:A,B,Summa:integer;*) begin Write(2); Readln(A); Write(2); Readln(B); Summa:=A+B; Write(4); Readln;(*программа будет ждать пока кто то не нажмет "Enter"после чего завершит свою работу*) end. Здесь токо одна ошибка, вы б лутше сказали что должно делать программа может ошибка в алгоритме работы программы. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станіслав Васильович (статус: 3-ий класс) Ответ отправлен: 29.02.2008, 12:15

Отвечает: Евчик Сергей Александрович Здравствуйте, Brodjaga! Гм... Думаю так будет правильней: program Tutor1; var A,B,Summa:integer; begin Write('2'); Readln(A); Write('2'); Readln(B); Summa:=A+B; Write(summa); end. У вас тут несколько ошибок: Вы неправильно написали integer, если вы хотите вывести что-нибудь на экран, кроме переменных, констант и т.п, надо указывать это в кавычках и все переменные пишутся через запятую. Удачи...

Ответ отправил: Евчик Сергей Александрович (статус: 2-ой класс) Ответ отправлен: 29.02.2008, 19:07

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