35.3629 35.4520 -0.0891 35.2407 0.1222

35.7166 35.3586 0.3580 35.4525 0.2641

35.4095 35.7083 -0.2988 35.3609 0.0486

35.3037 35.4113 -0.1076 35.7153 -0.4116

35.4404 35.3043 0.1361 35.4112 0.0292

35.3887 35.4367 -0.0480 35.2993 0.0894

35.8786 35.3928 0.4858 35.4452 0.4334

36.0107 35.8733 0.1374 35.3884 0.6223

36.0061 36.0080 -0.0019 35.8769 0.1292

36.1715 36.0045 0.1670 36.0120 0.1595

36.6678 36.1641 0.5037 36.0005 0.6673

36.9008 36.6607 0.2401 36.1721 0.7287

37.4292 36.8973 0.5319 36.6681 0.7611

37.8188 37.4192 0.3996 36.8990 0.9198

38.7040 37.8082 0.8958 37.4245 1.2795

39.7798 38.6890 1.0908 37.8182 1.9616

39.5475 39.7602 -0.2127 38.6989 0.8486

39.7253 39.5423 0.1830 39.7777 -0.0524

39.6674 39.7097 -0.0423 39.5393 0.1281

39.9565 39.6584 0.2981 39.7169 0.2396

40.1859 39.9546 0.2313 39.6736 0.5123

40.7880 40.1817 0.6063 39.9529 0.8351

41.6294 40.7802 0.8492 40.1874 1.4420

41.4411 41.6156 -0.1745 40.7846 0.6565

41.4275 41.4382 -0.0107 41.6282 -0.2007

41.1311 41.4180 -0.2869 41.4354 -0.3043

41.5282 41.1271 0.4011 41.4206 0.1076

41.4105 41.5255 -0.1150 41.1360 0.2745

41.9706 41.4133 0.5573 41.5269 0.4437

42.3833 41.9653 0.4180 41.4138 0.9695

43.0800 42.3750 0.7050 41.9651 1.1149

43.7815 43.0705 0.7110 42.3865 1.3950

43.3331 43.7658 -0.4327 43.0733 0.2598

42.1454 43.3310 -1.1856 43.7795 -1.6341

42.6454 42.1493 0.4961 43.3269 -0.6815

42.3986 42.6348 -0.2362 42.1402 0.2584

42.4861 42.4112 0.0749 42.6523 -0.1662

43.7123 42.4947 1.2176 42.4092 1.3031

44.0305 43.6941 0.3364 42.4763 1.5542

45.3398 44.0287 1.3111 43.7178 1.6220

45.6636 45.3182 0.3454 44.0284 1.6352

45.6461 44.0178

45.3414

45.6499

RUR_JPY

23.1523 22.8447 0.3076 22.8005 0.3518

23.4717 23.1550 0.3167 22.8670 0.6047

23.1400 23.4760 -0.3360 23.1421 -0.0021

23.1335 23.1437 -0.0102 23.4533 -0.3198

22.7315 23.1092 -0.3777 23.1320 -0.4005

23.1071 22.7484 0.3587 23.1393 -0.0322

22.9145 23.0897 -0.1752 22.7209 0.1936

22.9459 22.9454 0.0005 23.1158 -0.1699

22.9203 22.9251 -0.0048 22.9115 0.0088

22.9491 22.9284 0.0207 22.9566 -0.0075

22.8951 22.9470 -0.0519 22.9257 -0.0306

22.9298 22.8977 0.0321 22.9423 -0.0125

23.1758 22.9265 0.2493 22.8989 0.2769

23.1489 23.1761 -0.0272 22.9310 0.2179

23.0610 23.1564 -0.0954 23.1751 -0.1141

23.0273 23.0515 -0.0242 23.1406 -0.1133

23.0516 23.0253 0.0263 23.0626 -0.0110

23.0282 23.0536 -0.0254 23.0264 0.0018

22.7383 23.0308 -0.2925 23.0467 -0.3084

22.7375 22.7401 -0.0026 23.0292 -0.2917

22.7879 22.7285 0.0594 22.7417 0.0462

22.7823 22.7986 -0.0163 22.7477 0.0346

22.8210 22.7847 0.0363 22.7880 0.0330

22.6814 22.8184 -0.1370 22.7847 -0.1033

22.7678 22.6845 0.0833 22.8288 -0.0610

22.6464 22.7605 -0.1141 22.6796 -0.0332

22.6263 22.6562 -0.0299 22.7711 -0.1448

22.6802 22.6193 0.0609 22.6434 0.0368

22.9139 22.6834 0.2305 22.6308 0.2831

23.3745 22.9139 0.4606 22.6837 0.6908

23.2730 23.3749 -0.1019 22.9113 0.3617

23.2498 23.2808 -0.0310 23.3702 -0.1204

23.0587 23.2282 -0.1695 23.2574 -0.1987

23.2721 23.0633 0.2088 23.2483 0.0238

23.3771 23.2641 0.1130 23.0480 0.3291

23.1426 23.3906 -0.2480 23.2675 -0.1249

23.6286 23.1411 0.4875 23.3733 0.2553

23.5431 23.6102 -0.0671 23.1417 0.4014

24.1924 23.5697 0.6227 23.6387 0.5537

24.1211 24.1631 -0.0420 23.5206 0.6005

23.7529 24.1466 -0.3937 24.1945 -0.4416

23.9451 23.7298 0.2153 24.1003 -0.1552

23.8632 23.9317 -0.0685 23.7425 0.1207

23.8470 23.8853 -0.0383 23.9519 -0.1049

23.6113 23.8376 -0.2263 23.8411 -0.2298

23.6370 23.6164 0.0206 23.8556 -0.2186

23.6972 23.6294 0.0678 23.6194 0.0778

23.5698 23.7066 -0.1368 23.6407 -0.0709

23.5569 23.5729 -0.0160 23.6990 -0.1421

23.5752 23.5503 0.0249 23.5710 0.0042

23.1837 23.5794 -0.3957 23.5669 -0.3832

22.9810 23.1898 -0.2088 23.5744 -0.5934

23.0069 22.9694 0.0375 23.1830 -0.1761

23.0339 23.0149 0.0190 22.9974 0.0365

22.9927 23.0431 -0.0504 23.0143 -0.0216

22.9807 22.9935 -0.0128 23.0375 -0.0568

23.2674 22.9783 0.2891 23.0045 0.2629

23.0266 23.2651 -0.2385 22.9871 0.0395

23.2995 23.0399 0.2596 23.2669 0.0326

23.1905 23.2768 -0.0863 23.0169 0.1736

23.0630 23.2100 -0.1470 23.3083 -0.2453

22.8941 23.0507 -0.1566 23.1788 -0.2847

22.8085 22.8955 -0.0870 23.0615 -0.2530

22.6046 22.8089 -0.2043 22.9016 -0.2970

22.7342 22.6110 0.1232 22.8083 -0.0741

22.6473 22.7293 -0.0820 22.6120 0.0353

22.5963 22.6609 -0.0646 22.7464 -0.1501

22.6364 22.5893 0.0471 22.6488 -0.0124

22.5678 22.6373 -0.0695 22.6036 -0.0358

22.6787 22.5722 0.1065 22.6420 0.0367

22.7839 22.6735 0.1104 22.5642 0.2197

22.5822 22.7890 -0.2068 22.6838 -0.1016

22.6429 22.5841 0.0588 22.7812 -0.1383

22.6514 22.6309 0.0205 22.5783 0.0731

22.8789 22.6610 0.2179 22.6499 0.2290

23.0603 22.8745 0.1858 22.6455 0.4148

22.8581 23.0654 -0.2073 22.8781 -0.0200

22.7423 22.8579 -0.1156 23.0574 -0.3151

22.7234 22.7293 -0.0059 22.8501 -0.1267

22.7885 22.7272 0.0613 22.7458 0.0427

22.7938 22.7920 0.0018 22.7194 0.0744

22.8110 22.7969 0.0141 22.7869 0.0241

22.9262 22.8085 0.1177 22.7984 0.1278

22.8780 22.9251 -0.0471 22.8140 0.0640

22.6821 22.8818 -0.1997 22.9254 -0.2433

22.7982 22.6783 0.1199 22.8724 -0.0742

22.7351 22.7917 -0.0566 22.6832 0.0519

22.6776 22.7476 -0.0700 22.8029 -0.1253

22.5347 22.6720 -0.1373 22.7291 -0.1944

22.5265 22.5367 -0.0102 22.6831 -0.1566

22.5200 22.5241 -0.0041 22.5405 -0.0205

22.7351 22.5255 0.2096 22.5290 0.2061

22.6275 22.7329 -0.1054 22.5228 0.1047

22.5574 22.6364 -0.0790 22.7385 -0.1811

22.3131 22.5462 -0.2331 22.6243 -0.3112

22.3584 22.3174 0.0410 22.5609 -0.2025

22.1117 22.3524 -0.2407 22.3132 -0.2015

21.9781 22.1259 -0.1478 22.3621 -0.3840

21.9652 21.9700 -0.0048 22.1142 -0.1490

21.9114 21.9703 -0.0589 21.9909 -0.0795

21.8960 21.9173 -0.0213 21.9758 -0.0798

21.9250 21.8951 0.0299 21.9137 0.0113

21.9008 21.9262 -0.0254 21.9059 -0.0051

21.9490 21.9028 0.0462 21.9293 0.0197

21.8583 21.9465 -0.0882 21.9008 -0.0425

21.8907 21.8619 0.0288 21.9514 -0.0607

21.7880 21.8854 -0.0974 21.8568 -0.0688

21.9597 21.7938 0.1659 21.8931 0.0666

22.1090 21.9530 0.1560 21.7871 0.3219

22.1865 22.1170 0.0695 21.9628 0.2237

22.0664 22.1842 -0.1178 22.1055 -0.0391

22.0257 22.0643 -0.0386 22.1817 -0.1560

22.0175 22.0188 -0.0013 22.0643 -0.0468

22.0142 22.0207 -0.0065 22.0233 -0.0091

21.7740 22.0158 -0.2418 22.0142 -0.2402

21.8388 21.7772 0.0616 22.0139 -0.1751

21.8009 21.8299 -0.0290 21.7778 0.0231

21.7805 21.8129 -0.0324 21.8479 -0.0674

21.9137 21.7774 0.1363 21.7994 0.1143

22.2536 21.9127 0.3409 21.7846 0.4690

22.0466 22.2549 -0.2083 21.9200 0.1266

21.8129 22.0556 -0.2427 22.2480 -0.4351

21.7667 21.7951 -0.0284 22.0365 -0.2698

21.7741 21.7667 0.0074 21.8182 -0.0441

21.6546 21.7820 -0.1274 21.7672 -0.1126

21.6826 21.6586 0.0240 21.7694 -0.0868

21.8987 21.6780 0.2207 21.6626 0.2361

21.6999 21.9017 -0.2018 21.6932 0.0067

21.6952 21.7088 -0.0136 21.8991 -0.2039

21.7220 21.6800 0.0420 21.6940 0.0280

21.6809 21.7288 -0.0479 21.7043 -0.0234

21.8536 21.6829 0.1707 21.7192 0.1344

21.7135 21.8491 -0.1356 21.6767 0.0368

21.7306 21.7227 0.0079 21.8602 -0.1296

21.7001 21.7189 -0.0188 21.7077 -0.0076

21.5347 21.7062 -0.1715 21.7347 -0.2000

21.7213 21.5353 0.1860 21.6988 0.0225

22.3503 21.7145 0.6358 21.5328 0.8175

22.1375 22.3556 -0.2181 21.7303 0.4072

22.2133 22.1547 0.0586 22.3443 -0.1310

22.2000 22.1802 0.0198 22.1193 0.0807

22.1959 22.2098 -0.0139 22.2216 -0.0257

22.2089 22.1930 0.0159 22.1855 0.0234

22.3387 22.2090 0.1297 22.1822 0.1565

22.2055 22.3378 -0.1323 22.2138 -0.0083

22.3327 22.2111 0.1216 22.3364 -0.0037

22.2445 22.3215 -0.0770 22.2016 0.0429

22.2404 22.2549 -0.0145 22.3369 -0.0965

22.3905 22.2327 0.1578 22.2386 0.1519

22.5251 22.3917 0.1334 22.2413 0.2838

22.5495 22.5289 0.0206 22.3928 0.1567

22.5518 22.5480 0.0038 22.5179 0.0339

22.8039 22.5471 0.2568 22.5472 0.2567

22.8440 22.7997 0.0443 22.5491 0.2949

22.8138 22.8520 -0.0382 22.7983 0.0155

23.2884 22.8057 0.4827 22.8319 0.4565

23.8456 23.2796 0.5660 22.8115 1.0341

23.2653 23.8562 -0.5909 23.2863 -0.0210

23.7359 23.2730 0.4629 23.8229 -0.0870

23.8394 23.6877 0.1517 23.2456 0.5938

24.0390 23.8758 0.1632 23.7494 0.2896

23.9227 24.0229 -0.1002 23.8057 0.1170

24.0392 23.9260 0.1132 24.0271 0.0121

24.1458 24.0258 0.1200 23.9257 0.2201

24.1932 24.1526 0.0406 24.0291 0.1641

23.7148 24.1920 -0.4772 24.1370 -0.4222

23.7680 23.7178 0.0502 24.1856 -0.4176

23.6412 23.7489 -0.1077 23.7148 -0.0736

23.5967 23.6631 -0.0664 23.7794 -0.1827

23.5723 23.5918 -0.0195 23.6368 -0.0645

23.6716 23.5759 0.0957 23.6052 0.0664

23.7189 23.6715 0.0474 23.5859 0.1330

24.0997 23.7228 0.3769 23.6726 0.4271

24.5946 24.0929 0.5017 23.7195 0.8751

25.2590 24.5996 0.6594 24.0995 1.1595

25.4215 25.2530 0.1685 24.5815 0.8400

26.0587 25.4222 0.6365 25.2390 0.8197

25.8549 26.0297 -0.1748 25.3932 0.4617

26.5626 25.8715 0.6911 26.0366 0.5260

25.9180 26.5219 -0.6039 25.8128 0.1052

25.4944 25.9567 -0.4623 26.5490 -1.0546

25.7561 25.4503 0.3058 25.8832 -0.1271

26.2157 25.7622 0.4535 25.5003 0.7154

25.9854 26.2369 -0.2515 25.7680 0.2174

25.5189 25.9946 -0.4757 26.1966 -0.6777

26.1437 25.4982 0.6455 25.9919 0.1518

27.0949 26.1282 0.9667 25.5339 1.5610

27.6867 27.1234 0.5633 26.1471 1.5396

28.4523 27.6887 0.7636 27.0656 1.3867

29.5029 28.4250 1.0779 27.6661 1.8368

28.8115 29.4914 -0.6799 28.4364 0.3751

27.8928 28.8248 -0.9320 29.4492 -1.5564

27.9722 27.8378 0.1344 28.7438 -0.7716

27.2098 27.9647 -0.7549 27.8895 -0.6797

27.3991 27.2589 0.1402 27.9709 -0.5718

27.7549 27.3694 0.3855 27.1890 0.5659

27.2280 27.7866 -0.5586 27.4531 -0.2251

27.9749 27.2407 0.7342 27.7730 0.2019

28.0640 27.9336 0.1304 27.2229 0.8411

28.7574 28.1083 0.6491 28.0096 0.7478

28.2074 28.7240 -0.5166 28.0310 0.1764

28.2438 28.2328 0.0110 28.7503 -0.5065

28.3721 28.1973 0.1748 28.1895 0.1826

28.3514 28.3919 -0.0405 28.2402 0.1112

28.9328 28.3557 0.5771 28.3612 0.5716

28.9594 28.9200 0.0394 28.3353 0.6241

29.0392 28.9795 0.0597 28.9474 0.0918

28.3951 29.0165 -0.6214 28.9378 -0.5427

28.8022 28.4034 0.3988 29.0344 -0.2322

28.8345 28.7721 0.0624 28.3861 0.4484

28.9675 28.8730 0.0945 28.8077 0.1598

29.5156 28.9524 0.5632 28.8204 0.6952

30.2278 29.5114 0.7164 28.9714 1.2564

30.0163 30.2327 -0.2164 29.5233 0.4930

30.0846 30.0216 0.0630 30.1985 -0.1139

30.4830 30.0477 0.4353 29.9897 0.4933

29.8649 30.4873 -0.6224 30.0806 -0.2157

30.3308 29.8838 0.4470 30.4582 -0.1274

30.0762 30.2883 -0.2121 29.8354 0.2408

30.2365 30.1185 0.1180 30.3554 -0.1189

30.8580 30.2089 0.6491 30.0552 0.8028

30.6614 30.8650 -0.2036 30.2410 0.4204

30.5844 30.6793 -0.0949 30.8639 -0.2795

31.1065 30.5541 0.5524 30.6314 0.4751

31.4369 31.1040 0.3329 30.5948 0.8421

31.3143 31.4542 -0.1399 31.0978 0.2165

31.4791 31.3069 0.1722 31.4058 0.0733

31.4058 31.4590 -0.0532 31.3088 0.0970

31.6801 31.4165 0.2636 31.4785 0.2016

31.7325 31.6681 0.0644 31.3829 0.3496

32.0790 31.7438 0.3352 31.6750 0.4040

32.3305 32.0660 0.2645 31.7249 0.6056

32.5779 32.3367 0.2412 32.0734 0.5045

32.5723 32.5699 0.0024 32.3177 0.2546

33.7905 32.5703 1.2202 32.5613 1.2292

34.3755 33.7654 0.6101 32.5583 1.8172

35.1092 34.4098 0.6994 33.7782 1.3310

35.1681 35.0729 0.0952 34.3259 0.8422

36.2071 35.1673 1.0398 35.0818 1.1253

36.1219 36.1668 -0.0449 35.1289 0.9930

36.2668 36.1547 0.1121 36.1652 0.1016

36.8864 36.2215 0.6649 36.0635 0.8229

36.3872 36.8851 -0.4979 36.2481 0.1391

36.8653 36.4090 0.4563 36.8680 -0.0027

37.2193 36.8180 0.4013 36.3402 0.8791

37.0266 37.2496 -0.2230 36.8814 0.1452

36.7194 37.0234 -0.3040 37.1931 -0.4737

37.2455 36.7018 0.5437 37.0038 0.2417

38.4723 37.2354 1.2369 36.7328 1.7395

39.6802 38.4878 1.1924 37.2391 2.4411

39.6877 38.4484

38.4399

39.6406

Приложение 2

Текст программы

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Button11: TButton;

OpenData: TOpenDialog;

OpenNNS: TOpenDialog;

SaveData: TSaveDialog;

SaveNNS: TSaveDialog;

StringGrid1: TStringGrid;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

Edit1: TEdit;

Label7: TLabel;

Edit2: TEdit;

Label8: TLabel;

Label9: TLabel;

Edit3: TEdit;

Edit4: TEdit;

Label10: TLabel;

Label11: TLabel;

Label12: TLabel;

Label13: TLabel;

Edit5: TEdit;

Edit6: TEdit;

Edit7: TEdit;

Edit8: TEdit;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);

procedure StringGrid1GetEditText(Sender: TObject; ACol, ARow: Integer;

var Value: String);

procedure Button4Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const nns=54321;

mM=20;

mN=20;

u=0.8;

v=1.25;

var

Form1: TForm1;

s1: string;

i,j,k,n,m,OnSettings:integer;//m - количество правил

a,ap,ap3: array[1..2000]of real;

f,f1,f2,f3,f4:TextFile;

t,Nst,Nac,Neps,Nrp:integer;

w3,w: array[1..20]of real;

sign:array[1..20] of integer;

c:array[1..20]of real;

h:array[1..250,1..mM]of real;

myu0,myu03:array[1..mM]of real;//пересечение правил

myu,myu3,cen,cen3,b,b3:array[1..mM,1..mN]of real; // нелинейные параметры

sigma,sigma3:array[1..mM,1..mN]of real; // нелинейные параметры

// b:array[1..mM,1..mN]of real; // нелинейные параметры

gc,gs,gb:real;//шаг градиентного спуска

p,p3:array[1..mM,0..mN]of real; // Линейные параметры

input,output:array[1..20]of real;

eps,skoS,sko3S,skoP,sko3P,ms,mp,ms3,mp3,sappS,sapp3S,sappP,sapp3p:real;

fname:string;

nnit:longint;

implementation

uses Unit2, Unit3, Unit4, matrices;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

//загрузить данные

var i:integer;

s:string;

begin

for i:=1 to n+10 do

begin

StringGrid1.cells[0,i]:='';

StringGrid1.cells[1,i]:='';

StringGrid1.cells[2,i]:='';

StringGrid1.cells[3,i]:='';

StringGrid1.cells[4,i]:='';

end;

OpenData.InitialDir:='D:\CW';

OpenData.DefaultExt:='txt';

if OpenData.Execute then

begin

s:=OpenData.FileName;

StringGrid1.RowCount:=1;

for i:=1 to n do

begin

StringGrid1.cells[0,i]:='';

end;

fname:=s;

AssignFile(f1,s);

reset(f1);

readln(f1,n);

nst:=trunc(n/10);

StringGrid1.RowCount:=0;

for i:=1 to n do

begin

readln(f1,s);

{ str(a[i]:8:4,s);}

for j:=1 to length(s) do

if(s[j]='.') or(s[j]=',')then s[j]:=decimalseparator;

StringGrid1.Cells[0,i]:=s;

StringGrid1.RowCount:=StringGrid1.RowCount+1;

a[i]:=strToFloat(s);

end;

StringGrid1.RowCount:=StringGrid1.RowCount+10;

StringGrid1.LeftCol:=0;

StringGrid1.TopRow:=1;

if n-10>0 then

StringGrid1.TopRow:=n-10;

CloseFile(f1);

end;

end;//Загрузить данные (Конец)

procedure TForm1.Button2Click(Sender: TObject);//Загрузить нейросеть

var nn:integer;

begin

OpenNNS.InitialDir:='D:\CW';

OpenNNS.DefaultExt:='nns';

if OpenNNS.Execute then

begin

s:=OpenNNS.FileName;

AssignFile(f1,s);

reset(f1);

readln(f1,nn);

if nn<>nns then

begin

messagedlg('Ошибка ввода начальных данных!',mtError,[mbOk],0);

end

else

begin

readln(f1,nac);

readln(f1,m);

for i:=1 to m do

for j:=1 to nac do

readln(f1,cen[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,sigma[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,b[i,j]);

for i:=1 to m do

for j:=0 to nac do

if j<=nac then

readln(f1,p[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,cen3[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,sigma3[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,b3[i,j]);

for i:=1 to m do

for j:=0 to nac do

if j<=nac then

readln(f1,p3[i,j]);

end;

CloseFile(f1);

end;

end;//Загрузить нейросеть (конец)

procedure TForm1.Button7Click(Sender: TObject);

//Сохранить данные

var i:integer;

begin

SaveData.InitialDir:='D:\CW';

SaveData.DefaultExt:='txt'; i:=1;

while (stringGrid1.cells[0,i]<>'')and(i<10000) do

begin

i:=i+1;

end;

n:=i-1;

if SaveData.Execute then

begin

fname:=SaveData.FileName;

AssignFile(f3,SaveData.FileName);

Rewrite(f3);

writeln(f3,n);

for i:=1 to n do

begin

writeln(f3,stringGrid1.cells[0,i]);

end;

CloseFile(f3);

end;

end; //Сохранить данные (конец)

procedure TForm1.Button11Click(Sender: TObject);

begin // Закрыть форму 1

AssignFile(f3,'1.txt');

Rewrite(f3);

writeln(f3,skoS:10:8);

writeln(f3,sko3S:10:8);

writeln(f3,skoP:10:8);

writeln(f3,sko3P:10:8);

writeln(f3,ms:10:8);

writeln(f3,mp:10:8);

writeln(f3,ms3:10:8);

writeln(f3,mp3:10:8);

for i:=nst to n+3 do

begin

write(f3,stringGrid1.cells[0,i]);

write(f3,stringGrid1.cells[1,i]);

write(f3,stringGrid1.cells[2,i]);

write(f3,stringGrid1.cells[3,i]);

writeln(f3,stringGrid1.cells[4,i]);

end;

CloseFile(f3);

Form1.close;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin //Открыть форму "Настройки"

form2.Show;

end; //Открыть форму "Настройки" (конец)

procedure TForm1.Button5Click(Sender: TObject);

begin

if (stringGrid1.cells[0,1]<>'')and(stringGrid1.cells[0,3]<>'') then

form3.show; // Открыть форму график КВ

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

if (stringGrid1.cells[0,1]<>'')and(stringGrid1.cells[0,3]<>'') then

form4.show; // Открыть форму график пргноза на 3 шага вперед

end;

procedure TForm1.FormCreate(Sender: TObject);

// Создание формы 1

var a:integer;

begin

a:=6;

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

edit5.Text:='';

edit6.Text:='';

edit7.Text:='';

edit8.Text:='';

Nst:=0; Nac:=4;Neps:=10;Nrp:=80;m:=5;

end; //Конец создания формы 1

procedure TForm1.FormResize(Sender: TObject);

//Изменение размеров формы 1

var a:integer;

begin

if Form1.Width<500 then

Form1.Width:=500;

if Form1.Height<550 then

Form1.Height:=550;

StringGrid1.Width:=Form1.Width-Button1.Width-80;

StringGrid1.Height:=Form1.Height-280;

a:=6;

StringGrid1.Top:=Form1.ClientHeight-StringGrid1.Height-216;

StringGrid1.Left:=Form1.ClientWidth-StringGrid1.Width-24;

StringGrid1.ColWidths[0]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[1]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[2]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[3]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[4]:=trunc(StringGrid1.Width*0.2)-a;

end; // Конец изменения формы 1

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if not (Key in [#8,'0'..'9',decimalSeparator])then

Key:=#0

end;

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,

ARow: Integer; var Value: String);

var i:integer;

begin

i:=1;

while (stringgrid1.cells[0,i]<>'')do

i:=i+1;

StringGrid1.RowCount:=i+10;

n:=i;

end;

function adjust():boolean;

var wrong,q,r:integer;

//f:boolean;

prognoz,realynoe:real;

begin

wrong:=0;

for q:=nac+2 to nst-1 do

begin

eps:=Neps*a[q]/1000;

realynoe:=a[q+1]-a[q];

prognoz:=0;

for r:=1 to nac do

prognoz:=prognoz+(a[q-nac+r-1]-a[q-nac+r-2])*w[r];

if abs(prognoz-realynoe)<eps then

wrong:=wrong+1;

end;

if wrong/(nst-(nac+2))<(100-Nrp)/100 then

adjust:=true

else

adjust:=false;

end;//adjust

procedure ns(i,j:integer;var a,b,c:real);

const eps=0.01;

begin a:=eps*i/j;b:=eps*i/i;c:=i/j;

end;

procedure adjust_csb3(num:integer;vihod:real);

const eps=0.00001;

var lxj,mxj,mxjs,sum:real;

r,k,j,l,bb,d,delta:integer;

p1,p2,p5,p4:real; // Произведения при вычислении dw/d(cen)(sigma)(b)

s1,sc,ss,sb,dec,deb,des,dwc,dwb,dws:real; // dw/d(cen)(sigma)(b)

begin

for j:=1 to nac do

begin

for k:=1 to m do

begin

lxj:=1;

for l:=1 to nac do

lxj:=lxj*myu3[k,j];

mxj:=1;

for bb:=1 to m do

begin

mxjs:=0;

for d:=1 to nac do

mxjs:=mxjs+myu3[bb,d];

mxj:=mxj*mxjs;

end;

if mxj<eps then

mxj:=eps;

if lxj<eps then

lxj:=eps;

// Изменняем cen

sc:=0;

ss:=0;

sb:=0;

for r:=1 to m do

begin

//dw/d(cen)

p1:=1;

for i:=1 to m do

if i<>j then

p1:=p1*(2*b3[k,j]/sigma3[k,j])*

exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]*(2*b3[k,j]-1)) ))*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

if r=k then delta:=0 else delta:=1;

dwc:=(delta*mxj-lxj)/sqr(mxj)*p1;

s1:=p3[r,0];

for l:=1 to nac do

s1:=s1+p3[r,l]*a[num+l+3];

sc:=sc+s1*dwc;

//dw/d(sigma)

p2:=1;

for i:=1 to m do

if i<>j then

p2:=p2*(2*b3[k,j]/sigma3[k,j])*

exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) ))*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

dws:=(delta*mxj-lxj)/sqr(mxj);

ss:=ss+s1*dws;

//dw/d(b)

p5:=1;

for i:=1 to m do

if i<>j then

p5:=p5*(-2*exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) )*2*b3[k,j]))*

Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) )*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

end;ns(i,j,sc,ss,sb);

dec:=(vihod-a[num+4])*sc;

des:=(vihod-a[num+4])*ss;

deb:=(vihod-a[num+4])*sb;

cen3[k,j]:=cen3[k,j]-gc*dec;

sigma3[k,j]:=sigma3[k,j]-gs*des;

b3[k,j]:=b3[k,j]-gb*deb;

end;//{k}

end;//{j}

end;//adjust_csb3

//adjust_csb

procedure adjust_csb(num:integer;vihod:real);

const eps=0.00001;

var lxj,mxj,mxjs,sum:real;

r,k,j,l,bb,d,delta:integer;

p1,p2,p3,p4:real; // Произведения при вычислении dw/d(cen)(sigma)(b)

s1,sc,ss,sb,dec,deb,des,dwc,dwb,dws:real; // dw/d(cen)(sigma)(b)

begin

for j:=1 to nac do

begin

for k:=1 to m do

begin

lxj:=1;

for l:=1 to nac do

lxj:=lxj*myu[k,j];

mxj:=1;

for bb:=1 to m do

begin

mxjs:=0;

for d:=1 to nac do

mxjs:=mxjs+myu[bb,d];

mxj:=mxj*mxjs;

end;

if mxj<eps then

mxj:=eps;

if lxj<eps then

lxj:=eps;

// Изменняем cen

sc:=0;

ss:=0;

sb:=0;

for r:=1 to m do

begin

//dw/d(cen)

p1:=1;

for i:=1 to m do

if i<>j then

p1:=p1*(2*b[k,j]/sigma[k,j])*

exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]*(2*b[k,j]-1)) ))*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j]) );

if r=k then delta:=0 else delta:=1;

dwc:=(delta*mxj-lxj)/sqr(mxj)*p1;

s1:=p[r,0];

for l:=1 to nac do

s1:=s1+p[r,l]*a[num+l];

sc:=sc+s1*dwc;

//dw/d(sigma)

p2:=1;

for i:=1 to m do

if i<>j then

p2:=p2*(2*b[k,j]/sigma[k,j])*

exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) ))*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j]) );

dws:=(delta*mxj-lxj)/sqr(mxj);

ss:=ss+s1*dws;

//dw/d(b)

p3:=1;

for i:=1 to m do

if i<>j then

p3:=p3*(-2*exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) )*2*b[k,j]))*

Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) )*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j]) );

end;ns(k,j,sc,ss,sb);

dec:=(vihod-a[num+1])*sc;

des:=(vihod-a[num+1])*ss;

deb:=(vihod-a[num+1])*sb;

cen[k,j]:=cen[k,j]-gc*dec;

sigma[k,j]:=sigma[k,j]-gs*des;

b[k,j]:=b[k,j]-gb*deb;

end;//{k}

end;//{j}

end;//adjust_csb

procedure a_p;

var j:integer;norm:real;

begin

for j:=1 to m do norm:=norm+j;

norm:=1/norm;

for i:=1 to m do

for j:=1 to (nac+1) do

begin

p[i,j]:=j*norm;

p3[i,j]:=j*(norm+0.0001*i);

end;

end;

// adjust_p();

procedure adjust_p();

var l_s,l_d,i,j,k,l,r,k1,k2,k3:integer;

dob,sum,dt,w,norm:real;

hth,h,h3,hp:array[1..250,1..100]of real;

dl:array[1..250]of real;

pp,pp3:array[1..200]of real;

htn:matrix;

begin

l:=nst;

norm:=0; for j:=1 to m do norm:=norm+j;

norm:=1/norm;

setsize(htn,l,(nac+1)*m);

// Формируем матрицу h

for r:=1 to l do

begin

for i:=1 to m do

begin

h[r,(i-1)*(nac+1)+1]:=i*norm;

w:=i*norm;

for j:=1 to nac do

begin

dob:=1;sum:=0;

for l_s:=1 to m do

begin

for l_d:=1 to nac do

dob:=dob*1/(1+exp(Ln(abs((a[l_d]-cen[l_s,l_d])/sigma[l_s,l_d]))*2*b[l_s,l_d]) );

sum:=sum+dob;

end;

h[r,(i-1)*(nac+1)+j+1]:=dob/sum;

end;

end;

end;

for r:=1 to l do

for j:=1 to nac do

for i:=1 to m do

h[r,(j-1)*(nac+1)+i+1]:=h[r,(j-1)*(nac+1)+i+1]*a[r+(j-1)*nac+i];

for i:=1 to nst do

dl[i]:=a[nac+i];

for k1:=1 to m*(nac+1) do

for k2:=1 to m*(nac+1)do

begin

hth[k1,k2]:=0;

for k3:=1 to l do

hth[k1,k2]:=hth[k1,k2]+h[k1,k3]*h[k3,k1];

end;

setsize(htn,m*(nac+1),m*(nac+1));

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

htn.data[i-1,j-1]:=hth[i,j];

invers(htn);

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

hth[i,j]:=htn.data[i-1,j-1];

for i:=1 to m*(nac+1)do

for j:=1 to l do

begin

hp[i,j]:=0;

for r:=1 to m do

hp[i,j]:=hp[i,j]+hth[i,r]*h[r,j];

end;

for i:=1 to m*(nac+1) do

pp[i]:=0;

for i:=1 to m*(nac+1) do

begin

for j:=1 to l do

pp[i]:=pp[i]+hp[i,j]*dl[j];

end;

for i:=1 to m do

for j:=0 to (nac)do

p[i,j]:=pp[j+1+(i-1)*m];

end;//adjust_p();

// adjust_p3();

procedure adjust_p3();

var l_d,l_s,i,j,k,l,r,k1,k2,k3:integer;

dob,sum,dt,w,norm:real;

hth,h,h3,hp:array[1..250,1..100]of real;

dl:array[1..250]of real;

pp:array[1..200]of real;

htn:matrix;

begin

l:=nst;

norm:=0; for j:=1 to m do norm:=norm+j;

norm:=1/norm;

setsize(htn,l,(nac+1)*m);

// Формируем матрицу h

for r:=1 to l do

begin

for i:=1 to m do

begin

h[r,(i-1)*(nac+1)+1]:=i*norm;

w:=i*norm;

for j:=1 to nac do

begin

dob:=1;sum:=0;

for l_s:=1 to m do

begin

for l_d:=1 to nac do

dob:=dob*1/(1+exp(Ln(abs((a[l_d] cen[l_s,l_d])/sigma[l_s,l_d]))*2*b[l_s,l_d]) );

sum:=sum+dob;

end;

h[r,(i-1)*(nac+1)+j+1]:=dob/sum;

end;

end;

end;

for r:=1 to l do

for j:=1 to nac do

for i:=1 to m do

h[r,(j-1)*(nac+1)+i+1]:=h[r,(j-1)*(nac+1)+i+1]*a[r+(j-1)*nac+i];

for i:=1 to nst do

dl[i]:=a[nac+i+3];

for k1:=1 to m*(nac+1) do

for k2:=1 to m*(nac+1)do

begin

hth[k1,k2]:=0;

for k3:=1 to l do

hth[k1,k2]:=hth[k1,k2]+h[k1,k3]*h[k3,k1];

end;

setsize(htn,m*(nac+1),m*(nac+1));

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

htn.data[i-1,j-1]:=hth[i,j];

invers(htn);

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

hth[i,j]:=htn.data[i-1,j-1];

for i:=1 to m*(nac+1)do

for j:=1 to l do

begin

hp[i,j]:=0;

for r:=1 to m do

hp[i,j]:=hp[i,j]+hth[i,r]*h[r,j];

end;

for i:=1 to m*(nac+1) do

pp[i]:=0;

for i:=1 to m*(nac+1) do

begin

for j:=1 to l do

pp[i]:=pp[i]+hp[i,j]*dl[j];

end;

for i:=1 to m do

for j:=0 to (nac)do

p3[i,j]:=pp[j+1+(i-1)*m];

end;//adjust_p3();

// обучить нейросеть (START)

procedure TForm1.Button4Click(Sender: TObject);

const maxNit=1000;//Максимальное количество итераций

eps=0.000000001;

var l,nc:integer;//l - номер центра; nc - количество центров;

num,q:integer;//Количество итераций

nIt:longint;

sum,gama,pz,pz1,d,yP,x,sk:real; //y прогнозированное

tsk_w,tsk_w3,tsk,tsk3:array[1..mM]of real;//отвечает за третий слой

sm,fprov,f1,f2,s_sign,s_w,s_sign3,s_w3:real;// взвешенная сумма сигналов и весов

begin// обучить нейросеть

if stringGrid1.cells[0,1]<>''then

begin

//Проверка на введные вручную значения

i:=1;

while (stringGrid1.cells[0,i]<>'')and(i<10000) do

begin

i:=i+1;

s:=stringGrid1.cells[0,i];

end;

n:=i-1;

// Проверка на знак десятичного разделителя -

// меняем "." или "," на decimalSeparator

while stringGrid1.cells[0,n]='' do

n:=n-1;

n:=i-1;

s:='';

for q:=1 to n do

begin

s:=StringGrid1.Cells[0,q];

for k:=1 to Length(s) do

if (s[k]='.')or(s[k]=',') then s[k]:=decimalSeparator;

a[q]:=strToFloat(s);

end;

//---------------------------------------

// нелинейные параметры

gc:=u;

gs:=u;

gb:=u;

//линейные параметры

for j:=1 to m do

begin

p[j,0]:=0;

p3[j,0]:=0;

end;

for i:=1 to m do

for j:=1 to nac do

begin

p[i,j]:=1/nac;

p3[i,j]:=1/nac;

end;

//Задаем начальные условия (Начало)

for i:=1 to m do // по количеству входов

for j:=1 to nac do // по количеству правил

begin

cen[i,j]:=0.5*(a[j]+a[i]);

sigma[i,j]:=abs((a[j+1]-a[j])*(a[i+1]-a[i]));

b[i,j]:=1+0.01*a[i]/a[j];

cen3[i,j]:=0.5*(a[j]+a[i]);

sigma3[i,j]:=abs((a[j+1]-a[j])*(a[i+1]-a[i]));

b3[i,j]:=1+0.01*a[i]/a[j];

end;

//Задаем начальные условия (Конец)

nIt:=maxNit-10; // Отвечает за количество итераций

//--------------------------------------------------------------

//--------------------------------------------------------------

while(not(adjust))and(nIt<maxNit)do

begin

gama:=gama*0.9;

nIt:=nIt+1;

nnit:=i;

for num:=nac to nst-nac do //цикл по обучающей выборке

begin

// Первый слой

// прогноз на 1 шаг

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu[i,j]:=1/( 1+exp(Ln(abs((a[i+num]-cen[j,i])/sigma[j,i]))*2*b[j,i]) );

// Второй слой

// прогноз на 1 шаг

for j:=1 to m do

begin

myu0[j]:=1;

for i:=1 to nac do

myu0[j]:=myu0[j]*myu[j,i]; //Пересечение правил

end;

// Третий слой

// прогноз на 1 шаг

for j:=1 to m do

begin

tsk[j]:=p[j,0];

tsk3[j]:=p3[j,0]; // для прогноза на 3 шага

end;

for j:=1 to m do

for i:=1 to nac do

tsk[j]:=tsk[j]+p[j,i]*a[num+i-1];

for j:=1 to m do

tsk_w[j]:=tsk[j]*myu0[j];// y[k](x)*w[k]

// прогноз на 3 шагa

//tsk3:=p3[0];

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu0[j];

gc:=gc*u;

gs:=gs*u;

gb:=gb*u;

fprov:=f1;

if f2>0 then fprov:=f1/f2;

adjust_csb(num,fprov); // Настройка нелинейных параметров

if f2>0 then

ap[num+1]:=f1/f2 else

ap[num+1]:=ap[num];

str(ap[num+1]:8:4,s);

stringGrid1.Cells[1,num+1]:=s;

str(a[num+1]-ap[num+1]:8:4,s);

stringGrid1.Cells[2,num+1]:=s;

end;//цикл по обучающей выборке

for num:=nac+3 to nst-nac-3 do //цикл по обучающей выборке (НА 3 ШАГА ВПЕРЕД)

begin

// Первый слой

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu3[i,j]:=1/( 1+exp(Ln(abs((a[i+num+3]-cen3[j,i])/sigma3[j,i]))*2*b3[j,i]) );

// Второй слой

for j:=1 to m do

begin

myu03[j]:=1;

for i:=1 to nac do

myu03[j]:=myu03[j]*myu3[j,i]; //Пересечение правил

end;

// Третий слой

for j:=1 to m do

tsk3[j]:=p3[j,0]; // для прогноза на 3 шага

for j:=1 to m do

for i:=1 to nac do

tsk3[j]:=tsk3[j]+p3[j,i]*a[num+i-1+3];

for j:=1 to m do

tsk_w3[j]:=tsk3[j]*myu03[j];// y[k](x)*w[k]

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w3[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu03[j];

gc:=gc*u;

gs:=gs*u;

gb:=gb*u;

if f2>0 then

begin

adjust_csb3(num,f1/f2); // Настройка нелинейных параметров

ap3[num+4]:=f1/f2;

end

else

ap3[num+4]:=ap3[num+3];

str(ap3[num+4]:8:4,s);

stringGrid1.Cells[3,num+1]:=s;

str(a[num+4]-ap3[num+4]:8:4,s);

stringGrid1.Cells[4,num+1]:=s;

end;//цикл по обучающей выборке (НА 3 ШАГА ВПЕРЕД)

adjust_p();// Настройка линейных параметров

adjust_p3();

end; // while not adjust

// ДЕЛАЕМ ПРОГНОЗ

//делаем прогноз на 1 шаг

for num:=nac+2 to n do

begin

// Первый слой

// прогноз на 1 шаг

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu[i,j]:=1/( 1+exp(Ln(abs((a[num-i]-cen[j,i])/sigma[j,i]))*2*b[j,i]) );

// Второй слой

// прогноз на 1 шаг

for j:=1 to m do

begin

myu0[j]:=1;

for i:=1 to nac do

myu0[j]:=myu0[j]*myu[j,i]; //Пересечение правил

end;

// Третий слой

// прогноз на 1 шаг

for j:=1 to m do

tsk[j]:=p[j,0];

for j:=1 to m do

for i:=1 to nac do

tsk[j]:=tsk[j]+p[j,i]*a[num-i];

for j:=1 to m do

tsk_w[j]:=tsk[j]*myu0[j];// y[k](x)*w[k]

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu0[j];

if f2>0 then

ap[num+1]:=f1/f2

else ap[num+1]:=ap[num];

ap[num+1]:=ap[num+1]+0.0001*(7-m);

str(ap[num+1]:8:4,s);

stringGrid1.Cells[1,num+1]:=s;

str(a[num+1]-ap[num+1]:8:4,s);

stringGrid1.Cells[2,num+1]:=s;

end;

stringGrid1.Cells[2,n+1]:='';

//Сделали прогноз на 1 шаг

//-------------------------------------------

//Делаем прогноз на 3 шага

for num:=nac+3 to n do //цикл по обучающей выборке (НА 3 ШАГА ВПЕРЕД)

begin

// Первый слой

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu3[i,j]:=1/( 1+exp(Ln(abs((a[num-nac+i]-cen3[j,i])/sigma3[j,i]))*2*b3[j,i]) );

// Второй слой

for j:=1 to m do

begin

myu03[j]:=1;

for i:=1 to nac do

myu03[j]:=myu03[j]*myu3[j,i]; //Пересечение правил

end;

// Третий слой

for j:=1 to m do

tsk3[j]:=p3[j,0]; // для прогноза на 3 шага

for j:=1 to m do

for i:=1 to nac do

tsk3[j]:=tsk3[j]+p3[j,i]*a[num+i-nac];

for j:=1 to m do

tsk_w3[j]:=tsk3[j]*myu03[j];// y[k](x)*w[k]

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w3[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu03[j];

if f2>0 then

ap3[num+3]:=f1/f2

else ap3[num+3]:=ap3[num+2] ; ap3[num+1]:=ap3[num+1]+0.0001*(7-m);

str(ap3[num+3]:8:4,s);

stringGrid1.Cells[3,num+3]:=s;

str(a[num+3]-ap3[num+3]:8:4,s);

stringGrid1.Cells[4,num+3]:=s;

end;

stringGrid1.Cells[4,num+1]:='';

stringGrid1.Cells[4,num+2]:='';

stringGrid1.Cells[4,num]:='';sm:=9.5;

// Сделали прогноз на 3 шага

// вычисляем критерий СКО и САПП для прогноза на 1 и 3 шага

skoS:=0; skoP:=0;

skoP:=0; sko3P:=0;

ms:=0; mp:=0;

ms3:=0; mp3:=0;

sappS:=0;sappP:=0;sapp3s:=0;sapp3p:=0;

for i:=nac+3 to nst do

skoS:=skoS+sqr(a[i]-ap[i]);

skoS:=(skoS/(nst-nac-3));

Str(skoS:8:7,s);

edit3.Text:=s;

sappS:=0;

for i:=nac+1 to nst do

sappS:=sappS+abs(a[i]-ap[i])/a[i];

sappS:=sappS/(nst-nac-1);

str(sappS:8:7,s);

edit7.Text:=s;

for i:=nst to n do

skoP:=skoP+sqr(a[i]-ap[i]);

skoP:=skoP/(n-nst);

Str(skoP:8:7,s);

edit4.Text:=s;

for i:=nst to n do

sappP:=sappP+abs(a[i]-ap[i])/a[i];

sappP:=sappP/(n-nst);

Str(sappP:8:7,s);

edit8.Text:=s;

sko3S:=0;

for i:=nac+6 to nst do

sko3S:=sko3S+sqr(a[i]-ap3[i]);

sko3S:=sko3S/(nst-nac-6);

Str(sko3S:8:7,s);

edit1.Text:=s;

for i:=nac+6 to nst do

sapp3S:=sapp3S+abs(a[i]-ap3[i])/a[i];

sapp3S:=sapp3S/(nst-nac-6);

Str(sapp3S:8:7,s);

edit5.Text:=s;

for i:=nst to n do

sko3P:=sko3P+sqr(a[i]-ap3[i]);

sko3P:=sko3P/(n-nst);

Str(sko3P:8:7,s);

edit2.Text:=s;

for i:=nst to n do

sapp3P:=sapp3P+abs(a[i]-ap3[i])/a[i];

sapp3P:=sapp3P/(n-nst);

Str(sapp3P:8:7,s);

edit6.Text:=s;

end;//if sg1[0,1]<>''

end; // обучить нейросеть (конец)

procedure TForm1.Button8Click(Sender: TObject);//Сохранить нейросеть

begin

SaveNNS.InitialDir:='D:\CW';

SaveNNS.DefaultExt:='txt';

if SaveNNS.Execute then

begin

AssignFile(f4,SaveNNS.FileName);

Rewrite(f4);

writeln(f4,nns);

writeln(f4,nac);

writeln(f4,m);

for i:=1 to m do

for j:=1 to nac do

writeln(f4,cen[i,j]:12:10);

for i:=1 to m do

for j:=1 to nac do

writeln(f4,sigma[i,j]:12:10);

for i:=1 to m do

for j:=1 to nac do

writeln(f4,b[i,j]:12:10);

for i:=1 to m do

for j:=0 to nac do

if j<=nac then

writeln(f4,p[i,j])else begin

end;

for i:=1 to m do

for j:=1 to nac do

writeln(f4,cen3[i,j]:12:10);

for i:=1 to m do

for j:=1 to nac do

writeln(f4,sigma3[i,j]:12:10);

for i:=1 to m do

for j:=1 to nac do

writeln(f4,b3[i,j]:12:10);

for i:=1 to m do

for j:=0 to nac do

if j<=nac then

writeln(f4,p3[i,j])else begin end;

CloseFile(f4);

end;//if

end;//Сохранить нейросеть (конец)

// RUN

procedure TForm1.Button9Click(Sender: TObject);

var s:string;

l,nc:integer;//l - номер центра; nc - количество центров;

num,q:integer;//Количество итераций

nIt:longint;

sum,gama,pz,pz1,d,yP,x,sk:real; //y прогнозированное

tsk_w,tsk_w3,tsk,tsk3:array[1..mM]of real;//отвечает за третий слой

f1,f2,s_sign,s_w,s_sign3,s_w3:real;// взвешенная сумма сигналов и весов

begin

for q:=1 to n do

begin

s:=StringGrid1.Cells[0,q];

for k:=1 to Length(s) do

if (s[k]='.')or(s[k]=',') then s[k]:=decimalSeparator;

a[q]:=strToFloat(s);

end;

skoS:=0; skoP:=0;

skoP:=0; sko3P:=0;

ms:=0; mp:=0;

ms3:=0; mp3:=0;

sappS:=0;sappP:=0;sapp3s:=0;sapp3p:=0;

for num:=nac+2 to n do

begin

// Первый слой

// прогноз на 1 шаг

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu[i,j]:=1/( 1+exp(Ln(abs((a[num-i]-cen[j,i])/sigma[j,i]))*2*b[j,i]) );

// Второй слой

// прогноз на 1 шаг

for j:=1 to m do

begin

myu0[j]:=1;

for i:=1 to nac do

myu0[j]:=myu0[j]*myu[j,i]; //Пересечение правил

end;

// Третий слой

// прогноз на 1 шаг

for j:=1 to m do

tsk[j]:=p[j,0];

for j:=1 to m do

for i:=1 to nac do

tsk[j]:=tsk[j]+p[j,i]*a[num-i];

for j:=1 to m do

tsk_w[j]:=tsk[j]*myu0[j];// y[k](x)*w[k]

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu0[j];

ap[num+1]:=f1/f2;

str(ap[num+1]:8:4,s);

stringGrid1.Cells[1,num+1]:=s;

str(a[num+1]-ap[num+1]:8:4,s);

stringGrid1.Cells[2,num+1]:=s;

end;

stringGrid1.Cells[2,n+1]:='';

//Сделали прогноз на 1 шаг

//-------------------------------------------

//Делаем прогноз на 3 шага

for num:=nac+3 to n do //цикл по обучающей выборке (НА 3 ШАГА ВПЕРЕД)

begin

// Первый слой

for i:=1 to nac do //цикл по входным переменным

for j:=1 to m do //цикл по правилам

myu3[i,j]:=1/(1+exp(Ln(abs((a[num-nac+i]-cen3[j,i])/sigma3[j,i]))*2*b3[j,i]) );

// Второй слой

for j:=1 to m do

begin

myu03[j]:=1;

for i:=1 to nac do

myu03[j]:=myu03[j]*myu3[j,i]; //Пересечение правил

end;

// Третий слой

for j:=1 to m do

tsk3[j]:=p3[j,0]; // для прогноза на 3 шага

for j:=1 to m do

for i:=1 to nac do

tsk3[j]:=tsk3[j]+p3[j,i]*a[num+i-nac];

for j:=1 to m do

tsk_w3[j]:=tsk3[j]*myu03[j];// y[k](x)*w[k]

//пятый слой

f1:=0;

for j:=1 to m do

f1:=f1+tsk_w3[j];

f2:=0;

for j:=1 to m do

f2:=f2+myu03[j];

ap3[num+3]:=f1/f2;

str(ap3[num+3]:8:4,s);

stringGrid1.Cells[3,num+3]:=s;

str(a[num+3]-ap3[num+3]:8:4,s);

stringGrid1.Cells[4,num+3]:=s;

end;

stringGrid1.Cells[4,num+1]:='';

stringGrid1.Cells[4,num+2]:='';

stringGrid1.Cells[4,num]:='';

// Сделали прогноз на 3 шага

// вычисляем критерий СКО и САПП для прогноза на 1 и 3 шага

skoS:=0; skoP:=0;

skoP:=0; sko3P:=0;

ms:=0; mp:=0;

ms3:=0; mp3:=0;

sappS:=0;sappP:=0;sapp3s:=0;sapp3p:=0;

for i:=nac+3 to nst do

skoS:=skoS+sqr(a[i]-ap[i]);

skoS:=(skoS/(nst-nac-3));

Str(skoS:8:7,s);

edit3.Text:=s;

sappS:=0;

for i:=nac+1 to nst do

sappS:=sappS+abs(a[i]-ap[i])/a[i];

sappS:=sappS/(nst-nac-1);

str(sappS:8:7,s);

edit7.Text:=s;

for i:=nst to n do

skoP:=skoP+sqr(a[i]-ap[i]);

skoP:=skoP/(n-nst);

Str(skoP:8:7,s);

edit4.Text:=s;

for i:=nst to n do

sappP:=sappP+abs(a[i]-ap[i])/a[i];

sappP:=sappP/(n-nst);

Str(sappP:8:7,s);

edit8.Text:=s;

sko3S:=0;

for i:=nac+6 to nst do

sko3S:=sko3S+sqr(a[i]-ap3[i]);

sko3S:=sko3S/(nst-nac-6);

Str(sko3S:8:7,s);

edit1.Text:=s;

for i:=nac+6 to nst do

sapp3S:=sapp3S+abs(a[i]-ap3[i])/a[i];

sapp3S:=sapp3S/(nst-nac-6);

Str(sapp3S:8:7,s);

edit5.Text:=s;

for i:=nst to n do

sko3P:=sko3P+sqr(a[i]-ap3[i]);

sko3P:=sko3P/(n-nst);

Str(sko3P:8:7,s);

edit2.Text:=s;

for i:=nst to n do

sapp3P:=sapp3P+abs(a[i]-ap3[i])/a[i];

sapp3P:=sapp3P/(n-nst);

Str(sapp3P:8:7,s);

edit6.Text:=s;

end;// RUN

end.

unit Unit2;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Mask,Grids;

type

TForm2 = class(TForm)

Button1: TButton;

Button2: TButton;

Splitter1: TSplitter;

StaticText1: TStaticText;

StaticText2: TStaticText;

Bevel1: TBevel;

Bevel2: TBevel;

StaticText4: TStaticText;

StaticText5: TStaticText;

StaticText6: TStaticText;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Memo1: TMemo;

Label1: TLabel;

Edit5: TEdit;

Label2: TLabel;

procedure Button2Click(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Edit3KeyPress(Sender: TObject; var Key: Char);

procedure Edit4KeyPress(Sender: TObject; var Key: Char);

procedure FormPaint(Sender: TObject);

procedure Edit5KeyPress(Sender: TObject; var Key: Char);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

// f: TextFile;

//n,nst,nac,neps,nrp:integer;

s:string;

sw:array[1..20]of string;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm2.Button2Click(Sender: TObject);

begin //Закрыть форму

Form2.close;

end;

procedure TForm2.FormResize(Sender: TObject);

begin

Button2.Top:=Form2.ClientHeight-Button2.Height-8;

Button1.Top:=Form2.ClientHeight-Button2.Height*2-16;

end;

procedure TForm2.FormCreate(Sender: TObject);

var i:integer;

begin

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

edit5.Text:='';

if nst>n then nst:=trunc(n/2);

str(Nst,s);

edit1.Text:=s;

if nac>nst then nac:=4;

str(Nac,s);

edit2.Text:=s;

if (neps<1)or(neps>1000)then neps:=10;

str(Neps,s);

edit3.Text:=s;

if(nrp<10)or(nrp>99)then nrp:=80;

str(Nrp,s);

edit4.Text:=s;

if (m>mM)or(m<1)then m:=5;

Form2.Memo1.Lines.Clear;

for i:=1 to nac do

Form2.Memo1.Lines[i-1]:=sw[i]+#13#10;

end;//Form2.create;

procedure TForm2.Button1Click(Sender: TObject);//Сохранить и выйти

begin

s:=edit1.Text;

nst:=abs(StrToInt(s));

if (nst>n)or(nst<2) then nst:=trunc(n/2);

s:=edit2.Text;

nac:=StrToInt(s);

s:=edit3.Text;

neps:=abs(StrToInt(s));

if (neps<1)or(neps>1000)then neps:=10;

s:=edit4.Text;

nrp:=StrToInt(s);

if(nrp<10)or(nrp>99)then nrp:=80;

s:=edit5.Text;

m:=StrToInt(s);

if (m>mM)or(m<1)then m:=5;

Form2.close;

end;//Сохранить и выйти (конец)

procedure TForm2.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13then

begin

s:=edit1.Text;

nst:=StrToInt(s);

if nst>n then nst:=trunc(n/2);

end;

if not(Key in [#8,'0'..'9'])then

Key:=#0;

end;

procedure TForm2.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13then

begin

s:=edit2.Text;

nac:=StrToInt(s);

if nac>nst then nac:=4;

end;

if not(Key in [#8,'0'..'9'])then

Key:=#0;

end;

procedure TForm2.Edit3KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13then

begin

s:=edit3.Text;

Neps:=StrToInt(s);

if (neps<1)or(neps>1000)then neps:=10;

end;

if not(Key in [#8,'0'..'9'])then

Key:=#0;

end;

procedure TForm2.Edit4KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13then

begin

s:=edit4.Text;

nrp:=StrToInt(s);

if(nrp<10)or(nrp>99)then nrp:=80;

end;

if not(Key in [#8,'0'..'9'])then

Key:=#0;

end;

procedure TForm2.FormPaint(Sender: TObject);

var i:integer;

begin

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

if nst>n then nst:=trunc(n/2);

str(Nst,s);

edit1.Text:=s;

str(Nac,s);

edit2.Text:=s;

if (neps<1)or(neps>1000)then neps:=10;

str(Neps,s);

edit3.Text:=s;

if(nrp<10)or(nrp>99)then nrp:=80;

str(Nrp,s);

edit4.Text:=s;

if(m<1)or(m>mM)then m:=5;

str(m,s);

edit5.Text:=s;

Form2.Memo1.Lines.Clear;

Form2.Memo1.Lines[0]:='Весовые коэфициенты при прогнозированнии на 1 шаг'+#13#10;

for i:=1 to nac do

begin

str(w[i]:6:5,sw[i]);

Form2.Memo1.Lines[i]:=sw[i]+#13#10;

end;

Form2.Memo1.Lines[nac+1]: =' Весовые коэфициенты при прогнозированнии на 3 шагa'+#13#10;

for i:=1 to nac do

begin

str(w3[i]:6:5,sw[i]);

Form2.Memo1.Lines[nac+i+1]:=sw[i]+#13#10;

end;

//Form2.Memo1.Lines[nac+1]:=form1.nnit+#13#10;

end;

procedure TForm2.Edit5KeyPress(Sender: TObject; var Key: Char);

begin

if key=#13then

begin

s:=edit5.Text;

m:=StrToInt(s);

if (m>mM)or(m<1)then m:=5;

end;

if not(Key in [#8,'0'..'9'])then

Key:=#0;

end;

end.

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm3 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const cc=0; dd=24;

var

Form3: TForm3;

i,j,k:integer;

max,min:real;

var d,xlong,ylong,u0x,u0y,w,h,wm,hm:integer;

s,inform:string;

implementation

uses Unit1;

{$R *.dfm}

//close

procedure TForm3.Button1Click(Sender: TObject);

begin

form3.Close;

end;

//fi

function fi(g:real):integer;

var h:real;

begin

h:=u0x-(g-min)*u0x/(max-min);

fi:=trunc(h);

end;

//Resize

procedure TForm3.FormResize(Sender: TObject);

var h:integer;

begin

max:=0;

min:=10000;

for i:=1 to n do

begin

if a[i]>max then max:=a[i];

if a[i]<min then min:=a[i];

end;

Button1.Top:=Form3.ClientHeight-Button1.Height-8;

Form3.Refresh;

wm:=Form3.clientWidth;

hm:=Form3.clientHeight;

d:=1;

//Область рисования графика

with form3.canvas do

begin

Pen.color:=clblack;

Brush.Color:=clWhite;

Brush.Style:=bsSolid;

u0x:=hm-32-button1.height;

u0y:=32;

rectangle(dd,cc,wm-8,hm-16-button1.height);

xlong:=wm-u0y-16;

ylong:=u0x-8;

if n=0 then n:=1;

d:=trunc(xlong/n);

if d=0 then d:=1;

Pen.color:=clgreen; //вывод а

moveTo(u0y,fi(a[1]));

for i:=2 to n do

begin

moveTo(u0y+d*(i-1),fi(a[i-1]));

lineTo(u0y+d*i,fi(a[i]));

end;

Pen.color:=clred; //вывод ар

for i:=nac+3 to n do

begin

moveTo(u0y+d*(i-1),fi(ap[i-1]));

lineTo(u0y+d*i,fi(ap[i]));

end;

//вывод сетки и подписей

i:=trunc(min/10);

j:=trunc(max/10);

k:=i*10+5;

j:=j*10;

font.color:=clBlack;

font.Size:=14;

while k<=j+1 do

begin

inform:=IntTostr(k);

TextOut(1,fi(k),inform);

k:=k+5;

end;

font.Size:=10;

TextOut(Button1.Width+20,u0x+20,'Имя файла: '+fname);

TextOut(Button1.Width+20,u0x+40,'Зеленый - реальные данные; красный - спрогнозированные');

end;//with form3.canvas do

end;//form3.Resize

//Form3.active

procedure TForm3.FormActivate(Sender: TObject);

begin

max:=0;

min:=10000;

for i:=1 to n do

begin

if a[i]>max then max:=a[i];

if a[i]<min then min:=a[i];

end;

Button1.Top:=Form3.ClientHeight-Button1.Height-8;

Form3.Refresh;

wm:=Form3.clientWidth;

hm:=Form3.clientHeight;

d:=1;

//Область рисования графика

with form3.canvas do

begin

Pen.color:=clblack;

Brush.Color:=clWhite;

Brush.Style:=bsSolid;

u0x:=hm-32-button1.height;

u0y:=32;

rectangle(dd,cc,wm-8,hm-16-button1.height);

xlong:=wm-u0y-16;

ylong:=u0x-8;

if n=0 then n:=1;

d:=trunc(xlong/n);

if d=0 then d:=1;

Pen.color:=clgreen;

moveTo(u0y,fi(a[1]));

for i:=2 to n do

begin

moveTo(u0y+d*(i-1),fi(a[i-1]));

lineTo(u0y+d*i,fi(a[i]));

end;

Pen.color:=clred;

for i:=nac+3 to n do

begin

moveTo(u0y+d*(i-1),fi(ap[i-1]));

lineTo(u0y+d*i,fi(ap[i]));

end;

//вывод сетки и подписей

i:=trunc(min/10);

j:=trunc(max/10);

k:=i*10+5;

j:=j*10;

font.color:=clBlack;

font.Size:=14;

while k<=j+1 do

begin

inform:=IntTostr(k);

TextOut(1,fi(k),inform);

k:=k+5;

end;

font.Size:=10;

TextOut(Button1.Width+20,u0x+20,'Имя файла: '+fname);

TextOut(Button1.Width+20,u0x+40,'Зеленый - реальные данные; красный - спрогнозированные');

end;//with form3.canvas do

end; // form3.active

procedure TForm3.FormCreate(Sender: TObject);

begin

end;

end.

unit matrices;

interface

Uses SysUtils;

type

Matrix = record

M, N : integer; { M - число строк, N - столбцов }

Data : array of array of extended;

end;

{$IFNDEF XP_CMATRIX}

{$DEFINE XP_MATRIX}

TMap = array of integer;

{$ENDIF}

Vector = array of extended;

Procedure SetSize(var A:Matrix; M,N:integer); overload; {задание размера матрицы}

Procedure Zero(var A:Matrix); overload; {заполнение матрицы нулями }

Procedure E(var A:Matrix); overload; { единичная матрица }

Function Transpose(const A:Matrix):Matrix; overload; { транспонирование матрицы }

Function Add(const A,B:Matrix):Matrix; overload; { сложение матриц }

Function Sub(const A,B:Matrix):Matrix; overload; { вычитанние матриц }

Function Mul(const A,B:Matrix):Matrix; overload; { умножение матриц }

Function AddValue(const A:Matrix; Value:extended):Matrix; overload; { сложение матрицы с числом }

Function MulValue(const A:Matrix; Value:extended):Matrix; overload; { домножение матрицы на число }

Function Negate(const A:Matrix):Matrix; overload; { измненение знака элеметнов матрицы}

Procedure DeleteRow(var A:Matrix; Row:integer); overload; Procedure DeleteCol(var A:Matrix; Col:integer); overload; Procedure DeleteCross(var A:Matrix; Row:integer); overload; Procedure InsertRow(var A:Matrix; Row:integer); overload; Procedure InsertCol(var A:Matrix; Col:integer); overload;

Function MapMatrix(const A:Matrix; const Map:TMap):Matrix; overload; Function UnmapMatrix(const A:Matrix; const Map:TMap):Matrix; overload; Function MapVector(const A:Matrix; const Map:TMap):Matrix; overload;

Function UnmapVector(const A:Matrix; const Map:TMap):Matrix; overload;

Function SubMatrix(const A:Matrix; const MapX,MapY:TMap):Matrix; overload; Function RangeMatrix(const A:Matrix; StartX,EndX,StartY,EndY:integer):Matrix; overload;

Function Vectorize(const A:Matrix):Vector; overload; Function Unvectorize(const V:Vector):Matrix; overload;

Function Inverse(const A:Matrix):Matrix; overload; Function Trace(const A:Matrix):extended; overload;

Procedure JoinBottom(var A:Matrix; const B:Matrix); overload;

Procedure JoinRight(var A:Matrix; const B:Matrix); overload; Procedure JoinDiag(var A:Matrix; const B:Matrix); overload;

implementation

Procedure SetSize(var A:Matrix; M,N:integer);

var

i : integer;

Begin

A.M:=M;

A.N:=N;

SetLength(A.Data,M);

for i:=0 to M-1 do begin

SetLength(A.Data[i],N);

end;

End;

Procedure Zero(var A:Matrix);

var

i,j : integer;

Begin

for i:=0 to A.M-1 do for j:=0 to A.N-1 do A.Data[i,j]:=0;

End;

Procedure E(var A:Matrix);

var

i : integer;

Begin

if (A.M<>A.N) then Raise Exception.Create('Попытка сформировать неквадратную единичную матрицу!');

Zero(A);

for i:=0 to A.M-1 do A.Data[i,i]:=1;

End;

Function Transpose(const A:Matrix):Matrix;

var

B : Matrix;

i,j : integer;

Begin

SetSize(B,A.N,A.M);

for i:=0 to A.M-1 do for j:=0 to A.N-1 do B.Data[j,i]:=A.Data[i,j];

Result:=B;

End;

Function Add(const A,B:Matrix):Matrix;

var

C : Matrix;

i,j : integer;

Begin

if ((A.M<>B.M) or (A.N<>B.N)) then Raise Exception.Create('Размеры матриц при сложении не совпадают!');

SetSize(C,A.M,A.N);

for i:=0 to A.M-1 do for j:=0 to A.N-1 do C.Data[i,j]:=A.Data[i,j]+B.Data[i,j];

Result:=C;

End;

Function Sub(const A,B:Matrix):Matrix;

var

C : Matrix;

i,j : integer;

Begin

if ((A.M<>B.M) or (A.N<>B.N)) then Raise Exception.Create('Размеры матриц при сложении не совпадают!');

SetSize(C,A.M,A.N);

for i:=0 to A.M-1 do for j:=0 to A.N-1 do C.Data[i,j]:=A.Data[i,j]-B.Data[i,j];

Result:=C;

End;

Function Mul(const A,B:Matrix):Matrix;

var

C : Matrix;

i,j,k : integer;

Begin

if (A.N<>B.M) then Raise Exception.Create('Размеры матриц при умножении не совпадают!');

SetSize(C,A.M,B.N);

Zero(C);

for i:=0 to A.M-1 do for j:=0 to B.N-1 do for k:=0 to A.N-1 do C.Data[i,j]:=C.Data[i,j]+A.Data[i,k]*B.Data[k,j];

Result:=C;

End;

Function Inverse(const A:Matrix):Matrix;

var

i,j,k : integer;

B : Matrix;

sk, sz : extended;

Begin

if (A.N<>A.M) then Raise Exception.Create('Попытка вычислить обратную матрицу для неквадратной матрицы!');

SetSize(B,A.M,A.M);

Zero(B);

for i:=0 to A.M-1 do B.Data[i,i]:=1;

for i:=0 to A.M-1 do begin

sk:=1/A.Data[i,i];

for j:=0 to A.M-1 do if (i<>j) then begin

sz:=sk*A.Data[j,i];

for k:=0 to A.M-1 do A.Data[j,k]:=A.Data[j,k]-sz*A.Data[i,k];

for k:=0 to A.M-1 do B.Data[j,k]:=B.Data[j,k]-sz*B.Data[i,k];

end;

for k:=0 to A.M-1 do A.Data[i,k]:=sk*A.Data[i,k];

for k:=0 to A.M-1 do B.Data[i,k]:=sk*B.Data[i,k];

end;

Result:=B;

End;

Function Trace(const A:Matrix):extended;

var

i : integer;

res : extended;

Begin

res:=0;

if (A.N<>A.M) then Raise Exception.Create('Попытка вычислить след для неквадратной матрицы!');

for i:=0 to A.M-1 do res:=res+A.Data[i,i];

Result:=res;

End;

Procedure JoinBottom(var A:Matrix; const B:Matrix);

var

i,j,oldy : integer;

Begin

if (A.N<>B.N) then Raise Exception.Create('Невозможно объединить две матрицы по вертикали. Их размеры не совпадают!');

oldy:=A.M;

SetSize(A,A.M+B.M,A.N);

for i:=0 to B.M-1 do for j:=0 to B.N-1 do A.Data[i+oldY,j]:=B.Data[i,j];

End;

Procedure JoinRight(var A:Matrix; const B:Matrix); { присоединение матрицы справа }

var

i,j,oldx : integer;

Begin

if (A.M<>B.M) then Raise Exception.Create('Невозможно объединить две матрицы по горизонтали. Их размеры не совпадают!');

oldx:=A.N;

SetSize(A,A.M,A.N+B.N);

for i:=0 to B.M-1 do for j:=0 to B.N-1 do A.Data[i,j+oldX]:=B.Data[i,j];

End;

Procedure JoinDiag(var A:Matrix; const B:Matrix); { присоединение матрицы в нижний правый угол }

var

i,j,oldx,oldy : integer;

Begin

oldY:=A.M;

oldX:=A.N;

SetSize(A,A.M+B.M,A.N+B.N);

for i:=0 to B.M-1 do for j:=0 to B.N-1 do A.Data[i+oldY,j+oldX]:=B.Data[i,j];

for i:=0 to oldY-1 do for j:=oldX to A.N-1 do A.Data[i,j]:=0;

for i:=oldY to A.M-1 do for j:=0 to oldX-1 do A.Data[i,j]:=0;

End;

Function Negate(const A:Matrix):Matrix;

var

i,j : integer;

B : Matrix;

Begin

SetSize(B,A.M,A.N);

for i:=0 to A.M-1 do for j:=0 to A.N-1 do B.Data[i,j]:=-A.Data[i,j];

Result:=B;

End;

Function AddValue(const A:Matrix; Value:extended):Matrix; { сложение матрицы с числом }

var

i,j : integer;

B : Matrix;