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

Выпуск № 613
от 25.03.2008, 23:05

Вопрос № 128.228

Дана действительная квадратная матрица порядка n. Преобразовать матрицу по следующему правилу: строку с нмером n сделать столбцом с номером n, а столбец с номером n - строкой с номером n. Нужно решить эту задачу с помощью двумерных массивов.

Отправлен: 20.03.2008, 07:19 Вопрос задал: Cobain (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Delph Здравствуйте, Cobain! Программа в приложении. Заполняется матрица при помощи генератора случайных чисел Random. Формула 20 * Random - 10 даёт случайные числа в диапазоне (-10; +10) (точные границы диапазона никогда не выдаются). Приложение: Program Pr128228; Uses CRT; Const N = 8; Var Matrix: Array[1..N, 1..N] of Real; r: Real; i, j: Integer; Begin ClrScr; Randomize; WriteLn('Исходная матрица:'); for i := 1 to N do begin for j := 1 to N do begin Matrix[i, j] := 20 * Random - 10; Write(Matrix[i, j]:8:4); end; WriteLn; end; WriteLn; for i := 1 to N do begin r := Matrix[i, N]; Matrix[i, N] := Matrix[N, i]; Matrix[N, i] := r; end; WriteLn('Преобразованная матрица:'); for i := 1 to N do begin for j := 1 to N do Write(Matrix[i, j]:8:4); WriteLn; end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 20.03.2008, 08:00 Оценка за ответ: 4

Отвечает: Петрова Анастасия Андреевна Здравствуйте, Cobain! Напишу просто алгоритм.Там будет две матрицы исходная А и результативная С.Вы задаете две одинаковые матрицы.производите все что хотите с ними вводите с клавиатуры или нет.А когда захотите перевернуть матрицу А то просто вставьте этот алгоритм и получите матрицу С. Приложение: for i :=1 to n do for j:=1 to n do c[j,i]:=a[i,j];

Ответ отправила: Петрова Анастасия Андреевна (статус: 1-ый класс) Ответ отправлен: 20.03.2008, 08:21

Отвечает: Пупорев Юрий Борисович !!! Здравствуйте, Cobain! В приведенном выше решении транспонируется вся матрица, а вам нужно поменять только последний столбуц с последней строкой. Вы пишите, что нужно использовать двумерные массивы. Скорее всего вы оговорились и по условию можно использовать два одномерныз массива. Хотя эту перестановку можно сделать вообще без использования дополнительных массивов. В первом варианте я привожу решение без использования допонительных массивов,во втором варианте с использованием дополнительных массивов. Выбирайте. Решение в приложении. В условии задачи сказано: "Дана действительная квадратная матрица...". Вы же используете целочисленную. Читайте задание внимательнее. ----- ∙ Отредактировал: Denisss (Профессионал) ∙ Дата редактирования: 20.03.2008, 10:11 Приложение: uses crt; var a:array[1..50,1..50]of integer; n,i,j,x:integer; begin clrscr; randomize; write('n=');readln(n); writeln('Ishodnaia 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; readln; for i:=1 to n do begin x:=a[i,n];a[i,n]:=a[n,i];a[n,i]:=x; end; writeln('Preobrazovannaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin write(a[i,j]:3); end; writeln; end; readln; end. uses crt; var a:array[1..50,1..50]of integer; b,c:array[1..50]of integer; n,i,j,x:integer; begin clrscr; randomize; write('n=');readln(n); writeln('Ishodnaia 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; readln; for i:=1 to n do b[i]:=a[i,n]; for j:=1 to n do c[j]:=a[n,j]; for i:=1 to n do a[i,n]:=c[i]; for j:=1 to n do a[n,j]:=b[j]; writeln('Preobrazovannaia matrica:'); for i:=1 to n do begin for j:=1 to n do begin write(a[i,j]:3); end; writeln; end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 9-ый класс) Ответ отправлен: 20.03.2008, 08:24

Вопрос № 128.244

Дана строка, содержащая текст, заканчивающийся точкой. Вывести на экран слова, содержащие три буквы. (Решить данную задачу используя строковые прочедуры и функции) Приложение: Решить данную задачу используя строковые прочедуры и функции.

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

Отвечает: Костя Симанович Здравствуйте, Попов Александр Олегович! Решение ищет слова содержащие 3 буквы до первой точки. если надо разобрать и второе предложение после точки (мало ли) пишите доработаю. один из вариантов решения в приложении. Удачи. Приложение: program stroki; var st : string; pod : string[1]; i : integer; l : integer; m : integer; a : boolean; begin a := true; m := 0; l := 0; writeln('wwedite stroku'); readln(st); m := pos('.', st); {ищем точку в строке} if m = 0 then writeln('tochki ne obnarugeno') else for i := 1 to m do begin pod := copy(st, i, 1); if (pod = ' ') or (pod = '.') then begin if l = 3 then begin writeln(copy(st, i-3, 3)); l := 0; a := false; end else l := 0; end else l := l + 1; end; if a then writeln('w stroke net elenentow s 3 simwolami'); readln; end.

Ответ отправил: Костя Симанович (статус: 2-ой класс) Ответ отправлен: 20.03.2008, 13:30

Вопрос № 128.279

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

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

Отвечает: Verena Здравствуйте, Мантуров С.Ю.! Поскольку из Вашего условия не ясно, надо ли найти длину первой такой последовательности, или она только одна, или надо найти длины всех, я реализовала последний вариант - из него можно получить любой другой. Проверку на принадлежность символа к цифрам я произвожу с помощью оператора in и множества '0'..'9' - так эта проверка выглядит наиболее компактно. Код с комментариями в приложении. Удачи! Приложение: Const c: set of char = ['0'..'9']; {Множество - цифры в символьном представлении} Var str: string; j, i: integer; Begin readln (str); {Получаем строку} i:= 1; while i<=length (str) do {Пока не конец строки} if str[i] in c then {Если текущий символ содержится в множестве с (если это цифра)} begin j:= i+1; {Начиная со следующего символа} while (j<=length(str)) and (str[j] in c) do inc (j); {Движемся по строке, пока она не кончится или очередной символ окажется буквой} writeln (j-i); {Выводим количество идущих вподряд цифр} i:= j+1; {Перескакиваем последовательность цифр и продолжаем искать такие последовательности в строке} end else inc (i); {Иначе просто переходим следующему символу} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.03.2008, 16:32

Вопрос № 128.307

здаравствуйте! немогу зделать задачу! помогите пожалуйсята! задача на тему обработка символьной информации звучит так: найти количество шипящих букв в каждом слове предложения и определить слово в котором етих букв больше

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

Отвечает: Louken Здравствуйте, коваль максим владимирович! Программа в приложении. Только вот я не помню какие буквы являются шипящими, это Вам придется дописать самому, т.е. заполнить множество cChar. Приложение: program z; uses Crt; {Множество шипящих букв, заглавные и строчные} const cChar: set of char = ['С', 'с', 'Ш', 'ш', 'Щ', 'щ' ]; var s,sl,slmax: string; k,kmax,i: integer; begin ClrScr; Writeln('Vvedite stroku: '); Readln(s); kmax:=0; {Удаляем лишние пробелы - двойные, в начале и в конце строки} While Pos(' ',s)>0 do Delete(s,Pos(' ',s),1); if s[1]=' ' then Delete(s,1,1); if s[Length(s)]=' ' then Delete(s,Length(s),1); Writeln; While s<>'' do begin if Pos(' ',s)>0 then begin sl:=Copy(s, 1, Pos(' ', s)-1); Delete(s, 1, Pos(' ', s)); end else begin sl:=s; s:=''; end; {Нашли очередное слово - sl} Write(sl); k:=0; for i:=1 to Length(sl) do {Узнаем сколько "шипящих" букв в слове} if sl[i] in cChar then Inc(k); Writeln(' = ',k); if k>kmax then begin kmax:=k; slmax:=sl; end; end; Writeln; Writeln('max: ',slmax); Readln; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 20.03.2008, 18:53

Вопрос № 128.309

даравствуйте! немогу зделать задачу! помогите пожалуйста! задача на тему обработка символьной информации звучит так: в каждом слове введённого предложения определить три символа которые встречаются больше всево раз

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

Отвечает: Delph Здравствуйте, коваль максим владимирович! По сложности Ваша задачка смахивает на подготовительную к олимпиаде. Мне пришлось воспользоваться подпрограммой, внутрь которой я зашил разбор каждого отдельного слова, иначе программа стала бы вообще неудобочитаемой. Приложение: Program Pr128309; Uses CRT; Type TCharsCount = Record ch: Char; Cnt: Byte; End; { Разбор слова в предложении } Procedure WordScan(str: String); var CharsCount : Array[0..255] of TCharsCount; i, j : Integer; tmp : TCharsCount; begin { Обнуление счётчиков и заполнение символов массива } for i := 0 to 255 do begin CharsCount[i].ch := Chr(i); CharsCount[i].Cnt := 0; end; { Подсчитываем частоту символов } for i := 1 to Length(str) do inc(CharsCount[ord(str[i])].Cnt); { Сортируем массив по убыванию частоты символов } for i := 0 to 254 do for j := i + 1 to 255 do if CharsCount[i].Cnt < CharsCount[j].Cnt then begin tmp := CharsCount[i]; CharsCount[i] := CharsCount[j]; CharsCount[j] := tmp; end; WriteLn; WriteLn('Самые частые символы в слове "', str, '": '); for i := 0 to 2 do WriteLn('"', CharsCount[i].ch, '": ', CharsCount[i].Cnt, ' раз(а)'); end; Var Str, s: String; i: Integer; Begin ClrScr; WriteLn('Введите предложение, разделяя слова пробелами: '); ReadLn(str); s := ''; str := str + ' '; { завершающий пробел - для анализа последнего слова } for i := 1 to Length(str) do if str[i] <> ' ' then s := s + str[i] else begin if s <> '' then WordScan(s); s := ''; end; ReadLn; End. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: Студент) Ответ отправлен: 21.03.2008, 09:30

Вопрос № 128.310

Ребята,большая просьба! Прогарамма в текстовом режиме паскаль Вычислить произведение элементов массива M[i,j] с нечетными номерами M[i,j]=sin a [i]/b sqr [j] + cos b [j]/sqrt a a i (0.3;1;2.4;3.5) b j (0.5;-0.5;1.7;7) Массивы а и b вводятся с клавиатурыжмассив и произведение элементов с нечетным номером вывести на экран монитора Сделать заставку используя модули wincrt Заранее спс))

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

Отвечает: Verena Здравствуйте, AHAPX! Как я понимаю, размерность массивов a и b одинаковая (иначе задача теряет смысл), и мы ищем произведение таких элементов полученной матрицы, у которых оба индекса - нечётные. Решение в приложении, думаю, всё ясно из комментариев, задача несложная. Удачи! Приложение: Var a, b: array [1..20] of real; m: array [1..20, 1..20] of real; i, j, n: integer; pr: real; Begin writeln ('Chislo elementov v massivah a i b: '); readln (n); {Ввод информации} writeln ('Massiv a?'); for i:=1 to n do readln (a[i]); writeln ('Massiv b?'); for i:=1 to n do readln (b[i]); for i:=1 to n do {Формируем матрицу по заданной формуле} for j:=1 to n do m[i,j]:= sin(a[i])/sqr(b[i]) + cos (b[j])/sqrt (a[i]); writeln; {Выводим матрицу (дейсвительные числа выводим форматированно)} for i:=1 to n do begin for j:=1 to n do write (m[i,j]:3:3, ' '); writeln; end; i:=1; j:=1; pr:=1; while i<=n do {Идём по нечётным индексам матрицы} begin j:=1; while j<=n do begin pr:= pr*m[i,j]; {Считаем произведение} inc (j,2); {Для нечётности добавляем 2} end; inc (i, 2); end; writeln ('Proizvedenie = ', pr:3:3); {Выводим результат} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.03.2008, 23:28 Оценка за ответ: 5 Комментарий оценки: Спасибо большое

Вопрос № 128.323

Помогите написать 4 программы в Turbo Pascal. 1) Удалить все элементы массива значения которых больше введённого числа. 2) Вставить "1" перед каждым четным элементом массива. 3) Переставить наименьший и послндний элементы массива местами (массив не содержит повторяющиеся элементы). 4) Заданны 2 массива одинаковой размерности. Отсортировать элементы каждого массива по возрастанию методм объмена используя только один цикл.

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

Отвечает: Verena Здравствуйте, Ханов Анатолий Юрьевич! Решила только первые три задачи - четвёртая мне не понятна, я не знаю ни одного метода сортировки с использованием одного цикла... В первой и третьей задачах, думаю, всё будет ясно из комментариев, а вот про вторую расскажу подробнее. Во-первых, из задания однозначно не ясно, нужно ли вставлять 1 перед чётными по значению элементами или чётными по положению в массиве. Я на всякий случай напишу оба решения, выберете нужное. Но для задачи на чётность значений никаких интересных решений особо не придумать, а вот задача на чётные индексы интересней. Такую задачу можно решить по-разному. Например, можно в лоб написать процедуру вставки элемента в массив и повставлять единицы на нужные места, но это не особо хорошее решение, поскольку будет неоправданно много проходов по массиву. Можно сдвигать каждый кусочек массива сразу на конечное количество мест, это можно было бы реализовать через вложенные циклы. Я выбрала другой подход: цикл в программе будет только один, зато будет дополнительная переменная-счётчик и два индекса. Можно легко проверить, что количество элементов в массиве увеличится на n div 2 (n целочисленно пополам), пожтому мы можем начать заполнять массив с его хвоста. Устанавливаем один индекс (j) на старый конец массива (на n), а другой (i) - на новый (n+n div 2). Тогда мы можем на каждой итерации цикла просто переписывать i-й элемент на j-ое место, отслеживая момент, когда в массив нужно дописать единицу. Этот момент мы будем отслеживать с помощью счётчика k - вписывать единицу нам нужно через каждые д ва шага (это условие не всегда выполняется только в конце массива, поскольку число элементов может быть как чётным, так и нечётным - в зависимости от этого начальным значением счётчика у нас будет либо 1, либо 0. В общем, смотрите решения в приложении. Удачи! Приложение: {#1} Var a: array [1..20] of integer; i, j, n, k: integer; Begin readln (n); {Ввод информации} for i:=1 to n do readln (a[i]); readln (k); i:=1; while i<=n do {Цикл по массиву с изменяющимся числом элементов} begin if (a[i]>k) then {Если элемент больше числа} begin for j:=i to n-1 do {Удаляем его, т.е. сдвигаем следующие элементы массива на 1 позицию влево} a[j]:= a[j+1]; dec (n); {Уменьшаем число элементов} end else inc (i); {Иначе наращиваем индекс} end; writeln; for i:=1 to n do write (a[i]:5); {Выводим рещультат} end. {#3} Var a: array [1..20] of integer; i, j, n, k, imin: integer; Begin readln (n); {Ввод данных} for i:=1 to n do readln (a[i]); imin:=1; {Первый элемент принимаем за минимальный} for i:=2 to n do if a[i]<a[imin] then imin:= i; {Если встречаем меньший - пересохраняем} k:= a[n]; {Меняем местами найденный с последним} a[n]:= a[imin]; a[imin]:= k; writeln; for i:=1 to n do write (a[i]:5); {Выводим результат} end. {Задача 2 при условии, что нужно вставлять 1 перед элементами с чётными индексами} Var a: array [1..20] of integer; i, j, n, n1, k: integer; Begin readln (n); {Ввод данных} for i:=1 to n do readln (a[i]); n1:= n + n div 2; {Вычисляем будущую размерность} i:= n1; j:= n; {Устанавливаем индексы} if (n mod 2<>0) then k:=0 else k:=1; {Устанавливаем флажок-счётчик} while j>=1 do {Пока не дойдём до начала массива} begin if (k=2) then begin a[i]:= 1; k:=0; end {Если два шага было - надо вставить 1 и обнулить счётчик} else begin a[i]:= a[j]; dec (j); inc (k); end; {Иначе переписываем элементы, уменьшаем индекс старого массива, наращиваем счётчик} dec (i); {Уменьшаем индекс нового массива} end; writeln; {Выводим результат} for i:=1 to n1 do write (a[i]:3); end. {Задача 2 при условии, что нужно вставлять 1 перед элементами с чётными значениями} Var a: array [1..20] of integer; i, j, n, n1, k: integer; Begin readln (n); {Ввод данных} for i:=1 to n do readln (a[i]); i:= 1; while i<=n do {Идём по массиву с изменяюейся длиной} begin if (a[i] mod 2 = 0) then {Если число чётное} begin for j:=n+1 downto i+1 do {Сдвигаем все числа после него на 1 вправо} a[j]:= a[j-1]; inc (n); {Увеличиваем длину массива} a[i]:=1; inc (i); {Вписываем 1 и наращиваем индекс, чтобы пропустить уже проверенное число} end; inc (i); {Наращиваем счётчик} end; writeln; for i:=1 to n do write (a[i]:3); end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Практикант) Ответ отправлен: 20.03.2008, 23:04 Оценка за ответ: 5

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ханов Анатолий Юрьевич! Задачу №1 можно решить по другому, не говорю, что лучше. Просто не пропадать же добру. Приложение: program udl_cisl; uses Crt; const n=10; var a:array[1..n] of integer; k,i,j,p,x:integer; begin ClrScr; randomize; write('k=');readln(k); for i:=1 to n do begin a[i]:=random(20); write(a[i],' '); end; readln; for i:=1 to n-1 do begin p:=0; for j:=1 to n-1 do if a[j]<k then {сортируем массив} begin x:=a[j]; a[j]:=a[j+1]; a[j+1]:=x; p:=p+1; end; end; for i:=n-p to n do {обрубаем лишнее} write(a[i],' '); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 9-ый класс) Ответ отправлен: 20.03.2008, 23:16 Оценка за ответ: 5

Отвечает: Зенченко Константин Николаевич Здравствуйте, Ханов Анатолий Юрьевич! Последняя задача в приложении. В сортировке методом обмена должно использоватся 2-а цикла. Чтобы не выходить за рамки условия задачи, внешний цикл заменяем рекурсией. Процедура Sort будет вызывать сама себя, каждый раз когда во внутреннем цикле встретится не упорядоченная пара соседних элементов массива. Выход из рекурсии происходит когда при очередной проверке элементов массива все они будут упорядоченны по возрастанию. Если будут вопросы по программе обращайтесь в мини-форум. Удачи! Приложение: const n=10; type mass=array[1..n]of integer; var a,b:mass; i:integer; {процедура будет вызыватся рекурсивно} procedure Sort(var aa:mass); var i,j:integer; begin {запускаем цикл проверки} for i:=1 to n-1 do if aa[i]>aa[i+1] then begin {обмениваем соседние элементы массива} j:=aa[i]; aa[i]:=aa[i+1]; aa[i+1]:=j; {вызываем саму себя с новым расположением элементов массива} Sort(aa); end; {сортировка закончилась} end; begin randomize; {массивы создаются с помощью генератора случайных чисел и выводятся сразу} write('A:'); for i:=1 to n do begin a[i]:=random(30); write(a[i]:3); end; writeln; write('B:'); for i:=1 to n do begin b[i]:=random(30); write(b[i]:3); end; writeln; writeln; {сортируем первый массив} Sort(a); {выводим результат сортировки первого массива} write('A:'); for i:=1 to n do write(a[i]:3); writeln; {сортируем второй массив} Sort(b); {выводим результат сортировки второго массива} write('B:'); for i:=1 to n do write(b[i]:3); writeln; readln; end. --------- И только наступив на грабли мы приобретаем драгоценный опыт!

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

Вопрос № 128.331

Дана строка. Подсчитать, сколько символов встречается в ней. Вывести на экран.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Raper! Думаю, что вы неправильно изложили задание, ибо в вашем варианте количество символов равно длине строки. Наверное нужно количество разных символов, тогда код с комментариями в приложении. Приложение: uses crt; var i,k:integer; s:string; m:set of char;{множество символов} begin clrscr; write('stroka: ');readln(s); m:=[];{пустое множество} for i:=1 to length(s) do include(m,s[i]);{заносим во множество символы строки} k:=0; for i:=1 to 255 do {коды символов} if chr(i)in m then begin k:=k+1; {если есть в строке, считаем} end; writeln('k=',k); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 9-ый класс) Ответ отправлен: 20.03.2008, 22:07

Отвечает: Шемет Станислав Васильевич Здравствуйте, Raper! Var s:string; Begin Readln(s); Write('Количество символов: ',Length(s)); Readln; end. или вот такая программа она не учитывает пробелы и тому подобные символы Var s:string; I:byte; Col:byte; Begin Readln(s); col:=0; for i:=1 to length(s) do if s[i]>#32 then inc(col); Write('Количество символов: ',col); Readln; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 4-ый класс) Ответ отправлен: 20.03.2008, 22:51

Вопрос № 128.332

Дана строка из N символов. Преобразовать её, заменив все двоеточие (, встречающихся среди первых N/2 символов, и заменив точками все восклицательные знаки, встречающихся среди символов, стоящих после N/2 символов.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Raper! Решение простое, поэтому без комментариев, просто по порядку выполняются все действия, оговоренные в условии. Код в придожении. Приложение: uses crt; const n=20; var s:string[n]; i:integer; begin clrscr; write('s:' ); readln(s); for i:=1 to n div 2 do if s[i]=':'then begin delete(s,i,1); insert('(',s,i); end; for i:=n div 2 to n do if s[i]='!'then begin delete(s,i,1); insert('.',s,i); end; write(s); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: 9-ый класс) Ответ отправлен: 20.03.2008, 21:45

Отвечает: Louken Здравствуйте, Raper! Вот мой вариант ответа на Ваш вопрос: Приложение: program z; uses Crt; var s: string; i,n: integer; begin ClrScr; Writeln('Vvedite stroku:'); Readln(s); n:=Length(s); for i:=1 to n div 2 do if s[i]=':' then s[i]:='('; for i:=n div 2+1 to n do if s[i]='!' then s[i]:='.'; Writeln(s); Readln; end.

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 20.03.2008, 22:22

Отвечает: Шемет Станислав Васильевич Здравствуйте, Raper! Программа в приложении Удачи !!! Приложение: Var s:string; i:integer; Begin Readln(s); for i:=1 to length(s) do Begin if ((length(s) div 2)<=i) and (s[i]=':') then s[i]:='.'; if ((length(s) div 2)>i) and (s[i]='!') then S[i]:='.'; end; Writeln(s); Readln; end. --------- Любовь это прекрасно!!!

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

Вопрос № 128.337

1.1.Создать файл данных, каждая запись которого состоит из следующих полей: Поля записи Название книги Автор Год издания Кол. страниц 1.2. Считать из файла информацию, указанную преподавателем, или предложить свою версию для считывания информации. огромное спасибо заранее!!!!!!!!!!!!!!!!!

Отправлен: 20.03.2008, 21:14 Вопрос задал: Перцев Владимир Николаевич Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шемет Станислав Васильевич Здравствуйте, Перцев Владимир Николаевич! Программа в приложении. Удачи!!! Приложение: uses crt; Type Tbooks=record Name:string; Avtor:string; Year:word; Col:word; end; Var Books:Tbooks; F:text; Ch:char; Procedure Write_file; Begin assign(f,'books.txt'); Rewrite(F); Writeln(f,books.name); Writeln(f,books.avtor); Writeln(f,books.year); Writeln(f,books.col); close(f); end; Procedure Read_File; Begin assign(f,'books.txt'); Reset(F); Readln(f,books.name); Readln(f,books.avtor); Readln(f,books.year); Readln(f,books.col); close(f); Writeln('Название книги: ',books.Name); Writeln('Автор: ',books.avtor); Writeln('Год издания: ',books.year); Writeln('Кол. страниц: ',books.col); end; Procedure Write_books; Begin Write('Название книги: '); Readln(books.name); Write('Автор: '); Readln(books.avtor); Write('Год издания: '); Readln(Books.year); Write('Кол. страниц: '); Readln(books.col); Writeln; end; Begin Repeat clrscr; Writeln; Writeln('1 - Заполнить информацию о книге '); Writeln('2 - Зчитать информацию о книге из файла'); Writeln('3 - Сохранить информацию о книге'); Writeln('Esc - Выход'); Writeln; ch:=Readkey; case ch of '1':Write_books; '2':Read_File; '3':Write_file; end; until ch=#27; end. --------- Любовь это прекрасно!!!

Ответ отправил: Шемет Станислав Васильевич (статус: 4-ый класс) Ответ отправлен: 20.03.2008, 22:59

Отвечает: Пупорев Юрий Борисович Здравствуйте, Перцев Владимир Николаевич! Поскольку ни ваш преподаватель ни вы лично не предложили свою версию о нужной информации, будем считать, что нас интересуют книги, изданные в 2003 году и в которых более 100 страниц. код с комментариями в приложении. Приложение: program knigi; uses crt; const n=10; type kniga=record {тип запись с полями, оговоренными в условии} avtor:string[20]; god:integer; str:integer; end; kn=array[1..n]of kniga; {тип массив записей} var sp:kn; {массив записей} i,j:integer; f:file of kniga; {типизированный файл записей} begin clrscr; for i:=1 to n do begin write('avtor: ');readln(sp[i].avtor); {создаем запись-список} write('god: ');readln(sp[i].god); write('str: ');readln(sp[i].str); end; assign(f,'kniga.txt'); {cоздаем файл} rewrite(f); {открываем его для записи} for i:=1 to n do begin write(f,sp[i]); {записываем данные в файл} end; close(f); {сохраняем файл и открываем его для чтения} reset(f); i:=1; while (not eof(f)) and(i<=n) do begin read(f,sp[i]); {читаем данные из файла в массив записей} inc(i); end; writeln; writeln('Spisok knig 2003 goda >100 str:'); {выводим на экран нужную информацию} for i:=1 to n do if (sp[i].god=2003)and(sp[i].str>100) then begin writeln(sp[i].avtor,' ',sp[i].god,' god ',sp[i].str,' str'); end; readln; end.

Ответ отправил: Пупорев Юрий Борисович (статус: 9-ый класс) Ответ отправлен: 21.03.2008, 10:25

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