Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/3: Рейтинг темы: голосов - 3, средняя оценка - 4.67
0 / 0 / 0
Регистрация: 17.05.2015
Сообщений: 67
1

Подскажите, в чем проблема?

14.04.2019, 18:26. Просмотров 594. Ответов 8
Метки нет (Все метки)

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
program DiskrModel; 
uses crt,graph;
type ta1=array[1..10] of integer ;  
  ta2=array[1..12,1..10] of integer;  
var i,j,kevnt,matr,dtime,nnq1,tnow,ttbeg,nnrns:integer; nrns,dtimz,tsob,ttfin,m,k1,k2,k3:integer;  
  f,f1:file of ta2; a,b,a1,atrib,dt,a2:ta1; a3:ta2;  
  fx :  TEXT; j1,rep_count,rp,rp1 : integer;      
procedure grup;{Перегрупировка событий по времени}  
var l,k,h,i,j,n:integer;                                                      
begin writeln(fx,'Перегруппировка событий по времени');  
  seek(f,0); read(f,a3); n:=1; while a3[matr+2,n]=1 do begin
  for k:=1 to nnq1-1 do for l:=1 to matr+2 do  begin   
  a3[l,k]:=a3[l,k+1]; a3[l,k+1]:=0; end; n:=n+1; end;  
  h:=nnq1 div 2; j:=0; while h<>0 do begin    
  for j:=h+1 to nnq1 do begin i:=j-h;  
  for k:=1 to matr+2 do a[k]:=a3[k,j]; repeat   
  for k:=1 to matr+2 do b[k]:=a3[k,i];    
  if (a[matr+2]<b[matr+2]) and (a[matr+2]>0) then begin  
  for k:=1 to matr+2 do a3[k,i+h]:=b[k]; i:=i-h; end;  
  until (i<=0) or (a[matr+2]>=b[matr+2]) or (a[matr+2]=0);  
  for k:=1 to matr+2 do a3[k,i+h]:=a[k]; end; h:=h div 2; end;  
  seek(f,0); write(f,a3); writeln(fx,'Вывод нового календаря'); 
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do  
  write(a3[j,i],' '); write(' '); end; writeln; end;  
procedure schdl(kevnt,dtime:integer;a4:ta1);{Процедура планирования}  
  var  i,j:integer;  
  begin  for i:=1 to matr do a2[i]:=a1[i];  
  writeLn(fx,'Атрибуты события ',a1[1]); 
  a2[matr+1]:=kevnt; writeln(fx,'код события',kevnt);  
  a2[matr+2]:=tnow+dtime; writeln(fx,'время события',tnow+dtime); 
  seek(f,0); write(f,a3);j:=1;     
  while a3[matr+1,j]<>0 do j:=j+1;  for i:=1 to matr+2 do a3[i,j]:=a2[i];   
  seek(f,0); write(f,a3); writeln(fx,'вывод календаря');       
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do       
  write(fx,a3[j,i],' '); write(fx,' '); end; writeln(fx); grup; end;  
procedure rmove;{Извлечение первой записи}     
  var i,j:integer;   
  begin  seek(f,0); read(f,a3); tsob:=a3[matr+2,1]; i:=a3[matr+1,1];  
  writeln(fx,'код извлечённого события ',i);   
  writeln(fx,'время извлечённого события', a3[matr+2,1]);  
    for j:=1 to matr+3 do a3[j,1]:=0; for j:=1 to matr do atrib[j]:=a3[j,1];    
    seek(f,0); write(f,a3); writeln(fx,'вывод календаря');  
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do  
    write(fx,a3[j,i],''); write(fx,' '); end; writeln(fx); grup; end;   
procedure intlc;  
  var l0,ml0,ni,nl,busy,ex1:integer; begin  
  tnow:=ttbeg; write(fx,'Время очередного прогона', tnow); writeln(fx);       
  nrns:=nrns+1; write(fx,'Номер очередного прогона',nrns); writeln(fx);       
  dt[1]:=2; dt[2]:=3; dt[3]:=4; write(fx,'Вызов подпрограммы планирования');  
  kevnt:=1; i:=kevnt; dtimz:=dt[1]+k3*random(k2); schdl(1,dtimz,a1); end;     
 
  procedure event(i:integer);{Процедура поиска процедуры обработки}            
  begin case i of 1: begin    
  writeln(fx,'Произошло событие с кодом',i,'с временем',tnow);    
   kevnt:=2; i:=kevnt; dtimz:=round(dt[2]*exp(k1)); schdl(2,dtimz,a1); end;   
  2:begin writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);        
   kevnt:=3; i:=kevnt; schdl(3,dt[3],a1); end;  
  3: writeln(fx,'Произошло событие с кодом',i,'c временем',tnow); end; end;   
procedure otputn;{Процедура отчета по прогону}     
  var nrns: integer;     
  begin write(fx,'Номер прогона ',' ',nrns); write(fx,'прогон завершен') end;  
procedure otput;{Процедура итогового отчета по прогонам} 
  var sd,sdd : array [1..640] of word;         
 x0,y0,i3,i33,i33_,i331,i22,j2,jj:word; x,y,m1:real;     
  graphdriver,graphmode:integer; switch:boolean; s : string;    
  begin write(fx,'Имитация закончена');   graphdriver:=detect;  
  initgraph(graphdriver,graphmode,'');  x0:=20; y0:=getmaxY div 2; switch:=true;  
  for j2:=0 to rep_count do begin cleardevice;  str(rp,s); setbkcolor(blue); 
  setcolor(white); line(x0,20,x0,getmaxY-20);  
  line(x0,y0,getmaxX-20,y0);   moveto(x0,y0);  
  for i3:=1 to getmaxX-40 do begin m1:=20; x:=random(k3)+1;   
  y:=(1/m1)*exp(-x/m1); sd[i3] := round(y*k2); end; i33_:=10;jj:=1;  
  while i33_<200 do begin i33_:=i33_+rp; sdd[jj] :=0;  
  for i33:=1 to getmaxX do begin if (sd[i33] = i33_)     
  then sdd[jj] := sdd[jj]+1; end;jj:=jj+1; end;jj:=x0;
  for i3:=1 to round(200/rp) do begin setcolor(10); 
  rectangle(jj,y0,jj+10,y0-round(sdd[i3]*k1)); jj:=jj+10; end;
  readln; end; closegraph; end;   
procedure slam;   
  var  i,j:integer;       
  begin intlc; rmove;i:=kevnt; tnow:=tnow+dt[i]; event(i);   
  if (tnow<ttfin)and(a2[matr+1]>0) then begin rmove; otputn; end;   
  if nrns<nnrns then intlc else otput; end;  
  begin clrscr; matr:=1; nnq1:=1; ttfin:=180;  ttbeg:=1; nrns:=0; k1:=5; k2:=20; k3:=100; 
  nnrns:=10; m:=20; assign(f,'C:\Users\Admin\Desktop\f1.dat');rewrite(f); 
  assign(fx,'C:\Users\Admin\Desktop\report.txt');   rewrite(fx);rp:=1; 
  rep_count:=0; for j1:=1 to 6 do slam; end.
в строчке
Pascal
1
 rectangle(jj,y0,jj+10,y0-round(sdd[i3]*k1)); jj:=jj+10; end;
постоянно пишет Ошибка проверки диапазона?????
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.04.2019, 18:26
Ответы с готовыми решениями:

Подскажите в чем проблема?
Есть прога на Oracle 8i и вот недавно накрылся винт, струдом востановив его, прога перестала...

Подскажите в чем проблема?
Такая вещь: 1 раз утром комп включаю все нормально гдето мин через 5 картинка зависает,...

Подскажите , в чем проблема
Программа генерирует таблицу из одинаковых квадратов и прописывает каждому разный id и одинаковый ...

Подскажите в чем проблема?
Ноутбук Asus K52 приобрел 10.10.11 и через пару дней он начал очень сильно тормозить,очень часто...

8
3103 / 1691 / 454
Регистрация: 28.02.2015
Сообщений: 3,409
15.04.2019, 15:03 2
Если хотите получить ответ, запишите свою программу в одну строчку.

Отформатируйте свой код нормально, уважайте людей, которых спрашиваете.
0
0 / 0 / 0
Регистрация: 17.05.2015
Сообщений: 67
17.06.2019, 14:05  [ТС] 3
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
program DiskrModel;
uses 
        crt,graph,bgi;  
type 
        ta1=array[1..10] of integer ;  
        ta2=array[1..12,1..10] of integer;  
var 
i,j,kevnt,matr,dtime,nnq1,tnow,ttbeg,nnrns:integer;         nrns,dtimz,tsob,ttfin,m,k1,k2,k3:integer;  
        f,f1:file of ta2;
        a,b,a1,atrib,dt,a2:ta1;
        a3:ta2;  
        fx :  TEXT;
        j1,rep_count,rp,rp1 : integer;   
   
procedure grup;{Перегрупировка событий по времени}  
var l,k,h,i,j,n:integer;                                                      
begin
writeln(fx,'Перегруппировка событий по времени');  
  seek(f,0);
  read(f,a3); 
  n:=1;
  while a3[matr+2,n]=1 do
   begin   
     for k:=1 to nnq1-1 do
        for l:=1 to matr+2 do  
    begin   
        a3[l,k]:=a3[l,k+1];
        a3[l,k+1]:=0;
    end;
     n:=n+1;
    end;  
    h:=nnq1 div 2; 
          j:=0;
    while h<>0 do 
          begin    
     for j:=h+1 to nnq1 do 
            begin
         i:=j-h;  
         for k:=1 to matr+2 do a[k]:=a3[k,j];
               repeat   
         for k:=1 to matr+2 do b[k]:=a3[k,i];    
{сначала время, потом приоритет}
          if (a[matr+2]<b[matr+2]) and (a[matr+2]>0) then 
                 begin  
        for k:=1 to matr+2 do 
                    a3[k,i+h]:=b[k]; 
                    i:=i-h; 
                 end;  
         until (i<=0) or (a[matr+2]>=b[matr+2]) or (a[matr+2]=0);  
          for k:=1 to matr+2 do 
                 a3[k,i+h]:=a[k]; 
            end; 
             h:=h div 2;
         end;  
          seek(f,0); write(f,a3); 
          writeln(fx,'Вывод нового календаря');
    for i:=1 to nnq1 do 
           begin 
             for j:=1 to matr+2 do  
        write(a3[j,i],' '); 
                    write(' '); 
           end; 
         writeln; 
     end;  
 
procedure schdl(kevnt,dtime:integer;a4:ta1);{Процедура планирования}  
{добавление событий в календарь}
  var  i,j:integer;  
  begin  
    for i:=1 to matr do 
    a2[i]:=a1[i];  
          writeLn(fx,'Атрибуты события ',a1[1]);
          a2[matr+1]:=kevnt;
          writeln(fx,'код события',kevnt);  
          a2[matr+2]:=tnow+dtime; writeln(fx,'время события',tnow+dtime);
          seek(f,0); write(f,a3);j:=1;     
          while a3[matr+1,j]<>0 do
    j:=j+1;  
         for i:=1 to matr+2 do a3[i,j]:=a2[i];   
          seek(f,0);
          write(f,a3);
          writeln(fx,'вывод календаря');       
        for i:=1 to nnq1 do
         begin
    for j:=1 to matr+2 do       
    write(fx,a3[j,i],' ');
    write(fx,' ');
         end;
        writeln(fx);
        grup;
end;
 
 
procedure rmove;{Извлечение первой записи}    
  var i,j:integer;   
  begin  
    seek(f,0); read(f,a3); 
    tsob:=a3[matr+2,1]; 
    i:=a3[matr+1,1];  
    writeln(fx,'код извлечённого события ',i);   
    writeln(fx,'время извлечённого события', a3[matr+2,1]);  
    for j:=1 to matr+3 do
      a3[j,1]:=0; 
    for j:=1 to matr do 
      atrib[j]:=a3[j,1];    
    seek(f,0); write(f,a3); 
    writeln(fx,'вывод календаря');  
    for i:=1 to nnq1 do 
      begin 
         for j:=1 to matr+2 do  
            write(fx,a3[j,i],''); write(fx,' '); 
      end; 
      writeln(fx); 
      grup;
  end;   
 
 
procedure intlc;  
  var l0,ml0,ni,nl,busy,ex1:integer; 
  begin  
   tnow:=ttbeg; 
   write(fx,'Время очередного прогона', tnow); 
   writeln(fx);       
   nrns:=nrns+1;
   write(fx,'Номер очередного прогона',nrns); 
   writeln(fx);       
  dt[1]:=2; dt[2]:=3; dt[3]:=4;
  write(fx,'Вызов подпрограммы планирования');  
  kevnt:=1; i:=kevnt;
  dtimz:=dt[1]+k3*random(k2);
  schdl(1,dtimz,a1); 
 end;
 
     procedure event(i:integer);{Процедура поиска процедуры обработки}          
       begin
        case i of
         1:
             begin    
        writeln(fx,'Произошло событие с кодом',i,'с временем',tnow);    
        kevnt:=2;
         i:=kevnt;
        dtimz:=round(dt[2]*exp(k1));
         schdl(2,dtimz,a1);
   end;  
 
        2:
   begin
        writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);        
        kevnt:=3;
        i:=kevnt;
        schdl(3,dt[3],a1);
          end;  
 
         3: 
            writeln(fx,'Произошло событие с кодом',i,'c временем',tnow); 
       end; 
      end;   
procedure otputn;{Процедура отчета по прогону}    
  var nrns: integer;     
  begin 
write(fx,'Номер прогона ',' ',nrns); 
write(fx,'прогон завершен'); 
  end;  
 
procedure otput;{Процедура итогового отчета по прогонам} 
  var sd,sdd : array [1..640] of word;         
        x0,y0,i3,i33,i33_,i331,i22,j2,jj:word; 
        x,y,m1:real;     
        graphdriver,graphmode:integer; 
        switch:boolean; 
        s : string;    
  begin
    write(fx,'Имитация закончена');
    graphdriver:=detect;  
    initgraph(graphdriver,graphmode,'');
    x0:=20;
    y0:=getmaxY div 2;
    switch:=true;  
    for j2:=0 to rep_count do 
           begin 
             cleardevice;  
             str(rp,s); 
             setbkcolor(blue);
             setcolor(white);  
             line(x0,20,x0,getmaxY-20);  
             line(x0,y0,getmaxX-20,y0);   
             moveto(x0,y0);  
             for i3:=1 to getmaxX-40 do  
              begin 
               m1:=20; 
               x:=random(k3)+1;   
               y:=(1/m1)*exp(-x/m1); 
               sd[i3] := round(y*k2); 
              end; 
              i33_:=10;
              jj:=1;  
              while i33_<200 do 
              begin 
               i33_:=i33_+rp; sdd[jj] :=0;  
               for i33:=1 to getmaxX do 
                begin if (sd[i33] = i33_)     
                 then sdd[jj] := sdd[jj]+1; 
                end;
                jj:=jj+1; 
              end;
             jj:=x0;
             for i3:=1 to round(200/rp) do 
              begin 
               setcolor(10);
               rectangle(jj,y0,jj+10,y0-round(sdd[i3]*k1)); 
               jj:=jj+10; 
             end;  
             readln; 
            end; 
            closegraph; 
           end;   
 
procedure slam;
  var  i,j:integer;       
  begin
    intlc; 
    rmove; 
    i:=kevnt;  
    tnow:=tnow+dt[i]; 
    event(i);  
    if (tnow<ttfin)and(a2[matr+1]>0) then  
    begin
        rmove;
        otputn;  
    end;   
    if nrns<nnrns then 
    intlc else otput;  
    end;
 
    begin
        clrscr;
        matr:=1;
        nnq1:=1;
        ttfin:=180;  
        ttbeg:=1;
        nrns:=0; k1:=5; k2:=20; k3:=100;
        nnrns:=10; m:=20; assign(f,'C:\Users\Admin\Desktop\f1.bat');rewrite(f);
          assign(fx,'C:\Users\Admin\Desktop\report.txt');   rewrite(fx);rp:=1;
          rep_count:=0; for j1:=1 to 6 do slam;
           end.
Добавлено через 4 минуты
пишет ошибка проверки диапазона

Pascal
1
rectangle(jj,y0,jj+10,y0-round(sdd[i3]*k1));
0
1658 / 819 / 326
Регистрация: 19.03.2019
Сообщений: 2,677
17.06.2019, 15:18 4
Цитата Сообщение от Владимир199 Посмотреть сообщение
пишет ошибка проверки диапазона
У тебя какой Турбо Паскаль?

у меня Turbo Pascal 7.0
никакой ошибки нет.
Правда, график тоже не строит, только оси рисует.

а ещё в f1.bat пишет какую-то двоичную хрень.
а ещё выкинул за ненадобностью BGI в uses:
Pascal
1
2
3
program DiskrModel;
uses 
        crt,graph;
1
0 / 0 / 0
Регистрация: 17.05.2015
Сообщений: 67
17.06.2019, 16:10  [ТС] 5
у меня Turbo Pascal 7.0

вот я тоже не могу понять по чему график не строится хотя должен строится гистограмма
0
Модератор
61574 / 46103 / 31822
Регистрация: 18.05.2008
Сообщений: 111,126
17.06.2019, 16:37 6
Вы бы хоть написали условие задачи, а то вообще непонятно.
0
0 / 0 / 0
Регистрация: 17.05.2015
Сообщений: 67
17.06.2019, 17:03  [ТС] 7
у меня Turbo Pascal 7.0

вот я тоже не могу понять по чему график не строится хотя должен строится гистограмма

Добавлено через 1 минуту
при изменении значения
dt[1] 1
dt[2] 2
dt[3] 3
K1 8
K2 19
K3 150
0
0 / 0 / 0
Регистрация: 17.05.2015
Сообщений: 67
18.06.2019, 12:31  [ТС] 8
Constantin Cat,
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
program DiskrModel;
uses crt,graph;
type ta1=array[1..10] of integer ;
  ta2=array[1..12,1..10] of integer;
var i,j,kevnt,matr,dtime,nnq1,tnow,ttbeg,nnrns:integer;
nrns,dtimz,tsob,ttfin,m,k1,k2,k3:integer;
  f,f1:file of ta2;
  a,b,a1,atrib,dt,a2:ta1;
  a3:ta2;
  fx :  TEXT;
  j1,rep_count,rp,rp1 : integer;
procedure grup;{Перегрупировка событий по времени}
var l,k,h,i,j,n:integer;
begin writeln(fx,'Перегруппировка событий по времени');
  seek(f,0);
  read(f,a3);
  n:=1;
  while a3[matr+2,n]=1 do begin
  for k:=1 to nnq1-1 do for l:=1 to matr+2 do  begin
  a3[l,k]:=a3[l,k+1];
  a3[l,k+1]:=0;
  end;
  n:=n+1;
  end;
  h:=nnq1 div 2;
  j:=0; while h<>0 do begin
  for j:=h+1 to nnq1 do begin i:=j-h;
  for k:=1 to matr+2 do a[k]:=a3[k,j];
  repeat
  for k:=1 to matr+2 do b[k]:=a3[k,i];
  if (a[matr+2]<b[matr+2]) and (a[matr+2]>0) then begin
  for k:=1 to matr+2 do a3[k,i+h]:=b[k];
  i:=i-h; end;
  until (i<=0) or (a[matr+2]>=b[matr+2]) or (a[matr+2]=0);
  for k:=1 to matr+2 do a3[k,i+h]:=a[k];
  end; h:=h div 2; end;
  seek(f,0);
  write(f,a3);
  writeln(fx,'Вывод нового календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
  write(a3[j,i],' ');
  write(' ');
  end;
  writeln;
  end;
procedure schdl(kevnt,dtime:integer;a4:ta1);{Процедура планирования}
  var  i,j:integer;
  begin  for i:=1 to matr do a2[i]:=a1[i];
  writeLn(fx,'Атрибуты события ',a1[1]);
  a2[matr+1]:=kevnt;
  writeln(fx,'код события',kevnt);
  a2[matr+2]:=tnow+dtime;
  writeln(fx,'время события',tnow+dtime);
  seek(f,0);
  write(f,a3);
  j:=1;
  while a3[matr+1,j]<>0 do j:=j+1;
  for i:=1 to matr+2 do a3[i,j]:=a2[i];
  seek(f,0);
  write(f,a3);
  writeln(fx,'вывод календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
  write(fx,a3[j,i],' ');
  write(fx,' ');
  end;
  writeln(fx);
  grup;
  end;
procedure rmove;{Извлечение первой записи}
  var i,j:integer;
  begin  seek(f,0);
  read(f,a3);
  tsob:=a3[matr+2,1];
  i:=a3[matr+1,1];
  writeln(fx,'код извлечённого события ',i);
  writeln(fx,'время извлечённого события', a3[matr+2,1]);
    for j:=1 to matr+3 do a3[j,1]:=0;
    for j:=1 to matr do atrib[j]:=a3[j,1];
    seek(f,0);
    write(f,a3);
    writeln(fx,'вывод календаря');
  for i:=1 to nnq1 do begin for j:=1 to matr+2 do
    write(fx,a3[j,i],'');
    write(fx,' ');
    end;
    writeln(fx);
    grup;
    end;
procedure intlc;
  var l0,ml0,ni,nl,busy,ex1:integer;
  begin
  tnow:=ttbeg;
  write(fx,'Время очередного прогона', tnow);
  writeln(fx);
  nrns:=nrns+1;
  write(fx,'Номер очередного прогона',nrns);
  writeln(fx);
  dt[1]:=1; dt[2]:=2; dt[3]:=3;
  write(fx,'Вызов подпрограммы планирования');
  kevnt:=1;
  i:=kevnt;
  dtimz:=dt[1]+k3*random(k2);
  schdl(1,dtimz,a1);
  end;
 
  procedure event(i:integer);{Процедура поиска процедуры обработки}
  begin case i of 1: begin
  writeln(fx,'Произошло событие с кодом',i,'с временем',tnow);
     kevnt:=2;
     i:=kevnt;
     dtimz:=round(dt[2]*exp(k1));
     schdl(2,dtimz,a1);
     end;
  2:begin writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);
     kevnt:=3;
     i:=kevnt;
     schdl(3,dt[3],a1);
     end;
  3: writeln(fx,'Произошло событие с кодом',i,'c временем',tnow);
     end;
     end;
procedure otputn;{Процедура отчета по прогону}
  var nrns: integer;
  begin write(fx,'Номер прогона ',' ',nrns);
  write(fx,'прогон завершен') end;
procedure otput;{Процедура итогового отчета по прогонам}
  var sd,sdd : array [1..940] of word;
 x0,y0,i3,i33,i33_,i331,i22,j2,jj:word;
 x,y,m1:real;
  graphdriver,graphmode:integer;
  switch:boolean;
  s : string;
  begin write(fx,'Имитация закончена');
  graphdriver:=detect;
  initgraph(graphdriver,graphmode,'');
  x0:=20;
  y0:=getmaxY div 2;
  switch:=true;
  for j2:=0 to rep_count do begin cleardevice;
  str(rp,s);
  setbkcolor(blue);
  setcolor(white);
  line(x0,20,x0,getmaxY-20);
  line(x0,y0,getmaxX-20,y0);
  moveto(x0,y0);
  for i3:=1 to getmaxX-40 do begin m1:=20;
  x:=random(k3)+1;
  y:=(1/m1)*exp(-x/m1);
  sd[i3] := round(y*k2);
  end;
  i33_:=10;
  jj:=1;
  while i33_<200 do begin i33_:=i33_+rp;
  sdd[jj] :=0;
  for i33:=1 to getmaxX do begin if (sd[i33] = i33_)
  then sdd[jj] := sdd[jj]+1;
  end;jj:=jj+1;
  end;jj:=x0;
  for i3:=1 to round(200/rp) do begin setcolor(10);
  rectangle(jj,y0,jj+10,y0-round(sd[i3]*k1));
  jj:=jj+10;
  end;
  readln;
  end;
  closegraph;
  end;
procedure slam;
  var  i,j:integer;
  begin intlc;
  rmove;
  i:=kevnt;
  tnow:=tnow+dt[i];
  event(i);
  if (tnow<ttfin)and(a2[matr+1]>0) then begin rmove;
  otputn;
  end;
  if nrns<nnrns then intlc else otput;
  end;
  begin clrscr;
  matr:=1;
  nnq1:=1;
  ttfin:=180;
  ttbeg:=1;
  nrns:=0;
  k1:=5;
  k2:=13;
  k3:=50;
  nnrns:=10;
  m:=20;
  assign(f,'C:\Users\Admin\Desktop\f1.bat');
  rewrite(f);
  assign(fx,'C:\Users\Admin\Desktop\report.txt');
  rewrite(fx);
  rp:=1;
  rep_count:=0;
  for j1:=1 to 6 do slam;
  end.
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5579 / 3316 / 2401
Регистрация: 22.11.2013
Сообщений: 9,325
24.06.2019, 10:12 9
Если кто-то будет разбираться, форматированный исходник в помощь:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
program DiskrModel;
 
uses crt, graph;
 
type
  ta1 = array[1..10] of Integer;
  ta2 = array[1..12, 1..10] of Integer;
var
  i, j, kevnt, matr, dtime, nnq1, tnow, ttbeg, nnrns: Integer;
  nrns, dtimz, tsob, ttfin, m, k1, k2, k3: Integer;
  f, f1: file of ta2;
  a, b, a1, atrib, dt, a2: ta1;
  a3: ta2;
  fx: Text;
  j1, rep_count, rp, rp1: Integer;
 
procedure grup;{Перегрупировка событий по времени}
var
  l, k, h, i, j, n: Integer;
begin
  WriteLn(fx, 'Перегруппировка событий по времени');
  Seek(f, 0);
  Read(f, a3);
  n := 1;
  while a3[matr + 2, n] = 1 do
  begin
    for k := 1 to nnq1 - 1 do
      for l := 1 to matr + 2 do
      begin
        a3[l, k] := a3[l, k + 1];
        a3[l, k + 1] := 0;
      end;
    n := n + 1;
  end;
  h := nnq1 div 2;
  j := 0;
  while h <> 0 do
  begin
    for j := h + 1 to nnq1 do
    begin
      i := j - h;
      for k := 1 to matr + 2 do
        a[k] := a3[k, j];
      repeat
        for k := 1 to matr + 2 do
          b[k] := a3[k, i];
        if (a[matr + 2] < b[matr + 2]) and (a[matr + 2] > 0) then
        begin
          for k := 1 to matr + 2 do
            a3[k, i + h] := b[k];
          i := i - h;
        end;
      until (i <= 0) or (a[matr + 2] >= b[matr + 2]) or (a[matr + 2] = 0);
      for k := 1 to matr + 2 do
        a3[k, i + h] := a[k];
    end;
    h := h div 2;
  end;
  Seek(f, 0);
  Write(f, a3);
  WriteLn(fx, 'Вывод нового календаря');
  for i := 1 to nnq1 do
  begin
    for j := 1 to matr + 2 do
      Write(a3[j, i], ' ');
    Write(' ');
  end;
  WriteLn;
end;
 
procedure schdl(kevnt, dtime: Integer; a4: ta1);{Процедура планирования}
var
  i, j: Integer;
begin
  for i := 1 to matr do
    a2[i] := a1[i];
  WriteLn(fx, 'Атрибуты события ', a1[1]);
  a2[matr + 1] := kevnt;
  WriteLn(fx, 'код события', kevnt);
  a2[matr + 2] := tnow + dtime;
  WriteLn(fx, 'время события', tnow + dtime);
  Seek(f, 0);
  Write(f, a3);
  j := 1;
  while a3[matr + 1, j] <> 0 do
    j := j + 1;
  for i := 1 to matr + 2 do
    a3[i, j] := a2[i];
  Seek(f, 0);
  Write(f, a3);
  WriteLn(fx, 'вывод календаря');
  for i := 1 to nnq1 do
  begin
    for j := 1 to matr + 2 do
      Write(fx, a3[j, i], ' ');
    Write(fx, ' ');
  end;
  WriteLn(fx);
  grup;
end;
 
procedure rmove;{Извлечение первой записи}
var
  i, j: Integer;
begin
  Seek(f, 0);
  Read(f, a3);
  tsob := a3[matr + 2, 1];
  i := a3[matr + 1, 1];
  WriteLn(fx, 'код извлечённого события ', i);
  WriteLn(fx, 'время извлечённого события', a3[matr + 2, 1]);
  for j := 1 to matr + 3 do
    a3[j, 1] := 0;
  for j := 1 to matr do
    atrib[j] := a3[j, 1];
  Seek(f, 0);
  Write(f, a3);
  WriteLn(fx, 'вывод календаря');
  for i := 1 to nnq1 do
  begin
    for j := 1 to matr + 2 do
      Write(fx, a3[j, i], '');
    Write(fx, ' ');
  end;
  WriteLn(fx);
  grup;
end;
 
procedure intlc;
var
  l0, ml0, ni, nl, busy, ex1: Integer;
begin
  tnow := ttbeg;
  Write(fx, 'Время очередного прогона', tnow);
  WriteLn(fx);
  nrns := nrns + 1;
  Write(fx, 'Номер очередного прогона', nrns);
  WriteLn(fx);
  dt[1] := 1;
  dt[2] := 2;
  dt[3] := 3;
  Write(fx, 'Вызов подпрограммы планирования');
  kevnt := 1;
  i := kevnt;
  dtimz := dt[1] + k3 * random(k2);
  schdl(1, dtimz, a1);
end;
 
procedure event(i: Integer);
{Процедура поиска процедуры обработки}
begin
  case i of
    1:
    begin
      WriteLn(fx, 'Произошло событие с кодом', i,
        'с временем', tnow);
      kevnt := 2;
      i := kevnt;
      dtimz := round(dt[2] * exp(k1));
      schdl(2, dtimz, a1);
    end;
    2:
    begin
      WriteLn(fx, 'Произошло событие с кодом', i,
        'c временем', tnow);
      kevnt := 3;
      i := kevnt;
      schdl(3, dt[3], a1);
    end;
    3: WriteLn(fx, 'Произошло событие с кодом', i,
        'c временем', tnow);
  end;
end;
 
procedure otputn;{Процедура отчета по прогону}
var
  nrns: Integer;
begin
  Write(fx, 'Номер прогона ', ' ', nrns);
  Write(fx, 'прогон завершен');
end;
 
procedure otput;{Процедура итогового отчета по прогонам}
var
  sd, sdd: array [1..940] of Word;
  x0, y0, i3, i33, i33_, i331, i22, j2, jj: Word;
  x, y, m1: Real;
  graphdriver, graphmode: Integer;
  switch: Boolean;
  s: String;
begin
  Write(fx, 'Имитация закончена');
  graphdriver := detect;
  initgraph(graphdriver, graphmode, '');
  x0 := 20;
  y0 := getmaxY div 2;
  switch := True;
  for j2 := 0 to rep_count do
  begin
    cleardevice;
    str(rp, s);
    setbkcolor(blue);
    setcolor(white);
    line(x0, 20, x0, getmaxY - 20);
    line(x0, y0, getmaxX - 20, y0);
    moveto(x0, y0);
    for i3 := 1 to getmaxX - 40 do
    begin
      m1 := 20;
      x := random(k3) + 1;
      y := (1 / m1) * exp(-x / m1);
      sd[i3] := round(y * k2);
    end;
    i33_ := 10;
    jj := 1;
    while i33_ < 200 do
    begin
      i33_ := i33_ + rp;
      sdd[jj] := 0;
      for i33 := 1 to getmaxX do
      begin
        if (sd[i33] = i33_) then
          sdd[jj] := sdd[jj] + 1;
      end;
      jj := jj + 1;
    end;
    jj := x0;
    for i3 := 1 to round(200 / rp) do
    begin
      setcolor(10);
      rectangle(jj, y0, jj + 10, y0 - round(sd[i3] * k1));
      jj := jj + 10;
    end;
    readln;
  end;
  closegraph;
end;
 
procedure slam;
var
  i, j: Integer;
begin
  intlc;
  rmove;
  i := kevnt;
  tnow := tnow + dt[i];
  event(i);
  if (tnow < ttfin) and (a2[matr + 1] > 0) then
  begin
    rmove;
    otputn;
  end;
  if nrns < nnrns then
    intlc
  else
    otput;
end;
 
begin
  clrscr;
  matr := 1;
  nnq1 := 1;
  ttfin := 180;
  ttbeg := 1;
  nrns := 0;
  k1 := 5;
  k2 := 13;
  k3 := 50;
  nnrns := 10;
  m := 20;
  Assign(f, 'C:\Users\Admin\Desktop\f1.bat');
  rewrite(f);
  Assign(fx, 'C:\Users\Admin\Desktop\report.txt');
  rewrite(fx);
  rp := 1;
  rep_count := 0;
  for j1 := 1 to 6 do
    slam;
end.
Гистограмма такая
0
Миниатюры
Подскажите, в чем проблема?  
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
24.06.2019, 10:12

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Подскажите в чем проблема?
======================= function yy=graf228(x,A,B) yy=A*sin(6*x.^3)+B*3*cos(x.^2); end...

Подскажите в чем проблема?
static void Main(string args) { int X; int Y; ...

SerialPort. Подскажите в чем проблема?
private void buttonSEND_Click(object sender, EventArgs e) { ...

Подскажите,в чем проблема видеокарты
Есть система : Материнская плата ASUS A8N5X Процессор Athlon 64 3500+ Venice Блок питания...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.