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

Выпуск № 372
от 16.05.2007, 22:05

Вопрос № 86.349

Напишите пожалуйста текст программы я буду очень благодарен!! Текст программы на Паскале хранится в файле на диске. Составить программу обработки текста программы: 1) Подсчитать, какие ключевые слова Паскаля и в каком колличестве использованы в обрабатываемом тексте; 2)Составить перечень имен простых переменных, используемых в левой части оператора присваивания; 3) представить перечень меток программы в алфавитном порядке. Приложение: Ключевые слова!! begin end for to do downto with in if then else procedure function repeat until while const var set of array string label type uses case unit and or nil not

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

Отвечает: Gh0stik Здравствуйте, Makes! в приложении доработанный код, который выполняет условие задачи. Но предупреждаю поскольку стили записей у каждого программиста разные, то код возможно прийдется немного доработать - хотя я старался сделать его универсальным. ;) Каждый пункт программы отмечен соответствующим разделителем. Good Luck!!! Приложение: const n=31; oper:array [1..n] of string= ('begin','end','for','to','do', 'downto','with','in','if','then', 'else','procedure','function','repeat','until', 'while','const','var','set','of', 'array','string','label','type','uses', 'case','unit','and','or','nil','not'); signs:set of char=[':',';','.',' ','[',']','(',')',#0,#9,#13,#15,#20,#31,#32,#34]; var opkol:array [1..n] of integer; i,o,ov,p:integer; s:string; f,rez:text; begin {=======part 1==============} assign(f,'matr.pas'); assign(rez,'rez.txt'); rewrite(rez); ov:=1; for o:=1 to n do begin opkol[o]:=0; reset(f); while not eof(f) do begin readln(f,s); repeat p:=pos(oper[o],s); if p<>0 then begin if (s[p+length(oper[o])] in signs) and (s[p-1] in signs) then inc(opkol[o]); delete(s,p,length(oper[o])); end; until p=0; end; end; for o:=1 to n do writeln(rez,opkol[o]:4,' ',oper[o]); reset(f); {=======part 2==============} writeln(rez,'*** variable ***'); while not eof(f) do begin readln(f,s); if pos('var ',s)<>0 then begin s:=copy(s,pos('var ',s)+4,length(s)-pos('var ',s)+4); writeln(rez,copy(s,1,pos(':',s)-1)); while pos('begin',s)=0 do begin readln(f,s); if pos('begin',s)=0 then writeln(rez,copy(s,1,pos(':',s)-1)); end; end; end; {=======part 3==============} writeln(rez,'*** label ***'); reset(f); while not eof(f) do begin readln(f,s); if pos('label ',s)<>0 then begin s:=copy(s,pos('label ',s)+6,length(s)-pos('label ',s)+6); writeln(rez,s); end; end; close(f); close(rez); end. --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 14.05.2007, 01:51 Оценка за ответ: 5 Комментарий оценки: Спасибо большое братан!!!!

Вопрос № 86.359

Уважаемые эксперты, помогите решить пару задач: 1. Дан массив A длинной n=20. Заменить максимальный по модулю отрицательный элемент нулем. 2. Составить программу печати всех символов заданного текста, входящих в него по одному разу.

Отправлен: 11.05.2007, 00:17 Вопрос задал: DancaN (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Verena Здравствуйте, DancaN! Сложность в первой задаче может представлять разве что то, что за максимум изначально надо брать отрицательный элемент массива. Во второй задаче берём первый символ строки в цикле, запоминаем, удалям из строки, проверяем, есть ли ещё вхождения, если есть - удаляем все, если нет - дописываем символ в ответ. 2. var a: string; {вводимый текст (не больше 255 символов)} b: char; otv: string; begin read (a); otv:=''; {формируемый ответ} while length(a)<>0 do begin b:= a[1]; delete (a, 1, 1); if pos (b, a)=0 then otv:=otv+b {если текущий символ больше в строке не повторяется, дописываем его в ответ} else while pos (b, a)<>0 do delete (a, pos (b, a), 1); {иначе удаляем все вхождения} end; writeln (otv); end. 1. const n=20; var a: array [1..n] of integer; i, max: integer; begin {ввод} for i:=1 to n do if a[i]<0 then begin max:= i; break; end; {берём за максимум первый отрицательный} for i:=1 to n do if (abs(a[max])<abs(a[i])) and (a[i]<0) then max:=i; a[max]:=0; {Вывод} end. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: 10-ый класс) Ответ отправлен: 11.05.2007, 00:39

Отвечает: Устинов С.Е. Здравствуйте, DancaN! 1. Первый вариант: const n=20; var a:array[1..n] of integer; i,m:integer; begin m:=1; for i:=1 to n do readln(a[i]); for i:=2 to n do if a[m] if a[m]<0 then a[m]:=0 else writeln('Otricatelnyh net'); for i:=1 to n do writeln(a[i]); end. В такой реализации будет заменен максимум один элемент на ноль, т.е. если "максимальный по модулю отрицательный элемент" несколько раз встречается в массиве, то будет заменено только первое его вхождение. Если нужно заменять все вхождения "максимального по модулю отрицательного элемента" на ноль, воспользуйтесь следующим решением: const n=20; var a:array[1..n] of integer; i,m:integer; begin m:=1; for i:=1 to n do readln(a[i]); for i:=2 to n do if a[m] if a[m]<0 then begin m:=a[m]; for i:=1 to n do if a[i]=m then a[i]:=0; end else writeln('Otricatelnyh net'); for i:=1 to n do writeln(a[i]); end. 2. Тут все просто - проверяем символы по порядку, если они есть в первом множестве, тогда заносим его во второе, иначе заносим в первое. Таким образом все символы, встречающиеся в тексте более одного раза войдут во второе множество. При выводе каждый символ проверяем - если не входит во второе множество, значит встречается в тексте лишь один раз, и тогда выводим его: var a,b:set of char; s:string; i:integer; begin a:=[]; b:=[]; readln(s); for i:=1 to length(s) do begin if s[i] in a then b:=b+[s[i]] else a:=a+[s[i]]; end; for i:=1 to length(s) do if not(s[i] in b) then write(s[i]); readln; end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Практикант) Ответ отправлен: 11.05.2007, 00:44 Оценка за ответ: 5 Комментарий оценки: Благодарю... Особенно приятно когда в ответе есть пояснения, благодаря которым легко разобраться... еще раз спасибо!

Отвечает: Gh0stik Здравствуйте, DancaN! Вот решения задач: 1) const n=20; var a:array [1..n] of real; mn,i:integer; begin randomize;writeln('***'); for i:=1 to n do begin a[i]:=random(34)*(ord(odd(i))*(-1)+ord(not odd(i))); {генереруем произвольный массив с отрицательными и положительными числами} write(a[i]:7:1);end; writeln; for i:=1 to n do if a[i]<0 then begin mn:=i;break; end; {находим индекс первого отрицательно элемента} for i:=1 to n do if abs(a[mn]) < abs(a[i]) and (a[i] < 0) then mn:=i; {поиск индекса максимального по модулю отрицательного} a[mn]:=0; for i:=1 to n do write(a[i]:7:1); {вывод результата} end. 2) var s:string; s1,s2:set of char; i:integer; begin write('Text: ');readln(s); s1:=[]; s2:=[]; for i:=1 to length(s) do if not (s[i] in s1) then include(s1,s[i]) else if not (s[i] in s2) then include(s2,s[i]); write('Symbol: '); for i:=0 to 255 do if chr(i) in (s1-s2) then write(chr(i)); readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 11.05.2007, 00:45 Оценка за ответ: 4 Комментарий оценки: Спасибо! Приятно что к первой задаче есть пояснения(комментарии). вторая задача более простая, я и сам не плохо разобрался...

Отвечает: Вологин Всеволод Вячеславович Здравствуйте, DancaN! Ну это, я тут накатал по-быстрому прогу. Но это моё решение - не судите строго. Program primer; Uses crt; Var A : array[1..20] of Integer; I,Min : Integer; Count : byte; Begin For i:=1 to 20 do Begin Write('введите ',i,'-й элемент --> '); Readln(A[i]); End; Clrscr; For I:=1 to 20 do Write(A[i] : 3); Count := 0; For i:= 1 to 20 Do If A[i]<0 Then Begin Inc(Count); If Count = 1 then Min := A[i]; If Min < A[i] Then Min := a[i]; End; For I:=1 to 20 do If A[i] = Min Then A[i] := 0; Writeln; For I:=1 to 20 do Write(A[i] : 4); Readkey; End. Постараюсь ответить на 2-й вопрос --------- Это круто - машина состояний с бесконечным циклом

Ответ отправил: Вологин Всеволод Вячеславович (статус: 1-ый класс) Ответ отправлен: 11.05.2007, 10:23 Оценка за ответ: 3 Комментарий оценки: Благодарю, что нашли время и помогли...

Вопрос № 86.478

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

Отправлен: 11.05.2007, 19:50 Вопрос задал: Cimus (статус: Студент) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Gh0stik Здравствуйте, Cimus! Вот решение вашей задачи, проверяете. Программа делает перевод числа из шестнадцатиричной системы счисления в двоичную. const masBin: array[0..15] of string[4]= ('0000','0001','0010','0011', '0100','0101','0110','0111', '1000','1001','1010','1011', '1100','1101','1110','1111'); var c16,c2:string; i:integer; begin write('HEX=');read(c16); c2:=''; for i:=1 to length(c16) do begin case ord(c16[i]) of 48..57: c2:=c2+masBin[ord(c16[i])-48]; //для 0..9 65..70: c2:=c2+masBin[ord(c16[i])-55]; //для A..F 97..102: c2:=c2+masBin[ord(c16[i])-87]; //для a..f end; end; write('BIN=',copy(c2,pos('1',c2),length(c2)-pos('1',c2)+1));//выводим число без ведущих нулей readln; readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессионал) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 11.05.2007, 20:03 Оценка за ответ: 5 Комментарий оценки: Проверить немогу, нет компилятора. За ответ спасибо.

Отвечает: Вологин Всеволод Вячеславович Здравствуйте, Cimus! Эта прога переводит не только двухразрядные 16-ти ричные числа, но и немного по-больше. Program p1; Uses crt; Var St : String; Figure_Dec,i : LongInt; {--------} Function Perevod(Const A:Char) : Integer; Var Code : integer; Buffer : Integer; Begin Buffer :=0; Case A of 'a','A': Buffer := 10; 'b','B': Buffer := 11; 'c','C': Buffer := 12; 'd','D': Buffer := 13; 'e','E': Buffer := 14; 'f','F': Buffer := 15; Else Val(A,Buffer,Code); End; Perevod:=Buffer; End; {--------} Function Dec_To_Oct(Var A: LongInt) : String; Var Buffer,Buf : String; Begin Buffer:=''; While A <> 0 Do Begin Str((A Mod 8),Buf); Buffer := Buf + Buffer; A:=A Div 8; End; Dec_To_Oct := Buffer; End; {--------} Begin Clrscr; Write('Введите число --> '); Readln(St); Figure_Dec :=0; For i:=1 to Length(st) Do Figure_Dec := Figure_Dec*16 + Perevod(St[i]); Write('Результат --> ',Dec_To_Oct(Figure_Dec)); Readkey; End. --------- Это круто - машина состояний с бесконечным циклом

Ответ отправил: Вологин Всеволод Вячеславович (статус: 1-ый класс) Ответ отправлен: 14.05.2007, 10:37 Оценка за ответ: 5 Комментарий оценки: Спасибо

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Email: support@rusfaq.ru, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.52 от 02.05.2007