Исправление ошибок программы паскаль онлайн

My Projects

Change Password

My Profile

Logout

Undo

Redo

Cut

Copy

Paste

Delete

Select All

Find

Find and Replace

Show Invisible

Hide Invisible

Show Line Numbers

Hide Line Numbers

Ace Editor (Default)

Vim Editor

Emacs Editor

Open New Project

Save Project

Save As New Project

Share Project

Search Project

Program HelloWorld(output);
begin
writeln(‘Hello, world!’);
end.

Language:

Layout:

program p71;
const
n=10;// n только от 2 до 15!
var
Matrix:array[1..n,1..n]of byte;//только byte!
uni:set of byte;
i,j:byte;
begin
randomize;//инициализация генератора случайных чисел
uni:=[];
//создание матрицы
for i:=1 to n do
begin
for j:=1 to n do
begin
Matrix[i,j]:=Random(128);//генератор случайных чисел
write(Matrix[i,j]:3,' ');
end;
writeln;
end;
//поиск уникальных элементов
writeln;
writeln;
for i:=1 to n do
for j:=1 to n do uni:=uni + [Matrix[i,j]];
write('Unikalnye chisla: ');
for i:=0 to 255 do
if i in uni then write(i:3,' ');
writeln;
readln;
end.
program p9;
uses crt;
const
CEndOfFile='@';//Символ конца файла. Можно задать любой символ или их комбинацию
type
TPDict=^TDict;
TDict=record
data:string;
next:TPDict;
end;
var
f:text;
s,n,w:string;
RusLet,Nums,Words:integer;
Dict:TPDict;
//функция подсчёта цифр
function CountNums(data:string):integer;
var
res,i:integer;
begin
res:=0;
for i:=1 to length(data) do
if data[i] in ['0'..'9'] then inc(res);
CountNums:=res;
end;
 
//функция подсчёта русских букв
function CountRusLet(data:string):integer;
var
res,i:integer;
begin
res:=0;
for i:=1 to length(data) do
if byte(data[i]) in [128..255] then inc(res);//считаем НЕанглийские буквы
//Если надо считать другие символы - их коды ввести в квадратных скобках вместо [128..255]
CountRusLet:=res;
end;
 
//функция, приводящая все английские буквы к верхнему регистру
function UpCaseStr(data:string):string;
var
i:integer;
begin
for i:=1 to length(data) do data[i]:=UpCase(data[i]);
UpCaseStr:=data;
end;
 
//функция подсчёта вхождения слов
function CountWords(data,wrd:string):integer;
var
n,res,i:integer;
s:string;
begin
res:=0;
data:=UpCaseStr(data);
wrd:=UpCaseStr(wrd);
s:='';
for i:=1 to length(data) do
if byte(data[i]) > 32 then s:=s+data[i] else
begin
if s <> '' then
begin
if s=wrd then inc(res);
s:='';
end;
end;
if s=wrd then inc(res);
CountWords:=res;
end;
 
//функция проверяет наличие заданного слова в словаре
function IsWordExist(pdict:TPDict;wrd:string):boolean;
var
res:boolean;
begin
res:=false;
while pdict <> nil do
begin
if UpCaseStr(pdict^.data)=UpCaseStr(wrd) then
begin
res:=true;
break;
end;
pdict:=pdict^.next;
end;
IsWordExist:=res;
end;
 
//процедура создания словаря (если существует - дополняет)
//строка не обрабатывается
procedure CreateDict(var pdict:TPDict;dat:string);
var
wlist:TPDict;
begin
if pdict = nil then
begin
new(pdict);
pdict^.data:=dat;
pdict^.next:=nil;
end else
begin
wlist:=pdict;
while wlist^.next <> nil do wlist:=wlist^.next;
new(wlist^.next);
wlist:=wlist^.next;
wlist^.next:=nil;
wlist^.data:=dat;
end;
end;
 
//процедура пополнения словаря (если не существует - создаёт)
//автоматически разделяет строку на слова
procedure StrToDict(var pdict:TPDict;data:string);
var
s:string;
i:integer;
begin
s:='';
for i:=1 to length(data) do
if byte(data[i]) > 32 then s:=s+data[i] else
begin
if s <> '' then
begin
if not IsWordExist(pdict,s) then CreateDict(pdict,s);
s:='';
end;
end;
if s <> '' then
if not IsWordExist(pdict,s) then CreateDict(pdict,s);
end;
 
//процедура сортировки слов в словаре
procedure SortDict(var pdict:TPDict);
var
head,tmp1,tmp2,nf:TPDict;
n:string;
begin
head:=nil;
nf:=pdict;
repeat
tmp1:=nf;
tmp2:=tmp1;
n:=tmp1^.data;
while tmp1 <> nil do
begin
if UpCaseStr(tmp1^.data) < UpCaseStr(n) then
begin
tmp2:=tmp1;
n:=tmp1^.data;
end;
tmp1:=tmp1^.next;
end;
tmp1:=nf;
if tmp1 = tmp2 then nf:=tmp2^.next else
begin
while tmp1 <> nil do
begin
if tmp1^.next <> tmp2 then tmp1:=tmp1^.next else
begin
tmp1^.next:=tmp2^.next;
break;
end;
end;
end;
tmp2^.next:=nil;
if head=nil then head:=tmp2 else
begin
tmp1:=head;
while tmp1^.next <> nil do tmp1:=tmp1^.next;
tmp1^.next:=tmp2;
end;
until nf=nil;
pdict:=head;
end;
 
//процедура сохранения словаря в файл
procedure WriteDict(pdict:TPDict;path:string);
var
f:text;
begin
assign(f,path);
rewrite(f);
while pdict <> nil do
begin
writeln(f,pdict^.data);
pdict:=pdict^.next;
end;
close(f);
end;
 
//Освобождение памяти от нашего словарика
//(мы ж культурные и должны за собой прибраться )
procedure DestroyDict(var pdict:TPDict);
var
tmp1, tmp2:TPDict;
begin
tmp1:=pdict;
pdict:=nil;
while tmp1 <> nil do
begin
tmp2:=tmp1^.next;
Dispose(tmp1);
tmp1:=tmp2;
end;
end;
 
begin
//инициализация переменных
Nums:=0;
RusLet:=0;
Words:=0;
Dict:=nil;
//ввод пути и создание файла
clrscr;
write('Vvedite put k failu: ');
readln(n);
assign(f,n);
rewrite(f);
clrscr;
//ввод текста и запись его в файл
writeln('Vvedite tekst.');
writeln('Dlja okonchania vvedite na novoj stroke "@" (bez kavychek).');
writeln;
readln(s);
while s<>CEndOfFile do
begin
writeln(f,s);
readln(s);
end;
close(f);
//ввод слова для поиска
clrscr;
write('Vvedite slovo dlja poiska: ');
readln(w);
//открытие только что записанного файла на чтение
//и его анализ в соответствии с заданием
assign(f,n);
reset(f);
while not eof(f) do
begin
readln(f,s);
Nums:=Nums+CountNums(s);
RusLet:=RusLet+CountRusLet(s);
Words:=Words+CountWords(s,w);
StrToDict(Dict,s);
end;
close(f);
SortDict(Dict);
clrscr;
if Nums > RusLet then writeln('Tsyfr bolshe, chem russkih bukv') else
if Nums < RusLet then writeln('Russkih bukv bolshe, chem tsyfr') else writeln('Russkih bukv i tsyfr porovnu');
writeln('Slovo "',w,'" vhodit v tekst ',Words,' raz.');
write('Vvedite put k failu slovarja: ');
readln(s);
WriteDict(Dict,s);
DestroyDict(Dict);
writeln;
writeln('Press [Enter] for exit.');
readln;
end.
program p10;
var
s:string;
c:char;
n:integer;
f,h:text;
begin
//начало основной программы
write('Type path to input file: ');
readln(s);
assign(f,s);
reset(f);
write('Type path to output file: ');
readln(s);
assign(h,s);
rewrite(h);
writeln;
write('Input letter: ');
readln(c);
while not eof(f) do
begin
readln(f,s);
n:=Pos(c,s);
while n > 0 do
begin
Delete(s,n,1);
n:=Pos(c,s);
end;
writeln(h,s);
end;
writeln;
writeln('Finished. Press [Enter] for exit.');
readln;
end.