РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 610 ∙ повысить рейтинг >>

_Ayl_ Статус: 6-й класс Рейтинг: 421 ∙ повысить рейтинг >>

Micren Статус: Практикант Рейтинг: 332 ∙ повысить рейтинг >>

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

Нам очень важно Ваше мнение об этом выпуске рассылки. Вы можете оценить этот выпуск по пятибалльной шкале, пройдя по ссылке:
оценить выпуск >>

Вопрос № 169388: Здравствуйте, помогите пожалуйста с задачей: "Напишите программу автоматического преобразования неправильных идентификаторов в синтаксически допустимые. Если исходная строка имеет слишком большую длину укоротите ее до допустимого размера...

Здравствуйте, помогите пожалуйста с задачей:

"Напишите программу автоматического преобразования неправильных идентификаторов в синтаксически допустимые. Если исходная строка имеет слишком большую длину укоротите ее до допустимого размера путем отбрасывания избыточных литер, если она пуста добавьте букву X. Если первая литера не является буквой то вставьте перед ней букву X. Если в строке присутствуют какие то “незаконные” литеры удалите их."

Все что смог сделать, в приложении.

Отправлен: 14.06.2009, 14:51
Вопрос задал: Антон Аз, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const bk=[\'A\'..\'Z\',\'a\'..\'z\'];{буквы латинского алфавита} ds=[\'0\'..\'9\',\'_\',\'A\'..\'Z\',\'a\'..\'z\'];{все допустимые символы} var s:array[1..100] of string;{массив строк} n,i,j:integer; begin clrscr; write(\'Количество строк n=\'); readln(n); writeln(\'Введите \',n,\' строк:\'); for i:=1 to n do readln(s[i]);{вводим строки} for i:=1 to n do{преобразуем} begin if length(s[i])>63 then{если длина больше 63, обрезаем} s[i]:=copy(s[i],1,63); if s[i]=\'\' then s[i]:=\'X\';{если пустая-пишем Х} if not(s[i][1] in bk) then{если первая не буква, вставляем Х} insert(\'X\',s[i],1); for j:=length(s[i])downto 1 do{идем с конца строки} if not(s[i][j] in ds) then{если недопустимый символ, удаляем его} delete(s[i],j,1); end; writeln(\'Восстановленные идентификаторы:\'); for i:=1 to n do writeln(s[i]); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 15.06.2009, 08:11

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250953 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Записать в фаил N чисел , введенных с клавиатуры.Считать из фаила эти числа и наити произведение нечетных чисел.

Отправлен: 14.06.2009, 15:26
Вопрос задал: prostak, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
program readwrite; uses crt; {Функция для определения чётности числа} function bIsEven(iNumber : integer) : boolean; var iR : integer; begin bIsEven := false; iR := iNumber mod 2; {Если остаток от деления числа на 2 равен нулю, то оно чётное} if iR = 0 then bIsEven := true; end; var iCounter : integer; {Счётчик строк в файле} iNumber : integer; {Вводимое число} iProduct : integer; {Произведение} iNumbers : array[0 .. 100] of integer; {Массив для хранения чисел, считанных из файла} NumbersFile : text; {Переменная для доступа к текстовому файлу} begin assign(NumbersFile, \'File.txt\'); {Связываем переменную с реальным файлом на диске} writeln(\'Вводите по одному положительные целые числа.\'); writeln(\'Для завершения ввода введите 0 (ноль).\'); rewrite(NumbersFile); {Открываем файл для записи} repeat write(\': \'); readln(iNumber); {Записываем в файл введённые числа, не равные нулю} if iNumber <> 0 then writeln(NumbersFile, iNumber); until iNumber = 0; {Если число ноль, завершаем ввод} close(NumbersFile); {Закрываем файл} writeln; writeln(\'Числа записаны в файл успешно.\'); reset(NumbersFile); {Открываем файл для чтения} writeln; writeln(\'Читается файл...\'); iCounter := 0; iProduct := 1; {1 * число равно число} while not eof(NumbersFile) do {Пока не достигнут конец файла} begin {Построчно считываем числа из файла} readln(NumbersFile, iNumbers[iCounter]); {Если число чётное, умножаем его} if bIsEven(iNumbers[iCounter]) = true then iProduct := iProduct * iNumbers[iCounter]; {Увеличиваем счётчик строк} iCounter := iCounter + 1; end; close(NumbersFile); {Закрываем файл} write(\'Произведение введённых чисел равно \'); writeln(iProduct); end. Казахстан, Алма-Ата
Организация: Казахский научный центр карантинных и зоонозных инфекций
Адрес сайта: Медицинские программы для Linux
ICQ # 256452186

Ответ отправил: Dr_Andrew, Модератор
Ответ отправлен: 14.06.2009, 17:44

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250940 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте!
Помогите справиться с задачкой. Текст задания в приложении.

Отправлен: 15.06.2009, 13:34
Вопрос задал: Reresana, 1-й класс
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; function Evclid(x,y:integer):integer; begin repeat if x>y then x:=x mod y else y:=y Mod x; until (x=0) or (y=0); Evclid:=x+y; end; var a,b,p,q:integer; begin clrscr; write(\'a=\');readln(a); write(\'b=\');readln(b); p:=a div Evclid(a,b); q:=b div Evclid(a,b); write(a,\'/\',b,\'=\',p,\'/\',q); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 15.06.2009, 15:12

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250983 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Даны два слова. Определить, сколько начальных букв первого слова совпадает с начальными буквами второго слова.

Отправлен: 15.06.2009, 06:16
Вопрос задал: Иванов Виктор Олегович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
{ Даны два слова. Определить, сколько начальных букв первого слова совпадает с начальными буквами второго слова. } Program Words; Var word1, word2 : string; i : Byte; k : Byte; l : Byte; Begin write (\'Введите первое слово: \'); readln (word1); write (\'Введите второе слово: \'); readln (word2); k := 0; l := length (word1); if l > length (word2) then l := length (word2); for i := 1 to l do if word1 [i] = word2 [i] then Inc (k) else break; if k = 0 then writeln (\'Совпадающих букв в началах слов не обнаружено\') else writeln (\'Количество совпадающих букв в началах слов равно \', k); End.

Ответ отправил: _Ayl_, 6-й класс
Ответ отправлен: 15.06.2009, 10:05

Оценка ответа: 5
Комментарий к оценке:
Огромное спасибо! Благодарю Вас!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250959 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

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

Отправлен: 15.06.2009, 06:17
Вопрос задал: Иванов Виктор Олегович, Посетитель
Всего ответов: 1
Страница вопроса >>

Приложение:
var in_str: string; temp: char; i, j: integer; pr, pr_temp: boolean; begin readln(in_str); {ввод строки} pr:= false; {основной признак } i:= 1; while not pr and (i < Length(in_str) - 3) do {перебор символов до наличия совпадения} begin temp:= in_str[i]; pr_temp:= true; {вспомогательный признак} j:= i+1; while pr_temp and (j < i + 5) do begin if temp <> in_str[j] then pr_temp:= false; Inc(j); end; Inc(i); if pr_temp then pr:= true; {при совпадении 5-и символов перебрасываем основной признак} end; if pr then writeln(\'yes\') else writeln(\'no\'); readln; end.

Ответ отправил: Шичко Игорь, Практикант
Ответ отправлен: 15.06.2009, 10:24

Оценка ответа: 5
Комментарий к оценке:
Огромное Вам спасибо! Все работает! Благодарю Вас!

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250962 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте!
Помогите пожалуйста с задачкой по Златопольскому 13,39 (а).

Отправлен: 15.06.2009, 13:56
Вопрос задал: Reresana, 1-й класс
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const n=20; type sotr=record {тип-запись с полями по условию} fam:string[20]; zrp:integer; pol:char; end; var st:array[1..n] of sotr;{массив записей} mx:integer; i,imx,k:byte; begin clrscr; writeln(\'Введите данные о сотрудниках:\'); for i:=1 to n do begin writeln(\'Сотрудник \',i); write(\'Фамилия: \');readln(st[i].fam); write(\'Зарплата: \');readln(st[i].zrp); repeat write(\'Пол (м,ж): \');readln(st[i].pol); until st[i].pol in [\'м\',\'ж\']; end; clrscr; writeln(\'Список сотрудников:\'); writeln(\'----------------------------\'); writeln(\'| Фамилия | Зарплата |Пол|\'); writeln(\'----------------------------\'); mx:=0;imx:=0;k:=0; for i:=1 to n do begin if (st[i].zrp>mx)and(st[i].pol=\'м\') then{если з/п больше макс и пол мужской} begin k:=1;{фиксируем} mx:=st[i].zrp; imx:=i;{его индекс в массиве} end; gotoXY(1,whereY);{заносим массив в таблицу} write(\'| \',st[i].fam); gotoXY(13,whereY); write(\'| \',st[i].zrp); gotoXY(24,whereY); write(\'| \',st[i].pol); gotoXY(28,whereY); write(\'|\'); writeln; end; writeln(\'----------------------------\'); if k=0 then write(\'Мужчин нет!\') else write(\'Самую высокую зарплату среди мужчин имеет \',st[imx].fam); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 15.06.2009, 14:55

Оценка ответа: 5
Комментарий к оценке:
Спасибо большое! :)

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250981 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте!
Помогите пожалуйста с задачкой.

-В слове имеются только две одинаковые буквы. Найти их.

Отправлен: 15.06.2009, 13:59
Вопрос задал: Reresana, 1-й класс
Всего ответов: 1
Страница вопроса >>

Приложение:
Бесплатный вопрос № 169425 -В слове имеются только две одинаковые буквы. Найти их. uses crt; var s:string; i,j:byte; begin clrscr; write(\'Слово: \'); readln(s); for i:=1 to length(s)-1 do{идем по символам слова} begin for j:=i+1 to length(s) do{смотрим дальше за ними} if s[i]=s[j] then{если нашли одинаковый} begin writeln(\'Эта буква \',s[i]);{это он} readln;{читаем} exit;{завершаем программу} end {если дошли до предпоследнего символа, и последний ему не равен, значит одинаковых нет} else if (i=length(s)-1)and(s[i]<>s[j])then write(\'В слове нет одинаковых букв!\'); end; readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 15.06.2009, 14:18

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250979 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Здравствуйте!
Помогите пожалуйста составить программу.

Отправлен: 15.06.2009, 14:14
Вопрос задал: Reresana, 1-й класс
Всего ответов: 1
Страница вопроса >>

Приложение:
uses crt; const m=25;{размеры матрицы-зала} n=36; var a:array[1..m,1..n] of byte;{матрица} i,j,k:byte; begin clrscr; randomize; for i:=1 to m do begin for j:=1 to n do begin a[i,j]:=random(2);{числа 0 и 1} if (i=12)and(a[i,j]=1) then{нужные на места выделим красным цветом, а то матрица большая плохо видно} begin textcolor(12); write(a[i,j]:2); end else begin textcolor(15);{остальные по умолчанию, обычно белый} write(a[i,j]:2); end; end; writeln; end; k:=0; for i:=1 to n do if a[12,i]=1 then k:=k+1;{считаем количество единиц в 12 строке матрицы} writeln(\'В 12-м ряду продано \',k,\' билетов\'); readln end.

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 15.06.2009, 14:00

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 250976 на номер 1151 (Россия) | Еще номера >>

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

подать вопрос экспертам этой рассылки >>