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

Выпуск № 383
от 29.05.2007, 02:05

Вопрос № 88.247

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

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

Отвечает: Verena Здравствуйте, Vedmak7! Программу, предложенную Вами, я изменила под текстовые файлы. Теперь признаком, что файл считан, будет являться не -1, а пустая строка (исходный файл переписывается в новый без пустых строк, если они там содержались; если же их также необходимо перенести в новый файл, можно просто учесть их количество и добавить в начало или конец файла с результатом). Комментарии я изменила в соответствии с изменениями в программе. Приложение: Program SortSlian; { 3-ленточная, 2-фазная сортировка естественным слиянием } Uses Crt; Var Name, name1: string[30]; { имя исходного файла } A, B, C, Q: text; L: integer; S, T, K: string; e: boolean; Procedure Pech(var F: text); Begin Reset(F); While not eof(F) do begin Readln (F, S); Write(S,' ') end; WriteLn End; Procedure CopyElem(var X, Y: text; var Buf: string; var E: boolean); { копирование элемента и считывание следующего } { в Buf с проверкой конца серии (E=True) } Begin K:=Buf; Writeln (Y, Buf); if not Eof(X) then Readln (X, Buf) else Buf:=''; { барьер: достигнут конец файла } E:=(Buf<K) { E=True в конце серии } End; Procedure CopySer(var X, Y: text; var Buf: string); { копирование серии из X в Y } { в начале Buf-первый элемент текущей серии на X } { в конце Buf-первый элемент следующей или '' (конец X) } Begin if Buf<>'' then { файл X не считан } Repeat CopyElem(X, Y, Buf, E) Until E { E=True в конце серии } End; Procedure Raspred; { распределение A ---> B и C } Begin Reset(A); Readln (A, S); { первый элемент из A } Rewrite(B); Rewrite(C); Repeat CopySer(A, B, S); { S-первый элемент следующей серии } if S<>'' then { файл A скопирован не весь } CopySer(A, C, S) Until S='' End; Procedure Slian; { слияние B и C--->A } Var E1, E2: boolean; Procedure SlianSer; { слияние серий из B и C ---> A } { S и T - первые элементы серий } { S=''-весь файл B считан, T=''-файл C считан } Begin Repeat E1:=False; E2:=False; if (S<>'') and ((S<T) or (T='')) then { файл B не считан и текущий элемент B меньше, чем в C, здесь и определяется отсортированный участок} { либо файл C полностью считан } begin CopyElem(B, A, S, E1); if E1 then { достигнут конец серии на B } CopySer(C, A, T) end else begin CopyElem(C, A, T, E2); if E2 then { достигнут конец серии на C } CopySer(B, A, S) end Until E1 or E2 End; Begin { начало Slian } Reset(B); Reset(C); if not (Eof(B) or Eof(C)) then begin { оба файла не пусты } Rewrite(A); Readln(B, S); Readln(C, T); L:=0; { счетчик числа серий } While (S<>'') or (T<>'') do begin SlianSer; L:=L+1 end end End; Begin { начало основной программы } ClrScr; Write('Введите имя файла для сортировки элементов: '); ReadLn(name1); Write('Введите имя файла для записи элементов: '); ReadLn(name); Assign(Q, Name1); Assign(A, Name); Assign(B, 'Rab1'); Assign(C, 'Rab2'); Reset (Q); Rewrite (A); While not EOF (Q) do begin readln (Q, S); if S<>'' then writeln (A, S); end; Close (Q); Close (A); L:=0; { L - число серий после слияния - параметр } Repeat WriteLn('Файл A: '); Pech(A); Raspred; { фаза распределения } WriteLn('Файл B: '); Pech(B); WriteLn('Файл C: '); Pech(C); ReadLn; { пауза } Slian { фаза слияния } Until L<=1; { L=0, если исходный файл отсортирован } WriteLn('Файл A в конце: '); Pech(A); Close(A); Close(B); Erase(B); { удаление рабочих файлов } Close(C); Erase(C); ReadLn End. --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 23.05.2007, 21:14 Оценка за ответ: 5

Отвечает: Устинов С.Е. Здравствуйте, Vedmak7! Предложу еще свой вариант - код в приложении. Смысл таков: из файла считывается 2 строки (если это можно) и во временный файл записываются в отсортированном виде. И так далее до конца файла. После того, как достигли конца файла - исходный файл удаляется и временный файл переименовывается в имя исходного. После этого из файла считывается 1 строка и записывается во временный и повторяется предыдущий цикл по считыванию и обработке 2-х строк. Все эти действия происходят до тех пор, пока не случится такого, что при проходе цикла не будет ни одной перестановки строк. Будут вопросы - спрашивайте. Удачи! Приложение: var f,q:text; s1,s2,t:string; b:boolean; c,count:integer; begin assign(f,'file.txt'); b:=false; count:=0; repeat assign(q,'temp.txt'); c:=0; inc(count); reset(f); rewrite(q); if b and not(eof(f)) then begin readln(f,s1); writeln(q,s1); end; while not(eof(f)) do begin readln(f,s1); if not(eof(f)) then begin readln(f,s2); if s2<s1 then begin t:=s2; s2:=s1; s1:=t; c:=c+1; end; writeln(q,s1); writeln(q,s2); end else writeln(q,s1); end; erase(f); rename(q,'file.txt'); close(q); b:=not b; until (c=0) and (count>1); writeln('Fayl bil perepisan ',count,' raz.'); end. --------- Ждешь квалифицированного ответа? Задай правильно вопрос!

Ответ отправил: Устинов С.Е. (статус: Специалист) Ответ отправлен: 24.05.2007, 00:20 Оценка за ответ: 5

Вопрос № 88.269

Ув. Эксперты помогите пожалуйста с кодом который изложен ниже а именно проблема в этих строках: Mx:=(cxk-cx-10)/(b-a); my:=(cxk-cx-10)/(maxf-minf); наверняка происходит переполнение при операциях с плавающей запятой но как исправить эту ошибку?Обьясните пожалуйста как или же исправте сразу и отпишите результат.Заранее спасибо. Приложение: Сама програма: Program New; Uses Graph, CRT; type Massiv=array[1..100] of real; var Fun:Massiv; Gd,Gm:integer; Suma,a,b,h,x,mx,my,minf,maxf:real; nn,nk,I,cx,cxk,cy,cyk,n,kkk:integer; Function f(x1:real):real; Begin F:=sqrt(6*x1-5); End; Function inSim(ff:massiv;nn:integer ):real; Var Il:integer; Ss:real; Begin Ss:=0; For Il:=2 to nn-1 do If il mod 2=0 then Ss:=ss+4*ff[il] else Ss:=ss+2*ff[il]; Ss:=abs(h/3*(ss+ff[1]+ff[nn])); InSim:=ss; End; Function Trapecia(ff:massiv;nn:integer):real; Var Il:integer; Ss:real; Begin Ss:=0; For Il:=2 to nn-1 do Ss:=ss+2*fun[il]; Ss:=abs(h/2*(fun[1]+fun[nn]+ss)); Trapecia:=ss; End; Function maxim(mas:massiv; nm:integer):real; Var Il:integer; Ss:real; Begin Ss:=mas[1]; For Il:=2 to nm do If mas[il]>ss then ss:=mas[il]; Maxim:=ss; End; Function minim(mas:massiv; nm:integer):real; Var Il:integer; Ss:real; Begin Ss:=mas[1]; For Il:=2 to nm do If mas[il]<ss then ss:=mas[il]; minim:=ss; End; Function dobutok(mas:massiv; pk,kk:integer):real; Var Il:integer; Ss:real; Begin Ss:=0; For il:=pk to kk do Ss:=ss*mas[il]; Suma:=ss; End; Procedure drow(c_x,c_y,xe,ye:integer; minf,maxf,minx,maxx:real); var S:string; Hh:integer; Hx,hy:real; Begin Setcolor(red); Line(c_x,c_y,c_x,ye); Line(c_x,c_y,xe,c_y); Outtextxy(c_x-6,ye-15,'F(X)'); Outtextxy(c_x-3,ye,'^'); Outtextxy(xe-3,c_y-3,'>X'); For hh:=1 to 6 do Begin Line(c_x-3,c_y-round((c_y-ye-10)/6)*hh, C_x+3,c_y-round((c_y-ye-10)/6)*hh); Line(c_x+round((xe-c_x-10)/6)*hh, C_y-3,c_x+round((xe-c_x-10)/6)*hh,c_y+3); End; Hx:=(maxx-minx)/6; Hy:=(maxf-minf)/6; Setcolor(blue); For hh:=1 to 7 do Begin str((hh-1)*hx+minx:4:2,s); End; For hh:=1 to 7 do begin Str((hh-1)*hy+minf:6:3,s); End; End; Begin Gd:=detect; InitGraph(Gd,Gm,''); If graphresult<>grOk then Halt(1); Setcolor(yellow); Outtextxy(245,70,'Kursova robota'); Outtextxy(270,100,'VIPOLNIL:'); Outtextxy(185,130,'Student I-kursu gruppy PM-62'); Outtextxy(255,160,'Omelchuk Ivan'); Setcolor(white); Outtextxy(470,450,'Press <Enter>'); Readln; Cleardevice; A:=0; b:=0.5; n:=16; h:=(b-a)/n; N:=n+1; x:=a; For I:=1 to n do Begin Fun[i]:=f(x); X:=x+h; End; {Minf:=min(Fun,n); Maxf:=max(Fun,n);} Cx:=100; Cy:=100; Cxk:=100; Cyk:=100; Cy:=getmaxy-cy; Cy:=getmaxx-cxk; Mx:=(cxk-cx-10)/(b-a); my:=(cxk-cx-10)/(maxf-minf); moveto(cx,cy); x:=a-h; for i:=1 to n do begin x:=x+h; setcolor(6); setlinestyle(0,0,1); kkk:=cy-round(my*(f(x)-minf)); lineto(cx+round(mx*(x-a)),kkk); setcolor(blue); setlinestyle(1,0,1); line(cx+round(mx*(x-a)),cy-round(my*(f(x)-minf)),cx,kkk); line(cx+round(mx*(x-a)),cy-round(my*(f(x)-minf)),cx+round(mx*(x-a)),cy); end; setlinestyle(0,0,1); drow(cx,cy,cxk,cyk,minf,maxf,a,b); readln; restoreCrtMode; for i:=1 to n do if i mod 21=0 then begin readln; clrscr; writeln('F(x[', i ,'])=',fun[i]); end else writeln('F(x[', i ,'])=',fun[i]); readln; clrscr; nn:=5; nk:=6; {suma:=sum(fun,nn,nk);} writeln('F(x[',nn,'])*…*F(x[',nk,'])=',suma); readln; clrscr; writeln('integral methodom trap=', Trapecia(fun,n):4:6); writeln('integral methodom simpsona=', inSim(fun,n):4:6); readln;closegraph;end. begin closegraph; clrscr; gotoxy(21,3); WriteLn('input number of chapter'); gotoxy(21,4); WriteLn('Make Array 1'); gotoxy(21,5); WriteLn('mini/maxi 2'); gotoxy(21,6); WriteLn('SumDob 3'); gotoxy(21,7); WriteLn('integral 4'); gotoxy(21,8); WriteLn('Build Graph. 5'); gotoxy(21,9); WriteLn('quit 6'); ReadLn(k); if k=1 then make_array; if k=2 then mini_maxi(c); if k=3 then SumDob(c); if k=4 then integral(c); if k=5 then draw; end; end.

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

Отвечает: Gh0stik Здравствуйте, Андрей Аноним:)! Ну что я Вам должен сказать, у меня при исполнении программы тоже возникла ошибка с кодом 207 (Invalid float point operation) в функции Function f(x1:real):real; . После анализа ошибки я нашел в чем причина, вот кусок кода: ........ Cleardevice; A:=0; b:=0.5; n:=16; h:=(b-a)/n; N:=n+1; x:=a; For I:=1 to n do Begin Fun[i]:=f(x); X:=x+h; End; ........ Как видно переменная а - принимает значение ноль, и далее переменной x - присваивается значение переменной а (x:=a;) - т.е. опять тотже ноль. Далее переменную x Вы используете при вызове функции Fun[i]:=f(x); . Как видно при первом вызове функции у нас в нее поступает значение равное нолю, при подстановке в функцию, легко увидеть что у нас получается такая формула: F:=sqrt(6*0-5); - как видим мы пытаемся найти корень из отрицательного числа, что и вызывает ошибку. Более того я пошел дальше, я просто взял и изменил значения переменных а и b - на произвольные, но такие которые не будут вызывать ошибки в функции Function f(x1:real):real;, т.е. при решении несложного неравенства значение переменной x1 - должно соответсвовать условию: x1>=5/6. Так вот после изменения выше указанных переменных ошибка в данной функции не возникает, но возникла ошибка в тех строках, которые Вы указали в вопросе: Mx:=(cxk-cx-10)/(b-a); my:=(cxk-cx-10)/(maxf-minf); Но тип ее уже был совершенно другой (Division by zero), следовательно Вам нужно будет еще провести дальнейший анализ вычислений.... Вобщем, Вам стоит при каждом сомнительном вычислении вывести на экран значение переменных, которые используются в той или иной формуле, и соответственно привести их к такому виду который будет соответствовать условию, а также и правилам использования их в языке программирования. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 23.05.2007, 23:27

Вопрос № 88.302

Уважаемые эксперты скажи пожалуйста каким образом можно прервать выполнение программой каких-либо операций на время Т и что для этого нужно написать в самой программе.заранее благодарен

Отправлен: 23.05.2007, 20:02 Вопрос задал: ClassiK (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Verena Здравствуйте, ClassiK! Видимо, Вам нужна процедура delay (время_в_миллисекундах: word). Эта процедура, как правило, используется для анимации, чтобы выводить изображение на экран с задержкой. Вставить в программу её просто, например: ... writeln ('Сейчас будет пауза'); {это сообщение появится сразу} delay (1000); writeln ('Пауза кончилась'); {а это - через 1000 миллисекунд} ... --------- Эта история - не для истории, понимаешь?

Ответ отправила: Verena (статус: Студент) Ответ отправлен: 23.05.2007, 20:16

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