/* (C) Универсальная когнитивная аналитическая система "ЭЙДОС-X++", beta-version, rel: 29.07.2020. (C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар. */ /* The Eidos-X++ system differs from other artificial intelligence systems in the following parameters: - it was developed in a universal setting, independent of the subject area. Therefore, it is universal and can be applied in many subject areas (http://lc.kubagro.ru/aidos/index.htm); - it is in full open free access (http://lc.kubagro.ru/aidos/_Aidos-X.htm) and has all the relevant source texts (http://lc.kubagro.ru/__AIDOS-X.txt); - it is one of the first domestic systems of artificial intelligence of the personal level, i.e. it does not take special training in the field of technologies of artificial intelligence from the user (there is an act of introduction of system "Eidos" in 1987) (http://lc.kubagro.ru/aidos/aidos02/PR-4.htm); - it provides stable identification in a comparable form of strength and direction of cause-effect relationships in incomplete noisy interdependent (nonlinear) data of very large dimension of numerical and non-numerical nature, measured in different types of scales (nominal, ordinal and numerical) and in different units of measurement (i.e. does not impose strict requirements to the data that cannot be performed, and processes the data that can); - it contains a large number of local (supplied with the installation) and cloud educational and scientific applications (currently 31 and 204 (http://aidos.byethost5.com/Source_data_applications/WebAppls.htm), respectively) (http://lc.kubagro.ru/aidos/Presentation_Aidos-online.pdf); - it provides multilingual interface support in 51 languages. The language databases are included in the installation and can be replenished automatically; - it supports on-line environment of knowledge accumulation and is widely used all over the world (http://aidos.byethost5.com/map5.php); - the most time-consuming, computationally, are the operations of the synthesis models and implements recognition using graphic processing unit (GPU) where some tasks can only support up to several thousand times; the solution of these tasks is intelligent processing of big data, big information and big knowledge; - it provides transformation of the initial empirical data into information, and its knowledge and solution using this knowledge of classification problems, decision support and research of the subject area by studying its system-cognitive model, generating a very large number of tabular and graphical output forms (development of cognitive graphics), many of which have no analogues in other systems (examples of forms can be found in: http://lc.kubagro.ru/aidos/aidos18_LLS/aidos18_LLS.pdf); - it well imitates the human style of thinking: gives the results of the analysis, understandable to experts according to their experience, intuition and professional competence. - instead of making almost impossible demands on the source data (such as the normality of distribution, absolute accuracy and complete repetitions of all combinations of factor values and their complete independence and additivity), the automated system-cognitive analysis (ASC-analysis) offers to process this data without any preliminary processing and thereby transform it into information, and then transform this information into knowledge by applying it to achieve goals (i.e. for the management) and solving problems of classification, decision support, and meaningful empirical research of the domain being modeled. What is the strength of the approach implemented in Eidos system? The strength is implementing an approach whose effectiveness does not depend on what we think about the subject area or whether we think at all. It generates models directly based on empirical data, rather than based on our understanding of the mechanisms for implementing patterns in this data. This is why Eidos models are effective, even if our understanding of the subject area is incorrect or totally absent. And this as well is the weakness of this approach implemented in Eidos system. Models of the Eidos system are phenomenological models, i.e. they do not reflect the mechanisms of determination, but only the fact and nature of determination. */ #include "inkey.ch" #include "dcdir.ch" #include "appevent.ch" #include "xbp.ch" #include "dll.ch" #include "dccursor.ch" #Include "thread.ch" #include "class.ch" #include "dmlb.ch" #include "fileio.ch" #include "dctree.ch" #include "SystemMetrics.ch" #include "appevent.ch" *#include "axcdxcmx.ch" // Графика ActiveX #include "collat.ch" #include "common.ch" #include "dbedit.ch" #include "dbfdbe.ch" #include "dcapp.ch" #include "dcbitmap.ch" #include "dccargo.ch" #include "dcdialog.ch" #include "dcdir.ch" #include "dcfiles.ch" #include "dcgra.ch" #include "dcgraph.ch" // графика #include "BdColors.Ch" // графика #include "dccolors.ch" // графика #include "dcprint.ch" // графика #include "dcicon.ch" #include "dcmsg.ch" #include "dcpick.ch" #include "deldbe.ch" #include "directry.ch" #include "dmlb.ch" #include "express.ch" #include "fileio.ch" #include "font.ch" #include "gra.ch" #include "inkey.ch" #include "memvar.ch" #include "natmsg.ch" #include "prompt.ch" #include '_dcdbfil.ch' #include "set.ch" #include "std.ch" #include "xbp.ch" #include '_dcappe.ch' #include 'dcscope.ch' #include '_dcstru.ch' #include 'dcfields.ch' #include 'dccolor.ch' #include "Fileio.ch" // Max_DB *#include "rmchart.ch" // Графика ActiveX *#include "dcads.ch" // Для альтернативного и неальтернативного выбора в просмотре таблиц *#define BMP_CHECKED "check1.bmp" *#define BMP_UNCHECKED "check2.bmp" *#define BMP_RACHECKED "radio1.bmp" *#define BMP_RAUNCHECKED "radio2.bmp" *#include "test.ch" *#define BMP_CHECKED 10002 *#define BMP_UNCHECKED 10003 *#define BMP_RACHECKED 10004 *#define BMP_RAUNCHECKED 10005 #include "xb2net.ch" #pragma Library("XB2NET.LIB") #pragma library( "ascom10.lib" ) #pragma library( "dclip1.lib" ) #pragma library( "dclip2.lib" ) #pragma library( "dclipx.lib" ) #pragma library( "xbtbase1.lib" ) #pragma library( "xbtbase2.lib" ) #pragma library( "xppui2.lib" ) *#pragma library( "XPPRT0.LIB" ) #Pragma Library("Taskbar.lib") #xtranslate NTrim() => LTrim(Str()) #define USE_HTTPCLIENT // comment out to try Method2 //#include "Imgview.ch" /* * We use user defined events */ #define xbeDS_DirChanged xbeP_User + 100 #define xbeFS_FileMarked xbeP_User + 101 #define xbeFS_FileSelected xbeP_User + 102 #define DCAREAMSG_1 'Invalid Expression in Index Key:' /* * This directive calculates a centered position */ #xtrans CenterPos( , ) => ; { Int( (\[1] - \[1]) / 2 ) ; , Int( (\[2] - \[2]) / 2 ) } #define DC_RDDMSG_1 'Invalid RDD selection - '+cSuperRdd #define DC_RDDMSG_2 'DBE Name Description' #define DC_RDDMSG_3 'Select a Database Driver' #define ADSDBE_MEMOFILE_EXT (DBE_USER+1) // RO #define ADSDBE_INDEX_EXT (DBE_USER+2) // RW #define ADSDBE_TBL_MODE (DBE_USER+3) // RW #define ADSDBE_LOCK_MODE (DBE_USER+4) // RW #define ADSDBE_RIGHTS_MODE (DBE_USER+5) // RW #define ADSDBE_MEMOBLOCKSIZE (DBE_USER+6) // RW #define ADSDBE_PASSWORD (DBE_USER+7) // RW // Для опредедения разрешения монитора от Джимми #define DESKTOPVERTRES 117 #define DESKTOPHORZRES 118 // Return types of ADSDBE_TBL_MODE #define ADSDBE_NTX 1 #define ADSDBE_CDX 2 #define ADSDBE_ADT 3 // Excel Orientation #DEFINE xlLandscape 2 #DEFINE xlPortrait 1 #DEFINE xlWorkbookNormal -4143 #DEFINE xlCellTypeLastCell 11 #DEFINE SRCCOPY 0xCC0020 // Для быстрой графики Роджера #define KEYEVENTF_KEYUP 0x02 #define VK_MENU 0x12 #define VK_SNAPSHOT 0x2C #DEFINE VK_LBUTTON 0x01 #DEFINE VK_RBUTTON 0x02 STATIC snHdll PROCEDURE AppSys // Рабочий стол остается окном приложения RETURN ******************************************************************************** FUNCTION Main() LOCAL GetList[0], GetOptions, nColor, oMessageBox, oMenuWords, oDlg, ; oMenuBar,oMenu1,oMenu2,oMenu3,oMenu4,oMenu5,oMenu6,oMenu7,; oMenu3_3, nKey := 0, oWebBrowser DC_IconDefault(1000) Xb2NetKey() ** Если ранее язык интерфейса не был задан - то задать русский, ** если был - то использовать тот, который был задан ** Если нет языковых баз - то создать их и задать текущим русский язык SET EXACT ON // Присравнении .T. если совпадают все символы, включая совпадение длины PUBLIC aLang_ru := {} // Массив для поиска русских текстовых элементов PUBLIC aLang_xx := {} // Массив для поиска нерусских текстовых элементов PUBLIC aNumUses := {} // Число использований j-го текстового элемента CreateDBLang() ZapDir('cygwin', .T.) // Он теперь не нужен, т.к. Гугл закрыл бесплатный on-line переводчик // Задать стиль кнопок ************************ * oConfig := DC_XbpPushButtonXPConfig():new() * oConfig:radius := 10 * oConfig:bgColor := GRA_CLR_CYAN * DC_PushButtonStyle( oConfig ) * oButtonConfig := DC_XbpPushButtonXPDefault():new() * DC_PushButtonStyle( oButtonConfig ) * DC_PushButtonStyle(1) * DC_PushButtonStyle(2) SET DECIMALS TO 15 SET DATE GERMAN SET ESCAPE On SET COLLATION TO SYSTEM // Руссификация *SET COLLATION TO ASCII // Руссификация ****** Системные переменные (общие переменные среды, переменые окружения) PUBLIC Flag_SysAdmin := .F., M_KodSysAdmin := 0 // .T. - SysAdmin PUBLIC Flag_AdmAppl := .F., M_KodAdmAppls := 0 // .T. - AdmApplications PUBLIC Flag_User := .F., M_KodAdmAppls := 0 // .T. - User PUBLIC RegimSys := 1, n := 0 // EXCLUSIVE-1, SHARED-2 PUBLIC Ar_MainWind[2], M_Language // Парамеры главного окна и язык интерфейса PUBLIC GradRad := 3.14159265358979323846 / 180 // Коэффициент перевода аргументов тригонометрических функций из градусов в радианы PUBLIC aCalcInf[10] ;AFILL(aCalcInf,.F.) // Массив с информацией о расчитанных стат.моделях и моделях знаний PUBLIC Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } PUBLIC M_CurrInf := 4 // Номер текущей стат.модели или моделях знаний PUBLIC M_Inf := Ar_Model[M_CurrInf] PUBLIC aVerifInf[10];AFILL(aVerifInf,.F.) // Массив с информацией о верифицированных стат.моделях и моделях знаний PUBLIC aInstLab[30];AFILL(aInstLab,.T.) // Массив с информацией об установленных (как приложения) лабораторных работах с копируемыми БД PUBLIC M_CurrLab := 0 // Номер установленой лаб.работы с формируемыми БД PUBLIC aSay[30], Mess97, Mess98, Mess99 // Массив сообщений отображаемых стадий исполнения (до 30 на экране) PUBLIC Time_progress, Wsego, oProgress, lOk PUBLIC nEvery := 100 // Количество корректировок прогресс-бар PUBLIC mDeltaSpectr := 90 // Неиспользуемая часть высокочастотного спектра PUBLIC mWindow := 17, M_NewAppl := '' // Интервал (окно) сглаживания ******************************************************************************************************** ****** Определить размеры экрана в пикселях разными способами и выбрать минимальные значения, но не нули ******************************************************************************************************** PUBLIC hDC := GetDC(0) PUBLIC nDHORZRES := GetDeviceCaps( hDC, DESKTOPHORZRES ) // native Monitor Size ! от Джимми PUBLIC nDVERTRES := GetDeviceCaps( hDC, DESKTOPVERTRES ) // native Monitor Size ! aWidth := {} aHeight := {} ******** 1-й способ стандартный ************ AADD(aWidth, AppDeskTop():currentSize()[1]) // current screen size width in pixels AADD(aHeight, AppDeskTop():currentSize()[2]) // current screen size height in pixels ******** 2-й способ от Роджера ************* aWorkArea := DC_GetWorkArea() AADD(aWidth, aWorkArea[3] - aWorkArea[1]) AADD(aHeight, aWorkArea[4] - aWorkArea[2]) ******** 3-й способ от Джимми ************** AppDesktop():Currentsize() AADD(aWidth, nDHORZRES) AADD(aHeight, nDVERTRES) ReleaseDC( 0, hDC ) ******************************************** nWidth = +99999999 nHeight = +99999999 FOR j=1 TO LEN(aWidth) IF aWidth[j] > 0 nWidth = MIN(nWidth, aWidth[j]) ENDIF IF aHeight[j] > 0 nHeight = MIN(nHeight, aHeight[j]) ENDIF NEXT // Если разрешение экрана выше, чем размеры изображения, то увеличивать его не надо (масштабирование только в сторону уменьшения) * LB_Warning(aWidth) // Отладка ################### * LB_Warning(aHeight) ******************************************************************************************************** PUBLIC aColor := {} // Все используемые цвета AADD(aColor, BD_BLUEMIST) // GraMakeRGBColor({195,238,255}) // BLUE 001 AADD(aColor, BD_PALETURQUOISE) // GraMakeRGBColor({175,238,238}) // BLUE 002 AADD(aColor, BD_PALEBLUE) // GraMakeRGBColor({140,223,255}) // BLUE 003 AADD(aColor, BD_FADEDBLUE) // GraMakeRGBColor({127,222,255}) // BLUE 004 AADD(aColor, BD_LIGHTBLUESKY) // GraMakeRGBColor({135,206,235}) // BLUE 005 AADD(aColor, BD_ISLANDBLUE) // GraMakeRGBColor({053,179,255}) // BLUE 006 AADD(aColor, BD_DODGERBLUE) // GraMakeRGBColor({030,144,255}) // BLUE 007 AADD(aColor, BD_PASTELBLUE) // GraMakeRGBColor({002,131,254}) // BLUE 008 AADD(aColor, BD_AZURE) // GraMakeRGBColor({000,127,255}) // BLUE 009### AADD(aColor, BD_ROYALBLUE) // GraMakeRGBColor({065,105,225}) // BLUE 010 AADD(aColor, BD_XBP_BLUE) // 2 // BLUE 011 AADD(aColor, BD_RICHBLUE) // GraMakeRGBColor({000,000,255}) // BLUE 012### AADD(aColor, BD_TLCDEEPBLUE) // GraMakeRGBColor({000,030,144}) // BLUE 013 AADD(aColor, BD_NAVYBLUE) // GraMakeRGBColor({000,000,128}) // BLUE 014### AADD(aColor, BD_DARKBLUE) // GraMakeRGBColor({000,000,087}) // BLUE 015############# AADD(aColor, BD_MIDNIGHTBLUE) // GraMakeRGBColor({025,025,112}) // BLUE 016 AADD(aColor, BD_NIGHT) // GraMakeRGBColor({036,026,068}) // OTHER 017 AADD(aColor, BD_SKYBLUE) // GraMakeRGBColor({209,241,255}) // BLUE 018 AADD(aColor, BD_ICEBLUE) // GraMakeRGBColor({209,253,255}) // BLUE 019 AADD(aColor, BD_TLCLIGHTBLUE) // GraMakeRGBColor({198,255,255}) // BLUE 020 AADD(aColor, BD_WISPBLUE) // GraMakeRGBColor({221,226,255}) // BLUE 021 AADD(aColor, BD_BLUEHINT) // GraMakeRGBColor({208,216,255}) // BLUE 022 AADD(aColor, BD_LIGHTSTEELBLUE) // GraMakeRGBColor({202,225,255}) // BLUE 023 AADD(aColor, BD_ROCKGREY) // GraMakeRGBColor({185,211,238}) // GREY 024 AADD(aColor, BD_CLEARBLUE) // GraMakeRGBColor({156,210,255}) // BLUE 025 AADD(aColor, BD_BLUESTEEL) // GraMakeRGBColor({117,186,229}) // BLUE 026 AADD(aColor, BD_CORNFLOWERBLUE) // GraMakeRGBColor({100,149,237}) // BLUE 027 AADD(aColor, BD_TLCDARKBLUE) // GraMakeRGBColor({075,116,171}) // BLUE 028### AADD(aColor, BD_TURQUOISE) // GraMakeRGBColor({064,244,208}) // BLUE 029 AADD(aColor, BD_TLCBLUE) // GraMakeRGBColor({075,268,200}) // BLUE 030 AADD(aColor, BD_TEAL) // GraMakeRGBColor({014,255,212}) // TEAL 031 AADD(aColor, BD_AQUAMARINE) // GraMakeRGBColor({000,255,232}) // BLUE 032 AADD(aColor, BD_XBP_CYAN) // 6 // CYAN 033 AADD(aColor, BD_LIGHTBLUE) // GraMakeRGBColor({014,240,255}) // BLUE 034 AADD(aColor, BD_ICEGREEN) // GraMakeRGBColor({222,255,189}) // GREEN 035 AADD(aColor, BD_GREENFROSTING) // GraMakeRGBColor({217,255,179}) // GREEN 036 AADD(aColor, BD_GREENHINT) // GraMakeRGBColor({204,255,191}) // GREEN 037 AADD(aColor, BD_PALETEAL) // GraMakeRGBColor({188,255,211}) // TEAL 038 AADD(aColor, BD_LIGHTTEAL) // GraMakeRGBColor({165,255,210}) // TEAL 039 AADD(aColor, BD_SEAFOAM) // GraMakeRGBColor({135,255,169}) // OTHER 040 AADD(aColor, BD_PALEGREEN) // GraMakeRGBColor({118,255,171}) // GREEN 041 AADD(aColor, BD_LEDGER) // GraMakeRGBColor({152,255,153}) // GREEN 042 AADD(aColor, BD_COLDGREEN) // GraMakeRGBColor({175,255,127}) // GREEN 043 AADD(aColor, BD_WISPGREEN) // GraMakeRGBColor({175,255,118}) // GREEN 044 AADD(aColor, BD_ISLANDGREEN) // GraMakeRGBColor({135,255,101}) // GREEN 045 AADD(aColor, BD_PASTELGREEN) // GraMakeRGBColor({135,255,000}) // GREEN 046 AADD(aColor, BD_LAWNGREEN) // GraMakeRGBColor({124,252,000}) // GREEN 047 AADD(aColor, BD_RICHGREEN) // GraMakeRGBColor({151,246,096}) // GREEN 048 AADD(aColor, BD_XBP_GREEN) // 5 // GREEN 049### AADD(aColor, BD_LIGHTGREEN) // GraMakeRGBColor({054,255,134}) // GREEN 050 AADD(aColor, BD_FADEDTEAL) // GraMakeRGBColor({103,214,171}) // TEAL 051 AADD(aColor, BD_BLUEGREY) // GraMakeRGBColor({135,183,169}) // BLUE 052 AADD(aColor, BD_LIGHTSEAGREEN) // GraMakeRGBColor({032,178,170}) // GREEN 053 AADD(aColor, BD_XBP_DARKCYAN) // 13 // CYAN 054### AADD(aColor, BD_CLEARGREEN) // GraMakeRGBColor({171,212,159}) // GREEN 055 AADD(aColor, BD_EARTHGREEN) // GraMakeRGBColor({153,173,092}) // GREEN 056 AADD(aColor, BD_MUDGREEN) // GraMakeRGBColor({153,173,000}) // GREEN 057### AADD(aColor, BD_LEAFYGREEN) // GraMakeRGBColor({129,153,040}) // GREEN 058 AADD(aColor, BD_MONEYLIGHTGREY) // GraMakeRGBColor({146,163,127}) // GREEN 059 AADD(aColor, BD_MONEYLIGHTGREEN) // GraMakeRGBColor({126,152,117}) // GREEN 060 AADD(aColor, BD_ASPARAGUS) // GraMakeRGBColor({123,160,091}) // OTHER 061 AADD(aColor, BD_DANKGREEN) // GraMakeRGBColor({077,123,084}) // GREEN 062 AADD(aColor, BD_MONEYGREENGREY) // GraMakeRGBColor({054,084,056}) // GREEN 063 AADD(aColor, BD_MONEYGREEN) // GraMakeRGBColor({024,050,021}) // GREEN 064### AADD(aColor, BD_CHARTREUSE) // GraMakeRGBColor({113,198,113}) // TEAL 065 AADD(aColor, BD_EMERALDGREEN) // GraMakeRGBColor({081,200,120}) // GREEN 066 AADD(aColor, BD_DEEPGREEN) // GraMakeRGBColor({054,194,114}) // GREEN 067 AADD(aColor, BD_FORESTGREEN) // GraMakeRGBColor({034,139,034}) // GREEN 068### AADD(aColor, BD_SEAGREEN) // GraMakeRGBColor({046,139,087}) // GREEN 069### AADD(aColor, BD_DARKGREEN) // GraMakeRGBColor({000,100,000}) // GREEN 070### AADD(aColor, BD_BISQUE) // GraMakeRGBColor({255,228,196}) // OTHER 071 AADD(aColor, BD_ANTIQUEWHITE) // GraMakeRGBColor({250,235,215}) // OTHER 072 AADD(aColor, BD_BONE) // GraMakeRGBColor({249,246,210}) // OTHER 073 AADD(aColor, BD_PEACH) // GraMakeRGBColor({255,230,188}) // OTHER 074 AADD(aColor, BD_PALEGOLDENROD) // GraMakeRGBColor({238,232,170}) // OTHER 075 AADD(aColor, BD_LIGHTGOLDENROD) // GraMakeRGBColor({238,221,130}) // OTHER 076 AADD(aColor, BD_BANANA) // GraMakeRGBColor({227,207,087}) // OTHER 077 AADD(aColor, BD_BURLYWOOD) // GraMakeRGBColor({222,184,135}) // OTHER 078 AADD(aColor, BD_PERU) // GraMakeRGBColor({205,133,063}) // OTHER 079 AADD(aColor, BD_COPPER) // GraMakeRGBColor({184,115,051}) // OTHER 080### AADD(aColor, BD_BROWN) // GraMakeRGBColor({150,075,000}) // OTHER 081### AADD(aColor, BD_MILKCHOCOLATE) // GraMakeRGBColor({112,046,000}) // OTHER 082### AADD(aColor, BD_AUBURN) // GraMakeRGBColor({113,047,044}) // OTHER 083 AADD(aColor, BD_CHOCOLATE) // GraMakeRGBColor({068,000,000}) // OTHER 084### AADD(aColor, BD_DARKWHEAT) // GraMakeRGBColor({205,186,150}) // OTHER 085 AADD(aColor, BD_DARKERWHEAT) // GraMakeRGBColor({194,182,133}) // OTHER 086 AADD(aColor, BD_LAZYGREEN) // GraMakeRGBColor({204,210,158}) // GREEN 087 AADD(aColor, BD_ECRU) // GraMakeRGBColor({178,188,121}) // OTHER 088 AADD(aColor, BD_FATIGUES) // GraMakeRGBColor({153,173,109}) // OTHER 089 AADD(aColor, BD_BRASS) // GraMakeRGBColor({181,166,066}) // OTHER 090 AADD(aColor, BD_GOLDENROD) // GraMakeRGBColor({218,165,032}) // OTHER 091 AADD(aColor, BD_DARKGOLDENROD) // GraMakeRGBColor({184,134,011}) // OTHER 092### AADD(aColor, BD_LIGHTCORAL) // GraMakeRGBColor({240,128,128}) // OTHER 093### AADD(aColor, BD_LIGHTSALMON) // GraMakeRGBColor({255,160,122}) // OTHER 094 AADD(aColor, BD_KHAKI) // GraMakeRGBColor({189,183,107}) // OTHER 095 AADD(aColor, BD_DARKKHAKI) // GraMakeRGBColor({197,185,115}) // OTHER 096 AADD(aColor, BD_CLOUD) // GraMakeRGBColor({245,245,240}) // OTHER 097 AADD(aColor, BD_IVORY) // GraMakeRGBColor({252,246,229}) // OTHER 098 AADD(aColor, BD_LINEN) // GraMakeRGBColor({253,240,230}) // OTHER 099 AADD(aColor, BD_LEMONCREME) // GraMakeRGBColor({255,250,205}) // OTHER 100 AADD(aColor, BD_CREME) // GraMakeRGBColor({249,246,189}) // TAN 101 AADD(aColor, BD_EGGSHELL) // GraMakeRGBColor({252,230,201}) // OTHER 102 AADD(aColor, BD_CORNSILK) // GraMakeRGBColor({238,232,205}) // OTHER 103 AADD(aColor, BD_SAND) // GraMakeRGBColor({232,228,216}) // OTHER 104 AADD(aColor, BD_KEYLIME) // GraMakeRGBColor({175,246,084}) // OTHER 105 AADD(aColor, BD_LIME) // GraMakeRGBColor({153,235,000}) // OTHER 106 AADD(aColor, BD_RICHLIME) // GraMakeRGBColor({087,255,000}) // OTHER 107 AADD(aColor, BD_MAGENTA) // GraMakeRGBColor({205,000,205}) // OTHER 108### AADD(aColor, BD_EGGPLANT) // GraMakeRGBColor({153,000,102}) // OTHER 109### AADD(aColor, BD_MAROON) // GraMakeRGBColor({139,028,098}) // OTHER 110 AADD(aColor, BD_MANGO) // GraMakeRGBColor({255,091,039}) // OTHER 111### AADD(aColor, BD_SANDYBROWN) // GraMakeRGBColor({244,164,096}) // OTHER 112### AADD(aColor, BD_SUNSET) // GraMakeRGBColor({245,160,014}) // OTHER 113 AADD(aColor, BD_MANGOCREME) // GraMakeRGBColor({255,129,063}) // OTHER 114 AADD(aColor, BD_SALMON) // GraMakeRGBColor({250,128,114}) // OTHER 115 AADD(aColor, BD_MISTYROSE) // GraMakeRGBColor({255,228,225}) // OTHER 116 AADD(aColor, BD_MOSS) // GraMakeRGBColor({200,201,001}) // OTHER 117 AADD(aColor, BD_OFFWHITE) // GraMakeRGBColor({255,255,235}) // OTHER 118 AADD(aColor, BD_PINKSAND) // GraMakeRGBColor({255,204,220}) // OTHER 119 AADD(aColor, BD_PINKROSE) // GraMakeRGBColor({255,184,255}) // OTHER 120 AADD(aColor, BD_ORCHID) // GraMakeRGBColor({218,112,214}) // OTHER 121 AADD(aColor, BD_FUSHIA) // GraMakeRGBColor({193,084,193}) // OTHER 122### AADD(aColor, BD_INDIGO) // GraMakeRGBColor({075,000,130}) // OTHER 123############# AADD(aColor, BD_PINEBARK) // GraMakeRGBColor({167,158,125}) // OTHER 124 AADD(aColor, BD_SANDSTONE) // GraMakeRGBColor({204,204,153}) // OTHER 125 AADD(aColor, BD_SANDYCORAL) // GraMakeRGBColor({214,213,189}) // OTHER 126 AADD(aColor, BD_JOURNALGREEN) // GraMakeRGBColor({220,232,210}) // GREEN 127 AADD(aColor, BD_SEASHELL) // GraMakeRGBColor({255,245,238}) // OTHER 128 AADD(aColor, BD_SNOW) // GraMakeRGBColor({255,250,255}) // OTHER 129 AADD(aColor, BD_WHEAT) // GraMakeRGBColor({245,222,179}) // OTHER 130 AADD(aColor, BD_PALEDESSERT) // GraMakeRGBColor({223,211,183}) // TAN 131 AADD(aColor, BD_LIGHTDESSERT) // GraMakeRGBColor({211,202,170}) // TAN 132 AADD(aColor, BD_DESSERT) // GraMakeRGBColor({211,202,183}) // TAN 133 AADD(aColor, BD_FADEDDESSERT) // GraMakeRGBColor({211,202,193}) // TAN 134 AADD(aColor, BD_XBP_PALEGRAY) // 15 // GREY 135 AADD(aColor, BD_SILVER) // GraMakeRGBColor({192,192,192}) // OTHER 136 AADD(aColor, BD_BRIGHTGREY) // GraMakeRGBColor({197,193,170}) // GREY 137 AADD(aColor, BD_GREY) // GraMakeRGBColor({188,188,176}) // GREY 138 AADD(aColor, BD_LIGHTGREY) // GraMakeRGBColor({230,231,232}) // GREY 139 AADD(aColor, BD_ICEGREY) // GraMakeRGBColor({236,242,234}) // GREY 140 AADD(aColor, BD_MICROSOFTGREY) // GraMakeRGBColor({224,223,227}) // GREY 141 AADD(aColor, BD_DEFAULTGREY) // GraMakeRGBColor({212,208,200}) // GREY 142 AADD(aColor, BD_WASHGREY) // GraMakeRGBColor({210,210,210}) // GREY 143 AADD(aColor, BD_SLATEGREY) // GraMakeRGBColor({158,182,205}) // GREY 144 AADD(aColor, BD_SILVERBLUE) // GraMakeRGBColor({131,156,165}) // OTHER 145 AADD(aColor, BD_GREYGREEN) // GraMakeRGBColor({153,173,174}) // GREY 146 AADD(aColor, BD_DARKGREY) // GraMakeRGBColor({090,091,080}) // GREY 147 AADD(aColor, BD_DULLGREY) // GraMakeRGBColor({087,091,090}) // GREY 148 AADD(aColor, BD_FRAMEGREY) // GraMakeRGBColor({148,148,148}) // GREY 149 AADD(aColor, BD_LINEGREY) // GraMakeRGBColor({128,128,128}) // GREY 150 AADD(aColor, BD_CREMESICLE) // GraMakeRGBColor({239,246,121}) // TAN 151 AADD(aColor, BD_FADEDGOLD) // GraMakeRGBColor({255,227,109}) // GOLD 152 AADD(aColor, BD_LIGHTGOLD) // GraMakeRGBColor({255,227,000}) // GOLD 153 AADD(aColor, BD_GOLD) // GraMakeRGBColor({255,217,000}) // GOLD 154 AADD(aColor, BD_TLCGOLD) // GraMakeRGBColor({255,197,000}) // GOLD 155 AADD(aColor, BD_ORANGE) // GraMakeRGBColor({255,160,000}) // ORANGE 156### AADD(aColor, BD_ORANGEPEEL) // GraMakeRGBColor({255,126,003}) // ORANGE 157### AADD(aColor, BD_BURNTORANGE) // GraMakeRGBColor({204,085,000}) // ORANGE 158### AADD(aColor, BD_LIGHTORANGE) // GraMakeRGBColor({255,180,000}) // ORANGE 159 AADD(aColor, BD_PALEORANGE) // GraMakeRGBColor({255,156,000}) // ORANGE 160 AADD(aColor, BD_TAN) // GraMakeRGBColor({244,226,171}) // TAN 161 AADD(aColor, BD_LIGHTTAN) // GraMakeRGBColor({244,225,199}) // TAN 162 AADD(aColor, BD_PALEYELLOW) // GraMakeRGBColor({255,255,210}) // YELLOW 163 AADD(aColor, BD_FLATYELLOW) // GraMakeRGBColor({255,255,193}) // YELLOW 164 AADD(aColor, BD_FADEDYELLOW) // GraMakeRGBColor({255,255,185}) // YELLOW 165 AADD(aColor, BD_HINTYELLOW) // GraMakeRGBColor({255,255,153}) // YELLOW 166 AADD(aColor, BD_LIGHTYELLOW) // GraMakeRGBColor({255,255,130}) // YELLOW 167 AADD(aColor, BD_YELLOW) // GraMakeRGBColor({255,229,053}) // YELLOW 168 AADD(aColor, BD_SUNNYYELLOW) // GraMakeRGBColor({255,255,000}) // YELLOW 169 AADD(aColor, BD_DEEPYELLOW) // GraMakeRGBColor({216,189,000}) // YELLOW 170 AADD(aColor, BD_DARKYELLOW) // GraMakeRGBColor({196,179,000}) // YELLOW 171 AADD(aColor, BD_OLIVEDRAB) // GraMakeRGBColor({142,142,056}) // GREEN 172 AADD(aColor, BD_XBP_BROWN) // 14 // TAN 173### AADD(aColor, BD_PINKCOTTON) // GraMakeRGBColor({255,215,255}) // PINK 174 AADD(aColor, BD_PUFFINK) // GraMakeRGBColor({241,185,213}) // PINK 175 AADD(aColor, BD_PALEPURPLE) // GraMakeRGBColor({231,160,226}) // PURPLE 176 AADD(aColor, BD_LIGHTPURPLE) // GraMakeRGBColor({210,152,206}) // PURPLE 177 AADD(aColor, BD_FUCHSIA) // GraMakeRGBColor({229,070,183}) // PINK 178 AADD(aColor, BD_HOTPINK) // GraMakeRGBColor({229,070,129}) // PINK 179### AADD(aColor, BD_XBP_PINK) // 4 // PINK 180### AADD(aColor, BD_XBP_DARKPINK) // 11 // PINK 181### AADD(aColor, BD_REDHINT) // GraMakeRGBColor({255,213,231}) // RED 182 AADD(aColor, BD_LAZYPURPLE) // GraMakeRGBColor({248,201,245}) // PURPLE 183 AADD(aColor, BD_WISPRED) // GraMakeRGBColor({239,195,228}) // RED 184 AADD(aColor, BD_FADEDPURPLE) // GraMakeRGBColor({241,187,241}) // PURPLE 185 AADD(aColor, BD_COTTONCANDYRED) // GraMakeRGBColor({255,147,156}) // RED 186 AADD(aColor, BD_PALERED) // GraMakeRGBColor({255,147,156}) // RED 187 AADD(aColor, BD_DEEPRED) // GraMakeRGBColor({229,070,097}) // RED 188 AADD(aColor, BD_RED) // 3 // RED 189 AADD(aColor, BD_CANDYRED) // GraMakeRGBColor({255,000,000}) // RED 190### AADD(aColor, BD_LIGHTRED) // GraMakeRGBColor({255,050,039}) // RED 191### AADD(aColor, BD_DARKRED) // GraMakeRGBColor({168,000,000}) // RED 192 AADD(aColor, BD_CRIMSON) // GraMakeRGBColor({220,020,060}) // RED 193### AADD(aColor, BD_INDIANRED) // GraMakeRGBColor({176,023,031}) // RED 194### AADD(aColor, BD_LAVENDER) // GraMakeRGBColor({230,230,250}) // OTHER 195 AADD(aColor, BD_PURPLEHINT) // GraMakeRGBColor({207,211,255}) // PURPLE 196 AADD(aColor, BD_COOLPURPLE) // GraMakeRGBColor({209,198,255}) // PURPLE 197 AADD(aColor, BD_PURPLE) // GraMakeRGBColor({188,151,255}) // PURPLE 198 AADD(aColor, BD_GRAPE) // GraMakeRGBColor({135,116,169}) // OTHER 199 AADD(aColor, BD_SLATEBLUE) // GraMakeRGBColor({113,113,198}) // BLUE 200 AADD(aColor, BD_FLATPURPLE) // GraMakeRGBColor({135,097,169}) // PURPLE 201 AADD(aColor, BD_AMETHYST) // GraMakeRGBColor({153,102,204}) // OTHER 202 AADD(aColor, BD_SIENNA) // GraMakeRGBColor({160,082,452}) // OTHER 203 AADD(aColor, BD_BLUEVIOLET) // GraMakeRGBColor({138,043,226}) // BLUE 204### AADD(aColor, BD_BRIGHTPURPLE) // GraMakeRGBColor({112,046,253}) // PURPLE 205### AADD(aColor, BD_DEEPPURPLE) // GraMakeRGBColor({117,007,229}) // PURPLE 206### AADD(aColor, BD_BEET) // GraMakeRGBColor({142,056,142}) // PURPLE 207 AADD(aColor, BD_TINTEDPURPLE) // GraMakeRGBColor({112,045,107}) // PURPLE 208 AADD(aColor, BD_RICHPURPLE) // GraMakeRGBColor({168,045,119}) // PURPLE 209### AADD(aColor, BD_OUTLOOKBUTT) // GraMakeRGBColor({236,233,216}) // OTHER 210 AADD(aColor, BD_OUTLOOKBGD) // GraMakeRGBColor({227,239,255}) // OTHER 211 AADD(aColor, BD_OUTLOOKRIBDARK) // GraMakeRGBColor({166,188,217}) // OTHER 212 AADD(aColor, BD_OUTLOOKRIBLIGHT) // GraMakeRGBColor({191,219,255}) // OTHER 213 AADD(aColor, BD_OUTLOOKMARGIN) // GraMakeRGBColor({101,147,207}) // OTHER 214 AADD(aColor, BD_SMSBGD) // GraMakeRGBColor({197,231,183}) // OTHER 215 AADD(aColor, BD_SMSRIBDARK) // GraMakeRGBColor({103,195,071}) // OTHER 216### AADD(aColor, BD_SMSRIBLIGHT) // GraMakeRGBColor({174,224,159}) // OTHER 217 AADD(aColor, BD_SMSRIBMARGIN) // GraMakeRGBColor({062,147,104}) // OTHER 218### AADD(aColor, BD_TRUE) // -4 // AAA 219 AADD(aColor, BD_WHITE) // 0 // AAA 220 AADD(aColor, BD_BACKGROUND) // -2 // AAA 221 AADD(aColor, BD_BLACK) // 1 // AAA 222############# AADD(aColor, BD_NEUTRAL) // -1 // AAA 223 AADD(aColor, BD_FALSE) // -5 // AAA 224 PUBLIC aColIndex := {} // Цвета, используемые для построения графиков AADD(aColIndex, 9) // GraMakeRGBColor({000,127,255}) // BLUE 009### AADD(aColIndex, 12) // GraMakeRGBColor({000,000,255}) // BLUE 012### AADD(aColIndex, 49) // 5 // GREEN 049### AADD(aColIndex, 54) // 13 // CYAN 054### AADD(aColIndex, 57) // GraMakeRGBColor({153,173,000}) // GREEN 057### AADD(aColIndex, 70) // GraMakeRGBColor({000,100,000}) // GREEN 070### AADD(aColIndex, 81) // GraMakeRGBColor({150,075,000}) // OTHER 081### AADD(aColIndex, 93) // GraMakeRGBColor({240,128,128}) // OTHER 093### AADD(aColIndex, 108) // GraMakeRGBColor({205,000,205}) // OTHER 108### AADD(aColIndex, 109) // GraMakeRGBColor({153,000,102}) // OTHER 109### AADD(aColIndex, 111) // GraMakeRGBColor({255,091,039}) // OTHER 111### AADD(aColIndex, 112) // GraMakeRGBColor({244,164,096}) // OTHER 112### AADD(aColIndex, 122) // GraMakeRGBColor({193,084,193}) // OTHER 122### AADD(aColIndex, 156) // GraMakeRGBColor({255,160,000}) // ORANGE 156### AADD(aColIndex, 157) // GraMakeRGBColor({255,126,003}) // ORANGE 157### AADD(aColIndex, 158) // GraMakeRGBColor({204,085,000}) // ORANGE 158### AADD(aColIndex, 173) // 14 // TAN 173### AADD(aColIndex, 179) // GraMakeRGBColor({229,070,129}) // PINK 179### AADD(aColIndex, 180) // 4 // PINK 180### AADD(aColIndex, 190) // GraMakeRGBColor({255,000,000}) // RED 190### AADD(aColIndex, 191) // GraMakeRGBColor({255,050,039}) // RED 191### AADD(aColIndex, 194) // GraMakeRGBColor({176,023,031}) // RED 194### AADD(aColIndex, 206) // GraMakeRGBColor({117,007,229}) // PURPLE 206### AADD(aColIndex, 216) // GraMakeRGBColor({103,195,071}) // OTHER 216### AADD(aColIndex, 218) // GraMakeRGBColor({062,147,104}) // OTHER 218### AADD(aColor, BD_BLACK) // 1 // AAA 222############# ***** Рекогносцировка ************************************************ CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций PUBLIC Disk_name := DISKNAME() PUBLIC Cur_dir := CURDIR() PUBLIC Disk_dir := Disk_name+":\"+Cur_dir // Путь на папку с системой * InstallFonts() // Установка шрифтов, независимых от Windows *************************************************************************************************************** ***** Если путь на папку с системой содержит русские символы или пробел, то выдать сообщение и завершить работу ***** Допустимы только символы с кодами: 48-57, 65-90, 97-122, а также символы: -_:\ mFlagErr = .F. mFlag32 = .F. mCharErr = '' FOR j=1 TO 255 DO CASE CASE 48 <= j .AND. j <= 57 // Цифры: 0-9 CASE 65 <= j .AND. j <= 90 // Заглавные латинские буквы: A-Z CASE 97 <= j .AND. j <= 122 // Строчные латинские буквы: a-z CASE j = 45 .OR. j = 95 .OR. j = 58 .OR. j = 92 // -_:\ OTHERWISE IF AT(CHR(j), Disk_dir) > 0 mFlagErr = .T. mCharErr = mCharErr + CHR(j) // Недопустимые символы ENDIF ENDCASE NEXT IF mFlagErr aMess := {} AADD(aMess, L('Система запущена в папке: "'+ConvToOemCP(ALLTRIM(Disk_dir))+'\"' )) AADD(aMess, L('Путь на папку с системой содержит недопустимые символы (между линиями):')) AADD(aMess, REPLICATE('-',135)) AADD(aMess, ConvToOemCP(mCharErr)) AADD(aMess, REPLICATE('-',135)) AADD(aMess, IF(AT(' ', Disk_dir) > 0,L(', а также символ: "пробел".'),'')) AADD(aMess, L('Для нормальной работы системы необходимо, чтобы путь на папку с системой был допустимым для' )) AADD(aMess, L('DOS и UNIX: не содержал недопустимых символов: "+=[]:;,./\?*<>|", пробела и русских букв.' )) AADD(aMess, L('Желательно разархивировать ее в корневом каталоге любого диска, например: "d:\Aidos-X\". ' )) AADD(aMess, L('Нельзя запускать исполнимый модуль: "_aidos-x.exe" в одной папке несколько раз, т.к. это ' )) AADD(aMess, L('вызывает конфликт обращения к базам данных, занятых исполнимым модулем, запущенным ранее. ' )) AADD(aMess, L('Папка, в которой запущена система, должна быть доступна на запись, т.к. система модифирует ' )) AADD(aMess, L('свои файлы и базы данных. Настройки политик безопасности MS Windows должны быть установлены' )) AADD(aMess, L('на "слабые", т.к. система "Эйдос" для ускорения работы обращается к файлам без API Windows,' )) AADD(aMess, L('а Windows расценивает это как угрозу безопасности' )) LB_Warning(aMess, L('(C) Система "Эйдос"')) QUIT ENDIF ***** Если путь на папку с системой содержит русские символы или пробел, то выдать сообщение и завершить работу *************************************************************************************************************** *************************************************************************************************************** ***** Если похоже, что система запущена из архива (в диск Disk_dir есть c:\Users\1\AppData\Local\Temp\_tc\), ***** то выдать сообщение и завершить работу IF AT('Users' , Disk_dir) > 0 .OR. ; AT('AppData', Disk_dir) > 0 .OR. ; AT('Local' , Disk_dir) > 0 .OR. ; AT('Temp' , Disk_dir) > 0 .OR. ; AT('_tc' , Disk_dir) > 0 aMess := {} AADD(aMess, L('Система запущена в папке: "')+ConvToOemCP(ALLTRIM(Disk_dir))+'\"' ) AADD(aMess, L(' ')) AADD(aMess, L('Вид пути на папку с системой позволяет предположить, что система запущена из архива.' )) AADD(aMess, L('Если это действительно так, то ряд функций системы не будет реализоваться в полном объеме.' )) AADD(aMess, L('Для нормальной работы системы необходимо, чтобы путь на папку с системой был допустимым для' )) AADD(aMess, L('DOS и UNIX: не содержал недопустимых символов: "+=[]:;,./\?*<>|", пробела и русских букв.' )) AADD(aMess, L('Желательно разархивировать ее в корневом каталоге любого диска, например: "d:\Aidos-X\". ' )) AADD(aMess, L('Нельзя запускать исполнимый модуль: "_aidos-x.exe" в одной папке несколько раз, т.к. это ' )) AADD(aMess, L('вызывает конфликт обращения к базам данных, занятых исполнимым модулем, запущенным ранее. ' )) AADD(aMess, L('Папка, в которой запущена система, должна быть доступна на запись, т.к. система модифирует ' )) AADD(aMess, L('свои файлы и базы данных. Настройки политик безопасности MS Windows должны быть установлены' )) AADD(aMess, L('на "слабые", т.к. система "Эйдос" для ускорения работы обращается к файлам без API Windows,' )) AADD(aMess, L('а Windows расценивает это как угрозу безопасности' )) LB_Warning(aMess, L('(C) Система "Эйдос"')) QUIT ENDIF ***** Если похоже, что система запущена из архива, то выдать сообщение и завершить работу *************************************************************************************************************** // Путь на папку с приложениями, можно сетевую или в Internet, // считывать сразу при запуске системы, а если его нет, // то создать папку БД приложений БД путей по умолчанию. Папка с группой приложений AID_DATA: // В последующем СисАдмин может в режиме 1.5 поменять путь на папку с текущей группой приложений когда угодно DIRCHANGE(Disk_dir) // Папка с исполнимым модулем системы Эйдос **************************************** IF FILE("cygwin\bin\Print_receipt.prg") ERASE("cygwin\bin\Print_receipt.prg") ENDIF IF FILE("cygwin\bin\Translator.prg") ERASE("cygwin\bin\Translator.prg") ENDIF **************************************** IF FILEDATE("AID_DATA",16) = CTOD("//") DIRMAKE("AID_DATA") ENDIF DIRCHANGE("AID_DATA") // Перейти в папку со всеми БД: AID_DATA // Создание ВСЕХ папок внутри Aid_data IF FILEDATE("Inp_data",16) = CTOD("//") DIRMAKE("Inp_data") ENDIF IF FILEDATE("Inp_rasp",16) = CTOD("//") DIRMAKE("Inp_rasp") ENDIF IF FILEDATE("OldAppls",16) = CTOD("//") DIRMAKE("OldAppls") ENDIF IF FILEDATE("BackGround",16) = CTOD("//") DIRMAKE("BackGround") // Скачать по FTP с моего сайта и записать в эту папку фоны главного меню ENDIF IF FILEDATE("Screenshots",16) = CTOD("//") DIRMAKE("Screenshots") ENDIF IF FILEDATE("LabWorks",16) = CTOD("//") DIRMAKE("LabWorks") Mess = L('В папке с БД приложений "AID_DATA" не было папки "LabWorks" для исходных БД лабораторных работ. Обратитесь за ними к разработчику!') LB_Warning(Mess, L("1.3. Установка лабораторных работ" )) ENDIF DIRCHANGE("LabWorks") // Перейти в папку с исходными БД лабораторных работ FOR j=1 TO 30 M_Name = "LabW"+STRTRAN(STR(j,4)," ","0") IF FILEDATE("M_Name",16) = CTOD("//") DIRMAKE(M_Name) ENDIF NEXT DIRCHANGE(Disk_dir) PUBLIC M_ApplsPath := UPPER(ALLTRIM(Disk_dir))+"\AID_DATA" IF FILE("PathGrAp.dbf") IF .NOT. FILE("Path_kod.ntx").OR.; .NOT. FILE("PathDefa.ntx").OR.; .NOT. FILE("PathName.ntx").OR.; .NOT. FILE("PathCrea.ntx") GenNtxPaths() ENDIF * USE PathGrAp INDEX Path_kod, PathDefa, PathName, PathCrea EXCLUSIVE NEW * * 1 2 3 4 *************************************************************************************************************** ***** Если система Эйдос уже запущена в данной папке выдать сообщение об этом и выйти CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathGrAp SHARED NEW IF Neterr() aMess := {} AADD(aMess, L('Система "Эйдос" уже запущена в папке: "'+ConvToOemCP(ALLTRIM(Disk_dir))+'\"' )) AADD(aMess, L('Нельзя запускать исполнимый модуль системы: "_aidos-x.exe"')) AADD(aMess, L('в одной папке несколько раз, т.к. система будет пытаться')) AADD(aMess, L('одновременно обращаться к одним и тем же базам данных, что')) AADD(aMess, L('вызывает конфликт. Но в других папках это вполне возможно.')) LB_Warning(aMess, L('(C) Система "Эйдос"')) QUIT ENDIF *************************************************************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathGrAp EXCLUSIVE NEW DBGOTOP() DO WHILE .NOT. EOF() IF LEN(ALLTRIM(By_default)) > 0 REPLACE By_default WITH "W" M_ApplsPath = UPPER(ALLTRIM(PathGrApps)) * MsgBox(M_ApplsPath) EXIT ENDIF DBSKIP(1) ENDDO ELSE GenDbfPaths() ENDIF ****** При запуске системы проверить, существует ли база приложений Appls.dbf, ****** и, если существует, найти текущее приложение и присвоить глобальным переменным ****** значения пути на него и его имени, а если не существует, то создать ****** и записать в виде файлов в текщей папке с исполнимым модулем системы PUBLIC M_PathAppl := "", M_NameAppl := "" IF .NOT. FILE("Appls.dbf") GenDbfAppls() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW SELECT Appls DBGOTOP() DO WHILE .NOT. EOF() IF LEN(ALLTRIM(By_default)) > 0 REPLACE By_default WITH "W" M_PathAppl = UPPER(ALLTRIM(Path_Appl)) // Путь на текущее приложение M_NameAppl = ALLTRIM(Name_Appl) EXIT ENDIF DBSKIP(1) ENDDO ** Если БД пользователей существует, то можно попытаться авторизоваться сразу, до запуска главного меню. ** Если это получится, то можно запустить меню с цветовой схемой данного пользователя, ** а иначе - с цветовой схемой по умолчанию Cf1 = 000;Cf2 = 000;Cf3 = 000;Cb1 = 025;Cb2 = 255;Cb3 = 204 IF FILE("Users.dbf") // БД администраторов приложений и паролей доступа к ним: Users.dbf M_KodAdmAppls = F1_1() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_kod EXCLUSIVE NEW SET ORDER TO 1;T=DBSEEK(STR(M_KodAdmAppls,8)) IF T * 000 000 000 025 255 204 * 12345678901234567890123 * 1 5 9 13 17 21 Cf1 = VAL(SUBSTR(ColorSchem, 1,3)) Cf2 = VAL(SUBSTR(ColorSchem, 5,3)) Cf3 = VAL(SUBSTR(ColorSchem, 9,3)) Cb1 = VAL(SUBSTR(ColorSchem,13,3)) Cb2 = VAL(SUBSTR(ColorSchem,17,3)) Cb3 = VAL(SUBSTR(ColorSchem,21,3)) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ELSE GenDbfUsers() ENDIF ********************************************************************************************************************* // Отметка в базе данных test_strings.txt на сайте: http://aidos.byethost5.com реквизитов посетителя // и переход (редирект) на основной сайт: http://lc.kubagro.ru ЕСЛИ ЕСТЬ INTERNET* ********************************************************************************************************************* n=0 IF .NOT. InternetGetConnectedState( @n, 0 ) == 0 RunShell('/C c:\Windows\System32\TaskList.exe /V /FO CSV > TaskList1.csv',,.F.,.T.) // .F. - чтобы программа не продожалась дальше, пока не закончится перевод DC_SpawnURL( 'http://aidos.byethost5.com/index.php', .T., .T. ) * DC_SpawnURL( 'http://aidos.byethost5.com/index.php' ) MILLISEC(100) RunShell('/C c:\Windows\System32\TaskList.exe /V /FO CSV > TaskList2.csv',,.F.,.T.) // .F. - чтобы программа не продожалась дальше, пока не закончится перевод ******* Определить, какой браузер открылся (установленный по умолчанию) и его принудительно закрыть, если он не был открыт до запуска системы Эйдос ************** aTaskList1 := {} // Все программы, запущенные на компьютере ДО обращения к FTP-серверу nHandle := DC_txtOpen( 'TaskList1.csv' ) DO WHILE !DC_TxtEOF( nHandle ) // Начало цикла по строкам mLine = DC_TxtLine( nHandle ) // Выделить строку из текстового файла mPosExe = AT('.exe', mLine) IF mPosExe > 0 mPos = AT('","', mLine) mModName = SUBSTR(mLine,2,mPos-2) * MsgBox(ConvToOemCP(mLine)) * MsgBox(mModName) * IF ASCAN(aTaskList1, mModName) = 0 // Каждая программа запоминается только один раз AADD (aTaskList1, mModName) * ENDIF ENDIF DC_TxtSkip( nHandle, 1 ) ENDDO DC_TxtClose( nHandle ) aTaskList2 := {} // Все программы, запущенные на компьютере ПОСЛЕ обращения к FTP-серверу nHandle := DC_txtOpen( 'TaskList2.csv' ) DO WHILE !DC_TxtEOF( nHandle ) // Начало цикла по строкам mLine = DC_TxtLine( nHandle ) // Выделить строку из текстового файла mPosExe = AT('.exe', mLine) IF mPosExe > 0 mPos = AT('","', mLine) mModName = SUBSTR(mLine,2,mPos-2) * MsgBox(ConvToOemCP(mLine)) * MsgBox(mModName) * IF ASCAN(aTaskList2, mModName) = 0 // Каждая программа запоминается только один раз AADD (aTaskList2, mModName) * ENDIF ENDIF DC_TxtSkip( nHandle, 1 ) ENDDO DC_TxtClose( nHandle ) aBrowsers := {} // Наименования exe-модулей различных браузеров. ДОБАВИТЬ их как можно больше AADD(aBrowsers, 'opera.exe' ) AADD(aBrowsers, 'firefox.exe' ) AADD(aBrowsers, 'chrome.exe' ) AADD(aBrowsers, 'iexplore.exe') aTaskList12 := {} // Только новые программы, запущенные на компьютере ПОСЛЕ обращения к FTP-серверу, их и надо принудительно закрыть FOR j=1 TO LEN(aTaskList2) IF ASCAN(aTaskList1, aTaskList2[j]) = 0 // Новая программа, запущенная на компьютере ПОСЛЕ обращения к FTP-серверу IF ASCAN(aBrowsers, aTaskList2[j]) > 0 // Запоминать только названия exe-модулей браузеров * IF ASCAN(aTaskList12, aTaskList2[j]) = 0 // Каждая новая программа запоминается только один раз AADD (aTaskList12, aTaskList2[j]) * ENDIF ENDIF ENDIF NEXT IF LEN(aTaskList12) > 0 FOR j=1 TO LEN(aTaskList12) DO CASE CASE aTaskList12[j] = 'opera.exe' RunShell('/F /IM ' + 'opera.exe' ,'c:\Windows\System32\taskKill.exe',.T.,.F.) // принудительно закрыть новую программу: aTaskList12[j] CASE aTaskList12[j] = 'firefox.exe' RunShell('/F /IM ' + 'firefox.exe' ,'c:\Windows\System32\taskKill.exe',.T.,.F.) // принудительно закрыть новую программу: aTaskList12[j] CASE aTaskList12[j] = 'chrome.exe' RunShell('/F /IM ' + 'chrome.exe' ,'c:\Windows\System32\taskKill.exe',.T.,.F.) // принудительно закрыть новую программу: aTaskList12[j] CASE aTaskList12[j] = 'iexplore.exe' RunShell('/F /IM ' + 'iexplore.exe','c:\Windows\System32\taskKill.exe',.T.,.F.) // принудительно закрыть новую программу: aTaskList12[j] ENDCASE NEXT ENDIF ENDIF ********************************************************************************************************************* ********************************************************************************************************************* // Цветовая схема главного меню fColor := GraMakeRGBColor({ Cf1,Cf2,Cf3 }) bColor := GraMakeRGBColor({ Cb1,Cb2,Cb3 }) DC_ReadGuiHandler( {|a,b,c,d,e,f|LogHandler(a,b,c,d,e,f)}) DC_XbpMenuConfig( ; { GRA_CLR_WHITE,; // 1 - Sub Menu Background Color fColor,; // 2 - Sub Menu Vertical Bar Foreground Color bColor,; // 3 - Sub Menu Vertical Bar Background Color GRA_CLR_BLACK,; // 4 - Sub Menu Outline Color '8.MS Sans Serif Bold', ; // 5 - Sub Menu Vertical Bar Font .F., ; '8.MS Sans Serif', ; // 6 - Sub Menu Check Character Font 'b', ; // 7 - Sub Menu Check Character fColor,; // 8 - Menu Bar Foreground Color bColor, ; // 9 - Menu Bar Background Color GRA_CLR_BLACK,; // 10 - Sub Menu Foreground Color '8.MS Sans Serif' } ) // 11 - Menu Bar Font ** Если ранее параметры главного окна не были заданы - то задать 1280 х 720, ** если были - то использовать те, которые были заданы // Здесь можно было бы узнать текущее разрешение видеокарты и сделать пропорции главного окна под них IF FILE("_MainWind.arx") Ar_MainWind = DC_ARestore("_MainWind.arx") W_MainWind = Ar_MainWind[1] H_MainWind = Ar_MainWind[2] ELSE Ar_MainWind[1] = 1280 Ar_MainWind[2] = 720 W_MainWind = Ar_MainWind[1] H_MainWind = Ar_MainWind[2] DC_ASave(Ar_MainWind, "_MainWind.arx") ENDIF * DbStrUpDate() // Обновление структур всех основных баз данных с сохранением информации в них #################################################### ********************************************************************************************************* *********** Создание среды многоуровневого иерархического меню системы Эйдос **************************** ********************************************************************************************************* ********* ############################################################################################################################################# ********* Если папка, на которую прописан путь с системой, не совпадает с папкой, в которой фактически находится система, то привести их в соответствие ********* Надо учесть, что папка с базами данных приложений Aid_data может находится не в папке с исполнимым модулем системы ########################## ********* ############################################################################################################################################# DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF .NOT. FILE("PathSystem.dbf") aStructure := { { "PathSystem", "C", 250, 0 } } DbCreate( 'PathSystem', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathSystem EXCLUSIVE NEW APPEND BLANK REPLACE PathSystem WITH 'Система запущена в данной папке впервые' ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathSystem EXCLUSIVE NEW IF PathSystem <> Disk_dir // Запомнить текущее положение системы в БД PathSystem.dbf ZAP APPEND BLANK REPLACE PathSystem WITH Disk_dir // Сначала удалить ВСЕ папки с приложениями, используя путь на фактическое расположение БД AID_DATA, // а потом пересоздать БД: PathGrAp.DBF, Appls.dbf и Users.dbf Zap_Appls() GenDbfPaths() GenDbfUsers() aMess := {} AADD(aMess, L('Была произведена локализация системы, т.е. удалены все приложения')) AADD(aMess, L('и пользователи и прописаны пути по фактическому положению системы')) AADD(aMess, L('т.к. система впервые запущена в папке: "'+ALLTRIM(Disk_dir)+'\"' )) LB_Warning(aMess, L('(C) Первый запуск системы "Эйдос" в папке') ) ENDIF * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * mPathSystem = STRTRAN(M_ApplsPath,"\AID_DATA","") // Папка, на которую в БД прописан путь, как на папку с системой * mDiskDir = DISKNAME()+":\"+CURDIR() // Папка, в которой фактически находится система * IF mDiskDir <> mApplsPath // Выполнить режим 1.11 * // Сначала удалить ВСЕ папки с приложениями, используя путь на фактическое расположение БД AID_DATA, * // а потом пересоздать БД: PathGrAp.DBF, Appls.dbf и Users.dbf * Zap_Appls() * GenDbfPaths() * GenDbfUsers() * aMess := {} * AADD(aMess, L('Была произведена локализация системы, т.е. удалены все приложения')) * AADD(aMess, L('и пользователи и прописаны пути по фактическому положению системы')) * AADD(aMess, L('т.к. система впервые запущена в папке: "'+ALLTRIM(mDiskDir)+'\"' )) * LB_Warning(aMess, L('(C) Первый запуск системы "Эйдос" в папке') ) * ENDIF *************************************************************** ***** БД, открытые перед запуском главного меню (главная среда) ***** Восстанавливать их после выхода из функций главного меню *************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** PUBLIC aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) в памяти DC_ASave(aSaveMainM, "_SaveMainM.arx") // Сохранение вычислительной среды (открытые и текущие БД и индексы) на диске * ExternalControl = F5_11() // Режим внешнего управления по таймеру. Возможно надо запускать либо его, либо главное меню * IF ExternalControl * aMess := {} * AADD(aMess, L('Запущен режим внешнего управления системой "Эйдос-Х++"')) * AADD(aMess, L('Для выхода из данного режима достаточно нажать "OK"')) * LB_Warning(aMess, L('(c) Универсальная когнитивная аналитическая система "ЭЙДОС-X++"')) ** mFN = 'F2_3_1()' ** &(mFN) * zTimer:destroy() // Закрытие режима внешнего управления * ELSE ********************************************************************************************************* *********** Многоуровневое иерархическое меню системы Эйдос ********************************************* ********************************************************************************************************* GradFonStart(1) // Организация смены фона главного окна по таймеру sms := {} AADD(sms, L('Чтобы запустить данный режим')) AADD(sms, L('сначала завершите предыдущий')) cmc = L('(C) Система "Эйдос"') Running(.F.) ******************************************** * F2_3_2_12() * QUIT ******************************************** DCMENUBAR oMenuBar OWNERDRAW BARBITMAP 'Checkers.bmp' DCSUBMENU oMenu1 PROMPT L('1. Администрирование') PARENT oMenuBar MESSAGE L('Подсистема администрирования') DCMENUITEM SEPARATOR PARENT oMenu1 DCMENUITEM L('1.1. Авторизация ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_1(),LB_Warning(sms,cmc)) } MESSAGE L('Авторизация сисадмина, администратора приложения или пользователя') DCMENUITEM L('1.2. Регистрация администратора приложения ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_2(),LB_Warning(sms,cmc)) } MESSAGE L('Регистрация и удаление регистрации администраторов приложений и задание паролей пользователей. Этот режим доступен только системному администратору и администраторам приложений') DCMENUITEM L('1.3. Диспетчер приложений ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_3(),LB_Warning(sms,cmc)) } MESSAGE L('Это подсистема администрирования приложений. Она предназначена для создания новых приложений, как пустых, так и на основе учебных примеров (лабораторных работ), имеющихся в системе, а также для выбора приложения для работы из уже имеющихся и удаления приложения. Выбор приложения для работы осуществляется путем отметки его любым символом. Удалять любые приложения разрешается только сисадмину, а Администратору приложений - только те, которые он сам создал') DCMENUITEM SEPARATOR PARENT oMenu1 * DCMENUITEM L('1.4. Выбор режима использования системы ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_4()old,LB_Warning(sms,cmc)) } MESSAGE L('Монопольный или многопользовательский (задается при инсталляции системы, но может быть изменен когда угодно сисадмином)') DCMENUITEM L('1.4. Multi-language support ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_4(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает: 1) задание текущего языка интерфейса (по умолчанию - русский); 2) корректировку локальной языковой базы данных по текущему языку (улучшение перевода); 3) объединение локальных и облачных языковых баз данных') DCMENUITEM L('1.5. Задание путей на папки с группами приложений') PARENT oMenu1 ACTION {|| IF( !Running(), F1_5(),LB_Warning(sms,cmc)) } MESSAGE L('Папки с различными группами приложениями могут быть на локальном компьютере, в локальной сети или в Internet. Пути на них задаются сисадмином при инсталляции системы и могут быть изменены им когда угодно. Один из этих путей, а именно первый из отмеченный специальных символов, считается текущим и используется при СОЗДАНИИ приложений в диспетчере приложений 1.3, а в последующем при запуске приложений на исполнение пути берутся уже из БД диспетчера приложений') DCMENUITEM L('1.6. Задание цветовой схемы главного меню ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_6(),LB_Warning(sms,cmc)) } MESSAGE L('Задается по умолчанию если в папке с системой нет файла: ColorSch.arx при инсталляции системы, но может быть изменена когда угодно сисадмином') DCMENUITEM L('1.7. Задание размера главного окна в пикселях ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_7(),LB_Warning(sms,cmc)) } MESSAGE L('Задается по умолчанию 1024 x 769 если в папке с системой нет файла: _MainWind.arx при инсталляции системы, но может быть изменена когда угодно сисадмином') DCMENUITEM L('1.8. Задание градиентных фонов главного окна ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_8(),LB_Warning(sms,cmc)) } MESSAGE L('Градиентные фоны главного окна задаются по умолчанию при инсталляции системы, но могут быть изменены когда угодно сисадмином') DCMENUITEM L('1.9. Прописывание путей по фактическому положению') PARENT oMenu1 ACTION {|| IF( !Running(), F1_9(),LB_Warning(sms,cmc)) } MESSAGE L('Доступно только сисадмину. Определяет фактическое месторасположение системы и приложений и прописывает пути на них в БД: PathGrAp.DBF и Appls.dbf, а также восстанавливает имена приложений в Appls.dbf на данные им при их создании') DCMENUITEM L('1.10. Экспериментальная графика Роджера ') PARENT oMenu1 ACTION {|| IF( !Running(), DC_Graph(),LB_Warning(sms,cmc))} MESSAGE L('Графика Роджера. Операции с графикой на основе манипулирования массивами. Определение характеристик пикселей') DCMENUITEM L('1.11. Локализация и инициализация (сброс) системы') PARENT oMenu1 ACTION {|| IF( !Running(), F1_11(),LB_Warning(sms,cmc)) } MESSAGE L('Доступно только сисадмину. Прописывает все пути по фактическому месторасположению системы, пересоздает общесистемные базы данных, удаляет все приложения и всех пользователей. Определяет фактическое месторасположение системы и приложений, удаляет все директории приложений с поддиректориями и всеми файлами в них, а затем прописывает все пути на них по фактическому месторасположению, т.е. пересоздает и переиндексирует БД: PathSystem.dbf, PathGrAp.dbf, Appls.dbf и Users.dbf') * DCMENUITEM L('1.12. Режим специального назначения ') PARENT oMenu1 ACTION {|| IF( !Running(), F1_12(),LB_Warning(sms,cmc)) } MESSAGE L('Комментарий: "Без комментариев"') DCSUBMENU oMenu2 PROMPT L('2. Формализация предметной области') PARENT oMenuBar MESSAGE L('Разработка классификационных и описательных шкал и градаций и формирование обучающей выборки') DCMENUITEM SEPARATOR PARENT oMenu2 DCMENUITEM L('2.1. Классификационные шкалы и градации ') PARENT oMenu2 ACTION {|| IF( !Running(), F2_1("Close"),LB_Warning(sms,cmc)) } MESSAGE L('Ручной ввод-корректировка классификационных шкал и градаций') DCMENUITEM L('2.2. Описательные шкалы и градации ') PARENT oMenu2 ACTION {|| IF( !Running(), F2_2("Close"),LB_Warning(sms,cmc)) } MESSAGE L('Ручной ввод-корректировка описательных шкал и градаций') DCMENUITEM SEPARATOR PARENT oMenu2 DCSUBMENU oMenu2_3 PROMPT L('2.3. Ввод обучающей выборки') PARENT oMenu2 MESSAGE L(' ') DCMENUITEM L('2.3.1. Ручной ввод-корректировка обучающей выборки ') PARENT oMenu2_3 ACTION {|| IF( !Running(), F2_3_1(),LB_Warning(sms,cmc))} MESSAGE L(' ') DCMENUITEM SEPARATOR PARENT oMenu2 DCMENUITEM L('2.4. Просмотр эвентологических баз данных ') PARENT oMenu2 ACTION {|| IF( !Running(), F2_4(),LB_Warning(sms,cmc)) } MESSAGE L('Просмотр эвентологических баз данных (баз событий), в которых исходные данные закодированы с помощью классификационных и описательных шкал и градаций и представлены в форме кодов событий, между которыми существуют причинно-следственные связи') DCSUBMENU oMenu2_3_2 PROMPT L('2.3.2. Программные интерфейсы с внешними базами данных') PARENT oMenu2_3 MESSAGE L('Автоматизированная формализация предметной области: разработка классификационных и описательных шкал и градаций и кодирование с их помощью исходных данных, в результате чего они преобразуются в обучающую выборку (базу событий). По сути это нормализация исходных баз данных. При этом сами данные могут быть различных типов: текстовыми, табличными (MS Excel, dbf) и графическими (jpg, bmp)') DCMENUITEM L('2.3.2.1. Импорт данных из текстовых файлов ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_1(),LB_Warning(sms,cmc)) } MESSAGE L('Универсальный программный интерфейс ввода данных из TXT, DOC и Internet (HTML) файлов неограниченного объема. Атрибуция текстов, АСК-анализ мемов') DCMENUITEM L('2.3.2.2. Универсальный программный интерфейс импорта данных в систему') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_2("",""),LB_Warning(sms,cmc))} MESSAGE L('Режим представляет собой УНИВЕРСАЛЬНЫЙ ПРОГРАММНЫЙ ИНТЕРФЕЙС ФОРМАЛИЗАЦИИ ПРЕДМЕТНОЙ ОБЛАСТИ И ИМПОРТА ДАННЫХ В СИСТЕМУ "ЭЙДОС-Х". Данный программный интерфейс обеспечивает автоматическое формирование классификационных и описательных шкал и градаций и обучающей выборки на основе XLS, XLSX или DBF-файла с исходными данными стандарта, описанного в Help режима. Кроме того он обеспечивает автоматический ввод распознаваемой выборки из внешней базы данных. В этом режиме может быть до 1000000 объектов обучающей выборки до 1500 шкал') DCMENUITEM L('2.3.2.3. Импорт данных из транспонированных внешних баз данных ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_3(),LB_Warning(sms,cmc)) } MESSAGE L('Режим представляет собой ПРОГРАММНЫЙ ИНТЕРФЕЙС ФОРМАЛИЗАЦИИ ПРЕДМЕТНОЙ ОБЛАСТИ И ИМПОРТА ДАННЫХ В СИСТЕМУ "ЭЙДОС-Х". Данный программный интерфейс обеспечивает автоматическое формирование классификационных и описательных шкал и градаций и обучающей выборки на основе XLS, XLSX или DBF-файла с исходными данными стандарта, описанного в Help режима стандарта, представляющего собой ТРАНСПОНИРОВАННЫЙ файл стандарта режима 2.3.2.2. Кроме того он обеспечивает автоматический ввод распознаваемой выборки из внешней базы данных. В этом режиме может быть до 1000000 шкал и до 1500 объектов обучающей выборки') DCMENUITEM L('2.3.2.4. Оцифровка изображений по внешним контурам ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2324ok() ,LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает оцифровку изображений по внешним контурам, т.е. кодирование и ввод в систему "Эйдос" изображений и формирование файла исходных данных "Inp_data" в стандарте режима 2.3.2.2 в котором каждое изображение представлено строкой') DCMENUITEM L('2.3.2.5. Оцифровка изображений по всем пикселям и спектру ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_5(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает оцифровку изображений по всем пикселям и спектру, т.е. кодирование и ввод в систему "Эйдос" изображений и формирование файла исходных данных "Inp_data" в стандарте режима 2.3.2.3 в котором каждое изображение представлено столбцом') DCMENUITEM L('2.3.2.6. Сценарный АСК-анализ символьных и числовых рядов ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_6(),LB_Warning(sms,cmc)) } MESSAGE L('Режим обеспечивает импорт данных из DOS-TXT-рядов чисел (цифр) и слов (букв), а также генерацию рядов для расчета асимптотического информационного критерия качества шума, отражающего степень выраженности закономерностей в предметной области. Это позволяет применить сценарный метод АСК-анализа для исследования временных рядов и каузальные зависимостей будущих сценариев изменения величины от прошлых') DCMENUITEM L('2.3.2.7. Транспонирование файлов исходных данных ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_7(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает транспонирование базы данных Inp_data.xls и ее запись в виде файла Out_transp.xls') DCMENUITEM L('2.3.2.8. Объединение нескольких файлов исходных данных в один ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_8(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает объединение нескольких одинаковых по структуре баз данных с именами вида: "Input####.xls", где: "####" - номер файла вида: 0001,0002,...,9999, в один файл с именем: "Add_data.xls"') DCMENUITEM L('2.3.2.9. Разбиение TXT-файла на файлы-абзацы ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_9(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает: обнаружение в папке: ../AID_DATA/INP_DATA/ TXT-файлов, загрузку этих файлов, нахождение в них абзацев, запись этих абзацев в виде TXT-файлов с именами вида: "###### - <ИМЯ TXT-ФАЙЛА>" из сквозного номера абзаца ###### и имени исходного TXT-файла') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('2.3.2.10.Чемпионат RAIF-Challenge 2017-API-bank ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_10(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf из файлов: t1.xlsx, t2.xlsx, t3.xlsx, t4.xlsx') DCMENUITEM L('2.3.2.11.Чемпионат RAIF-Challenge 2017-API-retail ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_11(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf и файла: Inp_name.txt соответственно из файлов:jet_raif_challenge.csv и description.csv') DCMENUITEM L('2.3.2.12. Прогнозирование землетрясений методом Н.А.Чередниченко ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_12(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf из файлов: "Input1.xls" и "Input2.xls" и создание модели для прогнозирования землетрясений методом Натальи Алексеевны Чередниченко (г.Владивосток, Россия)') DCSUBMENU oMenu2_3_3 PROMPT L('2.3.3. Управление обучающей выборкой ') PARENT oMenu2_3 MESSAGE ' ' DCMENUITEM L('2.3.3.1. Параметрическое задание объектов для обработки ') PARENT oMenu2_3_3 ACTION {|| IF( !Running(), Razrab() ,LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('2.3.3.2. Статистическая характеристика, ручной ремонт ') PARENT oMenu2_3_3 ACTION {|| IF( !Running(), Razrab() ,LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('2.3.3.3. Автоматический ремонт обучающей выборки ') PARENT oMenu2_3_3 ACTION {|| IF( !Running(), Razrab() ,LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('2.3.3.4. Распределение объектов обуч. выборки по классам') PARENT oMenu2_3_3 ACTION {|| IF( !Running(), F2_3_3_4(),LB_Warning(sms,cmc))} MESSAGE L('Формирование отчета о распределении объектов обучающей выборки по классам') DCMENUITEM L('2.3.4. Докодирование сочетаний признаков в обучающей выборке') PARENT oMenu2_3 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCSUBMENU oMenu3 PROMPT L('3. Синтез, верификация и улучшение модели') PARENT oMenuBar MESSAGE L('Создание модели, повышение ее качества и оценка достоверности') DCMENUITEM SEPARATOR PARENT oMenu3 DCMENUITEM L('3.1. Ускоренный синтез всех моделей ') PARENT oMenu3 ACTION {|| IF( !Running(), F3_1(),LB_Warning(sms,cmc))} MESSAGE L('Ускоренный синтез всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7}') DCMENUITEM L('3.2. Верификация всех моделей на GPU ') PARENT oMenu3 ACTION {|| IF( !Running(), F3_2(.T.),LB_Warning(sms,cmc))} MESSAGE L('Верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} на графическом процессоре (GPU) с использованием параллельных вычислений') DCMENUITEM L('3.3. Синтез и верификация всех моделей на GPU ') PARENT oMenu3 ACTION {|| IF( !Running(), F3_3(),LB_Warning(sms,cmc))} MESSAGE L('Ускоренный синтез и верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} на графическом процессоре (GPU) с использованием параллельных вычислений') DCMENUITEM SEPARATOR PARENT oMenu3 DCMENUITEM L('3.4. Анализ достоверности моделей с двумя инт.критериями') PARENT oMenu3 ACTION {|| IF( !Running(), F3_4(),LB_Warning(sms,cmc))} MESSAGE L('Оценивается достоверность (адекватность) заданных стат.моделей и моделей знаний. Для этого осуществляется синтез заданных моделей, обучающая выборка копируется в распознаваемую и в каждой заданной модели проводится распознавание с использованием двух интегральных критериев, подсчитывается количество верно идентифицированных и не идентифицированных, ошибочно идентифицированных и не идентифицированных объектов (ошибки 1-го и 2-го рода)') DCMENUITEM SEPARATOR PARENT oMenu3 DCMENUITEM L('3.5. Синтез и верификация заданных из 10 моделей ') PARENT oMenu3 ACTION {|| IF( !Running(), F3_5('CPU','SintRec','3.5'),LB_Warning(sms,cmc)) } MESSAGE L('Синтез и верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} на центральном процессоре (CPU) или на графическом процессоре (GPU)') DCMENUITEM L('3.6. Синтез и верификация заданной группы моделей ') PARENT oMenu3 ACTION {|| IF( !Running(), Razrab() ,LB_Warning(sms,cmc)) } MESSAGE L('В различных приложениях текущей группы приложений создаются и верифицируются модели: Abs, Prc1, Prc2, Inf1~Prc1, Inf2~Prc2, Inf3-хи-квадрат, Inf4-roi~Prc1, Inf5-roi~Prc2, Inf6-Dp~Prc1, Inf7-Dp~Prc2 с фиксированными и адаптивными интервалами со сценариями и без и для каждого класса определяется модель, в которой его идентификация осуществляется наиболее достоверно') DCMENUITEM SEPARATOR PARENT oMenu3 DCSUBMENU oMenu3_7 PROMPT L('3.7. Повышение качества модели') PARENT oMenu3 MESSAGE ' ' DCMENUITEM L('3.7.1. Поиск и удаление артефактов (робастная процедура) ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_1(),LB_Warning(sms,cmc))} MESSAGE L('Строится частотное распределение абсолютных частот встреч признаков в классах по матрице сопряженности Abs.dbf и пользователю предоставляется возможность удалить редко встречающиеся факты (сочетания), как случайные выбросы или артефакты. Для работы профессиональной графики нужна MS Windows 7 или выше') DCMENUITEM L('3.7.2. Значимость классификационных шкал ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_2(),LB_Warning(sms,cmc))} MESSAGE L('В данном режиме классификационные шкалы ранжируются в порядке убывания значимости, т.е. средней значимости их градаций (степени детерминированности классов). Детерминированность класса - это вариабельность значений частных критериев статистических баз и баз знаний') DCMENUITEM L('3.7.3. Степень детерминированности классов (град.клас.шкал)') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_3(),LB_Warning(sms,cmc))} MESSAGE L('В данном режиме все градации классификационных шкал (классы) ранжируются в порядке убывания степени детерминированности, т.е. вариабельности значений частных критериев статистических и системно-когнитивных моделей') DCMENUITEM L('3.7.4. Значимость описательных шкал ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_4(),LB_Warning(sms,cmc))} MESSAGE L('В данном режиме описательные шкалы ранжируются в порядке убывания значимости, т.е. средней значимости их градаций, т.е. признаков') DCMENUITEM L('3.7.5. Значимость градаций описательных шкал (признаков) ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_5(),LB_Warning(sms,cmc))} MESSAGE L('В данном режиме все градации описательных шкал (признаки) ранжируются в порядке убывания значимости, т.е. вариабельности значений частных критериев статистических и системно-когнитивных моделей') DCMENUITEM L('3.7.6. Разделение классов на типичную и нетипичную части ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_6(),LB_Warning(sms,cmc))} MESSAGE L('Из файла исходных данных "Inp_data.dbf" стандарта программного интерфейса 2.3.2.2 либо удаляются объекты обучающей выборки, которые привели к ошибкам неидентификации или ложной идентификации, либо для таких объектов создаются новые классы. В данном режиме используются результаты распознавания') DCMENUITEM L('3.7.7. Генерация подсистем классов и докод.об.и расп.выб. ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_7(),LB_Warning(sms,cmc))} MESSAGE L('На основе сочетания классов по 2, 3, N формируются подсистемы классов, которые добавляются в качестве градаций в классификационные шкалы подсистем классов и в объекты обучающей и распознаваемой выборки') DCMENUITEM L('3.7.8. Генерация подсистем признаков и докод.об.и расп.выб.') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_8(),LB_Warning(sms,cmc))} MESSAGE L('На основе сочетания признаков по 2, 3, N формируются подсистемы признаков, которые добавляются в качестве градаций в описательные шкалы подсистем признаков и в объекты обучающей и распознаваемой выборки') DCMENUITEM SEPARATOR PARENT oMenu3 DCSUBMENU oMenu4 PROMPT L('4. Решение задач с применением модели') PARENT oMenuBar MESSAGE L('Применение модели для решения задач идентификации (распознавания), прогнозирования и поддержки принятия решений (обратная задача прогнозирования), а также для исследования моделируемой предметной области путем исследования ее модели') DCMENUITEM SEPARATOR PARENT oMenu4 DCSUBMENU oMenu4_1 PROMPT L('4.1. Идентификация и прогнозирование ') PARENT oMenu4 MESSAGE ' ' DCMENUITEM L('4.1.1. Ручной ввод-корректировка распознаваемой выборки ') PARENT oMenu4_1 ACTION {|| IF( !Running(), F4_1_1(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('4.1.2. Пакетное распознавание в текущей модели ') PARENT oMenu4_1 ACTION {|| IF( !Running(), F4_1_2(0,.T.,"4_1_2",'GPU'),LB_Warning(sms,cmc))} MESSAGE L('Распознаются по очереди все объекты распознаваемой выборки в стат.модели или базе знаний, заданной текущей в режиме 3.3 или 5.6.') DCMENUITEM SEPARATOR PARENT oMenu4_1 DCSUBMENU oMenu4_1_3 PROMPT L('4.1.3. Вывод результатов распознавания') PARENT oMenu4_1 MESSAGE ' ' DCMENUITEM L('4.1.3.1. Подробно наглядно: "Объект - классы" ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_1(),LB_Warning(sms,cmc))} MESSAGE L('Визуализация результатов распознавания в подробной наглядной форме в отношении: "Один объект - много классов" с двумя интегральными критериями сходства между конкретным образом распознаваемого объекта и обобщенными образами классов: "Семантический резонанс знаний" и "Сумма знаний"') DCMENUITEM L('4.1.3.2. Подробно наглядно: "Класс - объекты" ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_2(),LB_Warning(sms,cmc))} MESSAGE L('Визуализация результатов распознавания в подробной наглядной форме в отношении: "Один класс - много объектов" с двумя интегральными критериями сходства между конкретным образом распознаваемого объекта и обобщенными образами классов: "Семантический резонанс знаний" и "Сумма знаний"') DCMENUITEM L('4.1.3.3. Итоги наглядно: "Объект - класс" ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_3(),LB_Warning(sms,cmc))} MESSAGE L('Отображение итоговых результатов распознавания в наглядной форме: отображаются пары: "Объект-класс" у которых наибольшее сходство по двум интегральным критериям сходства: "Семантический резонанс знаний" и "Сумма знаний". Приводится информация о фактической принадлежности объекта к классу') DCMENUITEM L('4.1.3.4. Итоги наглядно: "Класс - объект" ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_4(),LB_Warning(sms,cmc))} MESSAGE L('Отображение итоговых результатов распознавания в наглядной форме: отображаются пары: "Класс-объект" у которых наибольшее сходство по двум интегральным критериям сходства: "Семантический резонанс знаний" и "Сумма знаний". Приводится информация о фактической принадлежности объекта к классу') DCMENUITEM L('4.1.3.5. Подробно сжато: "Объекты - классы"') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_5(),LB_Warning(sms,cmc))} MESSAGE L('В подробной сжатой (числовой) форме приводится информация об уровне сходства всех объектов со всеми классами по двум интегральным критериям сходства: "Семантический резонанс знаний" и "Сумма знаний", а также о фактической принадлежности объекта к классу') DCMENUITEM SEPARATOR PARENT oMenu4_1_3 DCMENUITEM L('4.1.3.6. Обобщ.форма по достов.моделей при разных интегральных крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_6('4.1.3.6.') ,LB_Warning(sms,cmc)) } MESSAGE L('Отображаются обобщенные результаты измерения достоверности идентификации по всем моделям и интегральным критериям из БД: Dost_mod.DBF. Отображаются частотные распределения уровней сходства истинных и ложных положительных и отрицательных решений при разных моделях и интегральных критериях') DCMENUITEM L('4.1.3.7. Обобщ.стат.анализ результатов идент. по моделям и инт.крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_7() ,LB_Warning(sms,cmc)) } MESSAGE L('Отображаются результаты обобщенного стат.анализа достоверности идентификации по всем моделям и интегральным критериям из БД: VerModClsIT.dbf. Отображаются частотные распределения уровней сходства истинных и ложных положительных и отрицательных решений при разных моделях и интегральных критериях') DCMENUITEM L('4.1.3.8. Стат.анализ результ. идент. по классам, моделям и инт.крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_8(7),LB_Warning(sms,cmc)) } MESSAGE L('Отображаются результаты стат.анализа достоверности идентификации по всем классам, моделям и интегральным критериям из БД: VerModCls.dbf') DCMENUITEM L('4.1.3.9. Достоверность идент.объектов при разных моделях и инт.крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_9() ,LB_Warning(sms,cmc)) } MESSAGE L('Отображается достоверность идентификации объектов по классам (F-мера Ван Ризбергена) в разрезе по объектам при разных моделях (т.е. разных частных критериях) и при разных интегральных критериях из БД: Dost_clsF.dbf. Позволяет удалять из обучающей выборки плохо распознаваемые объекты') DCMENUITEM L('4.1.3.10.Достоверность идент.классов при разных моделях и инт.крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_10(),LB_Warning(sms,cmc)) } MESSAGE L('Отображается достоверность идентификации объектов по классам (F-мера Ван Ризбергена) в разрезе по классам при разных моделях (т.е. разных частных критериях) и при разных интегральных критериях из БД: Dost_clsF.dbf') * DCMENUITEM L('4.1.3.11.Распределения уровн.сходства при разных моделях и инт.крит.') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_11old(),LB_Warning(sms,cmc))} MESSAGE L('Отображаются частотные распределения уровней сходства верно и ошибочно идентифицированных и неидентифицированных объектов при разных моделях и интегральных критериях из БД: DostRasp.dbf и DostRsp#.dbf. Расчет и графическая визуализация частотных распределений уровней сходства: 1) TP,TN,FP,FN, интегральный критерий - резонанс знаний; 2) TP,TN,FP,FN, интегральный критерий - сумма знаний; 3) (TP-FP), (TN-FN), интегральный критерий - резонанс знаний; 4) (TP-FP), (TN-FN), интегральный критерий - сумма знаний; 5) (TP-FP)/(TP+FP)*100 и (TN-FN)/(TN+FN)*100, интегральный критерий - резонанс знаний; 6) (TP-FP)/(TP+FP)*100 и (TN-FN)/(TN+FN)*100, интегральный критерий - сумма знаний') DCMENUITEM L('4.1.3.11.Объединение в одной БД строк по самым достоверным моделям ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_11(.T.),LB_Warning(sms,cmc))} MESSAGE L('Объединение в одной БД "AddData.dbf" строк по наиболее достоверным моделям из Dost_modCls, формируемых в режиме 4.1.3.6. Этот режим предназначен для исследования зависимости достоверности моделей от объема обучающей выборки и других параметров моделей по F-критерию Ван Ризбергена, а также по L1- и L2-критериям проф.Е.В.Луценко') DCMENUITEM L('4.1.4. Пакетное распознавание в заданной группе моделей ') PARENT oMenu4_1 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE L('Распознаются по очереди все объекты распознаваемой выборки в стат.модели или базе знаний, заданной текущей, в всех моделях заданной группы моделей') DCMENUITEM L('4.1.5. Докодирование сочетаний признаков в распознаваемой выборке ') PARENT oMenu4_1 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('4.1.6. Рациональное назначение объектов на классы (задача о ранце) ') PARENT oMenu4_1 ACTION {|| IF( !Running(), F4_1_6(),LB_Warning(sms,cmc))} MESSAGE L('Управление персоналом на основе АСК-анализа и функционально-стоимостного анализа (задача о назначениях)') DCMENUITEM L('4.1.7. Интерактивная идентификация - последовательный анализ Вальда') PARENT oMenu4_1 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('4.1.8. Мультираспознавание (пакетное распознавание во всех моделях)') PARENT oMenu4_1 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE L('При идентификации объекта распознаваемой выборки с каждым классом он сравнивается в той модели, в которой этот класс распознается наиболее достоверно, как в системе "Эйдос-астра"') DCMENUITEM L('4.1.9. Подготовка результатов распознавания для http://kaggle.com ') PARENT oMenu4_1 ACTION {|| IF( !Running(), F4_1_9(),LB_Warning(sms,cmc))} MESSAGE L('Подготовка результатов распознавания в форме CSV-файлов в стандарте http://kaggle.com. Данный режим предполагает, что: 1) в модели 2 класса; 2) результаты распознавания во всех моделях уже получены в режиме 3.5') DCSUBMENU oMenu4_2 PROMPT L('4.2. Типология классов и принятие решений') PARENT oMenu4 MESSAGE ' ' DCMENUITEM L('4.2.1. Информационные портреты классов') PARENT oMenu4_2 ACTION {|| IF( !Running(), F4_2_1(),LB_Warning(sms,cmc))} MESSAGE L('Решение обратной задачи прогнозирования: выработка управляющих решений. Если при прогнозировании на основе значений факторов оценивается в какое будущее состояние перейдет объект управления, то при решении обратной задачи, наоборот, по заданному целевому будущему состоянию объекта управления определяется такая система значений факторов, которая в наибольшей степени обуславливает переход в это состояние') DCSUBMENU oMenu4_2_2 PROMPT L('4.2.2. Кластерный и конструктивный анализ классов') PARENT oMenu4_2 MESSAGE ' ' DCMENUITEM L('4.2.2.1. Расчет матриц сходства, кластеров и конструктов ') PARENT oMenu4_2_2 ACTION {|| IF( !Running(), F4_2_2_1(),LB_Warning(sms,cmc))} MESSAGE L('Расчет матриц сходства, кластеров и конструктов') DCMENUITEM L('4.2.2.2. Результаты кластерно-конструктивного анализа ') PARENT oMenu4_2_2 ACTION {|| IF( !Running(), F4_2_2_2(),LB_Warning(sms,cmc))} MESSAGE L('Состояния, соответствующие классам, расположенные около одного полюса конструкта, достижимы одновременно, т.к. имеют сходную систему детерминации, а находящиеся около противоположных полюсов конструкта являются альтернативными, т.е. одновременно недостижимы') DCMENUITEM L('4.2.2.3. Агломеративная древовидная кластеризация классов') PARENT oMenu4_2_2 ACTION {|| IF( !Running(), F4_2_2_3(),LB_Warning(sms,cmc))} MESSAGE L('Когнитивная кластеризация, путем объединения пар классов в матрице абсолютных частот и пересчет матриц условных и безусловных процентных распределений и системно-когнитивных моделей. Построение и визуализация древовидных диаграмм объединения класов (дендрограмм) в графическом виде') DCMENUITEM L('4.2.2.4. Дивизивная древовидная кластеризация классов') PARENT oMenu4_2_2 ACTION {|| IF( !Running(), F3_7_6() ,LB_Warning(sms,cmc))} MESSAGE L('Кластеризация, путем разделения классов на типичную и нетипичную части пока релизоавна в упрощенной форме (по сравнению с DOS-версией системы "Эйдос". Из файла исходных данных "Inp_data.dbf" стандарта программного интерфейса 2.3.2.2 либо удаляются объекты обучающей выборки, которые привели к ошибкам неидентификации или ложной идентификации, либо для таких объектов создаются новые классы. В данном режиме используются результаты распознавания)') DCMENUITEM L('4.2.3. Когнитивные диаграммы классов') PARENT oMenu4_2 ACTION {|| IF( !Running(), F4_2_3(),LB_Warning(sms,cmc))} MESSAGE L('Данный режим показывает в наглядной графической форме какими признаками сходны и какими отличаются друг от друга заданные классы') DCSUBMENU oMenu4_3 PROMPT L('4.3. Типологический анализ признаков') PARENT oMenu4 MESSAGE ' ' DCMENUITEM L('4.3.1. Информационные портреты признаков') PARENT oMenu4_3 ACTION {|| IF( !Running(), F4_3_1(),LB_Warning(sms,cmc))} MESSAGE L('Семантический (смысловой) портрет признака или значения фактора, т.е. количественная характеристика силы и направления его влияния на поведение объекта управления') DCSUBMENU oMenu4_3_2 PROMPT L('4.3.2. Кластерный и конструктивный анализ признаков') PARENT oMenu4_3 MESSAGE ' ' DCMENUITEM L('4.3.2.1. Расчет матриц сходства, кластеров и конструктов ') PARENT oMenu4_3_2 ACTION {|| IF( !Running(), F4_3_2_1(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('4.3.2.2. Результаты кластерно-конструктивного анализа ') PARENT oMenu4_3_2 ACTION {|| IF( !Running(), F4_3_2_2(),LB_Warning(sms,cmc))} MESSAGE L('Признаки или градации факторов, расположенные около одного полюса конструкта, оказывают сходное влияние на объект управления, т.е. на его принадлежность к классам или его переход в состояния, соответствующие классам и могут быть заменены одни другими, а находящиеся около противоположных полюсов конструкта оказывают сильно отличающееся влияние на объект управления и не могут быть заменены одни другими') DCMENUITEM L('4.3.2.3. Агломеративная древовидная кластеризация признаков') PARENT oMenu4_3_2 ACTION {|| IF( !Running(), F4_3_2_3(),LB_Warning(sms,cmc))} MESSAGE L('Когнитивная кластеризация, путем объединения пар признаков в матрице абсолютных частот и пересчет матриц условных и безусловных процентных распределений и системно-когнитивных моделей. Построение и визуализация древовидных диаграмм объединения признаков (дендрограмм) в графическом виде') DCMENUITEM L('4.3.3. Когнитивные диаграммы признаков') PARENT oMenu4_3 ACTION {|| IF( !Running(), F4_3_3(),LB_Warning(sms,cmc))} MESSAGE L('Данный режим показывает в наглядной графической форме какими классами сходны и какими отличаются друг от друга заданные признаки') DCSUBMENU oMenu4_4 PROMPT L('4.4. Исследование предметной области путем исследования ее модели') PARENT oMenu4 MESSAGE ' ' DCMENUITEM L('4.4.1. Оценка достоверности обучающей выборки ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE L('Выявление объектов с нарушенными корреляциями между классами и признаками. Выявление очень сходных друг с другом объектов обучающей выборки') DCMENUITEM L('4.4.2. Оценка достоверности распознаваемой выборки ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE L('Выявление очень сходных друг с другом объектов распознаваемой выборки') DCMENUITEM L('4.4.3. Измерение адекватности 3 стат.моделей и 7 моделей знаний ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE L('Любой заданной или всех') DCMENUITEM L('4.4.4. Измерение сходимости и устойчивости 10 моделей ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('4.4.5. Зависимость достоверности моделей от объема обучающей выборки ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM L('4.4.6. Измерение независимости классов и признаков (анализ хи-квадрат)') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc))} MESSAGE ' ' DCMENUITEM SEPARATOR PARENT oMenu4_4 DCMENUITEM L('4.4.7. Графические профили классов и признаков ') PARENT oMenu4_4 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('4.4.8. Количественный SWOT-анализ классов средствами АСК-анализа ') PARENT oMenu4_4 ACTION {|| IF( !Running(), F4_4_8(),LB_Warning(sms,cmc)) } MESSAGE L('АСК-анализ обеспечивает построение SWOT-матрицы (модели) для заданного класса с указанием силы влияния способствующих и препятствующих факторов непосредственно на основе эмпирических данных и поэтому является инструментом автоматизированного количественного SWOT-анализа (прямая задача SWOT-анализа). Классы интерпретируются как целевые и нежелательные состояния фирмы, факторы делятся на внутренние, технологические, описывающие фирму, и внешние, характеризующие окружающую среду, а количество информации, содержащееся в значении фактора, рассматривается как сила и направление его влияния на переход фирмы в те или иные будущие состояния') DCMENUITEM L('4.4.9. Количественный SWOT-анализ факторов средствами АСК-анализа ') PARENT oMenu4_4 ACTION {|| IF( !Running(), F4_4_9(),LB_Warning(sms,cmc)) } MESSAGE L('АСК-анализ обеспечивает построение количественной SWOT-матрицы (модели) для заданного значения фактора с указанием степени, в которой он способствует или препятствует переходу объекта управления в различные будущие состояния, соответствующие классам (обратная задача SWOT-анализа). Эта модель строится непосредственно на основе эмпирических данных и поэтому АСК-анализ может рассматриваться как инструмент автоматизированного количественного SWOT-анализа. Факторы делятся на внутренние, технологические, описывающие саму фирму, и внешние, характеризующие окружающую среду') DCMENUITEM L('4.4.10.Нелокальные нейроны ') PARENT oMenu4_4 ACTION {|| IF( !Running(), F4_4_10(),LB_Warning(sms,cmc))} MESSAGE L('Нелокальный нейрон отражает силу и знак влияния значений факторов (рецепторов-признаков) на активацию или торможение нейрона, т.е. на принадлежность или не принадлежность объекта с этими признаками к классу, соответствующему данному нейрону') DCMENUITEM L('4.4.11.Парето-подмножества нелокальной нейронной сети ') PARENT oMenu4_4 ACTION {|| IF( !Running(), F4_4_11('NeuroNet') ,LB_Warning(sms,cmc))} MESSAGE L('В этом режиме изображается вместе сразу несколько нелокальных нейронов, которые в режиме 4.4.10 изображались по одному, т.е. Парето-подмножество нелокальной нейронной сети') DCMENUITEM L('4.4.12.Интегральные когнитивные карты ') PARENT oMenu4_4 ACTION {|| IF( !Running(), F4_4_11('IntCognMaps'),LB_Warning(sms,cmc))} MESSAGE L('Это нелокальная нейронная сеть с указанием не только связей между значениями факторов и классов (как в режиме 4.4.11), но и с корреляциями между классами (как в режиме 4.2.2), и корреляциями между значениями факторов (как в режиме 4.3.2)') DCMENUITEM L('4.5. Визуализация когнитивных функций: текущее приложение, разные модели') PARENT oMenu4 ACTION {|| IF( !Running(), F4_5(),LB_Warning(sms,cmc))} MESSAGE L('В данном режиме осуществляется визуализация и запись когнитивных функций, созданных в текущем приложении на основе различных стат.моделей и моделей знаний') DCMENUITEM L('4.6. Подготовка баз данных для визуализация когнитивных функций в Excel ') PARENT oMenu4 ACTION {|| IF( !Running(), F4_6(),LB_Warning(sms,cmc))} MESSAGE L('Данный режим готовит базы данных для визуализации в MS Excel прямых и обратных, позитивных и негативных точечных и средневзвешенных редуцированных когнитивных функций, созданных на основе различных стат.моделей и моделей знаний') DCMENUITEM L('4.7. АСК-анализ изображений по пикселям, спектрам и контурам ') PARENT oMenu4 ACTION {|| IF( !Running(), F4_8(L('4.7. АСК-анализ изображений по пикселям, спектрам и контурам')),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает АСК-анализ изображений, как сгенерированных в учебных целях, так и внешних для системы "Эйдос-Х++", относящихся к какой-либо предметной области. АСК-анализ изображений возможен: по пикселям, спектру, по внешним контурам, по внутренним и внешним контурам (в разработке). Кроме того в данном режиме по кнопке "Формирование облака точек" возможна визуализация когнитивных функций, аналогично режимам 4.5 и 4.6. Данный режим интегрирован с Геокогнитивной подсистемой системы "Эйдос" (режим 4.8.)') DCMENUITEM L('4.8. Геокогнитивная подсистема ') PARENT oMenu4 ACTION {|| IF( !Running(), F4_8(L('4.8. Геокогнитивная подсистема')),LB_Warning(sms,cmc)) } MESSAGE L('Обеспечивает восстановление значений функций по признакам аргумента. Преобразует 2D Excel-таблицу с именем "Inp_map.xls" в файл исходных данных "Inp_data.dbf", содержащий координаты X,Y,Z точек и их признаки (модель описательной информации картографической базы данных). Визуализирует исходные данные из БД "Inp_data.dbf" или итоговые результаты распознавания из БД: "Rsp_it.dbf" в картографической форме (сетка и градиентная заливка цветом) с применением триангуляции Делоне. Обеспечивает пакетный ввод и оконтуривание изображений и формирование соответствующих файлов "Inp_data" и др. для создания и применения модели, созданной на основе этих изображений. Режим интегрирован с 4.7.') DCSUBMENU oMenu5 PROMPT L('5. Сервис') PARENT oMenuBar MESSAGE L('Конвертирование, печать и сохранение модели, пересоздание и переиндексация всех баз данных') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('5.1. Конвертер приложения OLD => NEW' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_1() ,LB_Warning(sms,cmc)) } MESSAGE L('Преобразование модели из стандарта БД системы Эйдос-12.5 в стандарт Эйдос-X++. Для конвертирования старого приложения надо скопировать в папку: файлы: Object.Dbf, Priz_Ob.Dbf, Priz_Per.Dbf, Priz_Per.Dbt, Obinfzag.Dbf, Obinfkpr.Dbf') DCMENUITEM L('5.2. Конвертер приложения NEW => OLD' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_2() ,LB_Warning(sms,cmc)) } MESSAGE L('Преобразование модели из стандарта БД системы Эйдос-X++ в стандарт Эйдос-12.5 в папку OldAppls. Все файлы из этой папки надо скопировать в текущую папку системы "Эйдос-12.5", выполнить режимы 7.2 и 2.3.5') DCMENUITEM L('5.3. Конв.трех БД расп.выборки в одну БД' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_3() ,LB_Warning(sms,cmc)) } MESSAGE L('Три базы данных распознаваемой выборки: Rso_Zag.dbf, Rso_Kcl.dbf, Rso_Kpr.dbf преобразуются в одну базу данных: Rso_all.dbf. По структуре эта база данных очень сходна с базами статистических и системно-когнитивных моделей, т.е. строки в ней соответствуют градациям описательных шкал (признакам), а колонки - объектам распознаваемой выборки, в ячейках - число встреч данного признака у данного объекта.') DCMENUITEM L('5.4. Конвер. результатов расп.для SigmaPlot') PARENT oMenu5 ACTION {|| IF( !Running(), F5_4() ,LB_Warning(sms,cmc)) } MESSAGE L('Конвертирует результаты распознавания, т.е. БД Rasp.dbf в параметрическую форму в стиле: "X, Y, Z", удобную для картографической визуализации в системе SigmaPlot. Это возможно, если предварительно были выполнены режимы 3.7.7 и 3.4(3.5.) и 4.1.2.') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('5.5. Просмотр основных БД всех моделей ' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_5(.T.),LB_Warning(sms,cmc)) } MESSAGE L('Обеспечивает просмотр и экспорт в Excel основных баз данных всех статистических моделей: Abs, Prc1, Prc2 и моделей знаний: Inf1~Prc1, Inf2~Prc2, Inf3-хи-квадрат, Inf4-roi~Prc1, Inf5-roi~Prc2, Inf6-Dp~Prc1, Inf7-Dp~Prc2') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('5.6. Выбрать модель и сделать ее текущей ' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_6(4,.T.,"MainMenu"),LB_Warning(sms,cmc))} MESSAGE L('Данная функция позволяет выбрать среди ранее рассчитанных в 3-й подсистеме статистических баз Abs, Prc1, Prc2 и моделей знаний INF#, текущую модель для решения в 4-й подсистеме задач идентификации, прогнозирования, приятия решений и исследования предметной области путем исследования ее модели') DCMENUITEM L('5.7. Переиндексация всех баз данных ' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_7() ,LB_Warning(sms,cmc)) } MESSAGE L('Заново создаются все необходимые для работы системы индексные массивы общесистемных баз данных (находящихся в папке с исполнимым модулем системы), а также баз данных текущего приложения, необходимые для работы с ним') DCMENUITEM L('5.8. Сохранение основных баз данных модели' ) PARENT oMenu5 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('5.9. Восстановление модели из основных БД ' ) PARENT oMenu5 ACTION {|| IF( !Running(), Razrab(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('5.10.Выгрузка исходных данных в "Inp_data"' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_10() ,LB_Warning(sms,cmc)) } MESSAGE L('Данный режим выполняет функцию, обратную универсальному программному интерфейсу с внешними базами данных 2.3.2.2(), т.е. не вводит исходные данные в систему, а наоборот, формирует на основе исходных данных файлы: Inp_data.dbf и Inp_data.txt, на основе которых в режиме 2.3.2.2() можно сформировать эту же модель') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('5.11. Внешнее управление системой "Эйдос"' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_11(),LB_Warning(sms,cmc)) } MESSAGE L('Данный режим обеспечивает управление системой "Эйдос" в реальном времени со стороны внешней программы путем задания ею последовательности функций системы "Эйдос" для исполнения (по сути программы, написанной на языке "Эйдос") в специальной базе данных: "ExternalControl.dbf" и программного контроля их исполнения') DCMENUITEM SEPARATOR PARENT oMenu5 DCMENUITEM L('5.12. Печать структур всех баз данных' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_12(),LB_Warning(sms,cmc)) } MESSAGE L('Распечатка структур (даталогических моделей) всех баз данных текущего приложения. Преобразование всех баз данных в Excel-файлы: dbf ===>>> xls') DCMENUITEM L('5.13. Редактирование БД лемматизации ' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_13(),LB_Warning(sms,cmc)) } MESSAGE L('Ввод-корректировка базы данных лемматизации: "Lemma.dbf"') DCMENUITEM L('5.14. On-line HELP по лабораторным работам' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_14(),LB_Warning(sms,cmc)) } MESSAGE L('On-line описания лабораторных работ (статьи и с сайта автора: http://lc.kubagro.ru/), а также пояснения по смыслу частных и интегральных критериев') DCMENUITEM L('5.15. Локальные HELP по режимам системы' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_15(),LB_Warning(sms,cmc)) } MESSAGE L('Локальные пояснения по режимам системы "Эйдос", входящие в ее исполнимый модуль') DCMENUITEM L('5.16. Минимизация инсталляции системы' ) PARENT oMenu5 ACTION {|| IF( !Running(), F5_16(),LB_Warning(sms,cmc)) } MESSAGE L('5.16. Минимизация инсталляции системы завершена успешно! Было произведено удаление из текущей инсталляции системы "Эйдос" локальных лабораторных работ, базы лемматизации, всех языковых баз. В результате минимизации rar-архив папки с системой будет уже не около 120 Мб, а примерно 40 Мб. При этом удалении ранее установленные приложения не затрагиваются. Для удаления всех приложений служит специальный режим 1.11. Все удаленное входит в полную инсталляцию, которую можно скачать с сайта автора: http://lc.kubagro.ru/aidos/_Aidos-X.htm') DCSUBMENU oMenu6 PROMPT L('6. О системе') PARENT oMenuBar MESSAGE ' ' DCMENUITEM SEPARATOR PARENT oMenu6 DCMENUITEM L('6.1. Информация о системе, разработчике и средствах разработки') PARENT oMenu6 ACTION {|| IF( !Running(), F6_1(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('6.2. Ссылки на патенты, документацию и текущую версию системы ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_2(),LB_Warning(sms,cmc)) } MESSAGE L('Internet-ссылки на патенты, монографии, учебные пособия, научные статьи и самую новую (на текущий момент) версию системы "Эйдос-Х++, а также полный комплект документации на нее одним файлом"') DCMENUITEM L('6.3. Развитый алгоритм принятия решений АСК-анализа ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_3(),LB_Warning(sms,cmc)) } MESSAGE L('Развитый алгоритм принятия решений в интеллектуальных системах управления на основе АСК-анализа и системы "Эйдос"') DCMENUITEM L('6.4. Порядок преобразования данных в информацию, а ее в знания') PARENT oMenu6 ACTION {|| IF( !Running(), F6_4(),LB_Warning(sms,cmc)) } MESSAGE L('В режиме раскрывается соотношение содержания понятий: "Данные", "Информация" и "Знания", а также последовательность преобразования данных в информацию, а ее в знания в системе "Эйдос-Х++" с указанием имен баз данных и ссылками на основные публикации по этим вопросам') DCMENUITEM L('6.5. Графическая заставка системы "Эйдос-12.5" ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_5(),LB_Warning(sms,cmc)) } MESSAGE ' ' DCMENUITEM L('6.6. Roger Donnay, Professional Developer, Developer eXPress++') PARENT oMenu6 ACTION {|| IF( !Running(), F6_6(),LB_Warning(sms,cmc)) } MESSAGE L('Roger Donnay, профессиональный разработчик программного обеспечения, разработчик высокоэффективной инструментальной системы программирования eXPress++, широко использованной при создании системы "Эйдос-Х++". Roger Donnay, Professional Developer, Developer eXPress++') DCMENUITEM L('6.7. Логотипы мультимоделей ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_7(),LB_Warning(sms,cmc)) } MESSAGE 'Это надо видеть' DCMENUITEM L('6.8. Свидетельства РосПатента РФ на систему "Эйдос" ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_8(),LB_Warning(sms,cmc)) } MESSAGE L('Основные (знаковые) свидетельства РосПатента на систему "Эйдос" 1994, 2003, 2012, 2017 годов') DCMENUITEM L('6.9. География пользователей системы "Эйдос-Х++" ') PARENT oMenu6 ACTION {|| IF( !Running(), F6_9(),LB_Warning(sms,cmc)) } MESSAGE L('Когда кто-либо в мире запускает систему "Эйдос-Х++" на исполнение на компьютере, подключенном к Internet, то на она программно обращается к специально созданному сайту, на котором размещен PHP-код, определяющий дату и время обращения, IP-адрес компьютера, с которого произошло это обращение, и по нему домен, страна, округ, регион, город, почтовый индекс, временной пояс и географические координаты места запуска') * DCMENUITEM L('Создание изображения в памяти и его вывод с масштабированием ') PARENT oMenu6 ACTION {|| IF( !Running(), ScalingJpg(),LB_Warning(sms,cmc)) } MESSAGE L('Отладка формирования большого изображения в памяти и его вывода на экран с масштабированием') DCMENUITEM L('7. Выход') PARENT oMenuBar ACTION {|| F7() } MESSAGE L('Завершение сеанса работы в системе "Эйдос". Перед выходом из системы осуществляется дополнение русской языковой базы текстовыми элементами интерфейса, которые встретились в текущем сеансе запуска системы "Эйдос" и которых не было в этой базе данных. Русская языковая база является основой для формирования в режиме 1.4 языковых баз по другим 43 языкам, поддерживаемых системой "Эйдос"') @ 100,100 DCSTATIC TYPE XBPSTATIC_TYPE_RAISEDBOX ; OBJECT oMessageBox ; INVISIBLE ; COLOR DC_XbpMenuConfig()[2], DC_XbpMenuConfig()[3] @ 4,4 DCSAY L('System Aidos') ; PARENT oMessageBox ; FONT '8.MS Sans Serif' ; SAYOPTION XBPSTATIC_TEXT_VCENTER + XBPSTATIC_TEXT_CENTER + XBPSTATIC_TEXT_WORDBREAK ; COLOR DC_XbpMenuConfig()[9], DC_XbpMenuConfig()[1] DCGETOPTIONS ; WINDOWHEIGHT H_MainWind ; WINDOWWIDTH W_MainWind DCREAD GUI ; TITLE L('(c) Универсальная когнитивная аналитическая система "ЭЙДОС-X++", beta-version, rel: 29.07.2020') ; HANDLER MenuHandler REFERENCE @oMessageBox ; OPTIONS GetOptions ; EVAL {|o|oDlg := o}; PARENT @oDlgBmp * DCREAD GUI TITLE L('Смена фона каждую секунду, минуту, час') PARENT @oDlgBmp OPTIONS GetOptions oTimer:destroy() // Закрытие фона главного меню *ENDIF // Внешнее управление ? ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW RETURN NIL ******************************************************************************** ******** 1.1. Авторизация сисадмина, администратора приложения или пользователя ******************************************************************************** FUNCTION F1_1() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions Running(.T.) M_Login = "1 " M_Passw = "1 " ***********XXXXXXXXXXXXXXX @0.0,0 DCGROUP oGroup1 CAPTION L('Задайте имя и пароль:' ) SIZE 76.0, 3.5 @4.0,0 DCGROUP oGroup2 CAPTION L('Особенности работы в системе:') SIZE 76.0, 5.0 @9.5,0 DCGROUP oGroup3 CAPTION L('Главное, что делает система:' ) SIZE 76.0, 19.0 @1,2 DCSAY L("Login :") PARENT oGroup1 @2,2 DCSAY L("Password:") PARENT oGroup1 @1,13 DCGET M_Login PASSWORD PARENT oGroup1 PICTURE "XXXXXXXXXXXXXXX" @2,13 DCGET M_Passw PASSWORD PARENT oGroup1 PICTURE "XXXXXXXXXXXXXXX" **** Если файл существует изображения и его контрольная сумма совпадает, то он отображается cFile = Disk_dir+"\_Aidos_gr55.jpg" IF FILE(cFile) IF FILECHECK(cFile) = 1847316 @8,320 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP CAPTION cFile SIZE 59,59 PIXEL PARENT oGroup1 ELSE Mess = L('Графический файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF ENDIF s = 1 d = 0.8 @s,2 DCSAY L("1.") PARENT oGroup2;@s, 4 DCSAY L("Если система в данной папке запускается впервые, то будет произведена ЛОКАЛИЗАЦИЯ" ) PARENT oGroup2;s=s+d @s, 4 DCSAY L("системы, т.е. будут удалены все приложения и пользователи и заново прописаны пути" ) PARENT oGroup2;s=s+d @s, 4 DCSAY L("на все базы данных по фактическому расположению системы. " ) PARENT oGroup2;s=s+d*1.5 @s,2 DCSAY L("2.") PARENT oGroup2;@s, 4 DCSAY L("Новое окно главного меню можно открывать только после закрытия всех предыдущих. " ) PARENT oGroup2;s=s+d*1.5 s = 1 d = 0.8 @s,2 DCSAY L("1.") PARENT oGroup3;@s, 4 DCSAY L('Альберт Эйнштейн писал, что научные законы это лишь высказывания о повторениях ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('в наблюдаемых явлениях. В системе "Эйдос" они называются событиями или фактами. ') PARENT oGroup3;s=s+d*1.5 @s,2 DCSAY L("2.") PARENT oGroup3;@s, 4 DCSAY L('Например, фактом является наблюдение определенного значения какого-либо свойства ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('у объектов некоторой обобщенной категории (класса), или наблюдение определенного ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('значения фактора при переходе объекта в состояние, соответствующее к классу. ') PARENT oGroup3;s=s+d*1.5 @s,2 DCSAY L("3.") PARENT oGroup3;@s, 4 DCSAY L('Система "Эйдос" выявляет эмпирические закономерности в фактах и решает на основе ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('знания этих закономерностей задачи идентификации-прогнозирования, принятия решений') PARENT oGroup3;s=s+d @s, 4 DCSAY L('и исследования моделируемой предметной области путем исследования ее модели. ') PARENT oGroup3;s=s+d*1.5 @s,2 DCSAY L("4.") PARENT oGroup3;@s, 4 DCSAY L('Кроме того система "Эйдос" выводит информацию об обнаруженных закономерностях ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('в большом количестве разнообразных текстовых, табличных и графических выходных форм.') PARENT oGroup3;s=s+d*1.5 @s, 4 DCSAY L('Работы автора системы "Эйдос" проф.Е.В.Луценко & C° по АСК-анализу и системе "Эйдос":') PARENT oGroup3;s=s+d*1.5 a = 41 b = 33 @s,2 DCPUSHBUTTON CAPTION L('Системное обобщение математики') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Work_on_emergence.htm' , .T., .T. )} PARENT oGroup3 @s,a DCPUSHBUTTON CAPTION L('АСК-анализ изображений ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_ASK-analysis_of_images.htm', .T., .T. )} PARENT oGroup3;s=s+d*2 @s,2 DCPUSHBUTTON CAPTION L('АСК-анализ текстов ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_ASK-analysis_of_texts.htm' , .T., .T. )} PARENT oGroup3 @s,a DCPUSHBUTTON CAPTION L('Когнитивные функции ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_cognitive_functions.htm' , .T., .T. )} PARENT oGroup3;s=s+d*2 @s,2 DCPUSHBUTTON CAPTION L('Выявление, представление и использование знаний, логика и методология научного познания') SIZE 72, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_identification_presentation_and_use_of_knowledge.htm', .T., .T. )} PARENT oGroup3;s=s+d*2 @s,2 DCPUSHBUTTON CAPTION L('АСК-анализ влияния космической среды на различные процессы на Земле') SIZE 72, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Work_on_the_study_of_the_influence_of_the_space_environment_on_various_processes_on_Earth.htm', .T., .T. )} PARENT oGroup3;s=s+d*2 DCREAD GUI; TO lExit ; FIT; ADDBUTTONS; MODAL; TITLE L('(c) Авторизация в системе ЭЙДОС-X++') ******************************************************************** IF lExit ** Button Ok ELSE QUIT ENDIF ******************************************************************** M_Login = SUBSTR(ALLTRIM(M_Login)+" ",1,10) M_Passw = SUBSTR(ALLTRIM(M_Passw)+" ",1,10) *Mess = M_Login+" "+M_Passw *LB_Warning(Mess, L("Login & Password" ) IF FILE("Users.dbf") // БД администраторов приложений и паролей доступа к ним: Users.dbf GenNtxUsers() ELSE GenDbfUsers() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_LPAA, Use_LPus EXCLUSIVE NEW PUBLIC Flag_SysAdmin := .F., M_KodSysAdmin := 0 PUBLIC Flag_AdmAppl := .F., M_KodAdmAppls := 0 PUBLIC Flag_User := .F., M_KodAdmAppls := 0 // Для авторизации сисадмина надо ввести login=1, password=1 IF M_Login = "1" .AND. M_Passw = "1" // Сисадмин, все права. Flag_SysAdmin = .T. M_KodAdmAppls = Kod_AdmApp LB_Warning(L("Приветствую тебя, о СИСАДМИН! Слушаюсь и повинуюсь!!!"), L("Авторизация сисадмина в системе ЭЙДОС-X++" )) Running(.F.) RETURN(M_KodAdmAppls) ENDIF // Для авторизации администратора приложения надо ввести login и password, заданные при его регистрации SET ORDER TO 1;T=DBSEEK(M_Login+M_Passw) IF T Flag_AdmAppl = .T. M_KodAdmAppls = Kod_AdmApp Mess = L("Авторизация администратора приложения: [#] прошла успешно!!!") Mess = STRTRAN(Mess, "#",UPPER(ALLTRIM(Name_AdmAp))) LB_Warning(Mess, L("Авторизация администратора приложения в системе ЭЙДОС-X++" )) Running(.F.) RETURN(M_KodAdmAppls) ENDIF // Для авторизации пользователя надо ввести password, заданный администратором приложения для пользователей SET ORDER TO 2;T=DBSEEK(UPPER(ALLTRIM(M_Login))+M_Passw) // login="USER" +Password пользователей приложения IF T Flag_User = .T. M_KodAdmAppls = Kod_AdmApp Mess = L("Авторизация пользователя приложения: [#] прошла успешно!!!") Mess = STRTRAN(Mess, "#",UPPER(ALLTRIM(Name_AdmAp))) LB_Warning(Mess, L("Авторизация пользователя в системе ЭЙДОС-X++" )) Running(.F.) RETURN(M_KodAdmAppls) ENDIF Mess = L('Неверное сочетание: Login - Password !!!') LB_Warning( L(Mess), L('1.1. Авторизация в системе ЭЙДОС-X++' )) ***** Проверка контрольной суммы exe-модуля системы Эйдос, и, если она не совпадает, то выдача сообщения ***** Это вставить в _START_AIDOS.exe, т.к. проверка контрольной суммы может быть только у закрытого файла cFile = "_aidos-x.exe" IF FILE(cFile) IF .NOT. FILE('_CheckSum.txt') // Если файла с контрольной суммой нет, то создать его StrFile(ALLTRIM(STR(FILECHECK(cFile))), '_CheckSum.txt') ELSE // Если файл с контрольной суммой есть, то проверить его совпадение и выдать сообщение, если он отличается mCheckSum = VAL(FileStr('_CheckSum.txt')) IF FILECHECK(cFile) <> mCheckSum aMess := {} AADD(aMess, L('EXE-модуль системы "Эйдос" был несанкционированно изменен,' )) AADD(aMess, L('Поэтому работоспособность системы "Эйдос" не гарантируется!')) LB_Warning(aMess,L('(С) "Эйдос-Х++"')) ENDIF ENDIF ENDIF * ***** Перенести в _START_AIDOS.exe, т.к. контрольная сумма правильно считается только для закрытого файла ******** * cFile = "_aidos-x.exe" * IF FILE(cFile) * IF .NOT. FILE('_CheckSum.txt') // Если файла с контрольной суммой нет, то создать его * StrFile(ALLTRIM(STR(FILECHECK(cFile))), '_CheckSum.txt') * ELSE // Если файл с контрольной суммой есть, то проверить его совпадение и выдать сообщение, если он отличается * mCheckSum = VAL(FileStr('_CheckSum.txt')) * IF FILECHECK(cFile) <> mCheckSum * Mess = L('EXE-модуль системы "Эйдос" поврежден и его работоспособность не гарантируется!' * LB_Warning(Mess) * ENDIF * ENDIF * ENDIF * ******************************************************************************************************** Running(.F.) RETURN(M_KodAdmAppls) **************************************************************************************** ******** 1.4. Выбор режима использования системы: монопольный или многопользовательский **************************************************************************************** *FUNCTION F1_4old() *Running(.T.) *IF .NOT. Flag_SysAdmin * LB_Warning(L("Эта функция доступна только сисадмину")) *ELSE * RegimSys := 1 // EXCLUSIVE-1, EXCLUSIVE-2 * @0,0 DCSAY L("Задайте режим ипользования системы: EXCLUSIVE-1, EXCLUSIVE-2") GET RegimSys PICTURE "#" COLOR "n/gb+" * DCREAD GUI FIT ADDBUTTONS TITLE L("1.4. Выбор режима: монопольный или сетевой") * DO CASE * CASE RegimSys = 1 * LB_Warning(L("Система будет работать в монопольном режиме")) * CASE RegimSys = 2 * LB_Warning(L("Система будет работать в сетевом режиме")) * OTHERWISE * RegimSys := 1 // EXCLUSIVE-1, EXCLUSIVE-2 * LB_Warning(L("Система будет работать в монопольном режиме")) * ENDCASE *ENDIF *Running(.F.) *RETURN NIL **************************************************************************************** ******** 1.5. Задание путей на папки с БД групп приложений (в БД Appls.dbf) **************************************************************************************** FUNCTION F1_5() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions Running(.T.) IF .NOT. Flag_SysAdmin LB_Warning(L("Эта функция доступна только сисадмину!")) Running(.F.) RETURN NIL ENDIF // На конкретный заспук системы активной является одна текущая группа, заданная "по умолчанию" // Разные группы могут быть на различных носителях, локальных, сетвеых и даже в Internet IF FILE("PathGrAp.dbf") // БД путей на группы приложений. ** Переиндексировать БД PathGrAp.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF FILE("Path_kod.ntx").AND.; FILE("PathDefa.ntx").AND.; FILE("PathName.ntx").AND.; FILE("PathCrea.ntx") ELSE GenNtxPaths() ENDIF ELSE GenDbfPaths() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *USE PathGrAp INDEX Path_kod, PathDefa, PathName, PathCrea EXCLUSIVE NEW * 1 2 3 4 USE PathGrAp EXCLUSIVE NEW aColors := { {GRA_CLR_WHITE,GRA_CLR_DARKRED },; {GRA_CLR_WHITE,GRA_CLR_DARKBLUE },; {GRA_CLR_BLACK,GRA_CLR_DARKGREEN} } aPres := ; { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },; // Header FG Color { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY },; // Header BG Color { XBP_PP_COL_FA_FGCLR, GRA_CLR_YELLOW },; // Footer FG Color { XBP_PP_COL_FA_BGCLR, GRA_CLR_DARKGRAY },; // Footer BG Color { XBP_PP_COL_DA_ROWSEPARATOR, XBPCOL_SEP_DOTTED },; // Row Sep { XBP_PP_COL_DA_COLSEPARATOR, XBPCOL_SEP_DOTTED },; // Col Sep { XBP_PP_COL_HA_ALIGNMENT, XBPALIGN_LEFT },; // Header alignment { XBP_PP_COL_DA_ROWHEIGHT, 20 },; // Row Height { XBP_PP_COL_DA_CELLHEIGHT, 20 } } // Cell Height /* ----- Create ToolBar ----- */ @ 27.5, 1 DCTOOLBAR oToolBar SIZE 130, 1.5 K=1.15 DCADDBUTTON CAPTION L('Помощь') ; SIZE K+LEN(L("Помощь")) ; ACTION {||Help15(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 1.2') DCADDBUTTON CAPTION L('Поиск') ; SIZE K+LEN(L("Поиск")) ; ACTION {||Search1_5(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Поиск по режиму 1.2') DCADDBUTTON CAPTION L('Сортировка') ; SIZE K+LEN(L("Сортировка")) ; ACTION {||Sort1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Сортировка по режиму 1.2') DCADDBUTTON CAPTION L('В начало БД') ; SIZE K+LEN(L("В начало БД")) ; ACTION {||dbGoTop(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на 1-ю запись') DCADDBUTTON CAPTION L('В конец БД') ; SIZE K+LEN(L("В конец БД")) ; ACTION {||dbGoBottom(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на последнюю запись') DCADDBUTTON CAPTION L('Предыдущая') ; SIZE K+LEN(L("Предыдущая")) ; ACTION {||dbSkip(-1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на предыдущую запись') DCADDBUTTON CAPTION L('Следующая') ; SIZE K+LEN(L("Следующая")) ; ACTION {||dbSkip(1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на следующую запись') DCADDBUTTON CAPTION L('Добавить') ; SIZE K+LEN(L("Добавить")) ; ACTION {||Add_rec1_5(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; FONT '9.Arial Bold' ; TOOLTIP L('Добавить запись') DCADDBUTTON CAPTION L('Вставить') ; SIZE K+LEN(L("Вставить")) ; ACTION {||Ins_rec1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Вставить пустую запись') DCADDBUTTON CAPTION L('Скопировать') ; SIZE K+LEN(L("Скопировать")) ; ACTION {||Copy_rec1_5(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Скопировать текущую запись') DCADDBUTTON CAPTION L('Удалить') ; SIZE K+LEN(L("Удалить")) ; ACTION {||Del_rec1_5(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить запись') DCADDBUTTON CAPTION L('Очистить БД') ; SIZE K+LEN(L("Очистить БД")) ; ACTION {||Zap_db1_5(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Очистить БД') /* ----- Create browse ----- */ @ 1, 0 DCBROWSE oBrowse ALIAS 'PathGrAp' SIZE 131,26 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; PRESENTATION aPres ; IF Flag_SysAdmin DCBROWSECOL FIELD PathGrAp->Kod_GrApps HEADER L("Код" ) PARENT oBrowse WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD PathGrAp->By_default HEADER L("По умолчанию" ) PARENT oBrowse WIDTH 1 DCBROWSECOL FIELD PathGrAp->NameGrApps HEADER L("Название группы приложений" ) PARENT oBrowse WIDTH 25 DCBROWSECOL FIELD PathGrAp->PathGrApps HEADER L("Путь на БД группы приложений") PARENT oBrowse WIDTH 30 DCBROWSECOL FIELD PathGrAp->Date HEADER L("Дата" ) PARENT oBrowse WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD PathGrAp->Time HEADER L("Время" ) PARENT oBrowse WIDTH 5 PROTECT {|| .T. } ENDIF DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; OPTIONS GetOptions ; MODAL ; TITLE L('1.5. Задание путей на папки с БД групп приложений') ; FIT ; CLEAREVENTS DBGOTOP() DO WHILE .NOT. EOF() IF LEN(ALLTRIM(By_default)) > 0 REPLACE By_default WITH "W" M_ApplsPath = UPPER(ALLTRIM(PathGrApps)) * MsgBox(M_ApplsPath) EXIT ENDIF DBSKIP(1) ENDDO ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN(M_ApplsPath) **************************************************************************************** ****** Функции обработки кнопок 1.5 **************************************************************************************** ************************************************************************************************** FUNCTION Help15() aHelp := {} AADD(aHelp, L('Помощь по режиму: "1.5. ЗАДАНИЕ ПУТЕЙ НА ПАПКИ С БД ГРУПП ПРИЛОЖЕНИЙ". ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Папки с различными группами приложений могут быть на локальном компьютере, в локальной сети ')) AADD(aHelp, L('или в Internet. Пути на них задаются сисадмином при инсталляции системы и могут быть изменены ')) AADD(aHelp, L('им когда угодно. Все ранее созданные пути сохраняются в базе данных: PathGrAp.dbf. Один из этих путей,')) AADD(aHelp, L('а именно первый из отмеченный специальных символов, считается текущим и используется при СОЗДАНИИ ')) AADD(aHelp, L('приложений в диспетчере приложений 1.3, а в последующем при запуске приложений на исполнение пути ')) AADD(aHelp, L('берутся уже из БД диспетчера приложений ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-18, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 1.5. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Поиск по столбцу в"Наименование" режиме 2.1 FUNCTION Search1_5() * xdemo.exe ReTURN nil ******** Сортировка по заданному столбцу в режиме 1.2. (xdemo.exe FUNCTION XDemo_4 ( oDialog, lMDI, lGui )) FUNCTION Sort1_5() LOCAL nChoice := 1, oAppWindow, oCrt, oParent DC_Gui(.t.) SetColor('W+/N') CLS SetColor('N/W,W+/B') @ 5,20 CLEAR TO 19,60 @ 5,20 TO 19,60 *USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 @ 7,25 PROMPT L('Код администратора приложения') @ 9,25 PROMPT L('Имя администратора приложения') @11,25 PROMPT L('Дата регистрации ') @13,25 PROMPT L('Exit ') MENU TO nChoice DO CASE CASE nChoice = 1 SET ORDER TO 1 CASE nChoice = 2 SET ORDER TO 2 CASE nChoice = 3 SET ORDER TO 5 CASE nChoice = 6 .OR. nChoice = 0 ENDCASE IF Valtype(oCrt) = 'O' .AND. oCrt:status()>0 oCrt:Destroy() SetAppWindow( oAppWindow ) ENDIF RETURN nil ******** Удалить текущую запись в БД, ******** а остальные сдвинуть вверх и перенумеровать FUNCTION Del_rec1_5() SET ORDER TO M_Recno = RECNO() DELETE;PACK *** Перенумеровать записи, начиная с удаленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Вставить пустую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Ins_rec1_5() SET ORDER TO M_Recno = RECNO() APPEND BLANK A_RecNew := {} // Пустая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Стереть текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Скопировать (сдублировать) текущую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Copy_rec1_5() SET ORDER TO M_Recno = RECNO() A_RecNew := {} // Текущая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT APPEND BLANK *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Скопировать текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Добавить пустую запись в конец БД FUNCTION Add_rec1_5() SET ORDER TO APPEND BLANK REPLACE Kod_GrApps WITH RECNO() REPLACE By_default WITH "W" REPLACE NameGrApps WITH "Новая группа приложений" REPLACE PathGrApps WITH UPPER(ALLTRIM(M_ApplsPath)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() RETURN NIL ******** Очистить БД FUNCTION Zap_db1_5() SET ORDER TO ZAP APPEND BLANK REPLACE Kod_GrApps WITH 1 REPLACE By_default WITH "W" REPLACE NameGrApps WITH "Базовая группа приложений (по умолчанию)" REPLACE PathGrApps WITH UPPER(ALLTRIM(M_ApplsPath)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() RETURN NIL **************************************************************************************** ******** 1.2. Регистрация и удаление регистрации ******** администратора приложения и его пользователей **************************************************************************************** FUNCTION F1_2() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions Running(.T.) IF Flag_SysAdmin .OR. Flag_AdmAppl ELSE LB_Warning(L("Эта функция доступна только Сисадмину и Администраторам приложений")) Running(.F.) RETURN NIL ENDIF IF ApplChange("1.2()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF IF FILE("Users.dbf") // БД администраторов приложений и паролей доступа к ним: Users.dbf ** Переиндексировать БД Users.dbf, GenNtxUsers() ELSE GenDbfUsers() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 aColors := { {GRA_CLR_WHITE,GRA_CLR_DARKRED },; {GRA_CLR_WHITE,GRA_CLR_DARKBLUE },; {GRA_CLR_BLACK,GRA_CLR_DARKGREEN} } aPres := ; { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },; // Header FG Color { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY },; // Header BG Color { XBP_PP_COL_FA_FGCLR, GRA_CLR_YELLOW },; // Footer FG Color { XBP_PP_COL_FA_BGCLR, GRA_CLR_DARKGRAY },; // Footer BG Color { XBP_PP_COL_DA_ROWSEPARATOR, XBPCOL_SEP_DOTTED },; // Row Sep { XBP_PP_COL_DA_COLSEPARATOR, XBPCOL_SEP_DOTTED },; // Col Sep { XBP_PP_COL_HA_ALIGNMENT, XBPALIGN_LEFT },; // Header alignment { XBP_PP_COL_DA_ROWHEIGHT, 20 },; // Row Height { XBP_PP_COL_DA_CELLHEIGHT, 20 } } // Cell Height /* ----- Create ToolBar ----- */ @ 27.5, 1 DCTOOLBAR oToolBar SIZE 130, 1.5 K=1.15 DCADDBUTTON CAPTION L('Помощь') ; SIZE K+LEN(L("Помощь")) ; ACTION {||Help12(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 1.2') DCADDBUTTON CAPTION L('Поиск') ; SIZE K+LEN(L("Поиск")) ; ACTION {||Search1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Поиск по режиму 1.2') DCADDBUTTON CAPTION L('Сортировка') ; SIZE K+LEN(L("Сортировка")) ; ACTION {||Sort1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Сортировка по режиму 1.2') DCADDBUTTON CAPTION L('В начало БД') ; SIZE K+LEN(L("В начало БД")) ; ACTION {||dbGoTop(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на 1-ю запись') DCADDBUTTON CAPTION L('В конец БД') ; SIZE K+LEN(L("В конец БД")) ; ACTION {||dbGoBottom(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на последнюю запись') DCADDBUTTON CAPTION L('Предыдущая') ; SIZE K+LEN(L("Предыдущая")) ; ACTION {||dbSkip(-1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на предыдущую запись') DCADDBUTTON CAPTION L('Следующая') ; SIZE K+LEN(L("Следующая")) ; ACTION {||dbSkip(1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar ; TOOLTIP L('Перейти на следующую запись') DCADDBUTTON CAPTION L('Добавить') ; SIZE K+LEN(L("Добавить")) ; ACTION {||Add_rec1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить запись') DCADDBUTTON CAPTION L('Вставить') ; SIZE K+LEN(L("Вставить")) ; ACTION {||Ins_rec1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Вставить пустую запись') DCADDBUTTON CAPTION L('Скопировать') ; SIZE K+LEN(L("Скопировать")) ; ACTION {||Copy_rec1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Скопировать текущую запись') IF Flag_SysAdmin DCADDBUTTON CAPTION L('Удалить') ; SIZE K+LEN(L("Удалить")) ; ACTION {||Del_rec1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить запись') DCADDBUTTON CAPTION L('Очистить БД') ; SIZE K+LEN(L("Очистить БД")) ; ACTION {||Zap_db1_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Очистить базу данных') ENDIF /* ----- Create browse ----- */ @ 1, 0 DCBROWSE oBrowse ALIAS 'Users' SIZE 131,26 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; PRESENTATION aPres ; * DCBROWSECOL DATA {||Decrypt(USERS->Passw_AdmA)} HEADER L('Password') WIDTH 10 // Шифрованный пароль (Роджер) DCBROWSECOL FIELD Users->KOD_AdmApp HEADER L("Код адм.приложения" ) PARENT oBrowse PROTECT {|| .T. } // Отображаемое некорректируемое поле DCBROWSECOL FIELD Users->NAME_AdmAp HEADER L("Ф.И.О.адм.приложения" ) PARENT oBrowse // Отображаемое корректируемое поле * DCBROWSECOL DATA {||REPL('*',LEN(ALLTRIM(Users->Login_AdmA)))} HEADER L("Login адм.приложения" ) PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) * DCBROWSECOL DATA {||REPL('*',LEN(ALLTRIM(Users->Passw_AdmA)))} HEADER L("Пароль адм.приложения") PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) *DCBROWSECOL DATA {||REPL('*',LEN(ALLTRIM(Users->Passw_User)))} HEADER L("Пароль пользователя" ) PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) DCBROWSECOL FIELD Users->Login_AdmA HEADER L("Login адм.приложения" ) PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) DCBROWSECOL FIELD Users->Passw_AdmA HEADER L("Пароль адм.приложения") PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) DCBROWSECOL FIELD Users->Passw_User HEADER L("Пароль пользователя" ) PARENT oBrowse // Неотображаемое корректируемое поле (Роджер) DCBROWSECOL FIELD Users->ColorSchem HEADER L("Цветовая схема меню" ) PARENT oBrowse // Отображаемое корректируемое поле DCBROWSECOL FIELD Users->Date HEADER L("Дата регистрации" ) PARENT oBrowse PROTECT {|| .T. } // Отображаемое некорректируемое поле DCBROWSECOL FIELD Users->Time HEADER L("Время регистрации" ) PARENT oBrowse PROTECT {|| .T. } // Отображаемое некорректируемое поле DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; OPTIONS GetOptions ; MODAL ; TITLE L('1.2. Регистрация и удаление регистрации администраторов приложений') ; FIT ; CLEAREVENTS ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ************************************************************************************************** FUNCTION Help12() aHelp := {} AADD(aHelp, L('Помощь по режиму: "1.2. РЕГИСТРАЦИЯ И УДАЛЕНИЕ РЕГИСТРАЦИИ АДМИНИСТРАТОРОВ ПРИЛОЖЕНИЙ". ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Администратор приложения имеет все права на создание и удаление приложения и на реализацию в ')) AADD(aHelp, L('созданном им приложении всех возможностей системы: ')) AADD(aHelp, L('- формализация предметной области; ')) AADD(aHelp, L('- синтез (многопараметрическая типизация) и верификация модели; ')) AADD(aHelp, L('- решение задач системной идентификации, прогнозирования и поддержки принятия решений; ')) AADD(aHelp, L('- исследование предметной области путем исследования ее модели. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Администратор приложений в данном режиме может: ')) AADD(aHelp, L('- задать и скорректировать данные СВОЕЙ учетной записи; ')) AADD(aHelp, L('- удалить свою учетную запись; ')) AADD(aHelp, L('- задать пароль пользователей СВОИХ приложений. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('После регистрации в данном режиме для реализации полномочий администратора приложения ему ')) AADD(aHelp, L('необходимо авторизоваться в режиме 1.1 и выбрать приложение для работы в диспетчере приложений')) AADD(aHelp, L('(режим 1.3.). ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Пользователь имеет все права администратора приложения, кроме создания и удаления приложения, ')) AADD(aHelp, L('а также корректировки любой информации в режиме 1.2, в частности создания и удаления записей ')) AADD(aHelp, L('регистрации администраторов приложений, задания и изменения паролей доступа для пользователей.')) AADD(aHelp, L(' ')) AADD(aHelp, L('Пользователи для получения доступа к приложению должны авторизоваться в режиме 1.1, задав ')) AADD(aHelp, L('Login: "User" и пароль, предоставленный администратором приложения, а затем выбрать приложение')) AADD(aHelp, L('для работы в диспетчере приложений (режим 1.3.) ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-7, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 1.2. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Поиск по столбцу в"Наименование" режиме 2.1 FUNCTION Search1_2() * xdemo.exe ReTURN nil ******** Сортировка по заданному столбцу в режиме 1.2. (xdemo.exe FUNCTION XDemo_4 ( oDialog, lMDI, lGui )) FUNCTION Sort1_2() LOCAL nChoice := 1, oAppWindow, oCrt, oParent DC_Gui(.t.) SetColor('W+/N') CLS SetColor('N/W,W+/B') @ 5,20 CLEAR TO 19,60 @ 5,20 TO 19,60 *USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 @ 7,25 PROMPT L('Код администратора приложения') @ 9,25 PROMPT L('Имя администратора приложения') @11,25 PROMPT L('Дата регистрации ') @13,25 PROMPT L('Exit ') MENU TO nChoice DO CASE CASE nChoice = 1 SET ORDER TO 1 CASE nChoice = 2 SET ORDER TO 2 CASE nChoice = 3 SET ORDER TO 5 CASE nChoice = 6 .OR. nChoice = 0 ENDCASE IF Valtype(oCrt) = 'O' .AND. oCrt:status()>0 oCrt:Destroy() SetAppWindow( oAppWindow ) ENDIF RETURN nil ******** Удалить текущую запись в БД, ******** а остальные сдвинуть вверх и перенумеровать FUNCTION Del_rec1_2() SET ORDER TO M_Recno = RECNO() DELETE;PACK *** Перенумеровать записи, начиная с удаленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Вставить пустую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Ins_rec1_2() SET ORDER TO M_Recno = RECNO() APPEND BLANK A_RecNew := {} // Пустая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Стереть текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Скопировать (сдублировать) текущую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Copy_rec1_2() SET ORDER TO M_Recno = RECNO() A_RecNew := {} // Текущая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT APPEND BLANK *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Скопировать текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) RETURN NIL ******** Добавить пустую запись в конец БД FUNCTION Add_rec1_2() SET ORDER TO APPEND BLANK REPLACE Kod_AdmApp WITH RECNO() REPLACE Login_AdmA WITH "" REPLACE Passw_AdmA WITH "" REPLACE Passw_User WITH "" REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE ColorSchem WITH "000 000 000 255 255 204" * 12345678901234567890123 * 1 5 9 12 17 21 RETURN NIL ******** Очистить БД Users.dbf и сформировать начальные записи FUNCTION Zap_db1_2() SET ORDER TO ZAP APPEND BLANK REPLACE Kod_AdmApp WITH 1 REPLACE Name_AdmAp WITH "Системый администратор" REPLACE Login_AdmA WITH "1" REPLACE Passw_AdmA WITH "1" REPLACE Passw_User WITH "1" REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE ColorSchem WITH "000 000 000 025 255 204" * 12345678901234567890123 * 1 5 9 13 17 21 APPEND BLANK REPLACE Kod_AdmApp WITH 2 REPLACE Name_AdmAp WITH "Администратор учебных приложений" REPLACE Login_AdmA WITH "2" REPLACE Passw_AdmA WITH "2" REPLACE Passw_User WITH "2" REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE ColorSchem WITH "000 000 000 255 255 204" * 12345678901234567890123 * 1 5 9 13 17 21 APPEND BLANK REPLACE Kod_AdmApp WITH 3 REPLACE Name_AdmAp WITH "Администратор научных приложений" REPLACE Login_AdmA WITH "3" REPLACE Passw_AdmA WITH "3" REPLACE Passw_User WITH "3" REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE ColorSchem WITH "000 000 000 155 255 204" * 12345678901234567890123 * 1 5 9 13 17 21 RETURN NIL ******** Display a warning message ******** Может выдавать сообщения элементами массива и без ctitle: *message := {} *AADD(message,'1-е сообщение') *AADD(message,'2-е сообщение') *AADD(message,'3-е сообщение') *LB_Warning( message ) FUNCTION LB_Warning( message, ctitle ) LOCAL aMsg := {} DEFAULT cTitle TO '' IF valtype(message) # 'A' aadd(aMsg,message) ELSE aMsg := message ENDIF IF LEN(ALLTRIM(cTitle)) > 0 DC_MsgBox( ,,aMsg,cTitle) ELSE DC_MsgBox( ,,aMsg,'(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"') ENDIF RETURN NIL *------------------------------------------------------------------------------ ******** Display a message of up to 60 characters in a window (usually ******** at the beginning of some lengthy, time-consuming process) FUNCTION LB_Inform(message) STATIC cDialog IF message == NIL DC_Impl(cDialog) cDialog := NIL ELSE cDialog := DC_WaitOn(message,,,,,,,,,,,.F.) ENDIF RETURN NIL * --------------- STATIC FUNCTION LogHandler( nEvent, mp1, mp2, oXbp, oDlg, GetList ) LOCAL oMenu, cMessage, cCaption, nPointer, cType := '', ; cProcName, cProcLine IF oXbp == nil RETURN DCGUI_NONE ENDIF IF oXbp:isDerivedFrom('XbpMenuBar') IF nEvent == xbeP_ItemSelected oMenu := oXbp:getItem(mp1)[1] IF Valtype(oMenu) == 'O' nPointer := oMenu:getListPointer cCaption := GetList[nPointer,cGETLIST_CAPTION] cMessage := GetList[nPointer,cGETLIST_MESSAGE] IF Valtype(cMessage) = 'A' cMessage := cMessage[1] ENDIF ELSE IF mp1 > 0 .AND. mp1 <= Len(oXbp:cargo[6]) cMessage := oXbp:cargo[5,mp1] cCaption := oXbp:cargo[8,mp1] ENDIF ENDIF cType := 'Menu Item' ENDIF ELSEIF oXbp:isDerivedFrom('DC_XbaseParts') IF nEvent == xbeP_Activate nPointer := oXbp:getListPointer cCaption := GetList[nPointer,cGETLIST_CAPTION] cMessage := GetList[nPointer,cGETLIST_MESSAGE] cType := 'Button' IF Valtype(cCaption) == 'B' cCaption := Eval(cCaption) ENDIF IF Empty(cCaption) cCaption := oXbp:caption ENDIF ENDIF ENDIF IF !Empty(cType) IF Valtype(cMessage) == 'A' cMessage := cMessage[1] ENDIF LogEvent( cType, cCaption, cMessage ) ENDIF RETURN DCGUI_NONE * --------------- STATIC FUNCTION LogEvent( cType, cCaption, cMessage ) LOCAL nHandle DEFAULT cCaption := '', ; cMessage := '' nHandle := FOpen( 'EVENTS.LOG', FO_WRITE ) IF nHandle <= 0 nHandle := FCreate( 'EVENTS.LOG' ) ENDIF FSeek( nHandle, 0, FS_END ) FWrite( nHandle, Dtos(Date()) + ' ' + Time() + ' : ' + ; cType + ' : ' + cCaption + ' : ' + cMessage + Chr(13) + Chr(10) ) FClose(nHandle) RETURN nil * --------------- STATIC FUNCTION MenuHandler( nEvent, mp1, mp2, oXbp, oDlg, GetList, oMessageBox ) LOCAL oMenu, aPos, cMessage, nPointer STATIC cMenuMessage := '' IF oXbp#nil .AND. oXbp:isDerivedFrom('XbpMenuBar') IF nEvent == xbeP_ItemMarked oMenu := oXbp:getItem(mp1)[1] IF Valtype(oMenu) == 'O' IF !oMessageBox:isVisible() oMessageBox:show() ENDIF nPointer := oMenu:getListPointer cMessage := GetList[nPointer,cGETLIST_MESSAGE] ELSE IF mp1 > 0 .AND. mp1 <= Len(oXbp:cargo[6]) cMessage := oXbp:cargo[5,mp1] ENDIF ENDIF IF Empty(cMessage) cMessage := Chr(255) ELSE cMessage := cMessage[1] ENDIF IF cMenuMessage # cMessage cMessage := Strtran(cMessage,';',Chr(13)) oMessageBox:ChildList()[1]:setCaption(cMessage) cMenuMessage := cMessage ENDIF IF Valtype(oMenu) == 'O' .AND. !Empty(cMessage) oMessageBox:setSize({oMenu:currentSize()[1],130}) oMessageBox:childList()[1]:setPos({4,4}) oMessageBox:childList()[1]:setSize({oMessageBox:currentSize()[1]-8,oMessageBox:currentSize()[2]-20}) aPos := oMenu:currentPos() oMessageBox:setPos({aPos[1],aPos[2]-130}) oMessageBox:toFront() ENDIF ELSEIF nEvent == xbeMENB_EndMenu .OR. nEvent == xbeP_ActivateItem oMessageBox:hide() ENDIF ENDIF RETURN DCGUI_NONE ******** Расчет координат главного окна *FUNCTION CenterPos( aSize, aRefSize ) *RETURN { Int( (aRefSize[1] - aSize[1]) / 2 ) ; * , Int( (aRefSize[2] - aSize[2]) / 2 ) + 14 } // Информационное сообщение *LB_Warning(Mess) *LB_Inform("Ура! Получилось!") // Сообщение об ошибке *LB_Warning(L("Нет папки! Создайте!", "Сообщение об ошибке" ) ******** Заглушка FUNCTION Razrab() LB_Warning(L("Данная функция в процессе разработки"), L("Информационное сообщение" )) RETURN NIL ******************************************************************************* ******** Выбор цветовой схемы главного меню (использован пример из demo3) ******************************************************************************* FUNCTION F1_6() LOCAL i, aCoords, aLocals[76], GetOptions, GetList Running(.T.) IF Flag_SysAdmin .OR. Flag_AdmAppl ELSE LB_Warning(L("Эта функция доступна только Сисадмину и Администраторам приложений")) Running(.F.) RETURN NIL ENDIF PUBLIC Cf1:=000,Cf2:=000,Cf3:=000, Cb1:=025,Cb2:=255,Cb3:=255 // Загрузить цветовую схему меню, заданную авторизованным пользователем CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_kod EXCLUSIVE NEW SET ORDER TO 1;T=DBSEEK(STR(M_KodAdmAppls,8)) IF T * 000 000 000 025 255 204 * 12345678901234567890123 * 1 5 9 13 17 21 Cf1 = VAL(SUBSTR(ColorSchem, 1,3)) Cf2 = VAL(SUBSTR(ColorSchem, 5,3)) Cf3 = VAL(SUBSTR(ColorSchem, 9,3)) Cb1 = VAL(SUBSTR(ColorSchem,13,3)) Cb2 = VAL(SUBSTR(ColorSchem,17,3)) Cb3 = VAL(SUBSTR(ColorSchem,21,3)) ENDIF GetList := {} nRed = Cb1 nGreen = Cb2 nBlue = Cb3 @ 2.5, 20 DCSPINBUTTON nRed PARENT oTabPage1 SIZE 7 LIMITS 0,255 ; OBJECT oRedSpin ; CALLBACK {|a,b,o|o:GetData(),oRedBar:SetData(),RGB(aLocals)} @ 0, -10 DCSAY L('Red') SAYSIZE 5 PARENT oTabPage1 RELATIVE oRedSpin @ 0, 10 DCSCROLLBAR DATA nRed SIZE 40,1 PARENT oTabPage1 ; RELATIVE oRedSpin ; TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oRedBar ; SCROLL { |a,x,o| nRed := a[1], ; oRedSpin:SetData(), ; o:SetData(), RGB(aLocals) } @ 2, 0 DCSPINBUTTON nGreen PARENT oTabPage1 SIZE 7 LIMITS 0,255 ; OBJECT oGreenSpin RELATIVE oRedSpin ; CALLBACK {|a,b,o|o:GetData(),oGreenBar:SetData(),RGB(aLocals)} @ 0, -10 DCSAY L('Green') SAYSIZE 5 PARENT oTabPage1 RELATIVE oGreenSpin @ 0, 10 DCSCROLLBAR DATA nGreen SIZE 40,1 PARENT oTabPage1 ; TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oGreenBar ; RELATIVE oGreenSpin ; SCROLL { |a,x,o| nGreen := a[1], ; oGreenSpin:SetData(), ; o:SetData(), RGB(aLocals) } @ 2, 0 DCSPINBUTTON nBlue PARENT oTabPage1 SIZE 7 LIMITS 0,255 ; OBJECT oBlueSpin RELATIVE oGreenSpin ; CALLBACK {|a,b,o|o:GetData(),oBlueBar:SetData(),RGB(aLocals)} @ 0, -10 DCSAY L('Blue') SAYSIZE 5 PARENT oTabPage1 RELATIVE oBlueSpin @ 0, 10 DCSCROLLBAR DATA nBlue SIZE 40,1 PARENT oTabPage1 ; RELATIVE oBlueSpin ; TYPE XBPSCROLL_HORIZONTAL RANGE 0,255 OBJECT oBlueBar ; SCROLL { |a,x,o| nBlue := a[1], ; oBlueSpin:SetData(), ; o:SetData(), RGB(aLocals) } @ 5, 0 DCSTATIC TYPE XBPSTATIC_TYPE_RAISEDBOX SIZE 45,4 ; OBJECT oColorBox PARENT oTabPage1 RELATIVE oBlueSpin ; EVAL { |o| o:paint := {||RGB(aLocals)} } /* ---- Tool Bar ---- */ @ .1,.2 DCTOOLBAR oToolBar SIZE 9,1 BUTTONSIZE 9,1 DCADDBUTTON CAPTION L('Exit') PARENT oToolBar ; ACTION {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)} DCREAD GUI ; TITLE L('1.6. Выбор цветовой схемы главного меню') ; OPTIONS GetOptions ; FIT ** Присвоить фону цвет, заданный в диалоге ******* ** MsgBox(STR(nRed)+STR(nGreen)+STR(nBlue)) Cb1 = nRed Cb2 = nGreen Cb3 = nBlue fColor := GraMakeRGBColor({ Cf1, Cf2, Cf3 }) // Цветовые параметры текста меню bColor := GraMakeRGBColor({ Cb1, Cb2, Cb3 }) // Цветовые параметры фона меню ApplColSch() ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ******** Принять цветовую схему главного меню FUNCTION ApplColSch() * 000 000 000 025 255 204 * 12345678901234567890123 * 1 5 9 13 17 21 Mess = STRTRAN(STR(Cf1,3)," ","0")+" "+; STRTRAN(STR(Cf2,3)," ","0")+" "+; STRTRAN(STR(Cf3,3)," ","0")+" "+; STRTRAN(STR(Cb1,3)," ","0")+" "+; STRTRAN(STR(Cb2,3)," ","0")+" "+; STRTRAN(STR(Cb3,3)," ","0") CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_kod EXCLUSIVE NEW SET ORDER TO 1;T=DBSEEK(STR(M_KodAdmAppls,8)) IF T REPLACE ColorSchem WITH Mess ENDIF *Mess = "Fr_Red=" +STRTRAN(STR(Cf1,3)," ","0")+" "+; * "Fr_Green="+STRTRAN(STR(Cf2,3)," ","0")+" "+; * "Fr_Blue=" +STRTRAN(STR(Cf3,3)," ","0")+" "+; * "Bg_Red=" +STRTRAN(STR(Cb1,3)," ","0")+" "+; * "Bg_Green="+STRTRAN(STR(Cb2,3)," ","0")+" "+; * "Bg_Blue=" +STRTRAN(STR(Cb3,3)," ","0") aMess := {} AADD(aMess, L("Выбрана следующая цветовая схема главного меню:")) AADD(aMess, " Red=" +STRTRAN(STR(Cb1,3)," ","0")+"; "+; " Green="+STRTRAN(STR(Cb2,3)," ","0")+"; "+; " Blue=" +STRTRAN(STR(Cb3,3)," ","0")) AADD(aMess, L(" Данная цветовая схема вступит в силу")) AADD(aMess, L(" после перезагрузки системы Эйдос-Х++")) LB_Warning(aMess, L("Цветовая схема фона главного меню") ) Flad_ExitColSch = .F. RETURN NIL ******** Выйти на просмотр следующей цветовой схемы главного меню FUNCTION NextColSch() Mess = "Cf1="+STRTRAN(STR(Cf1,3)," ","0")+" "+; "Cf2="+STRTRAN(STR(Cf2,3)," ","0")+" "+; "Cf3="+STRTRAN(STR(Cf3,3)," ","0")+" "+; "Cb1="+STRTRAN(STR(Cb1,3)," ","0")+" "+; "Cb2="+STRTRAN(STR(Cb2,3)," ","0")+" "+; "Cb3="+STRTRAN(STR(Cb3,3)," ","0") LB_Warning(Mess, L("Текущая цветовая схема") ) Flad_ExitColSch = .T. RETURN NIL ******** Выйти из режима просмотра и выбора цветовых схем главного меню FUNCTION ExitColSch() LB_Warning(L("Для выхода нажмите [X]"), L("Выход") ) Flad_ExitColSch = .F. RETURN NIL ****************************************************************** STATIC PROCEDURE RGB( aLocals ) LOCAL aAttr := Array(GRA_AA_COUNT) // area attributes LOCAL nMax, aOldAttr, aOldRGB oPS := oColorBox:LockPS() nMax := 255 // oPS:maxColorIndex() // max colors // Set new RGB color and draw box aAttr[ GRA_AA_COLOR ] := nMax aOldAttr := oPS:setAttrArea( aAttr ) aOldRGB := oPS:setColorIndex( nMax, {nRed,nGreen,nBlue} ) GraBox( oPS, {0,0}, {400,400}, GRA_FILL ) oPS:setAttrArea( aOldAttr ) oPS:setColorIndex( nMax, aOldRGB ) oColorBox:unlockPS( oPS ) RETURN ****************************************************************** * Create std dialog window hidden ****************************************************************** FUNCTION GuiStdDialog( cTitle ) LOCAL oDlg LOCAL aSize := {600,400} LOCAL aPos := CenterPos( aSize, AppDesktop():currentSize() ) DEFAULT cTitle TO "Standard Dialog Window" oDlg := XbpDialog():new( ,, aPos, aSize,, .F. ) oDlg:icon := 1 oDlg:taskList := .T. oDlg:title := cTitle oDlg:drawingArea:ClipChildren := .T. oDlg:create() oDlg:drawingArea:setFontCompoundName( FONT_DEFPROP_SMALL ) RETURN oDlg *FUNCTION CenterPos( aSize, aRefSize ) *RETURN { Int( (aRefSize[1] - aSize[1]) / 2 ) ; * , Int( (aRefSize[2] - aSize[2]) / 2 ) } ****************************************************************** * Get filename with filedialog ****************************************************************** FUNCTION GetFilename() LOCAL oDlg := XbpFiledialog():New(), cFile oDlg:Title := "Please select DBF file" oDlg:Create() cFile := oDlg:Open( "..\..\DATA\*.DBF" ) RETURN cFile ****************************************************************** * Data code block for fields ****************************************************************** FUNCTION EditBlock( cFieldName ) LOCAL bBlock, cBlock IF FieldPos( cFieldName ) <> 0 IF ! "->" $ cFieldName cFieldName := "FIELD->"+cFieldName ENDIF cBlock := "{|x| IIf(x==NIL,"+cFieldName+",WriteField('"+cFieldName+"',x) ) }" bBlock := &cBlock ENDIF RETURN bBlock ****************************************************************** * Write value to field when record lock can be obtained ****************************************************************** FUNCTION WriteField( cField, xValue ) IF RLock() &cField := xValue DbUnlock() ENDIF RETURN xValue ******** GUI-DBEDIT от Роджера ***************** * This sample demonstrates a browse of a database with a toolbar at the top * containing pushbuttons for navigation of the browse. * BROWSE(DATABASE) *FUNCTION XSample_7() *RETURN NIL **************************************************************************************** ******** 2.1. Классификационные шкалы и градации **************************************************************************************** FUNCTION F2_1() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("2.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF Flag_Classes = .T. Flag_ClassSc = .T. Flag_GrClSc = .T. IF .NOT. FILE("Class_Sc.dbf") // БД класс.шкал: Class_Sc.dbf Flag_ClassSc = .F. GenDbfClSc(.F.) ENDIF IF .NOT. FILE("Gr_ClSc.dbf") // БД градаций класс.шкал: Gr_ClSc.dbf Flag_GrClSc = .F. GenDbfGrClSc(.F.) ENDIF IF .NOT. FILE("Classes.dbf") // БД градаций класс.шкал + градаций класс.шкал: Classes.dbf Flag_Classes = .F. GenDbfClass(.F.) ENDIF aStructure := { { "Rang" , "N", 8, 0 }, ; { "Kod_min" , "N", 8, 0 }, ; { "Kod_max" , "N", 8, 0 } } DbCreate( 'aKodCls', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT() USE aKodCls EXCLUSIVE NEW;ZAP IF N_ClSc * N_GrClSc = 0 .AND. N_Cls > 0 Flag_Classes = .T. Flag_ClassSc = .F. Flag_GrClSc = .F. ENDIF // Нет БД Class_Sc и Gr_ClSc: однооконный интерфейс, в котором задать и сформировать класс.шкалы и градации IF Flag_Classes = .T. .AND.; Flag_ClassSc = .F. .AND.; Flag_GrClSc = .F. aMess := {} AADD(aMess, L('В текущем приложении нет баз данных классификационных шкал и градаций: "Class_Sc", "Gr_ClSc"!')) AADD(aMess, L('Необходимо вручную задать КОДЫ классиф.шкал и нажать кнопку: "Создать класс.шкалы и градации"')) LB_Warning(aMess) F2_1win1() ENDIF // Все нормально, двухоконный интерфейс, аналогичный 2.2() ***************************** IF Flag_Classes = .T. .AND.; Flag_ClassSc = .T. .AND.; Flag_GrClSc = .T. F2_1win2() ENDIF // Все нормально, двухоконный интерфейс, аналогичный 2.2() ***************************** IF Flag_Classes = .F. .AND.; Flag_ClassSc = .F. .AND.; Flag_GrClSc = .F. F2_1win2() ENDIF ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) ReTURN nil **************************************************************************************** **************************************************************************************** ******** 2.1. Классификационные шкалы и градации, 1 окно **************************************************************************************** FUNCTION F2_1win1() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions aColors := { {GRA_CLR_WHITE,GRA_CLR_DARKRED },; {GRA_CLR_WHITE,GRA_CLR_DARKBLUE },; {GRA_CLR_BLACK,GRA_CLR_DARKGREEN} } aPres := ; { { XBP_PP_COL_HA_FGCLR, GRA_CLR_WHITE },; // Header FG Color { XBP_PP_COL_HA_BGCLR, GRA_CLR_DARKGRAY },; // Header BG Color { XBP_PP_COL_FA_FGCLR, GRA_CLR_YELLOW },; // Footer FG Color { XBP_PP_COL_FA_BGCLR, GRA_CLR_DARKGRAY },; // Footer BG Color { XBP_PP_COL_DA_ROWSEPARATOR, XBPCOL_SEP_DOTTED },; // Row Sep { XBP_PP_COL_DA_COLSEPARATOR, XBPCOL_SEP_DOTTED },; // Col Sep { XBP_PP_COL_HA_ALIGNMENT, XBPALIGN_LEFT },; // Header alignment { XBP_PP_COL_DA_ROWHEIGHT, 20 },; // Row Height { XBP_PP_COL_DA_CELLHEIGHT, 20 } } // Cell Height KodOne2_1() /* ----- Create ToolBar ----- */ @ 27.5, 1 DCTOOLBAR oToolBar SIZE 130, 1.5 DCADDBUTTON CAPTION L('Помощь') ; SIZE 5+LEN(L("Помощь")) ; ACTION {||Help21win1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 2.1') DCADDBUTTON CAPTION L('Присвоить коды по возрастанию') ; SIZE 5+LEN(L("Присвоить коды по возрастанию")) ; ACTION {||Kod_progr2_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Присвоить всем класс.шкалам коды в порядке возрастания') DCADDBUTTON CAPTION L('Присвоить всем шкалам код 1') ; SIZE 5+LEN(L("Присвоить всем шкалам код 1")) ; ACTION {||KodOne2_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Присвоить всем класс.шкалам код 1') @ DCGUI_ROW, DCGUI_COL + 30 DCPUSHBUTTON CAPTION L('Создать класс.шкалы и градации') ; SIZE 2+LEN(L("Создать класс.шкалы и градации")), 1.5 ; ACTION {||CreateClScGr(.T.), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Создать класс.шкалы и градации') /* ----- Create browse ----- */ @ 1, 0 DCBROWSE oBrowse ALIAS 'Classes' SIZE 131,26 ; HEADLINES 4 ; // Кол-во строк в заголовке (перенос строки - ";") EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; PRESENTATION aPres ; DCBROWSECOL FIELD Classes->Kod_cls HEADER L('Код' ) PARENT oBrowse WIDTH 5 FOOTER '1' PROTECT {|| .T. } DCBROWSECOL FIELD Classes->Name_cls HEADER L('Наименование класса' ) PARENT oBrowse WIDTH 67 FOOTER '2' DCBROWSECOL FIELD Classes->Rang HEADER L('Код;классифи-;кационной;шкалы') PARENT oBrowse WIDTH 7 FOOTER '3' DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; OPTIONS GetOptions ; MODAL ; TITLE L('2.1. Классификационные шкалы и градации. Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"'; FIT ; CLEAREVENTS GenDbfClass(.F.) // Пересоздать БД Classes.dbf ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) ReTURN nil **************************************************************************************** ******** Присвоить всем класс.шкалам коды в порядке возрастания FUNCTION Kod_progr2_1() SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() REPLACE Rang WITH RECNO() DBSKIP(1) ENDDO DBGOTOP() ReTURN nil ******** Присвоить всем класс.шкалам код 1 FUNCTION KodOne2_1() SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() REPLACE Rang WITH 1 DBSKIP(1) ENDDO DBGOTOP() ReTURN nil ********* Помощь по режиму 2.1 *FUNCTION Help21win1() *LOCAL GetList[0], cText *TEXT INTO cText WRAP "\n" TRIMMED * РЕЖИМ: "2.1. КЛАССИФИКАЦИОННЫЕ ШКАЛЫ И ГРАДАЦИИ" предназначен * для ручного ввода и корректировки кодов классификационных шкал, * а затем автоматического формирования с их использованием баз * данных классификационных шкал и градаций классификационных шкал. * Корректировки обучающей и распознаваемой выборки не требуется. *ENDTEXT *@ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT SIZE 0 ; * CAPTION cText FORMATTED ; * FONT '10.Lucida Console' ; * COLOR GRA_CLR_BLACK, GRA_CLR_WHITE * DCREAD GUI FIT TITLE L('Помощь по режиму 2.1') *ReTURN nil ************************************************************************************************** FUNCTION Help21win1() aHelp := {} AADD(aHelp, L('РЕЖИМ: "2.1. КЛАССИФИКАЦИОННЫЕ ШКАЛЫ И ГРАДАЦИИ" предназначен ')) AADD(aHelp, L('для ручного ввода и корректировки кодов классификационных шкал, ')) AADD(aHelp, L('а затем автоматического формирования с их использованием баз ')) AADD(aHelp, L('данных классификационных шкал и градаций классификационных шкал.')) AADD(aHelp, L('Корректировки обучающей и распознаваемой выборки не требуется. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-0, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 2.1. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Создать классификационные шкалы и градации на основе информации в Classes.dbf FUNCTION CreateClScGr(Dialog) // .T. - с диалогом, .F. - без диалога SELECT Class_Sc;ZAP SELECT Gr_ClSc ;ZAP SELECT Classes INDEX ON STR(Rang,19) TO Cls_rang UNIQUE COUNT TO N_Rang ******* Проверка на пропуски в нумерации класс.шкал SET ORDER TO DBGOBOTTOM();mRangMax = Rang PRIVATE aRang[mRangMax] AFILL(aRang, 0) DBGOTOP() DO WHILE .NOT. EOF() IF VALTYPE(Rang) = "N" aRang[Rang] = aRang[Rang] + 1 ENDIF DBSKIP(1) ENDDO ASORT(aRang) IF aRang[1] = 0 aMess := {} AADD(aMess, L('В нумерации классификационных шкал есть пропуски !!')) AADD(aMess, L('Коды шкал должны возрастать на 1, а не на 2 или др.')) LB_Warning(aMess) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT() USE aKodCls EXCLUSIVE NEW RETURN NIL ENDIF DBGOTOP() IF Rang = 0 LB_Warning(L('Перед вызовом данной функции необходимо ввести коды классификационных шкал !')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT() USE aKodCls EXCLUSIVE NEW RETURN NIL ENDIF ***** Определение начальной и конечной записей для каждой классификационной шкалы PRIVATE aKodClsMin[N_Rang] // Начальная запись классификационной шкалы (код класса и номер записи в БД Classes) PRIVATE aKodClsMax[N_Rang] // Конечная запись классификационной шкалы (код класса и номер записи в БД Classes) INDEX ON STR(Rang,19) TO Cls_rang DBGOTOP() mRang = Rang mNameCls = Name_cls IF mRang <> 1 aMess := {} AADD(aMess, L('Минимальный код классификационной шкалы должен' )) AADD(aMess, L('быть равен 1 и коды шкал должны возрастать на 1!')) LB_Warning(aMess) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT() USE aKodCls EXCLUSIVE NEW RETURN NIL ENDIF aKodClsMin[mRang] = Kod_cls aKodClsMax[mRang] = Kod_cls DBGOTOP() DO WHILE .NOT. EOF() IF mRang = Rang aKodClsMax[mRang] = Kod_cls ELSE mRang = Rang aKodClsMin[mRang] = Kod_cls aKodClsMax[mRang] = Kod_cls ENDIF DBSKIP(1) ENDDO SELECT aKodCls FOR j=1 TO LEN(aKodClsMin) APPEND BLANK REPLACE Rang WITH j REPLACE Kod_min WITH aKodClsMin[j] REPLACE Kod_max WITH aKodClsMax[j] NEXT *** Цикл по классификационным шкалам *********************** FOR mRang = 1 TO N_Rang ****** Формирование наименования классификационной шкалы SELECT Classes IF aKodClsMax[mRang] > aKodClsMin[mRang] Pos = 9999999999 FOR r = aKodClsMin[mRang] TO aKodClsMax[mRang]-1 DBGOTO(r );mNameCls1 = ALLTRIM(Name_cls) DBGOTO(r+1);mNameCls2 = ALLTRIM(Name_cls) Pos = MIN(Pos, POSDIFF(mNameCls1, mNameCls2)) mNameCls = ALLTRIM(SUBSTR(mNameCls1, 1, Pos-1)) NEXT ELSE DBGOTO(aKodClsMin[mRang]) mNameCls = ALLTRIM(Name_cls) Pos = 1 ENDIF // Убрать В КОНЦЕ наименования " - ", если это там есть IF SUBSTR(mNameCls, LEN(mNameCls), 1) = "-" mNameCls = ALLTRIM(SUBSTR(mNameCls, 1, LEN(mNameCls)-1)) ENDIF SELECT Class_Sc APPEND BLANK REPLACE Kod_ClSc WITH mRang REPLACE Name_ClSc WITH mNameCls REPLACE N_GrClSc WITH aKodClsMax[mRang] - aKodClsMin[mRang] + 1 REPLACE KodGr_min WITH aKodClsMin[mRang] REPLACE KodGr_max WITH aKodClsMax[mRang] FOR r = aKodClsMin[mRang] TO aKodClsMax[mRang] SELECT Classes DBGOTO(r) mNameCls = Name_cls SELECT Gr_ClSc APPEND BLANK REPLACE Kod_ClSc WITH mRang REPLACE Kod_GrCS WITH r REPLACE Name_GrCS WITH SUBSTR(mNameCls, Pos, LEN(mNameCls)-Pos+1) NEXT NEXT // Сделать БД Classes по новой структуре *********************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций COPY FILE ("Classes.dbf") TO ("Cls_tmp.dbf") GenDbfClass(.F.) USE Classes EXCLUSIVE NEW USE Cls_tmp EXCLUSIVE NEW USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW SELECT Cls_tmp DBGOTOP() DO WHILE .NOT. EOF() mKodCls = Kod_cls mNameCls = Name_cls mIntInf = Int_Inf mSumII = Sum_II mSiiPerc = SII_Perc mRang = Rang mAbs = Abs mPercFiz = Perc_fiz mDate = Date mTime = Time SELECT Gr_ClSc DBGOTO(mKodCls) mKodClSc = Kod_ClSc SELECT Class_Sc DBGOTO(mKodClSc) mNameClSc = ALLTRIM(Name_ClSc) SELECT Classes APPEND BLANK REPLACE Kod_cls WITH mKodCls REPLACE Name_cls WITH mNameCls REPLACE Kod_ClSc WITH mKodClSc REPLACE N_ChrClSc WITH LEN(mNameClSc) REPLACE Int_Inf WITH mIntInf REPLACE Sum_II WITH mSumII REPLACE SII_Perc WITH mSiiPerc REPLACE Rang WITH mRang REPLACE Abs WITH mAbs REPLACE Perc_fiz WITH mPercFiz REPLACE Date WITH mDate REPLACE Time WITH mTime SELECT Cls_tmp DBSKIP(1) ENDDO ***** Доформировать оставшиеся поля БД Class_Sc и Gr_ClSc (информативность и значимость) ############### IF Dialog LB_Warning(L('Формирование БД класс.шкал и градаций класс.шкал: "Class_Sc", "Gr_ClSc" завершено успешно!')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_ClSc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_GrClSc = RECCOUNT() USE aKodCls EXCLUSIVE NEW ENDIF RETURN NIL FUNCTION Set_MainWindow( oDialog ) STATIC soDialog IF Valtype(oDialog) == 'O' soDialog := oDialog ENDIF RETURN soDialog ************************************************************************************************** FUNCTION Help21() aHelp := {} AADD(aHelp, L('Режим: "2.1. КЛАССИФИКАЦИОННЫЕ ШКАЛЫ И ГРАДАЦИИ" предназначен ')) AADD(aHelp, L('для ручного ввода и корректировки справочника классов, которые')) AADD(aHelp, L('представляют собой градации классификационных шкал. После ')) AADD(aHelp, L('корректировки справочника классов обязательно необходимо: ')) AADD(aHelp, L('- скорректировать обучающую выборку; ')) AADD(aHelp, L('- провести пересинтез модели. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-0, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 2.1. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Поиск по столбцу в "Наименование" режиме 2.1 FUNCTION Search2_1() ReTURN nil ******** Сортировка по заданному столбцу в режиме 2.1. (xdemo.exe FUNCTION XDemo_4 ( oDialog, lMDI, lGui )) FUNCTION Sort2_1() LOCAL nChoice := 1, oAppWindow, oCrt, oParent DC_Gui(.t.) SetColor('W+/N') CLS SetColor('N/W,W+/B') @ 5,20 CLEAR TO 19,60 @ 5,20 TO 19,60 @ 7,25 PROMPT L('Код ') @ 9,25 PROMPT L('Наименование ') @11,25 PROMPT L('Редукция класса ') @13,25 PROMPT L('N объектов (абс.)') @15,25 PROMPT L('N объектов (%) ') @17,25 PROMPT L('Exit ') MENU TO nChoice *USE Classes INDEX Obj_kod, Obj_name, Obj_ini, Obj_abs EXCLUSIVE NEW DO CASE CASE nChoice = 1 SET ORDER TO 1 CASE nChoice = 2 SET ORDER TO 2 CASE nChoice = 3 SET ORDER TO 3 CASE nChoice = 4 SET ORDER TO 4 CASE nChoice = 5 SET ORDER TO 4 CASE nChoice = 6 .OR. nChoice = 0 ENDCASE IF Valtype(oCrt) = 'O' .AND. oCrt:status()>0 oCrt:Destroy() SetAppWindow( oAppWindow ) ENDIF RETURN nil ******** This example shows how to use the RGB Color Picker (xdemo.exe) FUNCTION XSample_136(Cf1,Cf2,Cf3,Cb1,Cb2,Cb3) LOCAL GetList := {}, GetOptions, oSay, bColor PUBLIC aRGBColor aRGBColor := { {0,0,0}, {0,0,0} } aRGBColor[1,1] = Cf1 aRGBColor[1,2] = Cf2 aRGBColor[1,3] = Cf3 aRGBColor[2,1] = Cb1 aRGBColor[2,2] = Cb2 aRGBColor[2,3] = Cb3 SET WRAP ON @ 0,0 DCSAY L('Red Foreground' ) GET aRGBColor[1,1] RANGE 0,255 @ 1,0 DCSAY L('Green Foreground') GET aRGBColor[1,2] RANGE 0,255 @ 2,0 DCSAY L('Blue Foreground' ) GET aRGBColor[1,3] RANGE 0,255 @ 4,0 DCSAY L('Red Background' ) GET aRGBColor[2,1] RANGE 0,255 @ 5,0 DCSAY L('Green Background') GET aRGBColor[2,2] RANGE 0,255 @ 6,0 DCSAY L('Blue Background' ) GET aRGBColor[2,3] RANGE 0,255 M_Caption = L('Выбрать цветовую схему меню') @ 8,0 DCPUSHBUTTON CAPTION M_Caption SIZE LEN(M_Caption),1.2 ; ACTION {|a|a := DC_PopColor(aRGBColor,0,.t.), ; aRGBColor[1,1] := a[1,1], ; aRGBColor[1,2] := a[1,2], ; aRGBColor[1,3] := a[1,3], ; aRGBColor[2,1] := a[2,1], ; aRGBColor[2,2] := a[2,2], ; aRGBColor[2,3] := a[2,3], ; Eval(bColor,nil,nil,oSay), ; DC_GetRefresh(GetList) } bColor := {|a,b,o|o:setColorFG(GraMakeRGBColor(aRGBColor[1])), ; o:setColorBG(GraMakeRGBColor(aRGBColor[2]))} @11,0 DCSAY L('Compound Color') SAYSIZE 0 FONT '14.Arial Bold' ; OBJECT oSay ; EVAL {|o|Eval(bColor,nil,nil,o)} DCGETOPTIONS SAYRIGHT SAYWIDTH 120 DCREAD GUI FIT ADDBUTTONS MODAL TITLE L('1.6. Выбор цветовой схемы меню') ; OPTIONS GetOptions EVAL {|o|SetAppWindow(o)} RETURN nil *** END OF EXAMPLE *** ******** Удалить текущую запись в БД, ******** а остальные сдвинуть вверх и перенумеровать FUNCTION Del_rec() SET ORDER TO M_Recno = RECNO() DELETE;PACK *** Перенумеровать записи, начиная с удаленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) DC_GetRefresh(GetList) RETURN NIL ******** Вставить пустую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Ins_rec() SET ORDER TO M_Recno = RECNO() APPEND BLANK A_RecNew := {} // Пустая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Стереть текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) DC_GetRefresh(GetList) RETURN NIL ******** Скопировать (сдублировать) текущую запись в БД на месте текущей, ******** а остальные сдвинуть вниз и перенумеровать FUNCTION Copy_rec() SET ORDER TO M_Recno = RECNO() A_RecNew := {} // Текущая запись FOR j=1 TO FCOUNT() AADD(A_RecNew, FIELDGET(j)) NEXT APPEND BLANK *** Переписать предпоследнюю запись на последнюю и т.д. до текущей FOR r=RECCOUNT()-1 TO M_Recno STEP -1 DBGOTO(r) A_Rec := {} FOR j=1 TO FCOUNT() AADD(A_Rec, FIELDGET(j)) NEXT DBGOTO(r+1) FOR j=1 TO FCOUNT() FIELDPUT(j, A_Rec[j]) NEXT NEXT *** Скопировать текущую запись DBGOTO(M_Recno) FOR j=1 TO FCOUNT() FIELDPUT(j, A_RecNew[j]) NEXT *** Перенумеровать записи, начиная со вставленной DBGOTO(M_Recno) DO WHILE .NOT. EOF() FIELDPUT(1, RECNO()) DBSKIP(1) ENDDO DBGOTO(M_Recno) DC_GetRefresh(GetList) RETURN NIL ******** Добавить пустую запись в конец БД FUNCTION Add_rec() SET ORDER TO APPEND BLANK FIELDPUT(1, RECNO()) DC_GetRefresh(GetList) RETURN NIL ******** Очистить БД FUNCTION Zap_db() SET ORDER TO ZAP DC_GetRefresh(GetList) RETURN NIL ******** Выход и редактора БД FUNCTION Exit_dbe() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL ******** Сообщение: текущая/всего БД FUNCTION Mess_dbe() Mess_dbe = ALLTRIM(STR(RECNO(),19))+"/"+ALLTRIM(STR(RECCOUNT(),19)) RETURN(Mess_dbe) *********************************************************************************************************** ******** 6.1. Информация о системе, разработчике и средствах разработки *********************************************************************************************************** FUNCTION F6_1() Running(.T.) aHelp := {} AADD(aHelp, L('ИНФОРМАЦИЯ О СИСТЕМЕ И РАЗРАБОТЧИКЕ: ')) AADD(aHelp, L('(C) Универсальная когнитивная аналитическая система "ЭЙДОС-X++", beta-version, rel: 29.07.2020, ')) AADD(aHelp, L('(C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар. ')) AADD(aHelp, L('URL: http://Lc.kubagro.ru, e-mail: prof.lutsenko@gmail.com, https://kubsau.ru/education/chairs/comp-system/staff/3965/ ')) AADD(aHelp, L('ФУНКЦИИ СИСТЕМЫ: ')) AADD(aHelp, L('Универсальная когнитивная аналитическая система "ЭЙДОС-X++", является программным инструментарием Автоматизированного системно-')) AADD(aHelp, L('когнитивного анализа (АСК-анализ), разработана в универсальной постановке, не зависящей от предметной области, и ОБЕСПЕЧИВАЕТ: ')) AADD(aHelp, L('- автоматизированную формализацию предметной области (разработка классификационных и описательных шкал и градаций и кодирование')) AADD(aHelp, L('с их попомщью исходных данных, в результате чего они преобразуются в обучающую выборку. ')) AADD(aHelp, L('- многопараметрическую типизацию, синтез, повышение качества и верификацию 3 статистических моделей и 7 системно-когнитивных ')) AADD(aHelp, L('моделей (СК-моделей) предметной области; ')) AADD(aHelp, L('- распознавание (системную идентификацию, распознавание, классификацию, диагностику, прогнозирование); ')) AADD(aHelp, L('- поддержку принятия решений (типология), информационные портреты и когнитивный SWOT- и PEST- анализ; ')) AADD(aHelp, L('- исследование объекта моделирования путем исследования его системно-когнитивной модели (СК-модели), включая: дивизивную и ')) AADD(aHelp, L('агломеративную когнитивную кластеризацию, конструктивный анализ и системно-когнитивный анализ (СК-анализ), нелокальные нейроны ')) AADD(aHelp, L('и нейронные сети, когнитивные диаграммы, классические и интегральные когнитивные карты, когнитивные функции и т.д. ')) AADD(aHelp, L('РАЗРАБОТЧИК концепции, математической модели (системной теории информации - СТИ), методики численных расчетов (структур данных ')) AADD(aHelp, L('и алгоритмов), программной реализации (100% кода на xBase++), технологиии и методики применения системы "Эйдос-X" (АСК-анализ) ')) AADD(aHelp, L('д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Alaska CID: E098865, http://Lc.lubagro.ru, prof.lutsenko@gmail.com ')) AADD(aHelp, L('Система "Эйдос-Х++" разработана по инициативе автора: проф. Е.В.Луценко, без заказа и финансирования со стороны ')) AADD(aHelp, L('каких-либо организаций и все права на нее принадлежат автору (Патент РФ: http://lc.kubagro.ru/aidos/2012619610.jpg, ')) AADD(aHelp, L('http://lc.kubagro.ru/aidos/index.htm и статью: Луценко Е.В. 30 лет системе <Эйдос> - одной из старейших отечественных ')) AADD(aHelp, L('универсальных систем искусственного интеллекта, широко применяемых и развивающихся и в настоящее время / Е.В. Луценко // ')) AADD(aHelp, L('Политематический сетевой электронный научный журнал Кубанского государственного аграрного университета (Научный журнал ')) AADD(aHelp, L('КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2009. - №10(54). С. 48 - 77. - Шифр Информрегистра: 0420900012\0110. ')) AADD(aHelp, L('- Режим доступа: http://ej.kubagro.ru/2009/10/pdf/04.pdf, 1,875 у.п.л.). ')) AADD(aHelp, L('УЧАСТИЕ В РАЗРАБОТКЕ И СОАВТОРСТВО: ')) AADD(aHelp, L('- Концепция групп приложений и алгоритмы голосования частных моделей в мультимодели разработаны проф.Е.В.Луценко совместно ')) AADD(aHelp, L('с Ph.D, Cand.Phys.-Math.Sci., prof. Alexander Trunev, Director, A&E Trounev IT Consulting, Toronto, Canada: http://trounev.com/')) AADD(aHelp, L('- Дмитрий Константинович Бандык, разработчик интеллектуальных систем из Белоруссии, разработал по постановке проф.Е.В.Луценко ')) AADD(aHelp, L('режимы: 1.8. Создание градиентных фонов главного окна, 4.5. Визуализация когнитивных функций, 6.7. Визуализация логотипов ')) AADD(aHelp, L('мультимоделей, 3.1. Ускоренный синтез моделей, 3.2. Распознавание во всех моделях на GPU. ')) AADD(aHelp, L('- Алексей Семенович Креймер: визуализация мест запусков системы "Эйдос", http://kubsau.ru/education/chairs/comp-system/staff/3395/')) AADD(aHelp, L('- Владлен Замышляев: кластерная кратографическая визуализация запусков системы "Эйдос" на карте мира https://github.com/Tapoch.')) AADD(aHelp, L('КОНСУЛЬТАТИВНАЯ И МОРАЛЬНАЯ ПОДДЕРЖКА ПРОГРАММНОЙ РЕАЛИЗАЦИИ: ')) AADD(aHelp, L('- Roger Donnay, Professional Developer, Developer eXPress++, Boise, Idaho USA, http://donnay-software.com, ')) AADD(aHelp, L('http://bb.donnay-software.com. ')) AADD(aHelp, L('- Boris Borzic is the CTO & President of Xb2.NET Inc. http://www.xb2.net. ')) AADD(aHelp, L('- Clifford Wiernik, CPA/CNE, Senior IT Analyst, www.aquafinance.com cwiernik@aquafinance.com Tel: 800-234-3663 x1126, ')) AADD(aHelp, L('Fax: 715-848-1411, Aqua Finance, Inc, One Corporate Dr, Ste 300, Wausau WI 54401, USA. ')) AADD(aHelp, L('ЛИЦЕНЗИОННЫЕ СРЕДСТВА РАЗРАБОТКИ: ')) AADD(aHelp, L('- Alaska Xbase++ (R) Version 1.90.355 SL1 Сер.№106281-143290, XbToosIII Сер.№205281-143319, http://alaska-software.com/ ')) AADD(aHelp, L('eXPress++ (C) Version 1.9 Build 255, http://donnay-software.com. ')) AADD(aHelp, L('- Xb2.NET ver 3.4.00. http://www.xb2.net. ')) AADD(aHelp, L('- Advantage Database Server (ADS) 10.0, №8142312, http://www.AdvantageDatabase.com. ')) AADD(aHelp, L('БЛАГОДАРНОСТИ: ')) AADD(aHelp, L('За приобретение лицензионных средств разработки автор благодарен зав.кафедрой компьютерных технологий и систем проф. В.И.Лойко ')) AADD(aHelp, L('и проректору по научной работе ФГБОУ ВО "Кубанский государственный аграрный университет имени И.Т.Трубилина" проф. Ю.П.Федулову')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.8;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-15, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT TITLE L('6.1. О системе "ЭЙДОС-X++", авторе-разработчике, средствах разработки и поддержке.') Running(.F.) RETURN NIL ************************************************************************************************** *********************************************************************************************************** ******** 6.2. Ссылки на патенты, монографии и статьи по системе *********************************************************************************************************** FUNCTION F6_2() Running(.T.) DCSETFONT TO '10.Helv Bold' @ 0,1 DCSAY L('САЙТ АВТОРА:') SAYSIZE 0 @ 1,1 DCSAY L('http://lc.kubagro.ru') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @ 3,1 DCSAY L('ПАТЕНТЫ:') SAYSIZE 0 @ 4,1 DCSAY L('http://lc.kubagro.ru/aidos/index.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/index.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @ 6,1 DCSAY L('НАУЧНЫЕ МОНОГРАФИИ И УЧЕБНЫЕ ПОСОБИЯ:') SAYSIZE 0 @ 7,1 DCSAY L('http://lc.kubagro.ru/aidos/index.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/index.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @ 8,1 DCSAY L('http://www.twirpx.com/user/858406/') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://www.twirpx.com/user/858406/', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @10,1 DCSAY L('УЧЕБНЫЕ ПОСОБИЯ:') SAYSIZE 0 @11,1 DCSAY L('http://lc.kubagro.ru/aidos/aidos06_lec/index.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/aidos06_lec/index.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @12,1 DCSAY L('http://lc.kubagro.ru/aidos/aidos06_lab/index.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/aidos06_lab/index.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @14,1 DCSAY L('НАУЧНЫЕ СТАТЬИ:') SAYSIZE 0 @15,1 DCSAY L('http://ej.kubagro.ru/a/viewaut.asp?id=11') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/a/viewaut.asp?id=11', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @16,1 DCSAY L('http://elibrary.ru/author_items.asp?authorid=123162') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://elibrary.ru/author_items.asp?authorid=123162', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @18,1 DCSAY L('АРХИВ СИСТЕМЫ "ЭЙДОС-Х++" С ПРИЛОЖЕНИЯМИ (~217 МБ):') SAYSIZE 0 @19,1 DCSAY L('http://lc.kubagro.ru/Install_Aidos-X/Aidos-X.exe') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Install_Aidos-X/Aidos-X.exe', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @21,1 DCSAY L('ТЕКУЩЕЕ ОБНОВЛЕНИЕ СИСТЕМЫ "ЭЙДОС-Х++" (~ 8 МБ)') SAYSIZE 0 @22,1 DCSAY L('http://lc.kubagro.ru/Install_Aidos-X/Downloads.exe') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Install_Aidos-X/Downloads.exe', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @24,1 DCSAY L('ИНФОРМАЦИЯ ОБ ОБНОВЛЕНИЯХ СИСТЕМЫ "ЭЙДОС-Х++" ЗА ВСЕ ВРЕМЯ (doc-файл ~560 Кб)') SAYSIZE 0 @25,1 DCSAY L('http://lc.kubagro.ru/Sheet_changes.doc') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Sheet_changes.doc', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @27,1 DCSAY L('ГРУППА В ФЕЙСБУКЕ ПО АСК-АНАЛИЗУ И СИСТЕМЕ "ЭЙДОС"') SAYSIZE 0 @28,1 DCSAY L('https://www.facebook.com/groups/558866657885969/') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://www.facebook.com/groups/558866657885969/', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @30,1 DCSAY L('ЛАБОРАТОРИЯ В ResearchGate ПО АСК-АНАЛИЗУ И СИСТЕМЕ "ЭЙДОС"') SAYSIZE 0 @31,1 DCSAY L('https://www.researchgate.net/lab/Eugene-Lutsenko-Lab-Eugene-Veniaminovich-Lutsenko') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://www.researchgate.net/lab/Eugene-Lutsenko-Lab-Eugene-Veniaminovich-Lutsenko', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} DCREAD GUI FIT TITLE L('6.2. Ссылки на патенты, литературу, обновление системы и группы в контактах и фэйсбуке') Running(.F.) RETURN nil *********************************************************************************************************** ******** 6.7. Запуск программы формирования логотипов мультимоделей *********************************************************************************************************** FUNCTION F6_7() Running(.T.) * RUN("_6_7.exe") ******** Проверять контрольную сумму программы и в _6_7.exe и других местах тоже ############################ * RunShell("","_6_7.exe",.T.) LC_RunShell("_6_7.exe", 38953662) Running(.F.) RETURN NIL ************************* ******** Выход из системы ************************* FUNCTION F7() SaveLangDB() // Запись языковых баз * RemoveFonts() // Отключение шрифтов, назависимых от Windows CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций QUIT RETURN NIL ******************************************************************************************************************************* ******** 6.3. Развитый алгоритм принятия решений в интеллектуальных системах управления на основе АСК-анализа и системы "Эйдос" ******************************************************************************************************************************* FUNCTION F6_3() Running(.T.) cFile = "Advanced_decision-making_algorithm_for_ASK-analysis.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 56456811 // <<<===############### DC_PrintPreviewAcrobat( cFile, '6.3. Развитый алгоритм принятия решений АСК-анализа' ) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF Running(.F.) RETURN NIL **************************************************************************************************************** ******** 6.4. Порядок преобразования данных в информацию, а ее в знания ******** В режиме раскрывается соотношение содержания понятий: "Данные", "Информация" и "Знания", ******** а также последовательность преобразования данных в информацию, а ее в знания в системе "Эйдос-Х++" ******** с указанием имен баз данных и ссылками на основные публикации по этим вопросам' **************************************************************************************************************** FUNCTION F6_4() Running(.T.) cFile = "_DataInfCogn.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 55490900 // <<<===############### DC_PrintPreviewAcrobat( cFile, '6.4. Последовательность обработки данных, информации и знаний в системе "Эйдос-Х++"' ) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF Running(.F.) RETURN NIL ********************************************************************************************************** ******** 6.5. Графическая заставка системы "Эйдос-12.5" ********************************************************************************************************** FUNCTION F6_5() Running(.T.) cFile = "_TITUL125.GIF" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 2200845 FullView( cFile, "по центру", 0 ) ELSE Mess = ('Графический файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF Running(.F.) RETURN NIL ********************************************************************************************************** ******** 6.6. Roger Donnay, Professional Developer, Developer eXPress++ ********************************************************************************************************** FUNCTION F6_6() Running(.T.) cFile = "_Roger.jpg" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 9087979 FullView( cFile, "по центру", 0 ) ELSE Mess = L('Графический файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF Running(.F.) RETURN NIL ********************************************************************************************************** ******** 6.8. Свидетельства РосПатента РФ на систему "Эйдос" ********************************************************************************************************** FUNCTION F6_8() Running(.T.) * cFile = "_2012619610.jpg" * IF .NOT. FILE(cFile) * Mess = L('В папке с исполнимым модулем системы нет файла: "#"') * Mess = STRTRAN(Mess, "#", cFile) * LB_Warning(Mess) * ENDIF * // Проверить контрольную сумму файла и если она не совпадает * // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). * IF FILECHECK(cFile) = 8312874 * FullView( cFile, "по центру", 0 ) * ELSE * Mess = L('Графический файл: "#" поврежден и не может быть отображен!') * Mess = STRTRAN(Mess, "#", cFile) ** Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла * LB_Warning(Mess) * ENDIF cFile = "_CertRosPatSysAidos.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 1093634864 DC_PrintPreviewAcrobat( cFile, '6.8. Свидетельства РосПатента РФ на систему "Эйдос"' ) ELSE Mess = L('Файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF Running(.F.) RETURN NIL *********************************************************************************************************** ******** 1.9. Прописывание путей по фактическому положению ******** Доступно только сисадмину. Определяет фактическое месторасположение системы и приложений ******** и прописывает пути на них в БД: PathGrAp.DBF и Appls.dbf, ******** а также восстанавливает имена приложений в Appls.dbf на данные им при их создании *********************************************************************************************************** FUNCTION F1_9() Running(.T.) IF .NOT. Flag_SysAdmin LB_Warning(L("Эта функция доступна только Сисадмину")) ELSE M_PathAppls = UPPER(ALLTRIM(Disk_dir))+"\AID_DATA\" DIRCHANGE(M_PathAppls) PRIVATE aAppls := Directory("A0*.*","D") GenDbfPaths() GenDbfAppls() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW FOR j=1 TO LEN(aAppls) Appls->(DBAPPEND()) Appls->Kod_AdmApp := 2 Appls->Kod_Appl := j Appls->Date := DTOC(DATE()) Appls->Time := TIME() Appls->Path_Appl := M_PathAppls+aAppls[ j, F_NAME ]+"\System\" // Считать M_NameAppl с диска из папки приложения, если он есть, а если нет - присвоить наименование, // и записать его в Appls.dbf DIRCHANGE(Appls->Path_Appl) IF .NOT. FILE("_NameAppl.arx") M_NameAppl = "Приложение № "+ALLTRIM(STR(j,19)) ELSE M_NameAppl = DC_ARestore("_NameAppl.arx") ENDIF // Записать M_NameAppl на диск в папку приложения DC_ASave(M_NameAppl, "_NameAppl.arx") DIRCHANGE(M_PathAppls) Appls->Name_Appl := M_NameAppl NEXT Appls->(DBGOTOP()) Appls->By_Default := "W" LB_Warning(L("Пути на фактическое расположение системы и приложений прописаны, имена приложений восстановлены!"), L("Сообщение о завершении операции") ) ENDIF ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************** ******** 1.11. Удаление всех приложений и пользователей ******** Доступно только сисадмину. Определяет фактическое месторасположение системы и приложений ******** и удаляет все директории приложений с поддиректориями и всеми файлами в них, ******** а затем пересоздает и переиндексирует БД: PathGrAp.DBF, Appls.dbf и Users.dbf' *********************************************************************************************************** FUNCTION F1_11() Running(.T.) IF .NOT. Flag_SysAdmin LB_Warning(L("Эта функция доступна только Сисадмину")) ELSE // Сначала удалить ВСЕ папки с приложениями, используя путь на фактическое расположение БД AID_DATA, // а потом пересоздать БД: PathGrAp.DBF, Appls.dbf и Users.dbf // Запомнить текущее положение системы в БД PathSystem.dbf CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций aStructure := { { "PathSystem", "C", 250, 0 } } DbCreate( 'PathSystem', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathSystem EXCLUSIVE NEW;ZAP APPEND BLANK REPLACE PathSystem WITH Disk_dir // Сначала удалить ВСЕ папки с приложениями, используя путь на фактическое расположение БД AID_DATA, // а потом пересоздать БД: PathGrAp.DBF, Appls.dbf и Users.dbf Zap_Appls() * Zap_InpData() // Содержимое папки Inp_data удалаять при удалении приложения GenDbfPaths() GenDbfUsers() aMess := {} AADD(aMess, L('Была произведена локализация системы, т.е. удалены все приложения')) AADD(aMess, L('и пользователи и прописаны пути по фактическому положению системы')) AADD(aMess, L('т.к. система впервые запущена в папке: "'+ALLTRIM(Disk_dir)+'\"' )) LB_Warning(aMess, L('1.11. Локализация системы "Эйдос" в папке') ) ENDIF ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************** ******** 1.10. Инсталляция ActiveX на данном компьютере ******** Доступно только сисадмину. Устанавливает ActiveX: RMChart.ocx на данном копьютере *********************************************************************************************************** FUNCTION F1_10() Running(.T.) *IF .NOT. Flag_SysAdmin * LB_Warning(L("Эта функция доступна только Сисадмину")) *ELSE * aMess := {} * DO CASE * CASE OSVER() = "3.1" * AADD(aMess, L('На комьютере установлена MS Windows NT 3.1')) * CASE OSVER() = "3.5" * AADD(aMess, L('На комьютере установлена MS Windows NT 3.5')) * CASE OSVER() = "3.51" * AADD(aMess, L('На комьютере установлена MS Windows NT 3.51') * CASE OSVER() = "4.0" * AADD(aMess, L('На комьютере установлена MS Windows NT 4.0')) * CASE OSVER() = "5.0" * AADD(aMess, L('На комьютере установлена MS Windows 2000')) * CASE OSVER() = "5.1" * AADD(aMess, L('На комьютере установлена MS Windows XP')) * CASE OSVER() = "5.2" * AADD(aMess, L('На комьютере установлена MS Server 2003')) * ENDCASE * IF LEN(aMess) > 0 * AADD(aMess, L('А для работы профессиональной графики нужна:' )) * AADD(aMess, L('MS Windows Vista / MS Windows Server 2008 или')) // OSVER() = "6.0" * AADD(aMess, L('MS Windows 7 / MS Windows Server 2008 R2' )) // OSVER() = "6.1" * LB_Warning(aMess, L('Сообщение о неудачном завершении операции')) * RETURN NIL * ENDIF * IF FILE("RMChart.ocx") ** RunShell("","c:\Windows\System32\regsvr32.exe RMChart.ocx",.F.) ** Run("c:\Windows\System32\regsvr32.exe RMChart.ocx") * Run("regsvr32.exe RMChart.ocx") * ELSE * LB_Warning(L("ActiveX: RMChart.ocx отсутствует в текущей папке. Обратитесь к разработчику !"), L("Сообщение о неудачном завершении операции") ) * ENDIF *ENDIF Running(.F.) RETURN NIL *********************************************************************************************************** *IF .NOT. Flag_SysAdmin * LB_Warning(L("Эта функция доступна только сисадмину")) *ELSE *ENDIF *********************************************************************************************************** ******** 1.3. Диспетчер приложений (xdemo.exe, FUNCTION XSample_130(): sample 4, OneToMany2) *********************************************************************************************************** FUNCTION F1_3() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems, lCancelled := .F. Running(.T.) IF Flag_SysAdmin .OR. Flag_AdmAppl ELSE LB_Warning(L("Эта функция доступна только Сисадмину и Администраторам приложений")) Running(.F.) RETURN NIL ENDIF IF FILE("Users.dbf") // БД администраторов приложений и паролей доступа к ним: Users.dbf ** Переиндексировать БД Users.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF FILE("Use_kod.ntx" ).AND.; FILE("Use_name.ntx").AND.; FILE("Use_LPAA.ntx").AND.; FILE("Use_LPus.ntx").AND.; FILE("Use_dreg.ntx") ELSE GenNtxUsers() ENDIF ELSE GenDbfUsers() ENDIF IF FILE("Appls.dbf") // БД администраторов приложений и паролей доступа к ним: Users.dbf ** Переиндексировать БД Appls.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("App_kapl.ntx").OR.; .NOT. FILE("App_kapp.ntx").OR.; .NOT. FILE("App_name.ntx").OR.; .NOT. FILE("App_crea.ntx") GenNtxAppls() ENDIF ELSE GenDbfAppls() ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE USERS INDEX ON Kod_AdmApp TO USERS CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW INDEX ON Kod_AdmApp TO APPLS USE USERS INDEX USERS EXCLUSIVE SELECT Users DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.прил. и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(L("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE *DBGOTOP();DBGOBOTTOM();DBGOTOP() USE APPLS INDEX APPLS EXCLUSIVE NEW SELECT Appls DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит и может все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.приложения и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(L("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE *DBGOTOP();DBGOBOTTOM();DBGOTOP() aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) /* ----- Create ToolBar ----- */ mStr1 = L("Помощь" );mStr1Len = LEN(mStr1) mStr2 = L("Добавить пустое приложение" );mStr2Len = LEN(mStr2) mStr3 = L("Добавить лабораторную работу" );mStr3Len = LEN(mStr3) mStr4 = L("Скачать приложение из облака" );mStr4Len = LEN(mStr4) mStr5 = L("Записать приложение в облако" );mStr5Len = LEN(mStr5) mStr6 = L("Скопировать текущее приложение");mStr6Len = LEN(mStr6) mStr7 = L("Удалить текущее приложение" );mStr7Len = LEN(mStr7) d = 2 n = 1.5 mL = 15 mK = 0.3 @ 27.5, 0 DCGROUP oGroup1 CAPTION L(' ') SIZE 171, 3.0 @ 1, 1 DCPUSHBUTTON CAPTION mStr1 SIZE mStr1Len+(mL-mStr1Len)*mK+n, 1.5 ACTION {||Help13() , DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Помощь по режиму 1.3') @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr2 SIZE mStr2Len+(mL-mStr2Len)*mK+n, 1.5 ACTION {||ADD_ZAPPL(L("Название приложения нужно ввести вручную в режиме 1.3.")), DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Добавить пустое приложение') @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr3 SIZE mStr3Len+(mL-mStr3Len)*mK+n+3, 1.5 ACTION {||AddsAppls() , DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Добавить учебное приложение с локального компьютера') FONT '9.Arial Bold' @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr4 SIZE mStr4Len+(mL-mStr4Len)*mK+n, 1.5 ACTION {||LoadAppCloud(), DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Скачать приложение из облака (DownLoad): с WEB-сервера системы "Эйдос"') @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr5 SIZE mStr5Len+(mL-mStr5Len)*mK+n, 1.5 ACTION {||SaveAppCloud(), DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Записать приложение в облако (UpLoad): на WEB-сервер системы "Эйдос"') @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr6 SIZE mStr6Len+(mL-mStr6Len)*mK+n, 1.5 ACTION {||Copy_rec1_3() , DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Создать новое приложение и скопировать в него все БД текущего') @ 1, DCGUI_COL+d DCPUSHBUTTON CAPTION mStr7 SIZE mStr7Len+(mL-mStr7Len)*mK+n, 1.5 ACTION {||Del_Appl() , DC_GetRefresh(GetList)} PARENT oGroup1 TOOLTIP L('Удалить текущее приложение') *@ 27.5, 0 DCTOOLBAR oToolBar SIZE 171, 1.5 *d = 1 *DCADDBUTTON CAPTION L('Помощь' ; * SIZE LEN(L("Помощь"))+3, 1.5 ; * ACTION {||Help13(), DC_GetRefresh(GetList)} ; * PARENT oToolBar ; * TOOLTIP L('Помощь по режиму 1.3') **** Функции, доступные только сисадмину и администратору приложения *IF Flag_SysAdmin .OR. Flag_AdmAppl * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить пустое приложение') ; * SIZE LEN(L("Добавить пустое приложение"))-2, 1.5 ; * ACTION {||ADD_ZAPPL(L("Пустое приложение. Его название можно поменять вручную")), DC_GetRefresh(GetList)}; * PARENT oToolBar ; * TOOLTIP L('Добавить пустое приложение') * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить лабораторную работу') ; * SIZE LEN(L("Добавить лабораторную работу"))+2, 1.5 ; * ACTION {||AddsAppls(), DC_GetRefresh(GetList)} ; * FONT '9.Arial Bold' ; * PARENT oToolBar ; * TOOLTIP L('Добавить учебное приложение с локального компьютера') * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Скачать приложение из облака') ; * SIZE LEN(L("Скачать приложение из облака"))-1, 1.5 ; * ACTION {||LoadAppCloud(), DC_GetRefresh(GetList)} ; * PARENT oToolBar ; * TOOLTIP L('Скачать приложение из облака (DownLoad): с WEB-сервера системы "Эйдос"') * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Записать приложение в облако') ; * SIZE LEN(L("Записать приложение в облако"))-2, 1.5 ; * ACTION {||SaveAppCloud(), DC_GetRefresh(GetList)} ; * PARENT oToolBar ; * TOOLTIP L('Записать приложение в облако (UpLoad): на WEB-сервер системы "Эйдос"') * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Сдублировать текущее приложение') ; * SIZE LEN(L("Скопировать текущее приложение"))-1, 1.5 ; * ACTION {||Copy_rec1_3(), DC_GetRefresh(GetList)} ; * PARENT oToolBar ; * TOOLTIP L('Создать новое приложение и скопировать в него все БД текущего') * @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить текущее приложение') ; * SIZE LEN(L("Удалить текущее приложение"))-1, 1.5 ; * ACTION {||Del_Appl(), DC_GetRefresh(GetList)} ; * PARENT oToolBar ; * TOOLTIP L('Удалить текущее приложение') *ENDIF /* ----- Create browse-1 ----- */ bApp := {|| APPLS->(DC_SetScope(0,USERS->Kod_AdmApp)), ; APPLS->(DC_SetScope(1,USERS->Kod_AdmApp)), ; APPLS->(DC_DbGoTop()), ; oBrowApp:refreshAll() } IF Flag_SysAdmin @ 1, 0 DCBROWSE oBrowUser ALIAS 'USERS' SIZE 48.9,26 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; // Редактирование БД Users NOSOFTTRACK ; HEADLINES 3 ; // Кол-во строк в заголовке (перенос строки - ";") SCOPE ; ITEMMARKED {|| Eval(bApp), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowUser DCBROWSECOL FIELD USERS->Kod_AdmApp HEADER L('Код;адм.;приложения' ) WIDTH 4 PROTECT {|| .T. } DCBROWSECOL FIELD USERS->Name_AdmAp HEADER L('Ф.И.О.адм.приложения' ) WIDTH 24 DCBROWSECOL FIELD USERS->Login_AdmA HEADER L('Login;адм.;приложения') WIDTH 10 DCBROWSECOL FIELD USERS->Passw_AdmA HEADER L('Password;адм.;прилож.') WIDTH 10 DCBROWSECOL FIELD USERS->Passw_User HEADER L('Password;пользователя') WIDTH 10 DCBROWSECOL FIELD USERS->Date HEADER L('Дата;регистрации' ) WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD USERS->Time HEADER L('Время;регистрации' ) WIDTH 5 PROTECT {|| .T. } ELSE @ 1, 0 DCBROWSE oBrowUser ALIAS 'USERS' SIZE 48.9,26 ; PRESENTATION DC_BrowPres() ; // Только просмотр БД Users HEADLINES 3 ; // Кол-во строк в заголовке (перенос строки - ";") NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bApp), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowUser DCBROWSECOL FIELD USERS->Kod_AdmApp HEADER L('Код;адм.;приложения' ) WIDTH 4 PROTECT {|| .T. } DCBROWSECOL FIELD USERS->Name_AdmAp HEADER L('Ф.И.О.адм.приложения') WIDTH 24 ENDIF /* ----- Create browse-2 ----- */ DCSETPARENT TO @ 1,51 DCBROWSE oBrowApp ALIAS 'APPLS' SIZE 120,26 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; HEADLINES 3 ; // Кол-во строк в заголовке (перенос строки - ";") NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems; COLOR {||IIF(LEN(ALLTRIM(APPLS->By_default))=0, {nil,GRA_CLR_WHITE}, {nil,aColor[153]})} DCSETPARENT oBrowApp IF Flag_SysAdmin DCBROWSECOL FIELD APPLS->Kod_AdmApp HEADER L('Код;адм.;приложения' ) WIDTH 4 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->Kod_Appl HEADER L('Код;приложения' ) WIDTH 4 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->By_default HEADER L('Признак;выбора;приложения' ) WIDTH 1 DCBROWSECOL FIELD APPLS->Name_Appl HEADER L('Наименование приложения' ) WIDTH 60 DCBROWSECOL FIELD APPLS->Date HEADER L('Дата;создания;приложения' ) WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->Time HEADER L('Время;создания;приложения' ) WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->Path_Appl HEADER L('Путь на папку с приложением') WIDTH 40 ELSE DCBROWSECOL FIELD APPLS->Kod_Appl HEADER L('Код;приложения' ) WIDTH 4 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->By_default HEADER L('Признак;выбора;приложения' ) WIDTH 1 DCBROWSECOL FIELD APPLS->Name_Appl HEADER L('Наименование приложения' ) WIDTH 60 DCBROWSECOL FIELD APPLS->Date HEADER L('Дата;создания;приложения' ) WIDTH 5 PROTECT {|| .T. } DCBROWSECOL FIELD APPLS->Time HEADER L('Время;создания;приложения' ) WIDTH 5 PROTECT {|| .T. } ENDIF DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE IF Flag_SysAdmin cTitle = L('1.3. Диспетчер приложений (режим СисАдмина)') ELSE cTitle = L('1.3. Диспетчер приложений (режим Администратора приложений)') ENDIF DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE cTitle ; EVAL {|o|SetAppFocus(oBrowUser:GetColumn(1))} ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ****** END OF EXAMPLE *********************** ************************************************************************************************** FUNCTION Help13() aHelp := {} AADD(aHelp, L('Помощь по режиму: "1.3. ДИСПЕТЧЕР ПРИЛОЖЕНИЙ". ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Это подсистема администрирования приложений. Она предназначена для создания новых приложений, как пустых, так и на основе учебных ')) AADD(aHelp, L('примеров (лабораторных работ), имеющихся в системе локально или в облаке (на web-сервере автора), а также для выбора приложения ')) AADD(aHelp, L('для работы из уже имеющихся и удаления приложения. Выбор приложения для работы осуществляется путем отметки его любым символом. ')) AADD(aHelp, L('Администратор приложения может выбирать для работы только созданные им приложения. Если таким способом отмечено несколько ')) AADD(aHelp, L('приложений, то используется первое по порядку. Удалять любые приложения разрешается только сисадмину, а Администратору приложений ')) AADD(aHelp, L('- только те, которые он сам создал. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Порядок работы в системе описан в режиме 6.4 и включает следующие этапы: ')) AADD(aHelp, L(' 1. Ввести исходные данные в систему в режиме 2.3.2.2. Файл исходных данных Inp_data.xls должен быть в папке: ../AID_DATA/INP_DATA/.')) AADD(aHelp, L(' 2. Посмотреть на классификационные шкалы и градации в режиме 2.1. ')) AADD(aHelp, L(' 3. Посмотреть на описательные шкалы и градации в режиме 2.2. ')) AADD(aHelp, L(' 4. Посмотреть на обучающую выборку в режиме 2.3.1. ')) AADD(aHelp, L(' 5. Запустить режим синтеза и верификации моделей с параметрами по умолчанию (режим 3.5). ')) AADD(aHelp, L(' 6. Посмотреть сформированные модели в режиме 5.5. ')) AADD(aHelp, L(' 7. Посмотреть достоверность моделей в режиме 4.1.3.6. ')) AADD(aHelp, L(' 8. Посмотреть частотные распределения уровней сходства при истинно и ложно положительных и отрицательных решениях (режим 4.1.3.11).')) AADD(aHelp, L(' 9. Сделать текущей наиболее достоверную модель по L2-критерию (в режиме 5.6). ')) AADD(aHelp, L('10. Провести распознавание в наиболее достоверной модели в режиме 4.1.2. ')) AADD(aHelp, L('11. Посмотреть результаты распознавания в режимах 4.1.3. ')) AADD(aHelp, L('12. Провести анализ наиболее достоверной модели в 4-й подсистеме. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-20, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 1.3. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******************************************************************** ******** Создать новое пустое приложение ******** и добавить запись с информацией о нем в конец БД Appls.dbf ******** и сделать новое приложение текущим ******** Новое приложение создавать по пути на группу приложений ### ******************************************************************** FUNCTION ADD_ZAPPL(M_NameAppl) aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) * DC_DataRest( aSave_adds ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) // использовать путь на группу приложений // Удалить отметку предыдущих преложений как текущих CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW SELECT Appls DBGOTOP() DO WHILE .NOT. EOF() REPLACE By_default WITH " " DBSKIP(1) ENDDO // Создать запись нового приложения и отметить его как текущее APPEND BLANK REPLACE Kod_AdmApp WITH M_KodAdmAppls REPLACE Kod_Appl WITH RECNO() REPLACE By_default WITH "W" REPLACE Name_Appl WITH ALLTRIM(M_NameAppl) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() // Имя папки с данным приложением в папке со всеми приложениями M_PuthAppl = "A"+STRTRAN(STR(RECNO(),7)," ","0") // Полный путь на основную папку конкретного приложения // а в ней могут быть еще папки для итераций или частных моделей // с разными параметрами, например, с разным числом градаций в шкалах * MsgBox(M_ApplsPath) REPLACE Path_Appl WITH UPPER(ALLTRIM(M_ApplsPath))+"\"+UPPER(ALLTRIM(M_PuthAppl))+"\System\" IF FILEDATE(M_ApplsPath,16) = CTOD("//") DIRMAKE(M_ApplsPath) ENDIF DIRCHANGE(M_ApplsPath) IF FILEDATE(M_PuthAppl,16) = CTOD("//") DIRMAKE(M_PuthAppl) ENDIF DIRCHANGE(M_PuthAppl) IF FILEDATE("System",16) = CTOD("//") DIRMAKE("System") ENDIF // Перейти в папку приложения и записать файл с его наименованием DIRCHANGE(Appls->Path_Appl) DC_ASave(M_NameAppl, "_NameAppl.arx") DIRCHANGE(Disk_dir) * aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DC_DataRest( aSave_adds ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE USERS INDEX ON Kod_AdmApp TO USERS CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW INDEX ON Kod_AdmApp TO APPLS USE USERS INDEX USERS EXCLUSIVE SELECT Users DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.прил. и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE *DBGOTOP();DBGOBOTTOM();DBGOTOP() USE APPLS INDEX APPLS EXCLUSIVE NEW SELECT Appls RETURN(UPPER(ALLTRIM(M_ApplsPath))+"\"+UPPER(ALLTRIM(M_PuthAppl))+"\System\") ********************************************************** ******** Добавить учебные приложения (лабораторные работы) ********************************************************** FUNCTION AddsAppls() LOCAL GetList[0], lOk:=.t. LOCAL lCancelled := .F. PUBLIC FlagAppl := .F. // Если .T. - новое приложение, если .F. - то уже имеющееся IF FILE("_InstLab.arx") // Файл с информацией о том, какие лаб.работы были установлены прошлый раз aInstLab = DC_ARestore("_InstLab.arx") ELSE AFILL(aInstLab, .F.) DC_ASave(aInstLab, "_InstLab.arx") ENDIF IF FILE("_CurrLab.arx") // Файл с информацией о том, какая лаб.работа прошлый раз была выбрана для установки M_CurrLab = DC_ARestore("_CurrLab.arx") ELSE M_CurrLab = 1 DC_ASave(M_CurrLab, "_CurrLab.arx") ENDIF IF .NOT. FILE("PathGrAp.dbf") GenDbfPaths() ENDIF IF .NOT. FILE("Appls.dbf") GenDbfAppls() ENDIF ****** Задание лабораторных работ для инсталляции nRadio = 1 @ 0, 0 DCGROUP oGroup1 CAPTION L('Задайте, каким путем устанавливать учебные приложения (лабораторные работы):') SIZE 119.0, 18.5 @ 1, 2 DCRADIO nRadio VALUE 1 PROMPT L('1. Лаб.работы 1-го типа, устанавливаемые путем КОПИРОВАНИЯ готовых баз данных учебного приложения:') PARENT oGroup1 @ 2, 2 DCRADIO nRadio VALUE 2 PROMPT L('2. Лаб.работы 2-го типа, устанавливаемые путем РАСЧЕТА исходных баз данных учебного приложения:' ) PARENT oGroup1 @ 3, 2 DCRADIO nRadio VALUE 3 PROMPT L('3. Лаб.работы 3-го типа, устанавливаемые путем ВВОДА из внешних баз исходных данных:' ) PARENT oGroup1 @ 4, 2 DCRADIO nRadio VALUE 4 PROMPT L('4. Лаб.работы 4-го типа, устанавливаемые путем СКАЧИВАНИЯ исходных данных из INTERNET:' ) PARENT oGroup1 @ 6, 1 DCGROUP oGroup2 CAPTION L('1. Лаб.работы 1-го типа, устанавливаемые путем КОПИРОВАНИЯ готовых баз данных учебного приложения:') SIZE 117.0, 11.5 PARENT oGroup1 HIDE {|| nRadio<>1 } @ 1, 2 DCCHECKBOX aInstLab[ 1] PROMPT L('Лаб.раб.№ 1.01: Прогноз пунктов назначения ж/д составов ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 2, 2 DCCHECKBOX aInstLab[ 2] PROMPT L('Лаб.раб.№ 1.02: Прогноз учебных достижений студентов на основе их имиджа ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 3, 2 DCCHECKBOX aInstLab[ 3] PROMPT L('Лаб.раб.№ 1.03: Прогноз учебных достижений студентов на основе их почерка ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 4, 2 DCCHECKBOX aInstLab[ 4] PROMPT L('Лаб.раб.№ 1.04: Прогноз учебн.дост.студ. на основе их социального статуса ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 5, 2 DCCHECKBOX aInstLab[ 5] PROMPT L('Лаб.раб.№ 1.05: Идентификация трехмерных тел по их проекциям ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 6, 2 DCCHECKBOX aInstLab[ 6] PROMPT L('Лаб.раб.№ 1.06: Идентификация правильных тел Платона по их признакам ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 7, 2 DCCHECKBOX aInstLab[ 7] PROMPT L('Лаб.раб.№ 1.07: Идентификация символов по их признакам ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 8, 2 DCCHECKBOX aInstLab[ 8] PROMPT L('Лаб.раб.№ 1.08: Прогнозирование и принятие решений в растениеводстве ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 9, 2 DCCHECKBOX aInstLab[ 9] PROMPT L('Лаб.раб.№ 1.09: Идентификация респондентов по астрономическим данным ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @10, 2 DCCHECKBOX aInstLab[10] PROMPT L('Лаб.раб.№ 1.10: Идентификация места по признакам (на примере остановок транспорта) ') PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } // Репозитарий UCI @ 1,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.01') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_01.htm")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 2,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.02') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_02.htm")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 3,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.03') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_03.htm")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 4,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.04') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_04.htm")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 5,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.05') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_08.htm")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 6,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.06') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2012/05/pdf/18.pdf")} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 7,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.07') SIZE 22, 1 ACTION {||TheoryLW1_07()} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 8,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.08') SIZE 22, 1 ACTION {||TheoryLW1_08()} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 9,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.09') SIZE 22, 1 ACTION {||TheoryLW1_09()} PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @10,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 1.10') SIZE 22, 1 ACTION {||Razrab() } PARENT oGroup2 EDITPROTECT {|| nRadio<>1 } HIDE {|| nRadio<>1 } @ 6, 1 DCGROUP oGroup3 CAPTION L('2. Лаб.работы 2-го типа, устанавливаемые путем РАСЧЕТА исходных баз данных учебного приложения:') SIZE 117.0, 11.5 PARENT oGroup1 HIDE {|| nRadio<>2 } @ 1, 2 DCRADIO M_CurrLab VALUE 11 PROMPT L('Лаб.раб.№ 2.01: Исследование RND-модели, аналогичной текущей ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 2, 2 DCRADIO M_CurrLab VALUE 12 PROMPT L('Лаб.раб.№ 2.02: Исследование свойств нат.чисел при разл.объемах выборки ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 3, 2 DCRADIO M_CurrLab VALUE 13 PROMPT L('Лаб.раб.№ 2.03: Исследование детерминации свойств системы ее структурой ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 4, 2 DCRADIO M_CurrLab VALUE 14 PROMPT L('Лаб.раб.№ 2.04: Исследование зашумленных когнитивных функций ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 5, 2 DCRADIO M_CurrLab VALUE 15 PROMPT L('Лаб.раб.№ 2.05: Исследование нормального распределения ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 6, 2 DCRADIO M_CurrLab VALUE 16 PROMPT L('Лаб.раб.№ 2.06: АСК-анализ изображений (на примере символов) ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 7, 2 DCRADIO M_CurrLab VALUE 17 PROMPT L('Лаб.раб.№ 2.07: Оценка стоимости квартир по параметрам квартиры, дома и района ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 8, 2 DCRADIO M_CurrLab VALUE 18 PROMPT L('Лаб.раб.№ 2.08: АСК-анализ числовых и символьных рядов, в т.ч. псевдослучаных чисел ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 9, 2 DCRADIO M_CurrLab VALUE 19 PROMPT L('Лаб.раб.№ 2.09: Исследование RND-модели при различных объемах выборки ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @10, 2 DCRADIO M_CurrLab VALUE 20 PROMPT L('Лаб.раб.№ 2.10: в процессе разработки ') PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 1,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.01') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_10.htm")} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 2,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.02') SIZE 22, 1 ACTION {||TheoryLW2_02()} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 3,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.03') SIZE 22, 1 ACTION {||TheoryLW2_03()} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 4,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.04') SIZE 22, 1 ACTION {||TheoryLW2_04()} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 5,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.05') SIZE 22, 1 ACTION {||Razrab() } PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 6,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.06') SIZE 22, 1 ACTION {||HelpASCAimages()} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 7,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.07') SIZE 22, 1 ACTION {||Razrab() } PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 8,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.08') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2014/05/pdf/22.pdf")} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 9,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.09') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/aidos06_lab/lab_10.htm")} PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @10,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 2.10') SIZE 22, 1 ACTION {||Razrab() } PARENT oGroup3 EDITPROTECT {|| nRadio<>2 } HIDE {|| nRadio<>2 } @ 6, 1 DCGROUP oGroup4 CAPTION L('3. Лаб.работы 3-го типа, устанавливаемые путем ВВОДА из внешних баз исходных данных:') SIZE 117.0, 11.5 PARENT oGroup1 HIDE {|| nRadio<>3 } @ 1, 2 DCRADIO M_CurrLab VALUE 21 PROMPT L('Лаб.раб.№ 3.01: Идентификация слов по входящим в них буквам ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 2, 2 DCRADIO M_CurrLab VALUE 22 PROMPT L('Лаб.раб.№ 3.02: Атрибуция анонимных и псевдонимных текстов ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 3, 2 DCRADIO M_CurrLab VALUE 23 PROMPT L('Лаб.раб.№ 3.03: Идентификация предметов по их признакам ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 4, 2 DCRADIO M_CurrLab VALUE 24 PROMPT L('Лаб.раб.№ 3.04: Оценка автомобилей с пробегом по их характеристикам ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 5, 2 DCRADIO M_CurrLab VALUE 25 PROMPT L('Лаб.раб.№ 3.05: Оценка квартир по параметрам квартиры, дома и района ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 6, 2 DCRADIO M_CurrLab VALUE 26 PROMPT L('Лаб.раб.№ 3.06: Прогнозирование и принятие решений в зерновом производстве ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 7, 2 DCRADIO M_CurrLab VALUE 27 PROMPT L('Лаб.раб.№ 3.07: Принятие решений по конфигурированию системы безопасности MS Windows ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 8, 2 DCRADIO M_CurrLab VALUE 28 PROMPT L('Лаб.раб.№ 3.08: Управление номенклатурой и объемами реализации продукции (бенчмаркинг)') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 9, 2 DCRADIO M_CurrLab VALUE 29 PROMPT L('Лаб.раб.№ 3.09: Автоматизированный SWOT-анализ и реинжиниринг бизнес процессов ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @10, 2 DCRADIO M_CurrLab VALUE 30 PROMPT L('Лаб.раб.№ 3.10: Прогноз рисков ДТП и страховых выплат в системе ОСАГО (андеррайтинг) ') PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 1,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.01') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2004/02/pdf/12.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 2,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.02') SIZE 22, 1 ACTION {||TheoryLW3_02()} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 3,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.03') SIZE 22, 1 ACTION {||Razrab()} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 4,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.04') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2013/10/pdf/36.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 5,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.05') SIZE 22, 1 ACTION {||Razrab()} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 6,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.06') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2010/05/pdf/07.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 7,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.07') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2010/05/pdf/06.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 8,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.08') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2010/05/pdf/08.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 9,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.09') SIZE 22, 1 ACTION {||TheoryLW3_09()} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @10,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 3.10') SIZE 22, 1 ACTION {||DC_SpawnUrl("http://ej.kubagro.ru/2007/05/pdf/08.pdf")} PARENT oGroup4 EDITPROTECT {|| nRadio<>3 } HIDE {|| nRadio<>3 } @ 6, 1 DCGROUP oGroup5 CAPTION L('4. Лаб.работы 4-го типа, устанавливаемые путем СКАЧИВАНИЯ исходных данных из INTERNET:') SIZE 117.0, 11.5 PARENT oGroup1 HIDE {|| nRadio<>4 } @ 1, 2 DCRADIO M_CurrLab VALUE 31 PROMPT L('Лаб.раб.№ 4.01: АСК-анализ мирового времени по данным сайта: "ftp://tai.bipm.org" ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 2, 2 DCRADIO M_CurrLab VALUE 32 PROMPT L('Лаб.раб.№ 4.02: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 3, 2 DCRADIO M_CurrLab VALUE 33 PROMPT L('Лаб.раб.№ 4.03: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 4, 2 DCRADIO M_CurrLab VALUE 34 PROMPT L('Лаб.раб.№ 4.04: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 5, 2 DCRADIO M_CurrLab VALUE 35 PROMPT L('Лаб.раб.№ 4.05: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 6, 2 DCRADIO M_CurrLab VALUE 36 PROMPT L('Лаб.раб.№ 4.06: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 7, 2 DCRADIO M_CurrLab VALUE 37 PROMPT L('Лаб.раб.№ 4.07: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 8, 2 DCRADIO M_CurrLab VALUE 38 PROMPT L('Лаб.раб.№ 4.08: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 9, 2 DCRADIO M_CurrLab VALUE 39 PROMPT L('Лаб.раб.№ 4.09: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @10, 2 DCRADIO M_CurrLab VALUE 40 PROMPT L('Лаб.раб.№ 4.10: в процессе разработки ') PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 1,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.01') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 2,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.02') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 3,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.03') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 4,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.04') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 5,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.05') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 6,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.06') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 7,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.07') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 8,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.08') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @ 9,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.09') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } @10,92 DCPUSHBUTTON CAPTION L('Теория по Лаб.раб.№ 4.10') SIZE 22, 1 ACTION {|| Razrab() } PARENT oGroup5 EDITPROTECT {|| nRadio<>4 } HIDE {|| nRadio<>4 } // Добавить новые лаб.работы: 1 расчетную и 9 основанных на исходных данных из Internet. @19, 0 DCGROUP oGroup6 CAPTION L('Как задавать лабораторные работы для изучения') SIZE 119.0, 5.5 @ 1, 2 DCSAY L('Задайте, какие лабораторные работы устанавливать. Для каждой лабораторной работы будет создана новая папка с числовым именем в папке с базовой ') PARENT oGroup6 @ 2, 2 DCSAY L('группой приложений AID_DATA, путь на которую задан в БД PathGrAp.DBF, а также новая запись в БД Appls.dbf с названием учебного приложения и путем ') PARENT oGroup6 @ 3, 2 DCSAY L('на него. После завершения установки лабораторных работ необходимо задать одну из них в качестве текущей и выполнить синтез моделей в 3-й подистеме.') PARENT oGroup6 @ 4, 2 DCSAY L('Описания лабораторных работ есть на сайте автора: http://lc.kubagro.ru/aidos/aidos06_lab/, а также по адресу: http://www.twirpx.com/file/38266/ ') PARENT oGroup6 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; ADDBUTTONS; OPTIONS GetOptions ; MODAL ; TITLE L('1.3. Задание лабораторных работ для инсталляции') ******************************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ******************************************************************** DC_ASave(aInstLab , "_InstLab.arx") // Файл с информацией о том, установка каких лаб.работ с копируемыми БД задана DC_ASave(M_CurrLab, "_CurrLab.arx") // Файл с информацией о выбранной лабораторной работе с формируемыми БД *LB_Warning(STR(M_CurrLab,19)) *DC_DebugQout( aInstLab, M_CurrLab) IF nRadio = 1 .AND. ASCAN(aInstLab, .T.) = 0 LB_Warning(L("Ни одной лабораторной работы не задано для установки!")) RETURN NIL ENDIF IF nRadio = 2 IF M_CurrLab < 11 .OR. M_CurrLab > 20 LB_Warning(L("Ни одной лабораторной работы не задано для установки!")) RETURN NIL ENDIF ENDIF IF nRadio = 3 IF M_CurrLab < 21 .OR. M_CurrLab > 30 LB_Warning(L("Ни одной лабораторной работы не задано для установки!")) RETURN NIL ENDIF aMess := {} AADD(aMess,L('Сейчас все файлы из папки: '+Disk_dir+'\AID_DATA\Inp_data\ будут удалены!')) AADD(aMess,L('Если какие-то из них нужны, скопируйте их в другое место и нажимите: "OK"')) LB_Warning(aMess) Zap_InpData() // Удалить все файлы из папки Inp_data ENDIF IF nRadio = 4 IF M_CurrLab < 31 .OR. M_CurrLab > 40 LB_Warning(L("Ни одной лабораторной работы не задано для установки!")) RETURN NIL ENDIF ENDIF ***************************************************************************************************** ***************************************************************************************************** // УСТАНОВКА ЛАБОРАТОРНЫХ РАБОТ ******************************** ***************************************************************************************************** ********* Наименования лабораторных работ // Номер ЛР aLabWName := {L('Лаб.раб.№ 1.01: Прогноз пунктов назначения ж/д составов' ),; // 01 // 1. Лаб.работы, устанавливаемые путем КОПИРОВАНИЯ готовых баз данных учебного приложения: L('Лаб.раб.№ 1.02: Прогноз учебных достижений студентов на основе их имиджа' ),; // 02 L('Лаб.раб.№ 1.03: Прогноз учебных достижений студентов на основе их почерка' ),; // 03 L('Лаб.раб.№ 1.04: Прогноз учебн.дост.студ. на основе их социального статуса' ),; // 04 L('Лаб.раб.№ 1.05: Идентификация трехмерных тел по их проекциям' ),; // 05 L('Лаб.раб.№ 1.06: Идентификация правильных тел Платона по их признакам' ),; // 06 L('Лаб.раб.№ 1.07: Идентификация символов по их признакам' ),; // 07 L('Лаб.раб.№ 1.08: Прогнозирование и принятие решений в растениеводстве' ),; // 08 L('Лаб.раб.№ 1.09: Идентификация респондентов по астрономическим данным' ),; // 09 L('Лаб.раб.№ 1.10: Идентификация места по признакам (на примере остановок)' ),; // 10 Новая L('Лаб.раб.№ 2.01: Исследование RND-модели, аналогичной текущей' ),; // 11 // 2. Лаб.работы, устанавливаемые путем РАСЧЕТА исходных баз данных учебного приложения: L('Лаб.раб.№ 2.02: Исследование свойств нат.чисел при разл.объемах выборки' ),; // 12 L('Лаб.раб.№ 2.03: Исследование детерминации свойств системы ее структурой' ),; // 13 L('Лаб.раб.№ 2.04: Исследование зашумленных когнитивных функций' ),; // 14 L('Лаб.раб.№ 2.05: Исследование нормального распределения' ),; // 15 L('Лаб.раб.№ 2.06: АСК-анализ изображений (на примере символов)' ),; // 16 Новая L('Лаб.раб.№ 2.07: В процессе разработки' ),; // 17 Новая L('Лаб.раб.№ 2.08: АСК-анализ числовых и символьных рядов, в т.ч. псевдослучаных чисел' ),; // 18 Новая L('Лаб.раб.№ 2.09: Исследование RND-модели при различных объемах выборки' ),; // 19 Новая L('Лаб.раб.№ 2.10: в процессе разработки' ),; // 20 Новая L('Лаб.раб.№ 3.01: Идентификация слов по входящим в них буквам' ),; // 21 // 3. Лаб.работы, устанавливаемые путем ВВОДА из внешних баз данных с помощью программного интерфейса: L('Лаб.раб.№ 3.02: Атрибуция анонимных и псевдонимных текстов' ),; // 22 L('Лаб.раб.№ 3.03: Идентификация предметов по их признакам' ),; // 23 L('Лаб.раб.№ 3.04: Оценка автомобилей с пробегом по их характеристикам' ),; // 24 L('Лаб.раб.№ 3.05: Оценка квартир по параметрам квартиры, дома и района' ),; // 25 L('Лаб.раб.№ 3.06: Прогнозирование и принятие решений в зерновом производстве' ),; // 26 Новая L('Лаб.раб.№ 3.07: Принятие решений по конфигурированию системы безопасности MS Windows' ),; // 27 Новая L('Лаб.раб.№ 3.08: Управление номенклатурой и объемами реализации продукции (бенчмаркинг)'),; // 28 Новая L('Лаб.раб.№ 3.09: Автоматизированный SWOT-анализ и реинжиниринг бизнес процессов' ),; // 29 Новая L('Лаб.раб.№ 3.10: Прогноз рисков ДТП и страховых выплат в системе ОСАГО (андеррайтинг)' ),; // 30 Новая L('Лаб.раб.№ 4.01: АСК-анализ мирового времени по данным сайта: "ftp://tai.bipm.org"' ),; // 31 Новая L('Лаб.раб.№ 4.02: в процессе разработки' ),; // 32 Новая L('Лаб.раб.№ 4.03: в процессе разработки' ),; // 33 Новая L('Лаб.раб.№ 4.04: в процессе разработки' ),; // 34 Новая L('Лаб.раб.№ 4.05: в процессе разработки' ),; // 35 Новая L('Лаб.раб.№ 4.06: в процессе разработки' ),; // 36 Новая L('Лаб.раб.№ 4.07: в процессе разработки' ),; // 37 Новая L('Лаб.раб.№ 4.08: в процессе разработки' ),; // 38 Новая L('Лаб.раб.№ 4.09: в процессе разработки' ),; // 39 Новая L('Лаб.раб.№ 4.10: в процессе разработки' ) } // 40 Новая *@ 1, 2 DCRADIO nRadio VALUE 1 PROMPT L('1. Лаб.работы 1-го типа, устанавливаемые путем КОПИРОВАНИЯ готовых баз данных учебного приложения:') PARENT oGroup1 *@ 2, 2 DCRADIO nRadio VALUE 2 PROMPT L('2. Лаб.работы 2-го типа, устанавливаемые путем РАСЧЕТА исходных баз данных учебного приложения:' ) PARENT oGroup1 *@ 3, 2 DCRADIO nRadio VALUE 3 PROMPT L('3. Лаб.работы 3-го типа, устанавливаемые путем ВВОДА из внешних баз исходных данных:' ) PARENT oGroup1 *@ 4, 2 DCRADIO nRadio VALUE 4 PROMPT L('4. Лаб.работы 4-го типа, устанавливаемые путем СКАЧИВАНИЯ исходных данных из INTERNET:' ) PARENT oGroup1 DO CASE CASE nRadio=1 // 1. Лаб.работы 1-го типа, устанавливаемые путем КОПИРОВАНИЯ готовых баз данных учебного приложения // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego // Задание максимальной величины параметра Time Wsego = 0 FOR M_CurrLab=1 TO 10 // В этой версии 10 Лаб.работ устанавливается путем копирования БД IF aInstLab[M_CurrLab] // Путь на исходные БД лабораторной работы M_PathLabW = UPPER(ALLTRIM(M_ApplsPath)) + "\LabWorks\LabW"+STRTRAN(STR(M_CurrLab,4)," ","0")+"\" // Кол-во ВСЕХ файлов в папке Лаб.работы № M_CurrLab N_All = ADIR(M_PathLabW+"*.*") Wsego = Wsego + N_All ENDIF NEXT // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,11.5 ; PARENT oTabPage1 @13,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105, 5.0 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lCancelled:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('1.3. Установка заданных из 30 учебных приложений (лабораторных работ)') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ********************************************************************************************************* // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // УСТАНОВКА ЛАБОРАТОРНЫХ РАБОТ ******************************** N_InsLPlan = 0 // Кол-во заданных на установку лабораторных работ (план) N_InsLFakt = 0 // Кол-во фактически установленных лабораторных работ (факт) aFlag := {} // Признак, что лаб.раб.установлена FOR j=1 TO 9 IF aInstLab[j] ++N_InsLPlan // Кол-во заданных на установку лабораторных работ (план) AADD(aFlag,.T.) ELSE AADD(aFlag,.F.) ENDIF NEXT ***************************************************************************************************** // Лаб.работы, устанавливаемые копированием готовых исходных БД: // Для лаб.работ №№1-10 // Исходные БД лаб.работы брать из папки: d:\ALASKA\AIDOS-X\AID_DATA\LabWorks\LabW####\, где: ####-номер лаб.работы // и копировать их в папку: d:\ALASKA\AIDOS-X\AID_DATA\########\, где: ########-номер приложения // Информацию о новом приложении вносить в БД Appls.dbf. Сделать массив имен копируемых файлов. // Файлы Лаб.работ уже должны быть в новом стандарте. Преобразовать их из старого стандарта // в новый и скопировать их в LabWorks\LabW#### надо самому (OldAppls, 5_1) * DIRCHANGE(M_ApplsPath) // Перейти в папку с БД приложений DIRCHANGE(Disk_dir+'\AID_DATA\') // Перейти в папку с БД с системой и баами данных ЛР IF FILEDATE("LabWorks",16) = CTOD("//") DIRMAKE("LabWorks") DIRCHANGE("LabWorks") // Перейти в папку с исходными БД лабораторных работ FOR j=1 TO 30 M_Name = "LabW"+STRTRAN(STR(j,4)," ","0") IF FILEDATE("M_Name",16) = CTOD("//") DIRMAKE(M_Name) ENDIF NEXT Mess = L('В папке с БД приложений "#" не было папки LabWorks для исходных БД лабораторных работ. Обратитесь за ними к разработчику!') Mess = STRTRAN(Mess, "#", UPPER(ALLTRIM(M_ApplsPath))) LB_Warning(Mess, L("1.3. Установка лабораторных работ" )) DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF // Операции, общие для установки первых 9 Лаб.работ, // устанавливаемых путем копирования исходных БД: aFileNameMin := {"Classes.dbf",; "Opis_Sc.dbf",; "Gr_OpSc.dbf",; "Obi_Zag.dbf",; "ObI_Kcl.dbf",; "Obi_Kpr.dbf",; "Rso_Zag.dbf",; "Rso_Kcl.dbf",; "Rso_Kpr.dbf" } // Копировать в папку приложения ВСЕ файлы из папки с исходными файлами Лаб.работы FOR M_CurrLab = 1 TO 9 // В этой версии 10 Лаб.работ устанавливается путем копирования БД (сделать 10 - остановки трамваев) DC_CompleteEvents() // Обработка события Cancel ************* Прерывание процесса по нажатию Cancel ############################################## IF lCancelled // Прерывание процесса по нажатию Cancel LB_Warning(L("Процесс установки учебных приложений был прерван пользователем !!!")) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() * aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DC_DataRest( aSave_adds ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE USERS INDEX ON Kod_AdmApp TO USERS CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE APPLS NEW INDEX ON Kod_AdmApp TO APPLS USE USERS INDEX USERS EXCLUSIVE SELECT Users DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.прил. и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(L("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE *DBGOTOP();DBGOBOTTOM();DBGOTOP() USE APPLS INDEX APPLS EXCLUSIVE NEW SELECT Appls RETURN NIL ENDIF ************* Прерывание процесса по нажатию Cancel ############################################## IF aInstLab[M_CurrLab] aSay[M_CurrLab]:SetCaption(aLabWName[M_CurrLab]) // Путь на исходные БД лабораторной работы * M_PathLabW = UPPER(ALLTRIM(M_ApplsPath)) + "\LabWorks\LabW"+STRTRAN(STR(M_CurrLab,4)," ","0")+"\" M_PathLabW = UPPER(ALLTRIM(Disk_dir+'\AID_DATA')) + "\LabWorks\LabW"+STRTRAN(STR(M_CurrLab,4)," ","0")+"\" // Лаб.раб. в папке с системой N_All = ADIR(M_PathLabW+"*.*") PRIVATE aFileNameAll[N_All] ADIR(M_PathLabW+"*.*",aFileNameAll) // Имена ВСЕХ файлов в папке Лаб.работы ASORT(aFileNameAll) IF N_All > 0 // Проверка наличия всех исходных БД устанавливаемой лабораторной работы FOR j=1 TO LEN(aFileNameMin) Name_SS = M_PathLabW+aFileNameMin[j] IF .NOT. FILE(Name_SS) // Существует ли обязательная исходная БД aFlag[M_CurrLab] = .F. ENDIF NEXT // Если все обязательные исходные БД Лаб.работы существуют, то создание нового приложения // и копирование ВСЕХ ФАЙЛОВ Лаб.работы (а не только обязательных) в папку нового приложения IF .NOT. aFlag[M_CurrLab] aSay[M_CurrLab]:SetCaption(aSay[M_CurrLab]:caption+L(' - Нет исходных БД')) ELSE // Создать папку приложения - новой лабораторной работы // Путь на БД новой лабораторной работы в папке приложений M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) FOR j=1 TO LEN(aFileNameAll) Name_SS = M_PathLabW+aFileNameAll[j] Name_DD = M_NewAppl +aFileNameAll[j] * LB_Warning(L("Источник: "+Name_SS+", приемник: "+Name_DD)) COPY FILE (Name_SS) TO (Name_DD) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT // Добавить информацию о новом учебном приложении в БД Appls.dbf SELECT Appls ++N_InsLFakt aSay[M_CurrLab]:SetCaption(aSay[M_CurrLab]:caption+L(' - Готово ')) ENDIF ENDIF ENDIF NEXT CASE nRadio=3 // 3. Лаб.работы 3-го типа, устанавливаемые путем ВВОДА из внешних баз исходных данных с помощью программного интерфейса 2.3.2.2. DIRCHANGE(M_ApplsPath) // Перейти в папку с БД приложений IF FILEDATE("LabWorks",16) = CTOD("//") DIRMAKE("LabWorks") DIRCHANGE("LabWorks") // Перейти в папку с исходными БД лабораторных работ FOR j=21 TO 30 M_Name = "LabW"+STRTRAN(STR(j,4)," ","0") IF FILEDATE("M_Name",16) = CTOD("//") DIRMAKE(M_Name) ENDIF NEXT Mess = L('В папке с БД приложений "#" не было папки LabWorks для исходных БД лабораторных работ. Обратитесь за ними к разработчику!') Mess = STRTRAN(Mess, "#", UPPER(ALLTRIM(M_ApplsPath))) LB_Warning(Mess, L("1.3. Установка лабораторных работ") ) DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF aFileNameMin := {"Inp_data.xls",; // Файлы для копирования "_2_3_2_2.arx" } M_PathLabW = UPPER(ALLTRIM(M_ApplsPath)) + "\LabWorks\LabW"+STRTRAN(STR(M_CurrLab,4)," ","0")+"\" // Путь на исходные БД лабораторной работы // Если файлы для копирования существуют, то создание нового приложения // и копирование этих файлов в папку нового приложения и в папку системы Name_SS1 = M_PathLabW+"Inp_data.xls" Name_SS2 = M_PathLabW+"_2_3_2_2.arx" IF .NOT. FILE(Name_SS1) aMess := {} AADD(aMess, L('Файла: "'+Name_SS1+'" не существует!')) AADD(aMess, L('Варианты решения проблемы:')) AADD(aMess, L('1. Скачать лабораторную работу из облака в режиме 1.3, если она там есть.')) AADD(aMess, L('2. Скачать полную инсталляцию системы с сайта разработчика: http://lc.kubagro.ru/aidos/_Aidos-X.htm')) AADD(aMess, L('3. Обратиться к разработчику по электронной почте: prof.lutsenko@gmail.com')) AADD(aMess, L('4. Изучить другую лабораторную работу, например 2-го типа (в которых исх.данные рассчитываются).')) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF IF .NOT. FILE(Name_SS2) aMess := {} AADD(aMess, L("Файла: "+Name_SS2+" не существует!")) AADD(aMess, L("Обращайтесь к разработчику или" )) AADD(aMess, L("скачивайте лаб.работу из облака!" )) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF // Создать папку приложения - новой лабораторной работы *** Потом в 2.3.2.2 эта папка создается повторно, поэтому здесь ее создавать не надо, или наоборот здесь создавать, а в 2.3.2.2 не надо ########## M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) // Путь на БД новой лабораторной работы в папке приложений и наименование ЛР в БД приложений // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки ******** Копирование файлов из папки лаб.работы в папки для работы Name_SS1 = M_PathLabW+"Inp_data.xls" Name_SS2 = M_PathLabW+"_2_3_2_2.arx" Name_DD1 = M_NewAppl +"Inp_data.xls" Name_DD2 = Disk_dir +"\Aid_data\Inp_data\Inp_data.xls" IF FILE( Name_DD2 ) IF IsFileOpened( Name_DD2 ) aMess := {} AADD(aMess, L('Файл # используется внешней программой!' )) AADD(aMess, L('Пожалуйста, закройте его и повторите операцию!')) aMess[1] = STRTRAN(aMess[1], "#", ALLTRIM(Name_DD2) ) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Del_Appl() // Удалить недосозданное приложение Running(.F.) RETURN NIL ENDIF ENDIF * LB_Warning(L("Источник: "+Name_SS1+", приемник: "+Name_DD1) * LB_Warning(L("Источник: "+Name_SS1+", приемник: "+Name_DD2) * COPY FILE (Name_SS1) TO (Name_DD1) COPY FILE (Name_SS1) TO (Name_DD2) Name_SS2 = M_PathLabW+"_2_3_2_2.arx" Name_DD3 = M_NewAppl +"_2_3_2_2.arx" // Папка приложений Name_DD4 = Disk_dir +"\_2_3_2_2.arx" // Папка системы * LB_Warning(L("Источник: "+Name_SS2+", приемник: "+Name_DD3) * LB_Warning(L("Источник: "+Name_SS2+", приемник: "+Name_DD4) COPY FILE (Name_SS2) TO (Name_DD3) COPY FILE (Name_SS2) TO (Name_DD4) F2_3_2_2(aLabWName[M_CurrLab],"1.3()") // Запуск универсального программного интерфейса с внешними базами данных aMess := {} mLW = ALLTRIM(aLabWName[M_CurrLab]) AADD(aMess, STRTRAN(L(mLW), ":", ': "')+L('" успешно установлена!')) AADD(aMess, L(" ")) AADD(aMess, L("Для дальнейшего ее изучения и выполнения необходимо:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Открыть файл исходных данных: "+Name_DD2+".")) AADD(aMess, L(" ")) AADD(aMess, L("2. Прочитать описание данной лабораторной работы в режиме 5.14.")) AADD(aMess, L(" ")) AADD(aMess, L("3. Выполнить режимы: 2.1, 2.2, 2.3, 3.5, 4.1.3.6, 4.1.3.1 и другие")) AADD(aMess, L(" в соответствии со схемой преобразования данных в информацию,")) AADD(aMess, L(" а ее в знания, приведенной в режиме 6.4.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) N_InsLPlan = 1 N_InsLFakt = 1 CASE nRadio=2 // 2. Лаб.работы 2-го типа, устанавливаемые путем РАСЧЕТА исходных баз данных учебного приложения N_InsLPlan = 1 // Кол-во заданных на установку лабораторных работ (план) N_InsLFakt = 0 // Кол-во фактически установленных лабораторных работ (факт) DO CASE ***************************************************************************************************** // Лаб.работы, устанавливаемые путем расчета исходных БД: CASE M_CurrLab=11 // Лаб.раб.№ 11: Исследование RND-модели при различных объемах выборки // Перейти в папку выбранного приложения, если оно есть, узнать параметры модели, // а если его нет - задать параметры модели по умолчанию IF ApplChange("") nRadio1 := 2 // Нет текущего приложения, задавать параметры вручную N_Csc = 10 // Кол-во класс.шкал N_Gcs = 30 // Суммарное кол-во градаций клас.шкал (классов) N_Osc = 10 // Кол-во опис.шкал N_Gos = 30 // Суммарное кол-во градаций опис.шкал (признаков) N_Obj = 30 // Кол-во объектов обучающей выборки N_AvrGcs = 5 // Кол-во классов в объекте обучающей выборки N_AvrGos = 20 // Кол-во признаков в объекте обучающей выборки N_AvrGrCs = 3 // Кол-во градаций в клас.шкале N_AvrGrOs = 3 // Кол-во градаций в опис.шкале N_Cls = N_Gcs N_ObiKcl = N_AvrGcs*N_Obj/4 // Кол-во записей в БД кодов классов обучающей выборки N_ObiKpr = N_AvrGos*N_Obj/7 // Кол-во записей в БД кодов признаков обучающей выборки ELSE nRadio1 := 1 // Есть текущее приложение, определять параметры автоматически с возможностью последующей корректировки CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW;N_Csc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_Gcs = RECCOUNT();N_Cls = N_Gcs USE Opis_Sc EXCLUSIVE NEW;N_Osc = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Obi_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Obi_Kcl EXCLUSIVE NEW;N_ObiKcl = RECCOUNT() // Кол-во записей в БД кодов классов обучающей выборки USE Obi_Kpr EXCLUSIVE NEW;N_ObiKpr = RECCOUNT() // Кол-во записей в БД кодов признаков обучающей выборки N_AvrGcs = N_ObiKcl/N_Obj*4 N_AvrGos = N_ObiKpr/N_Obj*7 N_AvrGrCs = N_Gcs/N_Csc N_AvrGrOs = N_Gos/N_Osc ENDIF @ 0,0 DCGROUP oGroup1 CAPTION L('Задание параметров RND-модели:') SIZE 98, 34 @ 1-0.2,2 DCRADIO nRadio1 VALUE 1 PROMPT L('Определить автоматически на основе текущего приложения') PARENT oGroup1 @ 2-0.2,2 DCRADIO nRadio1 VALUE 2 PROMPT L('Задать произвольные параметры RND-модели вручную' ) PARENT oGroup1 @ 4-0.7,1 DCGROUP oGroup2 CAPTION L('Автоматическое определение параметров RND-модели на основе текущего приложения') SIZE 96, 11.5 PARENT oGroup1 HIDE {|| .NOT.nRadio1=1 } Mess1 = L('<- Количество классификационных шкал в RND_модели' ) Mess2 = L('<- Количество классов (градаций классификационных шкал) в RND-модели' ) Mess3 = L('<- Количество описательных шкал в RND_модели' ) Mess4 = L('<- Количество признаков (градаций описательных шкал) в RND-модели' ) Mess5 = L('<- Количество объектов обучающей выборки в RND-модели' ) Mess6 = L('<- Оценка среднего количества классов, к которым относится объект обучающей выборки') Mess7 = L('<- Оценка среднего количества признаков у объекта обучающей выборки' ) Mess8 = L('<- Среднее количество градаций в классификационной шкале (округлено до целых)' ) Mess9 = L('<- Среднее количество градаций в описательной шкале (округлено до целых)' ) @ 1,1 DCSAY L("Наименование текущего приложения: ")+ALLTRIM(M_NameAppl) PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 2,0.2 DCSAY N_Csc PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 3,0.2 DCSAY N_Gcs PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 4,0.2 DCSAY N_Osc PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 5,0.2 DCSAY N_Gos PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 6,0.2 DCSAY N_Obj PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 7,0.2 DCSAY N_AvrGcs PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 8,0.2 DCSAY N_AvrGos PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 9,0.2 DCSAY N_AvrGrCs PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @10,0.2 DCSAY N_AvrGrOs PARENT oGroup2 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=1 } HIDE {|| .NOT.nRadio1=1 } @ 2,24 DCSAY Mess1 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 3,24 DCSAY Mess2 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 4,24 DCSAY Mess3 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 5,24 DCSAY Mess4 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 6,24 DCSAY Mess5 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 7,24 DCSAY Mess6 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 8,24 DCSAY Mess7 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 9,24 DCSAY Mess8 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @10,24 DCSAY Mess9 PARENT oGroup2 HIDE {|| .NOT.nRadio1=1 } @ 4-0.7,1 DCGROUP oGroup3 CAPTION L('Задание произвольных параметров RND-модели вручную') SIZE 96, 11.5 PARENT oGroup1 HIDE {|| .NOT.nRadio1=2 } Mess1 = L('<- Количество классификационных шкал в RND_модели' ) Mess2 = L('<- Количество классов (градаций классификационных шкал) в RND-модели') Mess3 = L('<- Количество описательных шкал в RND_модели' ) Mess4 = L('<- Количество признаков (градаций описательных шкал) в RND-модели' ) Mess5 = L('<- Количество объектов обучающей выборки в RND-модели' ) Mess6 = L('<- Количество классов, к которым относится объект обучающей выборки' ) Mess7 = L('<- Количество признаков у объекта обучающей выборки' ) Mess8 = L('<- Количество градаций в классификационной шкале' ) Mess9 = L('<- Количество градаций в описательной шкале' ) @ 1,1 DCSAY L("Наименование текущего приложения: ")+ALLTRIM(M_NameAppl) PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 2,0.2 DCSAY L(" ") GET N_Csc PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } * @ 3,0.2 DCSAY L(" ") GET N_Gcs PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 4,0.2 DCSAY L(" ") GET N_Osc PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } * @ 5,0.2 DCSAY L(" ") GET N_Gos PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 6,0.2 DCSAY L(" ") GET N_Obj PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 7,0.2 DCSAY L(" ") GET N_AvrGcs PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 8,0.2 DCSAY L(" ") GET N_AvrGos PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 9,0.2 DCSAY L(" ") GET N_AvrGrCs PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @10,0.2 DCSAY L(" ") GET N_AvrGrOs PARENT oGroup3 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=2 } HIDE {|| .NOT.nRadio1=2 } @ 2,24 DCSAY Mess1 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 3,24 DCSAY Mess2 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 4,24 DCSAY Mess3 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 5,24 DCSAY Mess4 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 6,24 DCSAY Mess5 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 7,24 DCSAY Mess6 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 8,24 DCSAY Mess7 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @ 9,24 DCSAY Mess8 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @10,24 DCSAY Mess9 PARENT oGroup3 HIDE {|| .NOT.nRadio1=2 } @15+0.2,1 DCGROUP oGroup4 CAPTION L('Что такое RND-модель?' ) SIZE 96, 7.5 PARENT oGroup1 @23+0.1,1 DCGROUP oGroup5 CAPTION L('Зачем создается и исследуется RND-модель?') SIZE 96, 10.2 PARENT oGroup1 @ 1,2 DCSAY L('RND-модель - это модель, в которой принадлежность объектов обучающей выборки к классам является случайной, ') PARENT oGroup4 @ 2,2 DCSAY L('как и признаки объектов. Для генерации случайных кодов классов и признаков используется числовой генератор ') PARENT oGroup4 @ 3,2 DCSAY L('равномерно распределенных случайных чисел. При автоматическом определении параметров RND-модели на основе ') PARENT oGroup4 @ 4,2 DCSAY L('текущей модели количество классов, признаков и объектов обучающей выборки в RND-модели будет таким же, как ') PARENT oGroup4 @ 5,2 DCSAY L('в текущей модели. Среднее количество классов, к которым относится объект обучающей выборки и среднее коли- ') PARENT oGroup4 @ 6,2 DCSAY L('чество признаков у него также будет совпадать с этими характеристиками объектов обуч.выборки текущей модели. ') PARENT oGroup4 @ 1,2 DCSAY L('Информацию об объектах обучающей выборки текущей модели можно считать суммой полезной информации о них ') PARENT oGroup5 @ 2,2 DCSAY L('(полезный сигнал) и шума. В RND-модели вся информация представляет собой шум. Поэтому сравнение этих моделей, ') PARENT oGroup5 @ 3,2 DCSAY L('не отличающихся перечисленными параметрами, позволяет оценить влияние значимой информации и шума на результаты,') PARENT oGroup5 @ 4,2 DCSAY L('в частности убедиться в наличии самой этой значимой информации, т.е. закономерностей в предметной области, а ') PARENT oGroup5 @ 5,2 DCSAY L('также оценить эффективность различных стат.моделей и моделей знаний и интегральных критериев для выявления и ') PARENT oGroup5 @ 6,2 DCSAY L('исследования этой значимой информации, знаний и закономерностей. При увеличении объема обучающей выборки в RND-') PARENT oGroup5 @ 7,2 DCSAY L('модели вероятность верной идентификации стремится к вероятности случайного угадывания, а в реальной модели к ') PARENT oGroup5 @ 8,2 DCSAY L('некоторому пределу, превосходящему вероятность случайного угадывания и характеризующему эффективность модели ') PARENT oGroup5 @ 9,2 DCSAY ('и целесообразность ее применения. ') PARENT oGroup5 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('1.3. Задание параметров RND-модели') ************************************************************************************************** *************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF *************************************************** IF N_Csc * N_Osc * N_Gos * N_Gcs * N_Obj * N_AvrGcs * N_AvrGos * N_AvrGrOs * N_AvrGrCs = 0 LB_Warning(L("Параметры модели равные нулю недопустимы !!!")) Running(.F.) RETURN NIL ENDIF // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // Определить значение Wsego // Задание максимальной величины параметра Time ################################################# Wsego = 1 + N_Csc + N_Osc + N_Obj + 1 IF nRadio1 = 1 Wsego = N_ObiKcl + N_ObiKpr + Wsego ENDIF ************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,8.5 ; PARENT oTabPage1 @10,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 PRIVATE aSay[13] s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('1.3. Установка ')+L(ALLTRIM(aLabWName[M_CurrLab])) ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ************************************************************************************************** M_OldNAppl = "" IF nRadio1 = 1 // Определить параметры RND-модели автоматически на основе текущей модели, // добавить RND-модель с этими параметрами и сделать ее текущей IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF M_OldNAppl = UPPER(ALLTRIM(M_NameAppl)) // Наименование текущего приложения CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW;N_Csc = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_Gcs = RECCOUNT();N_Cls = N_Gcs USE Opis_Sc EXCLUSIVE NEW;N_Osc = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Obi_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Obi_Kcl EXCLUSIVE NEW;N_ObiKcl = RECCOUNT() // Кол-во записей в БД кодов классов обучающей выборки USE Obi_Kpr EXCLUSIVE NEW;N_ObiKpr = RECCOUNT() // Кол-во записей в БД кодов признаков обучающей выборки aSay[1]:SetCaption(L('Определение среднего количества классов, к которым относится объект обучающей выборки')) SELECT Obi_Kcl N_AvrGcs = 0 // Суммарное количество кодов классов в обучающей выборке DO WHILE .NOT. EOF() FOR j=2 TO 5 M_Kcl = FIELDGET(j) IF 0 < M_Kcl .AND. M_Kcl <= N_Cls // Проверка на корректность кода класса ++N_AvrGcs ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) DBSKIP(1) ENDDO // Cреднее количество классов, к которым относится объект обучающей выборки N_AvrGcs = N_AvrGcs / N_Obj aSay[1]:SetCaption(aSay[1]:caption+L(' - Готово ')) // Определение среднего количества признаков у объекта обучающей выборки aSay[2]:SetCaption(L('Определение среднего количества признаков у объекта обучающей выборки')) SELECT Obi_Kpr N_AvrGos = 0 // Суммарное количество кодов признаков в обучающей выборке DO WHILE .NOT. EOF() FOR j=2 TO 8 M_Kpr = FIELDGET(j) IF 0 < M_Kpr .AND. M_Kpr <= N_Gos // Проверка на корректность кода признака ++N_AvrGos ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) DBSKIP(1) ENDDO // Cреднее количество признаков у объекта обучающей выборки N_AvrGos = N_AvrGos / N_Obj aSay[2]:SetCaption(aSay[2]:caption+L(' - Готово ')) N_AvrGrCs = N_Gcs/N_Csc N_AvrGrOs = N_Gos/N_Osc ENDIF // УСТАНОВКА ЛАБОРАТОРНОЙ РАБОТЫ ******************************** aSay[3]:SetCaption(L('Создание нового приложения с пустыми базами данных')) // Создание нового приложения DO CASE CASE nRadio1 = 1 // Определить параметры RND-модели автоматически на основе текущей модели M_NewNAppl = 'RND-модель на основе приложения: "'+M_OldNAppl+'"' CASE nRadio1 = 2 // Задавать параметры модели вручную M_NewNAppl = aLabWName[M_CurrLab] ENDCASE M_NewAppl = ADD_ZAPPL(M_NewNAppl) // Путь на БД новой лабораторной работы в папке приложений aSave_LW08 := DC_DataSave() // Сохранение вычислительной среды // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[3]:SetCaption(aSay[3]:caption+L(' - Готово ')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Obi_zag EXCLUSIVE NEW USE Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr EXCLUSIVE NEW aSay[4]:SetCaption(L('Генерация случайных классификационных шкал и градаций')) M_KodGrCs = 0 FOR i=1 TO N_Csc SELECT Class_Sc APPEND BLANK REPLACE Kod_ClSc WITH i REPLACE Name_ClSc WITH "Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19)) FOR j=1 TO N_AvrGrCs SELECT Gr_ClSc APPEND BLANK REPLACE Kod_ClSc WITH i REPLACE Kod_GrCs WITH ++M_KodGrCs REPLACE Name_GrCs WITH ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrCs,19))+"-Градация классификационной шкалы_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19)) SELECT Classes APPEND BLANK REPLACE Kod_Cls WITH M_KodGrCs REPLACE Name_Cls WITH "Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19))+"-Градация классификационной шкалы_"+ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrCs,19)) REPLACE Kod_ClSc WITH i REPLACE N_CHRCLSC WITH LEN("Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19))) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT aSay[4]:SetCaption(aSay[4]:caption+L(' - Готово ')) aSay[5]:SetCaption(L('Генерация случайных описательных шкал и градаций')) M_KodGrOs = 0 FOR i=1 TO N_Osc SELECT Opis_Sc APPEND BLANK REPLACE Kod_OpSc WITH i REPLACE Name_OpSc WITH "Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19)) FOR j=1 TO N_AvrGrOs SELECT Gr_OpSc APPEND BLANK REPLACE Kod_OpSc WITH i REPLACE Kod_GrOs WITH ++M_KodGrOs REPLACE Name_GrOs WITH ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrOs,19))+"-Градация описательной шкалы_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19)) SELECT Attributes APPEND BLANK REPLACE Kod_Atr WITH M_KodGrOs REPLACE Name_Atr WITH "Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19))+"-Градация описательной шкалы_"+ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrOs,19)) REPLACE Kod_OpSc WITH i REPLACE N_CHROPSC WITH LEN("Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19))) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT aSay[5]:SetCaption(aSay[5]:caption+L(' - Готово ')) aSay[6]:SetCaption(L('Генерация баз данных обучающей выборки')) FOR M_KodObj=1 TO N_Obj SELECT Obi_Zag APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH "Объект обучающей выборки_"+ALLTRIM(STR(M_KodObj,19))+"/"+ALLTRIM(STR(N_Obj,19)) ***** Генерация массива кодов классов для БД ObI_Kcl A_Kcl := {} DO WHILE LEN(A_Kcl) < N_AvrGcs M_KodCl = 1 + RANDOM()%N_Cls // Код класса IF ASCAN(A_Kcl, M_KodCl) = 0 // Если класс еще не встречался AADD (A_Kcl, M_KodCl) ENDIF ENDDO ASORT(A_Kcl) *** Занести массив кодов классов в БД ObI_Kcl SELECT Obi_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(A_Kcl) > 0 k=1 FOR j=1 TO LEN(A_Kcl) IF k <= 4 FIELDPUT(1+k++,A_Kcl[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,A_Kcl[j]) ENDIF NEXT ENDIF ***** Генерация массива кодов признаков для БД ObI_Kpr A_Kpr := {} DO WHILE LEN(A_Kpr) < N_AvrGos M_KodPr = 1 + RANDOM()%N_Gos // Код признака AADD (A_Kpr, M_KodPr) ENDDO ASORT(A_KPr) *** Занести массив кодов признаков в БД ObI_Kpr SELECT Obi_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(A_Kpr) > 0 k=1 FOR j=1 TO LEN(A_Kpr) IF k <= 7 FIELDPUT(1+k++,A_Kpr[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,A_Kpr[j]) ENDIF NEXT ENDIF lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT aSay[6]:SetCaption(aSay[6]:caption+L(' - Готово ')) aSay[7]:SetCaption(L('Переиндексация всех БД созданного приложения')) GenNtxClass() // Классификационные шкалы и градации GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[7]:SetCaption(aSay[7]:caption+L(' - Готово ')) N_InsLFakt = 1 // Кол-во фактически установленных лабораторных работ (факт) DC_DataRest( aSave_LW08 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ***************************************************************************************************** CASE M_CurrLab=12 // Лаб.раб.№ 2.02: Исследование свойств нат.чисел при разл.объемах выборки Chislo1 = 1 Chislo2 = 30 @0,0 DCSAY L('ЗАДАЙТЕ ГРАНИЦЫ ДИАПАЗОНА ЧИСЕЛ:') SAYSIZE 0 FONT '10.Arial Bold' @2,0 DCSAY L("- минимальное число: ") @3,0 DCSAY L("- максимальное число: ") @2,18 DCGET Chislo1 PICTURE "#####" @3,18 DCGET Chislo2 PICTURE "#####" DCREAD GUI FIT ADDBUTTONS TITLE L('1.3. Установка ')+L(ALLTRIM(aLabWName[M_CurrLab])) IF Chislo2 <= Chislo1 LB_Warning(L("Максимальное число должно быть больше минимального")) RETURN NIL ENDIF IF Chislo2 - Chislo1 + 1 > 1200 LB_Warning(L("Заданный дипазон не должен включать больше 1200 чисел")) RETURN NIL ENDIF ************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego // Определяются параметры модели, необходимые для прогнозирования длительности исполнения и формирования кл.и оп.шкал и градаций oScr := DC_WaitOn(L('Установка Лаб.раб.№ 2.02: Исследование свойств нат.чисел при разл.объемах выборки'),,,,,,,,,,,.F.) A_ClSc := {} AADD(A_ClSc, "Число: ") // 1, числа от Chislo2 до Chislo2 A_GrCS := {} FOR ss=Chislo1 TO Chislo2 AADD(A_GrCS , ALLTRIM(UPPER(A_ClSc[1]))+"-"+STRTRAN(STR(ss,4),' ','0')) // Код градации описательной шкалы NEXT A_OpSc := {} AADD(A_OpSc, "Делители: ") // 1, числа от 1 до Chislo2, являющиеся делителями чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Количество делителей: ") // 2, количество делителей чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Основание степени: ") // 3, числа от 1 до Chislo2, степенями которых являются числа от Chislo1 до Chislo2 AADD(A_OpSc, "Показатель степени: ") // 4, количество степеней от 1 до mStepMax, такой, что: 2^mStepMax < Chislo2 AADD(A_OpSc, "Простые множители: ") // 5, массив простых множителей чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Количество простых множителей:") // 6, количество простых от 1 до mPrMnMax множителей чисел от Chislo1 до Chislo2 ***** Определить числа от 1 до Chislo2, являющиеся делителями чисел от Chislo1 до Chislo2 A_Div := {} // Массив делителей FOR ss = Chislo1 TO Chislo2 // Числа FOR j=2 TO Chislo2-1 // Делители (включая 1 и самого себя) IF j <> ss .AND. j <> ss-1 IF ss-j*INT(ss/j) = 0 // ss нацело делится на j IF ASCAN(A_Div, j) = 0 AADD(A_Div, j) ENDIF ENDIF ENDIF NEXT NEXT ASORT(A_Div) A_KodOS := {} A_GrOs := {} FOR j=1 TO LEN(A_Div) AADD(A_KodOS, 1) // Код описательной шкалы AADD(A_GrOs , ALLTRIM(UPPER(A_OpSc[1]))+"-"+STRTRAN(STR(A_Div[j],4),' ','0')) // j - код градации описательной шкалы NEXT ****** Определить количество делителей для чисел от Chislo1 до Chislo2 и использовать его далее A_NDiv := {} // Массив количеств делителей чисел от Chislo1 до Chislo2 FOR ss=Chislo1 TO Chislo2 N_Div=0 // Кол-во делителей для числа ss (за исключением 1 и самого себя) *** Проверка делимости FOR j=2 TO Chislo2-1 IF j <> ss .AND. j <> ss-1 IF ss-j*INT(ss/j) = 0 ++N_Div ENDIF ENDIF NEXT IF ASCAN(A_NDiv, N_Div) = 0 AADD(A_NDiv, N_Div) ENDIF NEXT ASORT(A_NDiv) FOR j=1 TO LEN(A_NDiv) AADD(A_KodOS, 2) // Код описательной шкалы AADD(A_GrOs , ALLTRIM(UPPER(A_OpSc[2]))+"-"+STRTRAN(STR(A_NDiv[j],4),' ','0')) // Код градации описательной шкалы NEXT ******* Определить числа от 1 до Chislo2 (основания степеней), степенями которых являются числа от Chislo1 до Chislo2 ******* Массив чисел от Chislo1 до Chislo2 A_Chislo := {} FOR ss = Chislo1 TO Chislo2 AADD(A_Chislo, ss) NEXT N_Obj = LEN(A_Chislo) A_OsnSt := {} // Массив оснований степеней, которыми являются числа от Chislo1 до Chislo2 A_PokSt := {} // Массив показателей степеней, которыми являются числа от Chislo1 до Chislo2 FOR ss = Chislo1 TO Chislo2 FOR i=2 TO Chislo2 // Основания степени FOR j=2 TO Chislo2 // Показатели степени (за исключением 1) IF ss = i ^ j IF ASCAN(A_OsnSt, i) = 0 AADD(A_OsnSt, i) ENDIF IF ASCAN(A_PokSt, j) = 0 AADD(A_PokSt, j) ENDIF ENDIF NEXT NEXT NEXT ASORT(A_OsnSt) ASORT(A_PokSt) * DC_DebugQout( A_OsnSt ) * DC_DebugQout( A_PokSt ) FOR j=1 TO LEN(A_OsnSt) mGrOS = ALLTRIM(UPPER(A_OpSc[3]))+"-"+STRTRAN(STR(A_OsnSt[j],4),' ','0') * IF ASCAN(A_GrOs, mGrOS) = 0 AADD (A_KodOS, 3) // Код описательной шкалы AADD (A_GrOs, mGrOS) // Код градации описательной шкалы * ENDIF NEXT FOR j=1 TO LEN(A_PokSt) mGrOS = ALLTRIM(UPPER(A_OpSc[4]))+"-"+STRTRAN(STR(A_PokSt[j],4),' ','0') * IF ASCAN(A_GrOs, mGrOS) = 0 AADD (A_KodOS, 4) // Код описательной шкалы AADD (A_GrOs, mGrOS) // Код градации описательной шкалы * ENDIF NEXT * DC_DebugQout( A_GrOs ) ******* Найти ВСЕ простые числа на которые делятся числа от 2 до Chislo2 Ar_prch := {} // Массив простых чисел FOR ss = 2 TO Chislo2 **** Проверка, является ли ss простым числом Flag = .T. FOR i=2 TO ss-1 IF ss = i*INT(ss/i) // Делится ли ss на i Flag = .F. EXIT ENDIF NEXT IF Flag AADD(Ar_prch,ss) ENDIF NEXT * DC_DebugQout( Ar_prch ) *** Оставить только те из Ar_prch, на которые реально нацело делятся числа от Chislo1 до Chislo2 A_PrCh := {} FOR ss = Chislo1 TO Chislo2 FOR j=1 TO LEN(Ar_prch) IF ss = Ar_prch[j]*INT(ss/Ar_prch[j]) // Делится ли ss на j IF ASCAN(A_PrCh, Ar_prch[j]) = 0 AADD(A_PrCh, Ar_prch[j]) ENDIF ENDIF NEXT NEXT ASORT(A_PrCh) FOR j=1 TO LEN(A_PrCh) AADD(A_KodOS, 5) // Код описательной шкалы AADD(A_GrOs , ALLTRIM(UPPER(A_OpSc[5]))+"-"+STRTRAN(STR(A_PrCh[j],4),' ','0')) // Код градации описательной шкалы NEXT ******* Определить количество простых множителей в числах от Chislo1 до Chislo2 ******* с повторами одинаковых простых множителей, чтобы их произведение давало число A_NPrMn := {} FOR ss = Chislo1 TO Chislo2 Ar_prmn := {} // Массив простых множителей числа ss Chislo = ss FOR j=1 TO LEN(A_PrCh) **** Проверка, делится ли Chislo на простое число из массива Ar_prch DO WHILE Chislo = A_PrCh[j] * INT(Chislo/A_PrCh[j]) AADD(Ar_prmn,A_PrCh[j]) Chislo = Chislo/A_PrCh[j] ENDDO NEXT IF ASCAN(A_NPrMn, LEN(Ar_prmn)) = 0 IF LEN(Ar_prmn) > 0 AADD(A_NPrMn, LEN(Ar_prmn)) ENDIF ENDIF NEXT ASORT(A_NPrMn) FOR j=1 TO LEN(A_NPrMn) AADD(A_KodOS, 6) // Код описательной шкалы AADD(A_GrOs , ALLTRIM(UPPER(A_OpSc[6]))+"-"+STRTRAN(STR(A_NPrMn[j],4),' ','0')) // Код градации описательной шкалы NEXT // Создание нового приложения с пустыми базами данных M_NewAppl = ADD_ZAPPL(ALLTRIM(aLabWName[M_CurrLab])+' (чисел: '+ALLTRIM(STR(Chislo2 - Chislo1 + 1))+')'+', расч.исх.данные') // Путь на БД новой лабораторной работы в папке приложений aSave_LW09 := DC_DataSave() // Сохранение вычислительной среды // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки ********* Создать БД Inp_data.dbf DIRCHANGE(Disk_dir+"\AID_DATA\Inp_data\") // Перейти в папку Inp_data aStructure := { { "Object" , "N", 8, 0 }, ; // 1. Число { "Number ", "C", 19, 0 }, ; // 2. Число { "Dividers ", "C", 250, 0 }, ; // 3. Делители - числа от 1 до Chislo2, являющиеся делителями чисел от Chislo1 до Chislo2 { "N_divisors", "C", 250, 0 }, ; // 4. Количество делителей - количество делителей чисел от Chislo1 до Chislo2 { "BasDegree" , "C", 250, 0 }, ; // 5. Основание степени - числа от 1 до Chislo2, степенями которых являются числа от Chislo1 до Chislo2 { "Exponent" , "C", 250, 0 }, ; // 6. Показатель степени - количество степеней от 1 до mStepMax, такой, что: 2^mStepMax < Chislo2 { "SimMultipl", "C", 250, 0 }, ; // 7. Простой множитель - массив простых множителей чисел от Chislo1 до Chislo2 { "NSimMultip", "C", 250, 0 } } // 8. Количество простых множителей - количество простых от 1 до mPrMnMax множителей чисел от Chislo1 до Chislo2 DbCreate( 'Inp_data.dbf', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir+"\AID_DATA\Inp_data\") // Перейти в папку Inp_data USE Inp_data EXCLUSIVE NEW DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: USE Classes EXCLUSIVE NEW USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Obi_zag EXCLUSIVE NEW USE Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr EXCLUSIVE NEW // ########################################### // Генерация классификационных шкал и градаций SELECT Classes;ZAP FOR ss=1 TO LEN(A_GrCS) APPEND BLANK REPLACE Kod_cls WITH ss REPLACE Name_cls WITH A_GrCS[ss] REPLACE Kod_ClSc WITH 1 NEXT SELECT Class_Sc;ZAP APPEND BLANK REPLACE Kod_ClSc WITH 1 REPLACE Name_ClSc WITH UPPER(ALLTRIM(A_ClSc[1])) REPLACE KodGr_Min WITH Chislo1 REPLACE KodGr_Max WITH Chislo2 SELECT Gr_ClSc;ZAP FOR ss=1 TO LEN(A_GrCS) APPEND BLANK REPLACE Kod_ClSc WITH 1 REPLACE Kod_GrCS WITH ss * REPLACE Name_GrCS WITH A_GrCS[ss] // ################################ mPos = AT(":", A_GrCs[ss]) mLen = LEN(A_GrCs[ss]) REPLACE Name_GrCs WITH SUBSTR(A_GrCs[ss], mPos+2, mLen-mPos-1) NEXT // Генерация описательных шкал SELECT Opis_sc;ZAP FOR ss=1 TO LEN(A_OpSc) APPEND BLANK REPLACE Kod_OpSc WITH ss REPLACE Name_OpSc WITH UPPER(ALLTRIM(A_OpSc[ss])) NEXT // Генерация градаций описательных шкал SELECT Gr_OpSc;ZAP FOR ss=1 TO LEN(A_GrOs) APPEND BLANK REPLACE Kod_OpSc WITH A_KodOS[ss] REPLACE Kod_GrOs WITH ss mPos = AT(":", A_GrOs[ss]) mLen = LEN(A_GrOs[ss]) REPLACE Name_GrOs WITH SUBSTR(A_GrOs[ss], mPos+2, mLen-mPos-1) NEXT // Формирование обучающей выборки SELECT Obi_zag;ZAP SELECT Obi_Kcl;ZAP SELECT Obi_Kpr;ZAP mNumObj := 0 FOR ss=Chislo1 TO Chislo2 SELECT Obi_zag APPEND BLANK REPLACE Kod_obj WITH ++mNumObj REPLACE Name_obj WITH "Число: "+ALLTRIM(STR(ss)) SELECT Inp_data APPEND BLANK REPLACE Object WITH mNumObj REPLACE Number WITH ALLTRIM(STR(ss)) SELECT Obi_Kcl APPEND BLANK REPLACE Kod_obj WITH mNumObj * REPLACE CLS1 WITH ss // ####################################### Kod = ASCAN(A_GrCS , ALLTRIM(UPPER(A_ClSc[1]))+"-"+STRTRAN(STR(ss,4),' ','0')) // Код градации классификационной шкалы IF Kod > 0 REPLACE CLS1 WITH Kod ENDIF SELECT Obi_Kpr APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 // Позиция для записи в БД N_Div=0 // Кол-во делителей *** Проверка делимости FOR j=1 TO LEN(A_Div) IF j <> ss IF ss-A_Div[j]*INT(ss/A_Div[j]) = 0 Kod = ASCAN(A_GrOs , ALLTRIM(UPPER(A_OpSc[1]))+"-"+STRTRAN(STR(A_Div[j],4),' ','0')) // Код градации описательной шкалы IF Kod > 0 ++N_Div SELECT Inp_data REPLACE Dividers WITH IF(LEN(ALLTRIM(Dividers))>0,ALLTRIM(Dividers)+' ','') + STRTRAN(STR(A_Div[j],4),' ','0') SELECT Obi_Kpr IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF ENDIF ENDIF ENDIF NEXT *** Занесение количества делителей Kod = ASCAN(A_GrOs , ALLTRIM(UPPER(A_OpSc[2]))+"-"+STRTRAN(STR(N_Div,4),' ','0')) // Код градации описательной шкалы IF Kod > 0 IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF SELECT Inp_data REPLACE N_DIVISORS WITH STRTRAN(STR(N_Div,4),' ','0') SELECT Obi_Kpr ENDIF *** Проверка, является ли данное число ss *** целой степенью j некоторого натурального числа i SELECT Obi_Kpr * MsgBox(STR(LEN(A_GrOs))) * LB_Warning(A_GrOs) // ################## FOR i=1 TO LEN(A_OsnSt) // Основания степени FOR j=1 TO LEN(A_PokSt) // Показатели степени IF ss = A_OsnSt[i]^A_PokSt[j] // ss является целой степенью A_PokSt[j] натурального числа A_OsnSt[i] mGrOS = ALLTRIM(UPPER(A_OpSc[3]))+"-"+STRTRAN(STR(A_OsnSt[i],4),' ','0') Kod = ASCAN(A_GrOs , mGrOS ) // Код градации описательной шкалы IF Kod > 0 IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF SELECT Inp_data REPLACE BasDegree WITH IF(LEN(ALLTRIM(BasDegree))>0,ALLTRIM(BasDegree)+' ','') + STRTRAN(STR(A_OsnSt[i],4),' ','0') SELECT Obi_Kpr ENDIF mGrOS = ALLTRIM(UPPER(A_OpSc[4]))+"-"+STRTRAN(STR(A_PokSt[j],4),' ','0') Kod = ASCAN(A_GrOs , mGrOS ) // Код градации описательной шкалы IF Kod > 0 IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF SELECT Inp_data REPLACE Exponent WITH IF(LEN(ALLTRIM(Exponent))>0,ALLTRIM(Exponent)+' ','') + STRTRAN(STR(A_PokSt[j],4),' ','0') SELECT Obi_Kpr ENDIF ENDIF NEXT NEXT ******* 2. Разложить составное число на простые множители Ar_prmn := {} // Массив всех простых множителей числа ss с повторами множителей, // чтобы число получалось путем перемножения простых множителей Chislo = ss FOR j=1 TO LEN(A_PrCh) **** Проверка, делится ли Chislo на простое число из массива Ar_prch DO WHILE Chislo = A_PrCh[j] * INT(Chislo/A_PrCh[j]) AADD(Ar_prmn,A_PrCh[j]) Chislo = Chislo/A_PrCh[j] ENDDO NEXT *** Занести коды простых множителей в БД ObInfKPr.dbf и сами простые множители в Inp_data.dbf FOR j=1 TO LEN(Ar_prmn) Kod = ASCAN(A_GrOs , ALLTRIM(UPPER(A_OpSc[5]))+"-"+STRTRAN(STR(Ar_prmn[j],4),' ','0')) // Код градации описательной шкалы IF Kod > 0 IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF SELECT Inp_data REPLACE SIMMULTIPL WITH IF(LEN(ALLTRIM(SIMMULTIPL))>0,ALLTRIM(SIMMULTIPL)+' ','') + STRTRAN(STR(Ar_prmn[j],4),' ','0') SELECT Obi_Kpr ENDIF NEXT Kod = ASCAN(A_GrOs , ALLTRIM(UPPER(A_OpSc[6]))+"-"+STRTRAN(STR(LEN(Ar_prmn),4),' ','0')) // Код градации описательной шкалы IF Kod > 0 IF p+1 <= 7 FIELDPUT(++p+1, Kod) ELSE APPEND BLANK REPLACE Kod_obj WITH mNumObj p=0 FIELDPUT(++p+1, Kod) ENDIF SELECT Inp_data REPLACE NSIMMULTIP WITH STRTRAN(STR(LEN(Ar_prmn),4),' ','0') SELECT Obi_Kpr ENDIF NEXT // Переиндексация всех БД созданного приложения GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenNtxClass() // Классификационные шкалы и градации GenNtxClSc() // Классификационные шкалы GenNtxGrClSc() // Градации Классификационные шкал GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки DC_Impl(oScr) AADD(A_OpSc, "Делители: ") // 1, числа от 1 до Chislo2, являющиеся делителями чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Количество делителей: ") // 2, количество делителей чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Основание степени: ") // 3, числа от 1 до Chislo2, степенями которых являются числа от Chislo1 до Chislo2 AADD(A_OpSc, "Показатель степени: ") // 4, количество степеней от 1 до mStepMax, такой, что: 2^mStepMax < Chislo2 AADD(A_OpSc, "Простые множители: ") // 5, массив простых множителей чисел от Chislo1 до Chislo2 AADD(A_OpSc, "Количество простых множителей:") // 6, количество простых от 1 до mPrMnMax множителей чисел от Chislo1 до Chislo2 CrLf = CHR(13)+CHR(10) // Конец строки (записи) String = "Числа: " + CrLf +; "Делители: " + CrLf +; "Количество делителей: " + CrLf +; "Основание степени: " + CrLf +; "Показатель степени: " + CrLf +; "Простые множители: " + CrLf +; "Количество простых множителей:" DIRCHANGE(Disk_dir+"\AID_DATA\Inp_data\") // Перейти в папку Inp_data StrFile(String, "Inp_name.txt") // Запись текстового файла "Inp_name.txt" ******* Сформировать и записать файл параметров диалога для режима 2.3.2.2: Regim = 1 // Формализации ПО или ген.расп.выб. Flag_zer = 1 // Считать нули и пробелы отсутствием данных? [1]-да, [2]-нет M_ClSc1 = 2 // Номер начального столбца диапазона классификационных шкал M_ClSc2 = 2 // Номер конечного столбца диапазона классификационных шкал M_OpSc1 = 3 // Номер начального столбца диапазона описательных шкал M_OpSc2 = 8 // Номер конечного столбца диапазона описательных шкал N_SKGrCl = 40 N_SKGrPr = 40 K_N_ClSc = 1 // Кол-во числовых классификационных шкал K_N_OpSc = 6 // Кол-во числовых описательных шкал K_N_GrClSc = 3 K_N_GrOpSc = 3 M_ObAnk = 3 // Создавать анкеты исходной выборки по строкам Inp_data-[1], по классам-[2], и 1-е, и 2-е [3] N_Chast = 1 // На сколько частей N разбивать обучающую или распознавемую выборку (в зависимости от Regim) M_Interval = 1 // 1-равные интервалы, 2-адаптивные интервалы (с примерно равным количеством наблюдений, по Котельникову) M_Scenario = .F. K_GradNClSc = 3 K_GradNOpSc = 3 mGorizMin = 5 mGorizMax = 5 mGlubMin = 5 mGlubMax = 5 M_ChastObi = .F. M_ChastRso = .F. N_ChastObi = 1 N_ChastRso = 1 M_XlsDbf = 3 // Тип файла исходных данных: 1-xls, 2-xlsx, 3-dbf, 4-csv (в разработке) mTxtCSField = 1 // Способ интерпретации значений текстовых полей - значения рассматриваются как целое * mTxtCSField = 1 // Значения рассматриваются как целое * mTxtCSField = 2 // Значения рассматриваются как состоящие из элементов - символов * mTxtCSField = 3 // Значения рассматриваются как состоящие из элементов, разделенных разделителем (слов) mTxtOSField = 3 // Способ интерпретации значений текстовых полей - описательных шкал файла исходных данных (слова) * mTxtOSField = 1 // Значения рассматриваются как целое * mTxtOSField = 2 // Значения рассматриваются как состоящие из элементов - символов * mTxtOSField = 3 // Значения рассматриваются как состоящие из элементов, разделенных разделителем (слов) mTxtCSSep = " " // Разделитель элементов классификационных шкал, если mTxtCSField=3 mTxtOSSep = " " // Разделитель элементов описательных шкал, если mTxtOSField=3 mScenario = 1 // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей (старый вариант) mSpecInterprCls = .T. // Применять спец.интерпретацию текстовых полей классов mSpecInterprAtr = .T. // Применять спец.интерпретацию текстовых полей признаков mNameGrNumSc= 1 // Какие наименования ГРАДАЦИЙ числовых шкал использовать mClsAvr =.F. // .F. - делать модель из Inp_data, .T. - делать модель из Inp_data_avr mSortUnqCls = 2 // Выделять уникальные значения классов и сортировать, 1-да, 2-нет mLemmatCls = 2 // Проводить лемматизацию классов, 1-да, 2-нет mSortUnqGos = 2 // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет mLemmatGos = 2 // Проводить лемматизацию признаков, 1-да, 2-нет PRIVATE aSoftInt[40] aSoftInt[ 1] = Regim aSoftInt[ 2] = Flag_zer aSoftInt[ 3] = M_ClSc1 aSoftInt[ 4] = M_ClSc2 aSoftInt[ 5] = M_OpSc1 aSoftInt[ 6] = M_OpSc2 aSoftInt[ 7] = N_SKGrCl aSoftInt[ 8] = N_SKGrPr aSoftInt[ 9] = K_N_ClSc aSoftInt[10] = K_N_OpSc aSoftInt[11] = K_N_GrClSc aSoftInt[12] = K_N_GrOpSc aSoftInt[13] = M_ObAnk aSoftInt[14] = N_Chast aSoftInt[15] = M_Interval aSoftInt[16] = M_Scenario aSoftInt[17] = K_GradNClSc // Количество градаций в числовой классификационной шкале aSoftInt[18] = K_GradNOpSc // Количество градаций в числовой описательной шкале aSoftInt[19] = mGorizMin aSoftInt[20] = mGorizMax aSoftInt[21] = mGlubMin aSoftInt[22] = mGlubMax aSoftInt[23] = M_ChastObi aSoftInt[24] = M_ChastRso aSoftInt[25] = N_ChastObi aSoftInt[26] = N_ChastRso aSoftInt[27] = M_XlsDbf aSoftInt[28] = mTxtCSField aSoftInt[29] = mTxtOSField aSoftInt[30] = mTxtCSSep aSoftInt[31] = mTxtOSSep * aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей (старый вариант) aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа aSoftInt[33] = mSpecInterprCls // Применить спец.интерпретацию текстовых полей классов aSoftInt[34] = mSpecInterprAtr // Применить спец.интерпретацию текстовых полей признаков aSoftInt[35] = mNameGrNumSc // Какие наименования ГРАДАЦИЙ числовых шкал использовать aSoftInt[36] = mClsAvr // .F. = модель без усреднения по классам aSoftInt[37] = mSortUnqCls // Выделять уникальные значения классов и сортировать, 1-да, 2-нет aSoftInt[38] = IF(mSpecInterprCls,mLemmatCls,2) // Проводить лемматизацию классов, 1-да, 2-нет aSoftInt[39] = mSortUnqGos // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет aSoftInt[40] = IF(mSpecInterprAtr,mLemmatGos,2) // Проводить лемматизацию признаков, 1-да, 2-нет DC_ASave(aSoftInt , Disk_dir +"\_2_3_2_2.arx") DC_ASave(aSoftInt , M_NewAppl+"\_2_3_2_2.arx") ******* Запустить режим 2.3.2.2 DIRCHANGE(Disk_dir) // Перейти в папку системы mLW = ALLTRIM(aLabWName[M_CurrLab])+' (чисел: '+ALLTRIM(STR(Chislo2 - Chislo1 + 1))+')'+', исх.данные из: "Inp_data.dbf"' M_NewAppl = ADD_ZAPPL(mLW) // Путь на БД новой лабораторной работы в папке приложений DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки F2_3_2_2(mLW,"1.3()") // Запуск универсального программного интерфейса с внешними базами данных ******* Выдать сообщение о дальнейших действиях aMess := {} AADD(aMess, L(mLW)+L(", успешно установлена!")) AADD(aMess, L(" ")) AADD(aMess, L("Для дальнейшего ее изучения и выполнения необходимо:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Открыть файл исходных данных: "+Disk_dir+"\AID_DATA\Inp_data\Inp_data.dbf"+".")) AADD(aMess, L(" ")) AADD(aMess, L("2. Прочитать описание данной лабораторной работы в режиме 5.14.")) AADD(aMess, L(" ")) AADD(aMess, L("3. Выполнить режимы: 2.1, 2.2, 2.3, 3.5, 4.1.3.6, 4.1.3.1 и другие")) AADD(aMess, L(" в соответствии со схемой преобразования данных в информацию,")) AADD(aMess, L(" а ее в знания, приведенной в режиме 6.4.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) N_InsLFakt = 1 // Кол-во фактически установленных лабораторных работ (факт) * DC_DataRest( aSave_LW09 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) * aMess := {} * AADD(aMess, L('Лаб.раб.№ 2.02: Исследование свойств натуральных чисел') * AADD(aMess, L('при различных объемах выборки успешно установлена!') * LB_Warning(aMess, L("1.3. Установка лабораторных работ" ) ***************************************************************************************************** CASE M_CurrLab=13 // Лаб.раб.№ 13: Исследование детерминации свойств системы ее структурой ******************************************************************************* *** Исследование влияния подсистем различных уровней иерархии на эмер- *** *** джентные свойства системы в целом с применением автоматизированного *** *** системно-когнитивного анализа и интеллектуальной системы "Эйдос" *** ******************************************************************************* *** Подготовка данных для моделирования взаимосвязи *** *** генетических признаков с фенотипическими признаками *** ******************************************************************************* *** 1. Задание в диалоге диапазона простых чисел, являющихся базовыми *** *** для образования геномов объектов *** *** 2. Задание количества генетических признаков в объектах *** *** 3. Задание максимальной сложности подсистем фенотипических признаков *** *** 4. Генерация простых чисел без повторов в заданных диапазонах, *** *** являющихся базовыми для образования геномов объектов *** *** 5. Генерация на основе простых чисел, являющихся базовыми элементами, *** *** геномов объектов заданной сложности, путем перебора всех вариантов *** *** сочетаний: каждый вариант реализуется в новом объекте *** *** 6. Генерация на основе простых чисел, составляющих геномы объектов, *** *** составных натуральных чисел, моделирующих фенотипические признаки *** *** разного уровня сложности: от 1 до максимальной, заданной в диалоге *** *** 7. Сюда можно вставить определение других свойств сгенерированных чисел как в ЛР 9 *** 8. Формирование БД классов, признаков и обучающей выборки *** ******************************************************************************* @ 0,0 DCGROUP oGroup1 CAPTION L('Задание параметров синтеза модели') SIZE 88, 22 PUBLIC Ch_Min1 := 2, Ch_Max1 := 7 Mess1 = L('Задайте минимальное число диапазона простых чисел:') Mess2 = L('Задайте максимальное число диапазона простых чисел:') @ 1, 1 DCSAY Mess1 PARENT oGroup1 @ 2, 1 DCSAY Mess2 PARENT oGroup1 @ 1,50 DCSAY L(" ") GET Ch_Min1 PARENT oGroup1 PICTURE "###############" @ 2,50 DCSAY L(" ") GET Ch_Max1 PARENT oGroup1 PICTURE "###############" PUBLIC UrSlog_Obj := 4 Mess3 = L('Задайте макс.количество базовых признаков в объектах:') @ 3, 1 DCSAY Mess3 PARENT oGroup1 @ 3,50 DCSAY L(" ") GET UrSlog_Obj PARENT oGroup1 PICTURE "###############" // Количество признаков в объектах должно быть > 2 и < 10 PUBLIC UrSlog_FP := 15 Mess4 = L('Задайте максимальную сложность подсистем базовых признаков:') @ 4, 1 DCSAY Mess4 PARENT oGroup1 @ 4,50 DCSAY L(" ") GET UrSlog_FP PARENT oGroup1 PICTURE "###############" // Максимальный уровень сложности фенотипических признаков должен быть > 1 и < # PUBLIC Podsys_01 := 0 @ 5.2, 1 DCGROUP oGroup2 CAPTION L('Кодировать ли подсистемы базовых признаков?') SIZE 86, 3.5 PARENT oGroup1 @ 1, 1 DCRADIO Podsys_01 VALUE 0 PROMPT L('Не кодировать') PARENT oGroup2 @ 2, 1 DCRADIO Podsys_01 VALUE 1 PROMPT L('Кодировать' ) PARENT oGroup2 PUBLIC Podsystem := 0 @ 9.2, 1 DCGROUP oGroup3 CAPTION L('Какие подсистемы базовых признаков оставлять в модели?') SIZE 86, 3.5 PARENT oGroup1 @ 1, 1 DCRADIO Podsys_01 VALUE 0 PROMPT L('Всех уровней сложности' ) PARENT oGroup3 @ 2, 1 DCRADIO Podsys_01 VALUE 1 PROMPT L('Только макс.уровня сложности') PARENT oGroup3 @13.2, 1 DCGROUP oGroup4 CAPTION L('Принцип моделирования состава и свойств системы простыми и составными числами' ) SIZE 86, 8.5 PARENT oGroup1 @ 1, 1 DCSAY L('В лабораторной работе №12 исследуются числовые системы, основанные на базовых элементах, в качестве ') PARENT oGroup4 @ 2, 1 DCSAY L('которых выступают простые числа, с подсистемами различной сложности (уровней иерархии), образующими-') PARENT oGroup4 @ 3, 1 DCSAY L('ся путем перемножения простых чисел в различных сочетаниях. Это не накладывает ограничений на приме-') PARENT oGroup4 @ 4, 1 DCSAY L('нимость полученных на этом примере выводов в различных предметных областях, т.к. простые числа можно') PARENT oGroup4 @ 5, 1 DCSAY L('рассматривать как признаки, характеризующие состав систем, а составные числа как эмерджентные свой-') PARENT oGroup4 @ 6, 1 DCSAY L('ства этих систем, образующиеся путем взаимодействия соответствующих базовых элементов. Использование') PARENT oGroup4 @ 7, 1 DCSAY L('этой метафоры очень удобно, т.к. разложение сложных чисел на простые множители является единственным') PARENT oGroup4 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('1.3. Задание параметров модели детерминации свойств системы ее структурой') ************************************************************************************************** *************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF *************************************************** // Подготовка данных для отображения графического прогресс-бар // Задание максимальной величины параметра Time Wsego = IF(Podsys_01 = 0, 20, 21) // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,8.5 ; PARENT oTabPage1 @10,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 PRIVATE aSay[12] s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('1.3. Установка ')+L(aLabWName[M_CurrLab]) ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ************************************************************************************************** // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() aSay[1]:SetCaption(L('Создание нового приложения с пустыми базами данных')) // Создание нового приложения * LB_Warning(STR(M_CurrLab)) M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) // Путь на БД новой лабораторной работы в папке приложений aSave_LW10 := DC_DataSave() // Сохранение вычислительной среды // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 01 aSay[1]:SetCaption(aSay[1]:caption+L(' - Готово ')) aSay[2]:SetCaption(L('Генерация простых чисел в заданном диапазоне без повторов')) ***** Создать БД простых чисел CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций CREATE Struc APPEND BLANK REPLACE Field_name WITH "Pr_Chis",; Field_type WITH "N",; Field_len WITH 15 ,; Field_dec WITH 0 ****** Создаем БД CREATE Pr_chis FROM Struc ERASE Struc.dbf lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 02 ***** База и массив простых чисел Ar_prch := {} CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Pr_chis EXCLUSIVE NEW SELECT Pr_chis FOR j=Ch_Min1 TO Ch_Max1 **** Проверка, является ли j простым числом Flag = .T. FOR i=2 TO j-1 IF j=i*INT(j/i) // Делится ли j на i Flag = .F. EXIT ENDIF NEXT IF Flag APPEND BLANK REPLACE Pr_Chis WITH j AADD(Ar_prch, Pr_chis) ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 03 aSay[2]:SetCaption(aSay[2]:caption+L(' - Готово ')) aSay[3]:SetCaption(L('Генерация подсистем простых чисел путем перебора всех вариантов их сочетаний')) ******* Суммарное количество всех возможных подсистем всех уровней сложности ******* от 1 до максимального, заданного в диалоге UrSlog_FP - 1 Sum_Cnm = 0 FOR m=1 TO UrSlog_FP // от 1 до UrSlog_FP n = UrSlog_Obj Sum_Cnm = Sum_Cnm + F(n)/(F(m)*F(n-m)) // C(n,m) = число сочетаний из n по m NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 04 ***** Создать БД объектов CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций CREATE Struc APPEND BLANK REPLACE Field_name WITH "Obj_name",; Field_type WITH "C",; Field_len WITH 250; Field_dec WITH 0 FOR j=1 TO Sum_Cnm Mfn = "SlCh"+ALLTRIM(STR(j,2)) APPEND BLANK REPLACE Field_name WITH Mfn,; Field_type WITH "N",; Field_len WITH 15,; Field_dec WITH 0 NEXT FOR j=1 TO UrSlog_Obj Mfn = "PrCh"+ALLTRIM(STR(j,2)) APPEND BLANK REPLACE Field_name WITH Mfn,; Field_type WITH "N",; Field_len WITH 15 ,; Field_dec WITH 0 NEXT APPEND BLANK REPLACE Field_name WITH "Zero",; Field_type WITH "N",; Field_len WITH 1,; Field_dec WITH 0 ****** Создаем БД CREATE ObuchInf FROM Struc ERASE Struc.dbf lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 05 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE ObuchInf EXCLUSIVE NEW N = 0 FOR z=1 TO UrSlog_Obj SELECT ObuchInf ADD_ObInf(z) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 06 ***** Создать БД сложных чисел CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций CREATE Struc APPEND BLANK REPLACE Field_name WITH "Sl_Chis",; Field_type WITH "N",; Field_len WITH 15 ,; Field_dec WITH 0 FOR j=1 TO UrSlog_FP Mfn = "PrCh"+ALLTRIM(STR(j,2)) APPEND BLANK REPLACE Field_name WITH Mfn,; Field_type WITH "N",; Field_len WITH 15 ,; Field_dec WITH 0 NEXT ****** Создаем БД CREATE Sl_chis FROM Struc ERASE Struc.dbf lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 07 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Sl_chis EXCLUSIVE NEW INDEX ON STR(Sl_Chis,19) TO Sl_Chis lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 08 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Sl_chis INDEX Sl_Chis EXCLUSIVE NEW lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 09 USE ObuchInf EXCLUSIVE NEW SELECT ObuchInf DBGOTOP() DO WHILE .NOT. EOF() Ar_GenObj := {} FOR j=1 TO UrSlog_Obj Mfn = "PrCh"+ALLTRIM(STR(j,2)) IF &Mfn > 0 AADD(Ar_GenObj, &Mfn) ELSE EXIT ENDIF NEXT Ar_slch := {} SELECT Sl_Chis;SET ORDER TO 1 FOR z=1 TO UrSlog_FP ADD_SlChis(z) NEXT SELECT ObuchInf FOR j=1 TO LEN(Ar_Slch) Mfn = "SlCh"+ALLTRIM(STR(j,2)) REPLACE &Mfn WITH Ar_Slch[j] M_Zero = 1 FOR i=2 TO FCOUNT()-1 IF FIELDGET(i) = 0 M_Zero = 0 EXIT ENDIF NEXT REPLACE Zero WITH M_Zero NEXT DBSKIP(1) ENDDO lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 10 aSay[3]:SetCaption(aSay[3]:caption+L(' - Готово ')) aSay[4]:SetCaption(L('Формирование справочника классов')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;ZAP INDEX ON Name_cls TO Cls_name lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 11 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Cls_name EXCLUSIVE NEW;ZAP USE Sl_chis EXCLUSIVE NEW SELECT Sl_chis lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 12 M_KodCls = 0 DBGOTOP() DO WHILE .NOT. EOF() M_SlCh = Sl_chis M_Name = ALLTRIM(STR(M_SlCh,13))+" = " Ar_PrCh := {} FOR j=1 TO UrSlog_FP M_PrCh =FIELDGET(1+j) IF M_PrCh > 0 AADD(Ar_PrCh, M_PrCh) ELSE EXIT ENDIF NEXT FOR j=1 TO LEN(Ar_PrCh) M_Name = M_Name+ALLTRIM(STR(Ar_PrCh[j],19))+IF(j 0 k=2 FOR jj=1 TO LEN(Ar_klass) IF k <= 5 FIELDPUT(k++,Ar_klass[jj]) ELSE APPEND BLANK REPLACE Kod_obj WITH M_KodObj k=2 FIELDPUT(k++,Ar_klass[jj]) ENDIF NEXT ENDIF SELECT Obi_Kpr APPEND BLANK REPLACE Kod_obj WITH M_KodObj IF LEN(Ar_atrib) > 0 k=2 FOR jj=1 TO LEN(Ar_atrib) IF k <= 8 FIELDPUT(k++,Ar_atrib[jj]) ELSE APPEND BLANK REPLACE Kod_obj WITH M_KodObj k=2 FIELDPUT(k++,Ar_atrib[jj]) ENDIF NEXT ENDIF SELECT ObuchInf DBSKIP(1) ENDDO lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 18 ** Кодировать подсистемы базовых признаков IF Podsys_01 = 1 GenNtxObiKcl() SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod_cls M_Name = Name_cls M_Univ = Universal SELECT Gr_OpSc APPEND BLANK REPLACE Kod_OpSc WITH 1 REPLACE Kod_GrOs WITH M_Kod REPLACE Name_GrOs WITH M_Name REPLACE Universal WITH M_Univ SELECT Classes DBSKIP(1) ENDDO lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 19 SELECT Obi_Zag DBGOTOP() DO WHILE .NOT. EOF() M_KodObj = Kod_obj SELECT Obi_Kcl;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T Ar := {} DO WHILE .NOT. EOF() .AND. M_KodObj = Kod_obj FOR j=2 TO 5 Mv = FIELDGET(j) IF 0 < Mv .AND. Mv <= N_Gos AADD(Ar, Mv) ENDIF NEXT DBSKIP(1) ENDDO ****** Запись массива кодов признаков в БД Obi_Kpr SELECT Obi_Kpr APPEND BLANK FIELDPUT(1,M_KodObj) IF LEN(Ar) > 0 k=2 FOR jj=1 TO LEN(Ar) IF k <= 8 FIELDPUT(k++,Ar[jj]) ELSE APPEND BLANK FIELDPUT(1,M_KodObj) k=2 FIELDPUT(k ,Ar[jj]) ENDIF NEXT ENDIF ENDIF SELECT Obi_Zag DBSKIP(1) ENDDO ENDIF lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 20 aSay[6]:SetCaption(aSay[6]:caption+L(' - Готово ')) aSay[7]:SetCaption(L('Переиндексация всех БД созданного приложения')) GenNtxClass() // Классификационные шкалы и градации GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки aSay[7]:SetCaption(aSay[7]:caption+L(' - Готово ')) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 21 N_InsLFakt = 1 // Кол-во фактически установленных лабораторных работ (факт) DC_DataRest( aSave_LW10 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ***************************************************************************************************** // Лаб.работы, устанавливаемые путем расчета исходных БД: CASE M_CurrLab=14 // Лаб.раб.№ 14: Исследование зашумленных когнитивных функций на примере свип-сигнала aSave_LW13 := DC_DataSave() // Сохранение вычислительной среды ************************************************************************************************** ** Массив с параметрами модели ******************** ** Если файл _1_3_13.arx существует, то ** присвоить всем переменным, задаваемым в диалоге, начальные значения ** из этого файла и с этими значениями начинать диалог ** Если файл _1_3_13.arx не существует, то ** присвоить всем переменным, задаваемым в диалоге, начальные значения по умолчанию ** и начинать диалог с этих значений IF FILE(Disk_dir+"\_1_3_LW13.arx") aParLW13 = DC_ARestore(Disk_dir+"\_1_3_LW13.arx") Arg_MinV = aParLW13[ 1] // Начальное значение аргумента Arg_MaxV = aParLW13[ 2] // Конечное значение аргумента Arg_Delta = aParLW13[ 3] // Шаг изменения аргумента Ampl = aParLW13[ 4] // Начальная ампилитуда свип-сигнала Chast = aParLW13[ 5] // Начальная частота свип-сигнала Faza = aParLW13[ 6] // Фаза свип-сигнала KZat_Ampl = aParLW13[ 7] // Коэффициент затухания амплитуды KZat_Chast = aParLW13[ 8] // Коэффициент возрастания частоты *** Параметры гауссовского шума Mean = aParLW13[ 9] // Среднее значение Sigma = aParLW13[10] // Средне-квадратичное отклонение N_Izmer = aParLW13[11] // Количество измерений знач.функции ELSE PUBLIC Arg_MinV := 0 // Начальное значение аргумента PUBLIC Arg_MaxV := 360 // Конечное значение аргумента PUBLIC Arg_Delta := 1 // Шаг изменения аргумента PUBLIC Ampl := 1 // Начальная ампилитуда свип-сигнала PUBLIC Chast := 3 // Начальная частота свип-сигнала PUBLIC Faza := 0 // Фаза свип-сигнала PUBLIC KZat_Ampl := 0.005 // Коэффициент затухания амплитуды PUBLIC KZat_Chast := 0.015 // Коэффициент возрастания частоты *** Параметры гауссовского шума PUBLIC Mean := 0 // Среднее значение PUBLIC Sigma := 10 // Средне-квадратичное отклонение PUBLIC N_Izmer := 3 // Количество измерений знач.функции ENDIF ************************************************************************************************** @ 0 , 0 DCSAY L('Исследование когнитивных функций') FONT "10.Helvetica Bold" SIZE 0 @ 0.8, 0 DCSAY L('на примере свип-сигнала с шумом' ) FONT "10.Helvetica Bold" SIZE 0 @ 0 ,38 DCPUSHBUTTON CAPTION L('Помощь') SIZE 15, 1.8 ACTION {||Help_LW13()} @ 2 , 0 DCGROUP oGroup1 CAPTION L('Задайте параметры синтеза модели:') SIZE 53, 19 @ 1 , 1 DCGROUP oGroup2 CAPTION L('Задайте параметры свип-сигнала:' ) SIZE 51, 10.5 PARENT oGroup1 Mess1 = L('Начальное значение аргумента:') Mess2 = L('Конечное значение аргумента:') Mess3 = L('Шаг изменения аргумента:' ) @ 1, 1 DCSAY Mess1 PARENT oGroup2 @ 2, 1 DCSAY Mess2 PARENT oGroup2 @ 3, 1 DCSAY Mess3 PARENT oGroup2 @ 1,30 DCSAY L(" ") GET Arg_MinV PARENT oGroup2 PICTURE "###############" @ 2,30 DCSAY L(" ") GET Arg_MaxV PARENT oGroup2 PICTURE "###############" @ 3,30 DCSAY L(" ") GET Arg_Delta PARENT oGroup2 PICTURE "#######.#######" Mess1 = L('Начальная ампилитуда свип-сигнала:') @ 5, 1 DCSAY Mess1 PARENT oGroup2 @ 5,30 DCSAY L(" ") GET Ampl PARENT oGroup2 PICTURE "###############" Mess1 = L('Начальная частота свип-сигнала:') @ 6, 1 DCSAY Mess1 PARENT oGroup2 @ 6,30 DCSAY L(" ") GET Chast PARENT oGroup2 PICTURE "###############" Mess1 = L('Фаза свип-сигнала:') @ 7, 1 DCSAY Mess1 PARENT oGroup2 @ 7,30 DCSAY L(" ") GET Faza PARENT oGroup2 PICTURE "###############" Mess1 = L('Коэффициент затухания амплитуды:') @ 8, 1 DCSAY Mess1 PARENT oGroup2 @ 8,30 DCSAY L(" ") GET KZat_Ampl PARENT oGroup2 PICTURE "#######.#######" Mess1 = L('Коэффициент возрастания частоты:') @ 9, 1 DCSAY Mess1 PARENT oGroup2 @ 9,30 DCSAY L(" ") GET KZat_Chast PARENT oGroup2 PICTURE "#######.#######" * @12.5, 1 DCGROUP oGroup3 CAPTION L('Задайте параметры аддитивного гауссовского шума:') SIZE 51, 5.5 PARENT oGroup1 @12.5, 1 DCGROUP oGroup3 CAPTION L('Задайте параметры шума:' ) SIZE 51, 5.5 PARENT oGroup1 Mess1 = 'Среднее значение:' @1, 1 DCSAY Mess1 PARENT oGroup3 @1,30 DCSAY L(" ") GET Mean PARENT oGroup3 PICTURE "#######.#######" * Mess1 = L('Средне-квадратичное отклонение:') Mess1 = 'Ампилитуда:' @2, 1 DCSAY Mess1 PARENT oGroup3 @2,30 DCSAY L(" ") GET Sigma PARENT oGroup3 PICTURE "#######.#######" Mess1 = L('Количество измерений знач.функции') Mess2 = L('для каждого значения аргумента:' ) @ 3 , 1 DCSAY Mess1 PARENT oGroup3 @ 3.7, 1 DCSAY Mess2 PARENT oGroup3 @ 3.4,30 DCSAY L(" ") GET N_Izmer PARENT oGroup3 PICTURE "###############" DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('1.3. Задание параметров модели Лаб.раб.№14') *************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF *************************************************** ************************************************************************************************** N_Izmer = IF(N_Izmer >=1, N_Izmer, 1) // Сохранить файл с информацией о заданых параметрах модели в текущей директории системы // и в папке приложения, чтобы можно было потом узнать при каких параметрах оно создано PUBLIC aParLW13[11] aParLW13[ 1] = Arg_MinV // Начальное значение аргумента aParLW13[ 2] = Arg_MaxV // Конечное значение аргумента aParLW13[ 3] = Arg_Delta // Шаг изменения аргумента aParLW13[ 4] = Ampl // Начальная ампилитуда свип-сигнала aParLW13[ 5] = Chast // Начальная частота свип-сигнала aParLW13[ 6] = Faza // Фаза свип-сигнала aParLW13[ 7] = KZat_Ampl // Коэффициент затухания амплитуды aParLW13[ 8] = KZat_Chast // Коэффициент возрастания частоты *** Параметры гауссовского шума aParLW13[ 9] = Mean // Среднее значение aParLW13[10] = Sigma // Средне-квадратичное отклонение aParLW13[11] = N_Izmer // Количество измерений знач.функции DC_ASave(aParLW13 , Disk_dir +"\_1_3_LW13.arx") * DC_ASave(aParLW13 , M_NewAppl+"\_1_3_LW13.arx") ************************************************************************************************** // Задание максимальной величины параметра Time IF Sigma > 0 Wsego = 2 + ( ( Arg_MaxV - Arg_MinV + 1 ) / Arg_Delta ) * 2 * N_Izmer + 1 ELSE Wsego = 2 + ( ( Arg_MaxV - Arg_MinV + 1 ) / Arg_Delta ) * 1 * N_Izmer + 1 ENDIF // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage1 @ 7,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 PRIVATE aSay[12] s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // Создание файла исходных данных: "Inp_data.dbf" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Создание файла наим.класс.и опис.шкал и градаций: "Inp_name.txt" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // Заполнение файла исходных данных: "Inp_data.dbf" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // Формирование файла параметров программного интерфейса: "_2_3_2_2.arx" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('1.3. Установка ')+aLabWName[M_CurrLab] ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ************************************************************************************************** aSay[1]:SetCaption(L('1/4. Создание файла исходных данных: "Inp_data.dbf"')) //******************************************** // Путь на папку с исходными БД лабораторной работы M_PathInpData = UPPER(Disk_dir + "\AID_DATA\Inp_data\") DIRCHANGE(M_PathInpData) aStructure := { { "Obj_name" , "C", 25, 0 }, ; // Наименование объекта обучающей выборки { "Funct_TUni", "N", 19, 7 }, ; // Зашумленное (эмпирическое) значение функции (равномерное распределение) { "Funct_TNor", "N", 19, 7 }, ; // Зашумленное (эмпирическое) значение функции (нормальное распределение (аддитивный гауссовский шум)) { "Funct_True", "N", 19, 7 }, ; // Истинное (теоретическое) значение функции { "Noise_Unif", "N", 19, 7 }, ; // Значение шума (равномерное распределение) { "Noise_Norm", "N", 19, 7 }, ; // Значение шума (нормальное распределение (аддитивный гауссовский шум)) { "Argument" , "N", 19, 7 } } // Аргумент DbCreate( 'Inp_data.dbf', aStructure ) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 1 aSay[1]:SetCaption(aSay[1]:caption+L(' - Готово ')) aSay[2]:SetCaption(L('2/4. Создание файла наим.класс.и опис.шкал и градаций: "Inp_name.txt"')) //*************************** CrLf = CHR(13)+CHR(10) // Конец строки (записи) String = "Равномерно зашумленное (эмпирическое) значение функции" + CrLf +; "Нормально зашумленное (эмпирическое) значение функции" + CrLf +; "Истинное (теоретическое) значение функции" + CrLf +; "Значение шума (равномерное распределение)" + CrLf +; "Значение шума (нормальное распределение)" + CrLf +; "Значение аргумента" StrFile(String, "Inp_name.txt") // Запись текстового файла "Inp_name.txt" lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 2 aSay[2]:SetCaption(aSay[2]:caption+L(' - Готово ')) aSay[3]:SetCaption(L('3/4. Заполнение файла исходных данных: "Inp_data.dbf"')) //******************************************* * aParLW13[ 1] = Arg_MinV // Начальное значение аргумента * aParLW13[ 2] = Arg_MaxV // Конечное значение аргумента * aParLW13[ 3] = Arg_Delta // Шаг изменения аргумента * aParLW13[ 4] = Ampl // Начальная ампилитуда свип-сигнала * aParLW13[ 5] = Chast // Начальная частота свип-сигнала * aParLW13[ 6] = Faza // Фаза свип-сигнала * aParLW13[ 7] = KZat_Ampl // Коэффициент затухания амплитуды * aParLW13[ 8] = KZat_Chast // Коэффициент возрастания частоты * *** Параметры гауссовского шума * aParLW13[ 9] = Mean // Среднее значение * aParLW13[10] = Sigma // Средне-квадратичное отклонение * aParLW13[11] = N_Izmer // Количество измерений знач.функции ** F(X) для r=0 и заданных Mean и Sigma: rn = 0 IF Sigma > 0 r0 = 1 / ( Sigma * SQRT( 2 * PI())) * EXP( -1/2 * ( rn - Mean )^2 / Sigma^2 ) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Inp_data EXCLUSIVE NEW;ZAP SELECT Inp_data ********** Расчет и нормирование амплитуды шума ************ IF Sigma > 0 ru = Sec_1 rn = Sec_1 A_NoiseUnif := {} A_NoiseNorm := {} mMin_NoiseUnif = +9999999999 mMax_NoiseUnif = -9999999999 mMin_NoiseNorm = +9999999999 mMax_NoiseNorm = -9999999999 FOR mArg = Arg_MinV TO Arg_MaxV STEP Arg_Delta FOR mIzm = 1 TO N_Izmer ru = Mean + LC_RANDOM(ru) * 2 * Sigma - Sigma rn = Mean + LC_RANDOM(rn) * 2 * Sigma - Sigma r1 = 1 / ( Sigma * SQRT( 2 * PI())) * EXP( -1/2 * ( rn - Mean )^2 / Sigma^2 ) Gauss = IF(rn > 0, 1, -1) * (r0-r1) AADD(A_NoiseUnif, ru ) // Равномерное распределение AADD(A_NoiseNorm, Gauss ) // Нормальное распределение (аддитивный гауссовский шум) mMin_NoiseUnif = MIN(mMin_NoiseUnif, ru) mMax_NoiseUnif = MAX(mMax_NoiseUnif, ru) mMin_NoiseNorm = MIN(mMin_NoiseNorm, Gauss) mMax_NoiseNorm = MAX(mMax_NoiseNorm, Gauss) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 3 NEXT NEXT KNA_NoiseUnif = ( 2 * Sigma ) / (mMax_NoiseUnif - mMin_NoiseUnif) FOR j=1 TO LEN(A_NoiseUnif) A_NoiseUnif[j] = A_NoiseUnif[j] * KNA_NoiseUnif NEXT KNA_NoiseNorm = ( 2 * Sigma ) / (mMax_NoiseNorm - mMin_NoiseNorm) FOR j=1 TO LEN(A_NoiseNorm) A_NoiseNorm[j] = A_NoiseNorm[j] * KNA_NoiseNorm NEXT ENDIF un = 0 FOR mArg = Arg_MinV TO Arg_MaxV STEP Arg_Delta FOR mIzm = 1 TO N_Izmer F = Ampl*EXP(-KZat_Ampl*mArg)*COS(DTOR(Chast*mArg+Chast*EXP(+KZat_Chast*mArg)+Faza)) ++un APPEND BLANK IF Sigma > 0 REPLACE Obj_name WITH ALLTRIM(STR(mArg)) // Наименование объекта обучающей выборки REPLACE Funct_TUni WITH F + A_NoiseUnif[un] // Зашумленное (эмпирическое) значение функции (равномерное распределение) REPLACE Funct_TNor WITH F + A_NoiseNorm[un] // Зашумленное (эмпирическое) значение функции (нормальное распределение (аддитивный гауссовский шум)) REPLACE Funct_True WITH F // Истинное (теоретическое) значение функции REPLACE Noise_Unif WITH A_NoiseUnif[un] // Значение шума (равномерное распределение) REPLACE Noise_Norm WITH A_NoiseNorm[un] // Значение шума (нормальное распределение (аддитивный гауссовский шум)) REPLACE Argument WITH mArg // Аргумент ELSE REPLACE Obj_name WITH ALLTRIM(STR(mArg)) // Наименование объекта обучающей выборки REPLACE Funct_TUni WITH F // Зашумленное (эмпирическое) значение функции (равномерное распределение) REPLACE Funct_TNor WITH F // Зашумленное (эмпирическое) значение функции (нормальное распределение (аддитивный гауссовский шум)) REPLACE Funct_True WITH F // Истинное (теоретическое) значение функции REPLACE Noise_Unif WITH 0 // Значение шума (равномерное распределение) REPLACE Noise_Norm WITH 0 // Значение шума (нормальное распределение (аддитивный гауссовский шум)) REPLACE Argument WITH mArg // Аргумент ENDIF lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 3 NEXT NEXT aSay[3]:SetCaption(aSay[3]:caption+L(' - Готово ')) aSay[4]:SetCaption(L('4/4. Формирование файла параметров программного интерфейса: "_2_3_2_2.arx"')) //********************** Regim = 1 // Формализации ПО или ген.расп.выб. Flag_zer = 1 // Считать нули и пробелы отсутствием данных? [1]-да, [2]-нет N_Chast = 1 // На сколько частей N разбивать обучающую или распознаваемую выборку (в зависимости от Regim) M_ClSc1 = 2 // Номер начального столбца диапазона классификационных шкал M_ClSc2 = 4 // Номер конечного столбца диапазона классификационных шкал M_OpSc1 = 7 // Номер начального столбца диапазона описательных шкал M_OpSc2 = 7 // Номер конечного столбца диапазона описательных шкал M_ObAnk = 3 // Создавать анкеты исходной выборки по строкам Inp_data-[1], по классам-[2], и 1-е, и 2-е [3] M_Interval = 1 // 1-равные интервалы, 2-адаптивные интервалы (с примерно равным количеством наблюдений, по Котельникову) N_SKGrCl = 30 N_SKGrPr = 30 K_N_ClSc = 1 K_N_OpSc = 1 K_N_GrClSc = 30 K_N_GrOpSc = 30 M_Scenario = .F. mGorizMin = 5 mGorizMax = 5 mGlubMin = 5 mGlubMax = 5 K_GradNClSc = 30 K_GradNOpSc = 30 M_ChastObi = .F. M_ChastRso = .F. N_ChastObi = 1 N_ChastRso = 1 M_XlsDbf = 3 mTxtCSField = 1 // Способ интерпретации значений текстовых полей - классификационных шкал файла исходных данных mTxtOSField = 1 // Способ интерпретации значений текстовых полей - описательных шкал файла исходных данных mTxtCSSep = " " // Разделитель элементов классификационных шкал, если mTxtCSField=3 mTxtOSSep = " " // Разделитель элементов описательных шкал, если mTxtOSField=3 * mScenario = 1 // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей (старый вариант) mScenario = 1 // Не применять сценарный метод АСК-анализа mSpecInterprCls = .F. // .T. - Применить спец.интерпретацию текстовых полей классов, .F. - не применять mSpecInterprAtr = .F. // .T. - Применить спец.интерпретацию текстовых полей признаков, .F. - не применять mNameGrNumSc= 1 // Какие наименования ГРАДАЦИЙ числовых шкал использовать mClsAvr = .F. // .F. - делать модель из Inp_data, .T. - делать модель из Inp_data_avr mSortUnqCls = 1 // Выделять уникальные значения классов и сортировать, 1-да, 2-нет mLemmatCls = 2 // Проводить лемматизацию классов, 1-да, 2-нет mSortUnqGos = 1 // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет mLemmatGos = 2 // Проводить лемматизацию признаков, 1-да, 2-нет // Сохранить файл с информацией о заданых параметрах программного интерфейса в текущей директории системы PRIVATE aSoftInt[40] aSoftInt[ 1] = Regim aSoftInt[ 2] = Flag_zer aSoftInt[ 3] = M_ClSc1 aSoftInt[ 4] = M_ClSc2 aSoftInt[ 5] = M_OpSc1 aSoftInt[ 6] = M_OpSc2 aSoftInt[ 7] = N_SKGrCl aSoftInt[ 8] = N_SKGrPr aSoftInt[ 9] = K_N_ClSc aSoftInt[10] = K_N_OpSc aSoftInt[11] = K_N_GrClSc aSoftInt[12] = K_N_GrOpSc aSoftInt[13] = M_ObAnk aSoftInt[14] = N_Chast aSoftInt[15] = M_Interval aSoftInt[16] = M_Scenario aSoftInt[17] = K_GradNClSc // Количество градаций в числовой классификационной шкале aSoftInt[18] = K_GradNOpSc // Количество градаций в числовой описательной шкале aSoftInt[19] = mGorizMin aSoftInt[20] = mGorizMax aSoftInt[21] = mGlubMin aSoftInt[22] = mGlubMax aSoftInt[23] = M_ChastObi aSoftInt[24] = M_ChastRso aSoftInt[25] = N_ChastObi aSoftInt[26] = N_ChastRso aSoftInt[27] = M_XlsDbf aSoftInt[28] = mTxtCSField aSoftInt[29] = mTxtOSField aSoftInt[30] = mTxtCSSep aSoftInt[31] = mTxtOSSep * aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей (старый вариант) aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа aSoftInt[33] = mSpecInterprCls // Применить спец.интерпретацию текстовых полей классов aSoftInt[34] = mSpecInterprAtr // Применить спец.интерпретацию текстовых полей признаков aSoftInt[35] = mNameGrNumSc // Какие наименования ГРАДАЦИЙ числовых шкал использовать aSoftInt[36] = mClsAvr // .F. = модель без усреднения по классам aSoftInt[37] = mSortUnqCls // Выделять уникальные значения классов и сортировать, 1-да, 2-нет aSoftInt[38] = IF(mSpecInterprCls,mLemmatCls,2) // Проводить лемматизацию классов, 1-да, 2-нет aSoftInt[39] = mSortUnqGos // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет aSoftInt[40] = IF(mSpecInterprAtr,mLemmatGos,2) // Проводить лемматизацию признаков, 1-да, 2-нет DC_ASave(aSoftInt , Disk_dir +"\_2_3_2_2.arx") * DC_ASave(aSoftInt , M_NewAppl+"\_2_3_2_2.arx") lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // 4 aSay[4]:SetCaption(aSay[4]:caption+L(' - Готово ')) Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() **** Отображение графических диаграмм PointChart("Norm") PointChart("Unif") *** Вызов функции 2.3.2.2() ********************************** ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW // Создать папку приложения - новой лабораторной работы M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) // Путь на БД новой лабораторной работы в папке приложений и наименование ЛР в БД приложений // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки F2_3_2_2(aLabWName[M_CurrLab],"1.3()") // Запуск универсального программного интерфейса с внешними базами данных aMess := {} mLW = ALLTRIM(aLabWName[M_CurrLab]) AADD(aMess, STRTRAN(mLW, ":", ': "')+'" успешно установлена!') AADD(aMess, L(" ")) AADD(aMess, L("Для дальнейшего ее изучения и выполнения необходимо:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Открыть файл исходных данных: "+M_PathInpData+"Inp_data.dbf.")) AADD(aMess, L(" ")) AADD(aMess, L("2. Прочитать описание данной лабораторной работы в режиме 5.14.")) AADD(aMess, L(" ")) AADD(aMess, L("3. Выполнить режимы: 2.1, 2.2, 2.3, 3.5, 4.1.3.6, 4.1.3.1 и другие")) AADD(aMess, L(" в соответствии со схемой преобразования данных в информацию,")) AADD(aMess, L(" а ее в знания, приведенной в режиме 6.4.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) N_InsLFakt = 1 // Кол-во фактически установленных лабораторных работ (факт) CASE M_CurrLab=15 // Лаб.раб.№ 15: Исследование нормального распределения ************************************************************************************************** ** Массив с параметрами модели ******************** ** Если файл _1_3_15.arx существует, то ** присвоить всем переменным, задаваемым в диалоге, начальные значения ** из этого файла и с этими значениями начинать диалог ** Если файл _1_3_15.arx не существует, то ** присвоить всем переменным, задаваемым в диалоге, начальные значения по умолчанию ** и начинать диалог с этих значений IF FILE(Disk_dir+"\_1_3_LW15.arx") aParLW15 = DC_ARestore(Disk_dir+"\_1_3_LW15.arx") *** Параметры исходных данных Arg_MinV = aParLW15[ 1] // Начальное значение аргумента Arg_MaxV = aParLW15[ 2] // Конечное значение аргумента N_Arg = aParLW15[ 3] // Количество значений аргумента N_Nabl = aParLW15[ 4] // Количество наблюдений *** Параметры нормальных распределений Mean_MinV = aParLW15[ 5] // Начальное значение среднего Mean_MaxV = aParLW15[ 6] // Конечное значение среднего N_Mean = aParLW15[ 7] // Количество значений среднего Sigma_MinV = aParLW15[ 8] // Начальное значение среднеквадратичного отклонения Sigma_MaxV = aParLW15[ 9] // Конечное значение среднеквадратичного отклонения N_Sigma = aParLW15[10] // Количество значений среднеквадратичного отклонения ELSE *** Параметры исходных данных PUBLIC Arg_MinV := -4 // Начальное значение аргумента PUBLIC Arg_MaxV := +4 // Конечное значение аргумента PUBLIC N_Arg := 500 // Количество значений аргумента PUBLIC N_Nabl := 250 // Количество наблюдений *** Параметры нормальных распределений PUBLIC Mean_MinV := -0.5 // Начальное значение среднего PUBLIC Mean_MaxV := +0.5 // Конечное значение среднего PUBLIC N_Mean := 3 // Количество значений среднего PUBLIC Sigma_MinV := 0.5 // Начальное значение среднеквадратичного отклонения PUBLIC Sigma_MaxV := 1.5 // Конечное значение среднеквадратичного отклонения PUBLIC N_Sigma := 3 // Количество значений среднеквадратичного отклонения ENDIF ************************************************************************************************** @ 0 , 0 DCSAY L('Исследование нормальных распреде-') FONT "10.Helvetica Bold" SIZE 0 @ 0.8, 0 DCSAY L('лений методами теории информации ') FONT "10.Helvetica Bold" SIZE 0 @ 0 ,42 DCPUSHBUTTON CAPTION L('Помощь') SIZE 12, 1.8 ACTION {||Help_LW13()} @ 2.0, 0 DCGROUP oGroup1 CAPTION L('Задайте параметры исходных данных:') SIZE 54, 5.5 Mess1 = L('Начальное значение аргумента:') Mess2 = L('Конечное значение аргумента:') Mess3 = L('Количество значений аргумента:') Mess4 = L('Количество наблюдений в распределении:') @ 1 , 1 DCSAY Mess1 PARENT oGroup1 @ 2 , 1 DCSAY Mess2 PARENT oGroup1 @ 3 , 1 DCSAY Mess3 PARENT oGroup1 @ 4 , 1 DCSAY Mess4 PARENT oGroup1 @ 1.0,32 DCSAY L(" ") GET Arg_MinV PARENT oGroup1 PICTURE "###############" @ 2.0,32 DCSAY L(" ") GET Arg_MaxV PARENT oGroup1 PICTURE "###############" @ 3.0,32 DCSAY L(" ") GET N_Arg PARENT oGroup1 PICTURE "###############" @ 4.0,32 DCSAY L(" ") GET N_Nabl PARENT oGroup1 PICTURE "###############" @ 8.0, 0 DCGROUP oGroup2 CAPTION L('Задайте параметры среднего значения:') SIZE 54, 4.5 Mess1 = L('Начальное значение среднего:') Mess2 = L('Конечное значение среднего:') Mess3 = L('Количество значений среднего:') @ 1 , 1 DCSAY Mess1 PARENT oGroup2 @ 2 , 1 DCSAY Mess2 PARENT oGroup2 @ 3 , 1 DCSAY Mess3 PARENT oGroup2 @ 1.0,32 DCSAY L(" ") GET Mean_MinV PARENT oGroup2 PICTURE "#######.#######" @ 2.0,32 DCSAY L(" ") GET Mean_MaxV PARENT oGroup2 PICTURE "#######.#######" @ 3.0,32 DCSAY L(" ") GET N_Mean PARENT oGroup2 PICTURE "###############" @13.0, 0 DCGROUP oGroup3 CAPTION L('Задайте параметры стандартного отклонения:') SIZE 54, 4.5 Mess1 = L('Начальное значение станд.отклонения:') Mess2 = L('Конечное значение станд.отклонения:') Mess3 = L('Количество значений станд.отклонения:') @ 1 , 1 DCSAY Mess1 PARENT oGroup3 @ 2 , 1 DCSAY Mess2 PARENT oGroup3 @ 3 , 1 DCSAY Mess3 PARENT oGroup3 @ 1.0,32 DCSAY L(" ") GET Sigma_MinV PARENT oGroup3 PICTURE "#######.#######" @ 2.0,32 DCSAY L(" ") GET Sigma_MaxV PARENT oGroup3 PICTURE "#######.#######" @ 3.0,32 DCSAY L(" ") GET N_Sigma PARENT oGroup3 PICTURE "###############" DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('1.5. Задание параметров модели Лаб.раб.№15') *************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF *************************************************** ************************************************************************************************** * N_Arg // Кол-во значений аргумента * N_Nabl = IF(N_Nabl >=N_Arg, N_Nabl, N_Arg) // Сохранить файл с информацией о заданых параметрах модели в текущей директории системы // и в папке приложения, чтобы можно было потом узнать при каких параметрах оно создано PUBLIC aParLW15[10] *** Параметры исходных данных aParLW15[ 1] = Arg_MinV // Начальное значение аргумента aParLW15[ 2] = Arg_MaxV // Конечное значение аргумента aParLW15[ 3] = N_Arg // Количество значений аргумента aParLW15[ 4] = N_Nabl // Количество наблюдений *** Параметры нормальных распределений aParLW15[ 5] = Mean_MinV // Начальное значение среднего aParLW15[ 6] = Mean_MaxV // Конечное значение среднего aParLW15[ 7] = N_Mean // Количество значений среднего aParLW15[ 8] = Sigma_MinV // Начальное значение среднеквадратичного отклонения aParLW15[ 9] = Sigma_MaxV // Конечное значение среднеквадратичного отклонения aParLW15[10] = N_Sigma // Количество значений среднеквадратичного отклонения ************************************************************************************************** ** Проверить корректность заданных параметров FlagErr = .F. IF Arg_MinV < Arg_MaxV ELSE MessErr = 'Неверно задан диапазон значений аргументов: конечное значение должно быть больше начального !' FlagErr = .T. ENDIF IF N_Arg > 2 ELSE MessErr = 'Неверно задано количество значений аргумента: их должно быть больше одного !' FlagErr = .T. ENDIF IF N_Nabl > 2 ELSE MessErr = 'Неверно задано количество наблюдений: их должно быть больше одного !' FlagErr = .T. ENDIF IF Mean_MinV < Mean_MaxV ELSE MessErr = 'Неверно задан диапазон значений среднего: конечное значение должно быть больше начального !' FlagErr = .T. ENDIF IF N_Mean > 2 ELSE MessErr = 'Неверно задано количество значений среднего: их должно быть больше одного !' FlagErr = .T. ENDIF IF Sigma_MinV < Sigma_MaxV ELSE MessErr = 'Неверно задан диапазон значений станд.отклонения: конечное значение должно быть больше начального !' FlagErr = .T. ENDIF IF N_Sigma > 2 ELSE MessErr = 'Неверно задано количество значений станд.отклонения: их должно быть больше одного !' FlagErr = .T. ENDIF IF FlagErr LB_Warning(MessErr, '(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"') ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN(.F.) ENDIF DC_ASave(aParLW15 , Disk_dir +"\_1_3_LW15.arx") * DC_ASave(aParLW15 , M_NewAppl+"\_1_3_LW15.arx") ************************************************************************************************** // Задание максимальной величины параметра Time Wsego = N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 5 + N_Arg + 1 // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,6.5 ; PARENT oTabPage1 @ 8,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 PRIVATE aSay[12] s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // Создание файла для расчета норм.рапределений: "Norm_raspr.dbf" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Создание файла исходных данных: "Inp_data.dbf" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // Создание файла наим.класс.и опис.шкал и градаций: "Inp_name.txt" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // Заполнение файла исходных данных: "Inp_data.dbf" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // Формирование файла параметров программного интерфейса: "_2_3_2_2.arx" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('1.3. Установка ')+aLabWName[M_CurrLab] ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ************************************************************************************************** aSay[1]:SetCaption(L('1/5. Создание файла для расчета норм.рапр.: "Norm_raspr.dbf"')) //*********************************** // Путь на папку с исходными БД лабораторной работы M_PathInpData = UPPER(Disk_dir + "\AID_DATA\Inp_data\") DIRCHANGE(M_PathInpData) aStructure := { { "Num_pp" , "N", 15, 0 },; // Порядковый номер { "Agrument", "N", 19, 7 } } // Значение аргумента FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma mFun = "NR-"+ALLTRIM(STR(im,19))+"-"+ALLTRIM(STR(jm,19)) AADD(aStructure, { mFun, "N", 19, 7 }) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean NEXT DbCreate( 'Norm_raspr.dbf', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Norm_raspr EXCLUSIVE NEW SELECT Norm_raspr * ********************************************************************************** * *** Параметры исходных данных * aParLW15[ 1] = Arg_MinV // Начальное значение аргумента * aParLW15[ 2] = Arg_MaxV // Конечное значение аргумента * aParLW15[ 3] = N_Arg // Количество значений аргумента * aParLW15[ 4] = N_Nabl // Количество наблюдений * *** Параметры нормальных распределений * aParLW15[ 5] = Mean_MinV // Начальное значение среднего * aParLW15[ 6] = Mean_MaxV // Конечное значение среднего * aParLW15[ 7] = N_Mean // Количество значений среднего * aParLW15[ 8] = Sigma_MinV // Начальное значение среднеквадратичного отклонения * aParLW15[ 9] = Sigma_MaxV // Конечное значение среднеквадратичного отклонения * aParLW15[10] = N_Sigma // Количество значений среднеквадратичного отклонения * ********************************************************************************** ****** Заполнение БД значениями аргумента и функции для разных распределений PUBLIC aMean[N_Mean*N_Sigma] PUBLIC aSigma[N_Mean*N_Sigma] c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ aMean[c] = Mean_MinV + (im-1) * (Mean_MaxV - Mean_MinV ) / (N_Mean -1) aSigma[c] = Sigma_MinV + (jm-1) * (Sigma_MaxV - Sigma_MinV) / (N_Sigma-1) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 NEXT FOR km = 1 TO N_Arg xm = Arg_MinV + (km-1) * (Arg_MaxV - Arg_MinV) / (N_Arg-1) APPEND BLANK REPLACE Num_pp WITH km REPLACE Agrument WITH xm c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ FIELDPUT(2+c, 1 / ( aSigma[c] * SQRT( 2 * PI())) * EXP( -1/2 * ( xm - aMean[c] )^2 / aSigma[c]^2 )) NEXT NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg NEXT aSay[1]:SetCaption(aSay[1]:caption+L(' - Готово ')) ************************************************************************************************************************ * MsgBox('STOP') aSay[2]:SetCaption(L('2/5. Создание файла исходных данных: "Inp_data.dbf"')) //******************************************** // Путь на папку с исходными БД лабораторной работы M_PathInpData = UPPER(Disk_dir + "\AID_DATA\Inp_data\") DIRCHANGE(M_PathInpData) aStructure := { { "Num_obj" , "C", 15, 0 },; // 1 Порядковый номер { "FunctChr", "C", 19, 0 },; // 2 Значение функции текстовое { "FunctNum", "N", 19, 7 },; // 3 Значение функции числовое { "Argument", "N", 19, 7 },; // 4 Значение аргумента { "Mean" , "N", 19, 7 },; // 5 Среднее значение { "Sigma" , "N", 19, 7 } } // 6 Стандартное отклонение DbCreate( 'Inp_data.dbf', aStructure ) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 aSay[2]:SetCaption(aSay[2]:caption+L(' - Готово ')) ************************************************************************************************************************ * MsgBox('STOP') aSay[3]:SetCaption(L('3/5. Создание файла наим.класс.и опис.шкал и градаций: "Inp_name.txt"')) //*************************** CrLf = CHR(13)+CHR(10) // Конец строки (записи) String = "Текстовое значение функции" + CrLf +; "Числовое значение функции" + CrLf +; "Значение аргумента" + CrLf +; "Среднее значение" + CrLf +; "Стандартное отклонение" StrFile(String, "Inp_name.txt") // Запись текстового файла "Inp_name.txt" lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 aSay[3]:SetCaption(aSay[3]:caption+L(' - Готово ')) ************************************************************************************************************************ * MsgBox('STOP') aSay[4]:SetCaption(L('4/5. Заполнение файла исходных данных: "Inp_data.dbf"')) //******************************************* * ********************************************************************************** * *** Параметры исходных данных * aParLW15[ 1] = Arg_MinV // Начальное значение аргумента * aParLW15[ 2] = Arg_MaxV // Конечное значение аргумента * aParLW15[ 3] = N_Arg // Количество значений аргумента * aParLW15[ 4] = N_Nabl // Количество наблюдений * *** Параметры нормальных распределений * aParLW15[ 5] = Mean_MinV // Начальное значение среднего * aParLW15[ 6] = Mean_MaxV // Конечное значение среднего * aParLW15[ 7] = N_Mean // Количество значений среднего * aParLW15[ 8] = Sigma_MinV // Начальное значение среднеквадратичного отклонения * aParLW15[ 9] = Sigma_MaxV // Конечное значение среднеквадратичного отклонения * aParLW15[10] = N_Sigma // Количество значений среднеквадратичного отклонения * ********************************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Inp_data EXCLUSIVE NEW USE Norm_raspr EXCLUSIVE NEW PUBLIC aSumma[N_Mean*N_Sigma] PUBLIC aPrice[N_Mean*N_Sigma] AFILL(aSumma, 0) AFILL(aPrice, -1) SELECT Norm_raspr DBGOTOP() DO WHILE .NOT. EOF() c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ aSumma[c] = aSumma[c] + FIELDGET(2+c) NEXT NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg DBSKIP(1) ENDDO c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ IF aSumma[c] <> 0 aPrice[c] = N_Nabl / aSumma[c] ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean NEXT APPEND BLANK c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ FIELDPUT(2+c, aSumma[c]) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 2 NEXT APPEND BLANK c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ FIELDPUT(2+c, aPrice[c]) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 3 NEXT APPEND BLANK c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ FIELDPUT(2+c, aMean[c]) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 4 NEXT APPEND BLANK c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ FIELDPUT(2+c, aSigma[c]) NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 5 NEXT * aStructure := { { "Num_obj" , "C", 15, 0 },; // 1 Порядковый номер * { "FunctChr", "C", 19, 0 },; // 2 Значение функции текстовое * { "FunctNum", "N", 19, 7 },; // 3 Значение функции числовое * { "Argument", "N", 19, 7 },; // 4 Значение аргумента * { "Mean" , "N", 19, 7 },; // 5 Среднее значение * { "Sigma" , "N", 19, 7 } } // 6 Стандартное отклонение SELECT Inp_data mNumObj = 0 FOR km = 1 TO N_Arg xm = Arg_MinV + (km-1) * (Arg_MaxV - Arg_MinV) / N_Arg c = 0 FOR im=1 TO N_Mean FOR jm=1 TO N_Sigma c++ N_Record = aPrice[c] / ( aSigma[c] * SQRT( 2 * PI())) * EXP( -1/2 * ( xm - aMean[c] )^2 / aSigma[c]^2 ) IF N_Record > 0 FOR r=1 TO ROUND(N_Record,0) APPEND BLANK REPLACE Num_obj WITH ALLTRIM(STR(++mNumObj)) REPLACE FunctChr WITH "Gauss-"+ALLTRIM(STR(im,19))+"-"+ALLTRIM(STR(jm,19)) REPLACE FunctNum WITH N_Record REPLACE Argument WITH xm REPLACE Mean WITH aMean[c] REPLACE Sigma WITH aSigma[c] NEXT ENDIF NEXT NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 5 + N_Arg NEXT aSay[4]:SetCaption(aSay[4]:caption+L(' - Готово ')) ************************************************************************************************************************ * MsgBox('STOP') aSay[5]:SetCaption(L('5/5. Формирование файла параметров программного интерфейса: "_2_3_2_2.arx"')) //********************** * IF FILE("_2_3_2_2.arx") * * aSoftInt = DC_ARestore(Disk_dir+"\_2_3_2_2.arx") // Если параметры были заданы ранее, то использовать их * * ELSE Regim = 1 // Формализации ПО или ген.расп.выб. Flag_zer = 1 // Считать нули и пробелы отсутствием данных? [1]-да, [2]-нет N_Chast = 1 // На сколько частей N разбивать обучающую или распознаваемую выборку (в зависимости от Regim) M_ClSc1 = 2 // Номер начального столбца диапазона классификационных шкал M_ClSc2 = 2 // Номер конечного столбца диапазона классификационных шкал M_OpSc1 = 3 // Номер начального столбца диапазона описательных шкал M_OpSc2 = 6 // Номер конечного столбца диапазона описательных шкал M_ObAnk = 3 // Создавать анкеты исходной выборки по строкам Inp_data-[1], по классам-[2], и 1-е, и 2-е [3] M_Interval = 1 // 1-равные интервалы, 2-адаптивные интервалы (с примерно равным количеством наблюдений, по Котельникову) N_SKGrCl = 30 N_SKGrPr = 30 K_N_ClSc = 1 K_N_OpSc = 1 K_N_GrClSc = 30 K_N_GrOpSc = 30 M_Scenario = .F. mGorizMin = 5 mGorizMax = 5 mGlubMin = 5 mGlubMax = 5 K_GradNClSc = 30 K_GradNOpSc = 30 M_ChastObi = .F. M_ChastRso = .F. N_ChastObi = 1 N_ChastRso = 1 M_XlsDbf = 3 mTxtCSField = 1 // Способ интерпретации значений текстовых полей - классификационных шкал файла исходных данных mTxtOSField = 1 // Способ интерпретации значений текстовых полей - описательных шкал файла исходных данных mTxtCSSep = " " // Разделитель элементов классификационных шкал, если mTxtCSField=3 mTxtOSSep = " " // Разделитель элементов описательных шкал, если mTxtOSField=3 * mScenario = 1 // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей mScenario = 1 // Не применять сценарный метод АСК-анализа mSpecInterprCls = .F. // Не применять спец.интерпретацию текстовых полей классов mSpecInterprAtr = .F. // Не применять спец.интерпретацию текстовых полей признаков mNameGrNumSc= 1 // Какие наименования ГРАДАЦИЙ числовых шкал использовать mClsAvr = .F. // .F. - делать модель из Inp_data, .T. - делать модель из Inp_data_avr mSortUnqCls = 1 // Выделять уникальные значения классов и сортировать, 1-да, 2-нет mLemmatCls = 2 // Проводить лемматизацию классов, 1-да, 2-нет mSortUnqGos = 1 // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет mLemmatGos = 2 // Проводить лемматизацию признаков, 1-да, 2-нет // Сохранить файл с информацией о заданых параметрах программного интерфейса в текущей директории системы PRIVATE aSoftInt[40] aSoftInt[ 1] = Regim aSoftInt[ 2] = Flag_zer aSoftInt[ 3] = M_ClSc1 aSoftInt[ 4] = M_ClSc2 aSoftInt[ 5] = M_OpSc1 aSoftInt[ 6] = M_OpSc2 aSoftInt[ 7] = N_SKGrCl aSoftInt[ 8] = N_SKGrPr aSoftInt[ 9] = K_N_ClSc aSoftInt[10] = K_N_OpSc aSoftInt[11] = K_N_GrClSc aSoftInt[12] = K_N_GrOpSc aSoftInt[13] = M_ObAnk aSoftInt[14] = N_Chast aSoftInt[15] = M_Interval aSoftInt[16] = M_Scenario aSoftInt[17] = K_GradNClSc // Количество градаций в числовой классификационной шкале aSoftInt[18] = K_GradNOpSc // Количество градаций в числовой описательной шкале aSoftInt[19] = mGorizMin aSoftInt[20] = mGorizMax aSoftInt[21] = mGlubMin aSoftInt[22] = mGlubMax aSoftInt[23] = M_ChastObi aSoftInt[24] = M_ChastRso aSoftInt[25] = N_ChastObi aSoftInt[26] = N_ChastRso aSoftInt[27] = M_XlsDbf aSoftInt[28] = mTxtCSField aSoftInt[29] = mTxtOSField aSoftInt[30] = mTxtCSSep aSoftInt[31] = mTxtOSSep * aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа и спец.интерпретацию TXT-полей (старый вариант) aSoftInt[32] = mScenario // mScenario=1 Не применять сценарный метод АСК-анализа aSoftInt[33] = mSpecInterprCls // Применить спец.интерпретацию текстовых полей классов aSoftInt[34] = mSpecInterprAtr // Применить спец.интерпретацию текстовых полей признаков aSoftInt[35] = mNameGrNumSc // Какие наименования ГРАДАЦИЙ числовых шкал использовать aSoftInt[36] = mClsAvr // .F. = модель без усреднения по классам aSoftInt[37] = mSortUnqCls // Выделять уникальные значения классов и сортировать, 1-да, 2-нет aSoftInt[38] = IF(mSpecInterprCls,mLemmatCls,2) // Проводить лемматизацию классов, 1-да, 2-нет aSoftInt[39] = mSortUnqGos // Выделять уникальные значения признаков и сортировать, 1-да, 2-нет aSoftInt[40] = IF(mSpecInterprAtr,mLemmatGos,2) // Проводить лемматизацию признаков, 1-да, 2-нет * ENDIF DC_ASave(aSoftInt , Disk_dir +"\_2_3_2_2.arx") * DC_ASave(aSoftInt , M_NewAppl+"\_2_3_2_2.arx") lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) // N_Mean * 2 + N_Arg + 1 + 1 + N_Arg + N_Mean * 5 + N_Arg + 1 aSay[5]:SetCaption(aSay[5]:caption+L(' - Готово ')) ************************************************************************************************************************ * MsgBox('STOP') Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() **** Отображение графических диаграмм * PointChart("Norm") * PointChart("Unif") *** Вызов функции 2.3.2.2() ********************************** ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW // Создать папку приложения - новой лабораторной работы M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) // Путь на БД новой лабораторной работы в папке приложений и наименование ЛР в БД приложений // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки F2_3_2_2(aLabWName[M_CurrLab],"1.3()") // Запуск универсального программного интерфейса с внешними базами данных **************************************************************************************************************** ***** Подготовка распознаваемой выборки ************************************************************************ **************************************************************************************************************** ***** На основе БД EventsKO.dbf сделать БД распознаваемой выборки, ***** включающие столько описаний объектов, сколько задано распределений ***** для каждого распределения в кодах классов включить все уникальные коды классов всех объектов обучающей выборки, ***** а в коды признаков включить ВСЕ коды признаков всех объектов обучающей выборки ***** Сделать краткое отображение времени исполнения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE EventsKO EXCLUSIVE NEW INDEX ON FunctCHR TO NR_tmp CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE EventsKO INDEX NR_tmp EXCLUSIVE NEW USE Rso_Zag EXCLUSIVE NEW;ZAP USE Rso_Kcl EXCLUSIVE NEW;ZAP USE Rso_Kpr EXCLUSIVE NEW;ZAP SELECT EventsKO SET ORDER TO 1 DBGOTOP() mFunctCHR = FunctCHR A_KodCls := {} A_KodAtr := {} M_KodObj = 0 DO WHILE .NOT. EOF() IF mFunctCHR = FunctCHR IF ASCAN(A_KodCls, FunctCHR) = 0 AADD (A_KodCls, FunctCHR) ENDIF AADD (A_KodCls, FunctNum) FOR j=4 TO 6 AADD (A_KodAtr, FIELDGET(j)) NEXT ELSE ****** Запись заголовка в БД Rso_Zag SELECT Rso_Zag APPEND BLANK REPLACE Kod_obj WITH ++M_KodObj REPLACE Name_obj WITH ALLTRIM(STR(M_KodObj)) ****** Запись массива кодов классов в БД Rso_Kcl * ASORT(A_KodCls) SELECT Rso_Kcl APPEND BLANK FIELDPUT(1,M_KodObj) IF LEN(A_KodCls) > 0 k=2 FOR jj=1 TO LEN(A_KodCls) IF k <= 5 FIELDPUT(k++,A_KodCls[jj]) ELSE k=2 APPEND BLANK FIELDPUT(1,M_KodObj) FIELDPUT(k++,A_KodCls[jj]) ENDIF NEXT ENDIF ****** Запись массива кодов признаков в БД Rso_Kpr * ASORT(A_KodAtr) SELECT Rso_Kpr APPEND BLANK FIELDPUT(1,M_KodObj) IF LEN(A_KodAtr) > 0 k=2 FOR jj=1 TO LEN(A_KodAtr) IF k <= 8 FIELDPUT(k++,A_KodAtr[jj]) ELSE k=2 APPEND BLANK FIELDPUT(1,M_KodObj) FIELDPUT(k++,A_KodAtr[jj]) ENDIF NEXT ENDIF SELECT EventsKO mFunctCHR = FunctCHR A_KodCls := {} A_KodAtr := {} ENDIF DBSKIP(1) ENDDO ****** Запись заголовка в БД Rso_Zag SELECT Rso_Zag APPEND BLANK REPLACE Kod_obj WITH ++M_KodObj REPLACE Name_obj WITH ALLTRIM(STR(M_KodObj)) ****** Запись массива кодов классов в БД Rso_Kcl * ASORT(A_KodCls) SELECT Rso_Kcl APPEND BLANK FIELDPUT(1,M_KodObj) IF LEN(A_KodCls) > 0 k=2 FOR jj=1 TO LEN(A_KodCls) IF k <= 5 FIELDPUT(k++,A_KodCls[jj]) ELSE k=2 APPEND BLANK FIELDPUT(1,M_KodObj) FIELDPUT(k++,A_KodCls[jj]) ENDIF NEXT ENDIF ****** Запись массива кодов признаков в БД Rso_Kpr * ASORT(A_KodAtr) SELECT Rso_Kpr APPEND BLANK FIELDPUT(1,M_KodObj) IF LEN(A_KodAtr) > 0 k=2 FOR jj=1 TO LEN(A_KodAtr) IF k <= 8 FIELDPUT(k++,A_KodAtr[jj]) ELSE k=2 APPEND BLANK FIELDPUT(1,M_KodObj) FIELDPUT(k++,A_KodAtr[jj]) ENDIF NEXT ENDIF ****** Формирование массива параметров и запуск 3.5() **************************************************************************************************************** aMess := {} mLW = ALLTRIM(aLabWName[M_CurrLab]) AADD(aMess, STRTRAN(mLW, ":", ': "')+'" успешно установлена!') AADD(aMess, L(" ")) AADD(aMess, L("Для дальнейшего ее изучения и выполнения необходимо:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Открыть файл исходных данных: "+M_PathInpData+"Inp_data.dbf.")) AADD(aMess, L(" ")) AADD(aMess, L("2. Прочитать описание данной лабораторной работы в режиме 5.14.")) AADD(aMess, L(" ")) AADD(aMess, L("3. Выполнить режимы: 2.1, 2.2, 2.3, 3.5, 4.1.3.6, 4.1.3.1 и другие")) AADD(aMess, L(" в соответствии со схемой преобразования данных в информацию,")) AADD(aMess, L(" а ее в знания, приведенной в режиме 6.4.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) N_InsLFakt = 1 // Кол-во фактически установленных лабораторных работ (факт) ****************************************************************************************************************** CASE M_CurrLab=16 // Лаб.раб.№ 2.06: АСК-анализ изображений (на примере символов) // Путь на папку с исходными БД лабораторной работы M_PathInpData = UPPER(Disk_dir + "\AID_DATA\Inp_data\") aMess := {} AADD(aMess, L("Лаб.раб.№ 2.06: АСК-анализ изображений (на примере символов)")) AADD(aMess, L('запускается также из диспетчера приложений кликом на кнопке: "АСК-анализ изображений"')) AADD(aMess, L("и предполагает выполнение следующих ЭТАПОВ:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Задание параметров и генерация изображений символов, просмотр таблицы шрифта")) AADD(aMess, L(" ")) AADD(aMess, L("2. Выбор одного из способов оцифровки изображений: по всем пикселям, по внешним контурам,")) AADD(aMess, L(" по внешним и внутренним контурам и оцифровка изображений")) AADD(aMess, L(" ")) AADD(aMess, L('3. Ввод оцифрованных изображений в систему "Эйдос" с помощью одного из программных интерфейсов')) AADD(aMess, L(' После этого возникает новое приложение, название которого можно поменять в режиме 1.3.')) AADD(aMess, L(" ")) AADD(aMess, L("4. Просмотр классификационных и описательных шкал и градаций и обучающей выборки: 2.1, 2.2, 2.3.1, 2.4.")) AADD(aMess, L(" ")) AADD(aMess, L("5. Синтез и верификация системно-когнитивных моделей изображений: 3.4., 3.5, 4.1.3.6.")) AADD(aMess, L(" ")) AADD(aMess, L("6. Решение задач идентификации и исследования изображений: 4.1.3.1, 4.1.3.2.")) AADD(aMess, L(" ")) AADD(aMess, L("7. Просмотр и запись информационных портретов классов - обобщенных изображений символов.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) F4_7() ****************************************************************************************************************** CASE M_CurrLab=18 // Лаб.раб.№ 2.08: АСК-анализ символьных и числовых рядов aMess := {} AADD(aMess, L("Лаб.раб.№ 2.08: АСК-анализ исмвольных и числовых рядов")) AADD(aMess, L("и предполагает выполнение следующих ЭТАПОВ:")) AADD(aMess, L(" ")) AADD(aMess, L("1. Загрузка или генерация символьного или числового ряда")) AADD(aMess, L(" ")) AADD(aMess, L('2. Ввод исследуемого ряда в систему "Эйдос" с помощью универсального программного интерфейса 2.3.2.2.')) AADD(aMess, L(' После этого возникает новое приложение, название которого можно поменять в режиме 1.3.')) AADD(aMess, L(" ")) AADD(aMess, L("3. Просмотр классификационных и описательных шкал и градаций и обучающей выборки: 2.1, 2.2, 2.3.1, 2.4.")) AADD(aMess, L(" ")) AADD(aMess, L("4. Синтез и верификация системно-когнитивных моделей изображений: 3.4., 3.5, 4.1.3.6.")) AADD(aMess, L(" ")) AADD(aMess, L("5. Решение задач идентификации и исследования: 4.1.3.1, 4.1.3.2, 4.4.8, 4.4.9 и др.")) LB_Warning(aMess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) F2_3_2_6() *** Вызов функции 2.3.2.2() ********************************** ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW // Создать папку приложения - новой лабораторной работы M_NewAppl = ADD_ZAPPL(aLabWName[M_CurrLab]) // Путь на БД новой лабораторной работы в папке приложений и наименование ЛР в БД приложений // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки F2_3_2_2(aLabWName[M_CurrLab],"1.3()") // Запуск универсального программного интерфейса с внешними базами данных CASE M_CurrLab=19 // Лаб.раб.№ 19: Исследование RND-модели при различных объемах выборки, НОВАЯ: ######################### ****************************************************************************************************************************************** DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы ****** Выпонять ли лабораторную работу? mLogin = "Y" @0,0 DCGROUP oGroup1 CAPTION L('Выполнять лаб.работу?') SIZE 53.0, 3.5 @4,0 DCGROUP oGroup2 CAPTION L('Внимание!' ) SIZE 53.0, 3.0 @1.5,2 DCSAY L("Продолжить? :") GET mLogin PICTURE 'X' PARENT oGroup1 **** Если файл существует изображения и его контрольная сумма совпадает, то он отображается cFile = Disk_dir+"\_Aidos_gr55.jpg" IF FILE(cFile) IF FILECHECK(cFile) = 1847316 @8,240 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP CAPTION cFile SIZE 59,59 PIXEL PARENT oGroup1 ELSE Mess = L('Графический файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файлы LB_Warning(Mess) ENDIF ENDIF s = 1 d = 0.8 @s,2 DCSAY L('Выполнение лаб.работы приведет к удалению всех приложений') PARENT oGroup2;s=s+d @s,2 DCSAY L('Нажиме "OK" для продолжения или "Esc" для отмены. ') PARENT oGroup2;s=s+d DCREAD GUI; TO lExit ; FIT; ADDBUTTONS; MODAL; TITLE L('Лаб.работа №2.09: "Исследование RND-моделей"') ******************************************************************** IF lExit ** Button Ok ELSE RETURN NIL ENDIF ******************************************************************** IF mLogin = "N" RETURN NIL ENDIF F1_11() // Сброс всех приложений, если они есть ********** Создание БД параметров RND-приложений PRIVATE bItems aStructure := { { "Num" , "N", 5, 0 }, ; // 1 { "ParamName" , "C", 40, 0 }, ; // 2 { "InitValue" , "N", 15, 0 }, ; // 3 { "StepChang" , "N", 15, 0 }, ; // 4 { "FinalValue", "N", 15, 0 } } // 5 DbCreate( 'ParamRND', aStructure ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE ParamRND EXCLUSIVE NEW SELECT ParamRND ****** Начальные значения в таблице параметров ******** APPEND BLANK REPLACE Num WITH 1 REPLACE ParamName WITH L("Классификационных шкал") REPLACE InitValue WITH 10 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 2 REPLACE ParamName WITH L("Градаций в класс.шкале") REPLACE InitValue WITH 3 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 3 REPLACE ParamName WITH L("Описательных шкал") REPLACE InitValue WITH 10 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 4 REPLACE ParamName WITH L("Градаций в опис.шкале") REPLACE InitValue WITH 3 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 5 REPLACE ParamName WITH L("Объектов обучающей выборки") REPLACE InitValue WITH 10 REPLACE StepChang WITH 10 APPEND BLANK REPLACE Num WITH 6 REPLACE ParamName WITH L("Классов в объекте обуч.выборки") REPLACE InitValue WITH 5 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 7 REPLACE ParamName WITH L("Признаков в объекте обуч.выборки") REPLACE InitValue WITH 20 REPLACE StepChang WITH 0 APPEND BLANK REPLACE Num WITH 8 REPLACE ParamName WITH L("Число создаваемых RND-моделей") REPLACE InitValue WITH 3 REPLACE StepChang WITH 0 DBGOTO(8);mNumberCycles=FIELDGET(3) // Кодичество циклов создания приложений ******* В ЦИКЛЕ. ВЫХОД ИЗ ЦИКЛА ПО ЗАПУСКУ ФУНКЦИИ: 'Выход на расчет RND-приложений' PUBLIC mFlagExit := .T. RecalcParam() // Пересчитать параметры DO WHILE mFlagExit ******* Отображение БД ******* DBGOTOP() /* ----- Create ToolBar ----- */ d = 120 @13.2, 0 DCPUSHBUTTON CAPTION L('Помощь' ) SIZE 10, 1.5 ACTION {||HelpLW209() , DC_GetRefresh(GetList)} @13.2, DCGUI_COL+d DCPUSHBUTTON CAPTION L('Пересчитать параметры' ) SIZE 24, 1.5 ACTION {||RecalcParam(), DC_GetRefresh(GetList)} @13.2, DCGUI_COL+d+4 DCPUSHBUTTON CAPTION L('Выход на расчет RND-приложений') SIZE 32, 1.5 ACTION {||OutputCalc() , DC_GetRefresh(GetList)} FONT '9.Arial Bold' ****** Отображение таблицы *************** DCSETPARENT TO @ 1, 0 DCBROWSE ParamRND ALIAS 'ParamRND' SIZE 101,12.0 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; // Редактирование БД NOSOFTTRACK ; HEADLINES 3 ; // Кол-во строк в заголовке (перенос строки - ";") NOHSCROLL NOVSCROLL ; // Убрать горизонтальную и вертикальную полосы прокрутки SCOPE ; ITEMMARKED bItems DCSETPARENT ParamRND * aStructure := { { "Num" , "N", 5, 0 }, ; // 1 * { "ParamName" , "C", 40, 0 }, ; // 2 * { "InitValue" , "N", 15, 0 }, ; // 3 * { "StepChang" , "N", 15, 0 }, ; // 4 * { "FinalValue", "N", 15, 0 } } // 5 * DbCreate( 'ParamRND', aStructure ) *** Подарок от Роджера DCBROWSECOL FIELD ParamRND->Num HEADER L("Номер;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 5 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER DCBROWSECOL FIELD ParamRND->ParamName HEADER L("Наименование;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 45 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER DCBROWSECOL FIELD ParamRND->InitValue HEADER L("Начальное;значение;параметра") PARENT ParamRND FONT "9.Courier" WIDTH 15 COLOR {||{nil,aColor[ 38]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER DCBROWSECOL FIELD ParamRND->StepChang HEADER L("Шаг;изменения;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 15 COLOR {||{nil,aColor[ 38]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER DCBROWSECOL FIELD ParamRND->FinalValue HEADER L("Конечное;значение;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 15 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER * DCBROWSECOL DATA {||Alltrim(Str(ParamRND->Num ))} HEADER L("Номер;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 5 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER * DCBROWSECOL FIELD ParamRND->ParamName HEADER L("Наименование;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 45 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER * DCBROWSECOL DATA {||Alltrim(Str(ParamRND->InitValue ))} HEADER L("Начальное;значение;параметра") PARENT ParamRND FONT "9.Courier" WIDTH 15 COLOR {||{nil,aColor[ 38]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER * DCBROWSECOL DATA {||Alltrim(Str(ParamRND->StepChang ))} HEADER L("Шаг;изменения;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 15 COLOR {||{nil,aColor[ 38]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER * DCBROWSECOL DATA {||Alltrim(Str(ParamRND->FinalValue))} HEADER L("Конечное;значение;параметра" ) PARENT ParamRND FONT "9.Courier" WIDTH 15 PROTECT {|| .T. } COLOR {||{nil,aColor[100]}} ALIGN XBPALIGN_HCENTER+XBPALIGN_VCENTER DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE L('Задание параметров для расчета RND-моделей') ; EVAL {|o|SetAppFocus(ParamRND:GetColumn(1))} ****************************************************************************************************************************************** ENDDO DBGOTO(8);mNumberCycles=FIELDGET(3) // Число создаваемых RND-моделей RecalcParam() // Пересчитать параметры ****** Формирование параметров цикла по приложениям ************ * mNumberCycles // Кодичество циклов создания приложений PRIVATE aInitValue[8] // Начальные значения параметров PRIVATE aStepChang[8] // Шаг изменения значений параметров AFILL(aInitValue, 0) AFILL(aStepChang, 0) SELECT ParamRND * 1. Классификационных шкал * 2. Градаций в класс.шкале * 3. Описательных шкал * 4. Градаций в опис.шкале * 5. Объектов обучающей выборки * 6. Классов в объекте обуч.выборки * 7. Признаков в объекте обуч.выборки * 8. Число создаваемых RND-моделей FOR j=1 TO 7 DBGOTO(j) aInitValue[j] = FIELDGET(3) // Начальные значения параметров aStepChang[j] = FIELDGET(4) // Шаг изменения значений параметров NEXT ****** Проверка на корректность заданных параметров ######################### FOR mNumAppl = 1 TO mNumberCycles // Кодичество циклов создания приложений * FinalValue = InitValue + StepChang * ( mNumberCycles - 1 ) * mFinalValue = mInitValue + mStepChang * ( mNumAppl - 1 ) N_Csc = aInitValue[1] + aStepChang[1] * ( mNumAppl - 1 ) // 1. Классификационных шкал N_AvrGrCs = aInitValue[2] + aStepChang[2] * ( mNumAppl - 1 ) // 2. Градаций в класс.шкале N_Osc = aInitValue[3] + aStepChang[3] * ( mNumAppl - 1 ) // 3. Описательных шкал N_AvrGrOs = aInitValue[4] + aStepChang[4] * ( mNumAppl - 1 ) // 4. Градаций в опис.шкале N_Obj = aInitValue[5] + aStepChang[5] * ( mNumAppl - 1 ) // 5. Объектов обучающей выборки N_AvrGcs = aInitValue[6] + aStepChang[6] * ( mNumAppl - 1 ) // 6. Классов в объекте обуч.выборки N_AvrGos = aInitValue[7] + aStepChang[7] * ( mNumAppl - 1 ) // 7. Признаков в объекте обуч.выборки N_Gcs = N_Csc * N_AvrGrCs // Суммарное кол-во градаций клас.шкал (классов) N_Gos = N_Osc * N_AvrGrOs // Суммарное кол-во градаций опис.шкал (признаков) N_Cls = N_Gcs N_ObiKcl = N_AvrGcs*N_Obj/4 // Кол-во записей в БД кодов классов обучающей выборки N_ObiKpr = N_AvrGos*N_Obj/7 // Кол-во записей в БД кодов признаков обучающей выборки IF N_Csc * N_Osc * N_Gos * N_Gcs * N_Obj * N_AvrGcs * N_AvrGos * N_AvrGrOs * N_AvrGrCs = 0 LB_Warning(L("Параметры модели равные нулю недопустимы !!!"), L('Лаб.работа №2.09: "Исследование RND-моделей"')) RETURN NIL ENDIF // УСТАНОВКА ЛАБОРАТОРНОЙ РАБОТЫ ******************************** ########### Сделать функцию и обратиться здесь в 2.01 M_NewNAppl = aLabWName[M_CurrLab]+' ('+ALLTRIM(STR(N_Obj))+' объектов)' M_NewAppl = ADD_ZAPPL(M_NewNAppl) // Путь на БД новой лабораторной работы в папке приложений // Создание пустых баз данных нового приложения DIRCHANGE(M_NewAppl) // Перейти в папку с новым приложением и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Obi_zag EXCLUSIVE NEW USE Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr EXCLUSIVE NEW ********* Генерация случайных классификационных шкал и градаций M_KodGrCs = 0 FOR i=1 TO N_Csc SELECT Class_Sc APPEND BLANK REPLACE Kod_ClSc WITH i REPLACE Name_ClSc WITH "Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19)) FOR j=1 TO N_AvrGrCs SELECT Gr_ClSc APPEND BLANK REPLACE Kod_ClSc WITH i REPLACE Kod_GrCs WITH ++M_KodGrCs REPLACE Name_GrCs WITH ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrCs,19))+"-Градация классификационной шкалы_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19)) SELECT Classes APPEND BLANK REPLACE Kod_Cls WITH M_KodGrCs REPLACE Name_Cls WITH "Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19))+"-Градация классификационной шкалы_"+ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrCs,19)) REPLACE Kod_ClSc WITH i REPLACE N_CHRCLSC WITH LEN("Классификационная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Csc,19))) NEXT NEXT ********* Генерация случайных описательных шкал и градаций M_KodGrOs = 0 FOR i=1 TO N_Osc SELECT Opis_Sc APPEND BLANK REPLACE Kod_OpSc WITH i REPLACE Name_OpSc WITH "Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19)) FOR j=1 TO N_AvrGrOs SELECT Gr_OpSc APPEND BLANK REPLACE Kod_OpSc WITH i REPLACE Kod_GrOs WITH ++M_KodGrOs REPLACE Name_GrOs WITH ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrOs,19))+"-Градация описательной шкалы_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19)) SELECT Attributes APPEND BLANK REPLACE Kod_Atr WITH M_KodGrOs REPLACE Name_Atr WITH "Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19))+"-Градация описательной шкалы_"+ALLTRIM(STR(j,19))+"/"+ALLTRIM(STR(N_AvrGrOs,19)) REPLACE Kod_OpSc WITH i REPLACE N_CHROPSC WITH LEN("Описательная шкала_"+ALLTRIM(STR(i,19))+"/"+ALLTRIM(STR(N_Osc,19))) NEXT NEXT *** Генерация баз данных обучающей выборки FOR M_KodObj=1 TO N_Obj SELECT Obi_Zag APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH "Объект обучающей выборки_"+ALLTRIM(STR(M_KodObj,19))+"/"+ALLTRIM(STR(N_Obj,19)) ***** Генерация массива кодов классов для БД ObI_Kcl A_Kcl := {} DO WHILE LEN(A_Kcl) < N_AvrGcs M_KodCl = 1 + RANDOM()%N_Cls // Код класса IF ASCAN(A_Kcl, M_KodCl) = 0 // Если класс еще не встречался AADD (A_Kcl, M_KodCl) ENDIF ENDDO * ASORT(A_Kcl) *** Занести массив кодов классов в БД ObI_Kcl SELECT Obi_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(A_Kcl) > 0 k=1 FOR j=1 TO LEN(A_Kcl) IF k <= 4 FIELDPUT(1+k++,A_Kcl[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,A_Kcl[j]) ENDIF NEXT ENDIF ***** Генерация массива кодов признаков для БД ObI_Kpr A_Kpr := {} DO WHILE LEN(A_Kpr) < N_AvrGos M_KodPr = 1 + RANDOM()%N_Gos // Код признака AADD (A_Kpr, M_KodPr) ENDDO * ASORT(A_KPr) *** Занести массив кодов признаков в БД ObI_Kpr SELECT Obi_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(A_Kpr) > 0 k=1 FOR j=1 TO LEN(A_Kpr) IF k <= 7 FIELDPUT(1+k++,A_Kpr[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,A_Kpr[j]) ENDIF NEXT ENDIF NEXT ***** Переиндексация всех БД созданного приложения GenNtxClass() // Классификационные шкалы и градации GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки F3_5('GPU','SintRec','3.3') // Синтез и верификация всех моделей NEXT // Конец цикла по приложениям **** Перейти в папку с системой и запустить AddData F4_1_3_11(.F.) aMess := {} AADD(aMess, L('Успешно установлено ')+ALLTRIM(STR(mNumberCycles))+L(' RND-приложения(й) с заданными параметрами.') ) AADD(aMess, L('В каждом приложении выбрана модель с макс.достоверностью по F-критерию Ван Ризбергена, а также') ) AADD(aMess, L('по L1 и L2-критериям проф.Е.В.Луценко. Данные о достоверности этих моделей (те же, что в 4.1.3.6)') ) AADD(aMess, L('Записаны в базы данных:')) AADD(aMess, L('- по F-критерию Ван Ризбергена : ')+Disk_dir+'\"AddDataF.dbf"') AADD(aMess, L('- по L1-критерию проф.Е.В.Луценко: ' )+Disk_dir+'\"AddDataL1.dbf"') AADD(aMess, L('- по L2-критерию проф.Е.В.Луценко: ' )+Disk_dir+'\"AddDataL2.dbf"') AADD(aMess, L(' ')) AADD(aMess, L('Все эти базы данных открыватся в MS Excel.')) FOR j=1 TO LEN(aMess);aMess[j] = L(aMess[j]);NEXT // Перевод LB_Warning(aMess, L('Лаб.работа №2.09: "Исследование RND-моделей"')) ENDCASE CASE nRadio=4 // 4. Лаб.работы 4-го типа, устанавливаемые путем СКАЧИВАНИЯ исходных данных из INTERNET N_InsLPlan = 1 N_InsLFakt = 1 DO CASE CASE M_CurrLab=31 // Лаб.раб.№ 4.01: АСК-анализ мирового времени по данным сайта: "ftp://tai.bipm.org", НОВАЯ: ######################### LW401() CASE M_CurrLab=32 // Лаб.раб.№ 4.02: в процессе разработки CASE M_CurrLab=33 // Лаб.раб.№ 4.03: в процессе разработки CASE M_CurrLab=34 // Лаб.раб.№ 4.04: в процессе разработки CASE M_CurrLab=35 // Лаб.раб.№ 4.05: в процессе разработки CASE M_CurrLab=36 // Лаб.раб.№ 4.06: в процессе разработки CASE M_CurrLab=37 // Лаб.раб.№ 4.07: в процессе разработки CASE M_CurrLab=38 // Лаб.раб.№ 4.08: в процессе разработки CASE M_CurrLab=39 // Лаб.раб.№ 4.09: в процессе разработки CASE M_CurrLab=40 // Лаб.раб.№ 4.10: в процессе разработки ENDCASE ENDCASE ***************************************************************************************************** ***************************************************************************************************** Mess = L("УСТАНОВКА # ИЗ $ ЗАДАННЫХ ЛАБОРАТОРНЫХ РАБОТ УСПЕШНО ЗАВЕРШЕНА !!!") Mess = STRTRAN(Mess, "#", ALLTRIM(STR(N_InsLFakt,10))) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(N_InsLPlan,10))) * LB_Warning(Mess, L('(C) Универсальная когнитивная аналитическая система "Эйдос-Х++"')) IF 1 <= M_CurrLab .AND. M_CurrLab <= 10 // Лаб.работы, устанавливаемые путем копирования файлов Inp_data.xls в папку Inp_data, а файла _2_3_2_2.arx в папку системы Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(Mess) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE USERS INDEX ON Kod_AdmApp TO USERS CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW INDEX ON Kod_AdmApp TO APPLS USE USERS INDEX USERS EXCLUSIVE SELECT Users DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.прил. и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(L("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE DBGOTOP();DBGOBOTTOM();DBGOTOP() USE APPLS INDEX APPLS EXCLUSIVE NEW SELECT Appls DO CASE CASE Flag_SysAdmin = .T. SET FILTER TO // Сисадмин видит и может все CASE Flag_AdmAppl = .T. SET FILTER TO Kod_AdmApp = M_KodAdmAppls // Адм.приложения и пользователь CASE Flag_User = .T. // Видят только свои приложения SET FILTER TO Kod_AdmApp = M_KodAdmAppls OTHERWISE LB_Warning(L("Этот режим доступен только после авторизации в режиме 1.1 !!!")) RETURN NIL ENDCASE DBGOTOP();DBGOBOTTOM();DBGOTOP() RETURN NIL ********** ************************************************************************************************** FUNCTION HelpLW209() aHelp := {} AADD(aHelp, L('Что такое RND-модель? ')) AADD(aHelp, L(' ')) AADD(aHelp, L('RND-модель - это модель, в которой принадлежность объектов обучающей выборки к классам является случайной, ')) AADD(aHelp, L('как и признаки объектов. Для генерации случайных кодов классов и признаков используется числовой генератор ')) AADD(aHelp, L('равномерно распределенных случайных чисел. При автоматическом определении параметров RND-модели на основе ')) AADD(aHelp, L('текущей модели количество классов, признаков и объектов обучающей выборки в RND-модели будет таким же, как ')) AADD(aHelp, L('в текущей модели. Среднее количество классов, к которым относится объект обучающей выборки и среднее коли- ')) AADD(aHelp, L('чество признаков у него также будет совпадать с этими характеристиками объектов обуч.выборки текущей модели. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Зачем создается и исследуется RND-модель? ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Информацию об объектах обучающей выборки текущей модели можно считать суммой полезной информации о них ')) AADD(aHelp, L('(полезный сигнал) и шума. В RND-модели вся информация представляет собой шум. Поэтому сравнение этих моделей, ')) AADD(aHelp, L('не отличающихся перечисленными параметрами, позволяет оценить влияние значимой информации и шума на результаты,')) AADD(aHelp, L('в частности убедиться в наличии самой этой значимой информации, т.е. закономерностей в предметной области, а ')) AADD(aHelp, L('также оценить эффективность различных стат.моделей и моделей знаний и интегральных критериев для выявления и ')) AADD(aHelp, L('исследования этой значимой информации, знаний и закономерностей. При увеличении объема обучающей выборки в RND-')) AADD(aHelp, L('модели вероятность верной идентификации стремится к вероятности случайного угадывания, а в реальной модели к ')) AADD(aHelp, L('некоторому пределу, превосходящему вероятность случайного угадывания и характеризующему эффективность модели ')) AADD(aHelp, L('и целесообразность ее применения. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Если при установке данной лабораторной работы уже есть текущее приложение, то оно автоматически исследуется ')) AADD(aHelp, L('и параметры RND-модели определяется в результате этого исследования. Если же приложения отсутствуют, то ото- ')) AADD(aHelp, L('бражается таблица, в которой пользователь может задать количество и характеристики формируемых приложений. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Чтобы исследовать зависимость достоверности RND-модели от объема обучающей выборки (или других параметров) ')) AADD(aHelp, L('необходимо задать: ')) AADD(aHelp, L('- начальные параметры моделей; ')) AADD(aHelp, L('- шаг изменения начальных параметров в итерациях; ')) AADD(aHelp, L('- число циклов (итераций), т.е. число приложений с различными объемами выборки, которые надо создать; ')) AADD(aHelp, L('- кликнуть по кнопке: "Пересчитать параметры"; ')) AADD(aHelp, L('- если все устраивает, то кликнуть по кнопке: "Выход на расчет RND-приложений" и нажать ESC. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-13, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по лабораторной работе 2.09. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ********************** FUNCTION RecalcParam() DBGOTO(8);mNumberCycles=FIELDGET(3) FOR pp=1 TO 7 DBGOTO(pp) REPLACE FinalValue WITH InitValue + StepChang * ( mNumberCycles - 1 ) NEXT DBGOTOP() RETURN NIL ******** FUNCTION OutputCalc() PUBLIC mFlagExit := .F. RETURN NIL ************************************************************************************************************** FUNCTION PointChart(Parametr) * Param = "Unif" * Param = "Norm" PRIVATE aAttr // Массив атрибутов отображаемых линий PRIVATE nEvent, mp1, mp2, oXbp // Переменные анализа событий SELECT Inp_data N_Znach = RECCOUNT() // Кол-во значений в графиках PRIVATE aVal[N_Znach] // Массив значений функции PRIVATE aArg[N_Znach] // Массив значений аргумента *** Присвоить массивам параметрически заданные значения отображаемой функции j = 0 DBGOTOP() DO WHILE .NOT. EOF() ++j DO CASE CASE Parametr = "Unif" aVal[j] = FUNCT_TUNI CASE Parametr = "Norm" aVal[j] = FUNCT_TNOR ENDCASE aArg[j] = ARGUMENT DBSKIP(1) ENDDO DO CASE CASE Parametr = "Unif" @0, 0 DCSAY L("ТОЧЕЧНАЯ ДИАГРАММА ЭМПИРИЧЕСКИХ ЗНАЧЕНИЙ СВИП-СИГНАЛА С АДДИТИВНЫМ РАВНОМЕРНЫМ ШУМОМ") FONT ("22.HelveticalBold") SIZE 0 CASE Parametr = "Norm" @0, 0 DCSAY L("ТОЧЕЧНАЯ ДИАГРАММА ЭМПИРИЧЕСКИХ ЗНАЧЕНИЙ СВИП-СИГНАЛА С АДДИТИВНЫМ ГАУССОВСКИМ ШУМОМ") FONT ("22.HelveticalBold") SIZE 0 ENDCASE @ 2,1 DCSTATIC TYPE XBPSTATIC_TYPE_RECESSEDBOX SIZE 148,39 ; // Размер окна для отображения графика OBJECT oStatic; EVAL {|| _PresSpace13(oStatic, N_Znach, aArg, aVal) } DCREAD GUI ; TITLE L("Исследование зашумленных когнитивных функций на примере свип-сигнала"); // Надпись на окне графика FIT ; BUTTONS DCGUI_BUTTON_EXIT RETURN NIL ************************************************* STATIC FUNCTION _PresSpace13( oStatic, N_Znach, aArg, aVal ) LOCAL oPS, oDevice PUBLIC X_MaxW := 1024, Y_MaxW := 768 // Размер графического окна в пикселях oPS := XbpPresSpace():new() // Create a PS oDevice := oStatic:winDevice() // Get the device context oPS:create( oDevice ) // Link device context to PS oPS:SetViewPort( { 0, 0, X_MaxW, Y_MaxW } ) oStatic:paint := {|mp1,mp2,obj| mp1 := LC_DotChart( oPS, N_Znach, aArg, aVal ) } RETURN NIL ******************************************************* STATIC FUNCTION LC_DotChart(oPS, N_Znach, aArg, aVal ) ****** Поиск макс и мин значений функции Y_MinF = +99999999 // Минимальное значение Y отображаемой функции Y_MaxF = -99999999 // Максимальное значение Y отображаемой функции FOR x=1 TO LEN(aVal) Y_MinF = MIN(Y_MinF, aVal[x]) Y_MaxF = MAX(Y_MaxF, aVal[x]) NEXT ****** Поиск макс и мин значений аргумента aArgUniq := {} // Уникальные значения аргумента X_MinA = +99999999 // Минимальное значение Y отображаемой функции X_MaxA = -99999999 // Максимальное значение Y отображаемой функции FOR x=1 TO LEN(aArg) X_MinA = MIN(X_MinA, aArg[x]) X_MaxA = MAX(X_MaxA, aArg[x]) IF ASCAN(aArgUniq, aArg[x]) = 0 AADD (aArgUniq, aArg[x]) ENDIF NEXT N_aArgUniq = LEN(aArgUniq) // Кол-во уникальных значений аргумента PRIVATE X0 := 75 PRIVATE Y0 := 165 // Начало координат по осям X и Y с учетом места для легенды PRIVATE W_Wind := X_MaxW - X0 // Ширина окна для самого графика PRIVATE H_Wind := Y_MaxW - Y0 // Высота окна для самого графика PRIVATE NX := 10, NY := 10 // Кол-во меток и надписей по осям X и Y PRIVATE Kx := W_Wind / ( X_MaxA-X_MinA ) // Коэффициент масштабирования по оси X: преобразует аргумент функции в номер пикселя по оси X PRIVATE Ky := H_Wind / ( Y_MaxF-Y_MinF ) // Коэффициент масштабирования по оси Y: преобразует значение функции в номер пикселя по оси Y PRIVATE Y0A := IF(Y_MinF > 0, Y0, Y0+ABS(Y_MinF)*Ky) // Позиция оси X на оси Y ***** Закрасить фон прямоугольника *************** GraSetColor( oPS, aColor[98] , aColor[98] ) GraBox( oPS, { X0, Y0 }, { X0+W_Wind, Y0+H_Wind }, GRA_FILL ) GraSetColor( oPS, aColor[222] , aColor[222] ) ***** Нарисовать оси координат ******************* aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DEFAULT aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии aAttr [ GRA_AL_WIDTH ] := 2 // Задать толщину линии graSetAttrLine( oPS, aAttr ) // Установить атрибуты GraLine( oPS, {X0 , Y0A }, {X0+W_Wind, Y0A } ) // Нарисовать ось X GraLine( oPS, {X0 , Y0 }, {X0 , Y0+H_Wind} ) // Нарисовать границу рамки изображения слева это и есть ось Y GraLine( oPS, {X0 , Y0 }, {X0+W_Wind, Y0 } ) // Нарисовать границу рамки изображения внизу параллельно оси X GraLine( oPS, {X0 , Y0+H_Wind}, {X0+W_Wind, Y0+H_Wind} ) // Нарисовать границу рамки изображения вверху параллельно оси X GraLine( oPS, {X0+W_Wind, Y0 }, {X0+W_Wind, Y0+H_Wind} ) // Нарисовать границу рамки изображения справа параллельно оси Y aAttr := ARRAY( GRA_AM_COUNT ) // Массив для атрибутов маркеров aAttr [ GRA_AM_SYMBOL ] := GRA_MARKSYM_PLUS GraSetAttrMarker( oPS, aAttr ) aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DOT aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии aAttr [ GRA_AL_WIDTH ] := 1 // Задать толщину линии graSetAttrLine( oPS, aAttr ) // Установить атрибуты *** Закрасить области между метками на оси X ***** DX = LEN(aArgUniq)/NX // Диапазон значений x, через которое ставить метку GraSetColor( oPS, aColor[99], aColor[99] ) FOR x=1 TO LEN(aArgUniq) STEP 2*DX GraBox( oPS, { X0 + x*Kx, Y0 }, { X0 + (x+DX)*Kx, Y0 + H_Wind }, GRA_FILL ) NEXT GraSetColor( oPS, aColor[222], aColor[222] ) *** Сделать сетку и надписать метки на оси X ********************* DX = LEN(aArgUniq) /NX // Диапазон значений x, через которое ставить метку FOR j=1 TO LEN(aArgUniq) STEP DX x = aArgUniq[j] nX := X0 + x*Kx GraMarker ( oPS, { nX, Y0 } ) GraStringAt( oPS, { nX, Y0-25 }, ALLTRIM(STR(x,19,1)) ) GraLine( oPS, { nX, Y0 }, {nX, Y0+H_Wind} ) // Нарисовать пунктирную линию уровня x NEXT x = aArgUniq[N_aArgUniq] nX := X0 + x*Kx GraMarker ( oPS, { nX, Y0 } ) GraStringAt( oPS, { nX, Y0-25 }, ALLTRIM(STR(x,19,1)) ) GraLine( oPS, { nX, Y0 }, {nX, Y0+H_Wind} ) // Нарисовать пунктирную линию уровня x *** Сделать сетку и надписать метки на оси Y ********************* DY = (Y_MaxF-Y_MinF+1)/NY // Диапазон значений y, через которое ставить метку FOR y = Y_MinF TO Y_MaxF STEP DY nY := Y0A + y*Ky GraMarker ( oPS, { X0 , nY } ) GraStringAt( oPS, { X0-45, nY }, ALLTRIM(STR(y,19,3)) ) GraLine( oPS, { X0 , nY }, {X0+W_Wind, nY} ) // Нарисовать пунктирную линию уровня y NEXT nY := Y0A + Y_MaxF*Ky GraMarker ( oPS, { X0 , nY } ) GraStringAt( oPS, { X0-45, nY }, ALLTRIM(STR(y,19,3)) ) GraLine( oPS, { X0 , nY }, {X0+W_Wind, nY} ) // Нарисовать пунктирную линию уровня y ***** Рисование маркеров *************************************************** aAttr := Array( GRA_AM_COUNT ) // Создать массив атрибутов aAttr[ GRA_AM_COLOR ] := aColor[17] // Задать цвет маркера aAttr[ GRA_AM_SYMBOL ] := GRA_MARKSYM_DOT // Задать стиль маркера GraSetAttrMarker( oPS, aAttr ) // Установить атрибуты FOR j=1 TO LEN(aArg) X := X0 + aArg[j] * Kx Y := Y0A + aVal[j] * Ky GraMarker( oPS, { X, Y } ) NEXT ***** Нарисовать оси координат ********************************** aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DEFAULT aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии aAttr [ GRA_AL_WIDTH ] := 2 // Задать толщину линии graSetAttrLine( oPS, aAttr ) // Установить атрибуты графической линии GraLine( oPS, {X0 , Y0A }, {X0+W_Wind, Y0A } ) // Нарисовать ось X GraLine( oPS, {X0 , Y0 }, {X0 , Y0+H_Wind} ) // Нарисовать границу рамки изображения слева это и есть ось Y GraLine( oPS, {X0 , Y0 }, {X0+W_Wind, Y0 } ) // Нарисовать границу рамки изображения внизу параллельно оси X GraLine( oPS, {X0 , Y0+H_Wind}, {X0+W_Wind, Y0+H_Wind} ) // Нарисовать границу рамки изображения вверху параллельно оси X GraLine( oPS, {X0+W_Wind, Y0 }, {X0+W_Wind, Y0+H_Wind} ) // Нарисовать границу рамки изображения справа параллельно оси Y ****** Легенда *************************************************** Offset = -60 // Смщение вниз относительно нуля Y0 для позиции легенды Interval = 15 ***** Нарисовать рамку легенды aAttr := Array( GRA_AL_COUNT ) // Массив для атрибутов линии aAttr [ GRA_AL_TYPE ] := GRA_LINETYPE_DEFAULT aAttr [ GRA_AL_COLOR ] := 1 // Задать цвет линии aAttr [ GRA_AL_WIDTH ] := 1 // Задать толщину линии graSetAttrLine( oPS, aAttr ) // Установить атрибуты графической линии X1 := X0 Y1 := Y0 + Offset X2 := X0 + W_Wind Y2 := Y0 + Offset - 5 * Interval - 15 ***** Закрасить фон прямоугольника *************** GraSetColor( oPS, aColor[129] , aColor[129] ) GraBox( oPS, { X1, Y1 }, { X2, Y2 }, GRA_FILL) GraSetColor( oPS, aColor[222] , aColor[222] ) GraLine( oPS, {X1, Y1 }, {X2, Y1 } ) // Нарисовать ось X GraLine( oPS, {X1, Y1 }, {X1, Y2 } ) // Нарисовать ось Y GraLine( oPS, {X1, Y2 }, {X2, Y2 } ) // Нарисовать границу рамки изображения вверху параллельно оси X GraLine( oPS, {X2, Y1 }, {X2, Y2 } ) // Нарисовать границу рамки изображения справа параллельно оси Y ***** сделать надписи значений параметров aAttr[ GRA_AL_COLOR ] := aColor[17] // Задать цвет линии aAttr[ GRA_AL_WIDTH ] := 1 // Задать толщину линии graSetAttrLine( oPS, aAttr ) // Установить атрибуты * aParLW15[ 1] = Arg_MinV // Начальное значение аргумента * aParLW15[ 2] = Arg_MaxV // Конечное значение аргумента * aParLW15[ 3] = Arg_Delta // Шаг изменения аргумента X1 := X0 + 20 Y1 := Y0 + Offset - Interval X2 := X1 + 190 Y2 := Y0 + Offset - 1 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Начальное значение аргумента:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Arg_MinV,15))) Y2 := Y0 + Offset - 2 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Конечное значение аргумента:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Arg_MaxV,15))) Y2 := Y0 + Offset - 3 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Шаг изменения аргумента:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Arg_Delta,15,7))) Y2 := Y0 + Offset - 4 * Interval * aParLW13[ 4] = Ampl // Начальная ампилитуда свип-сигнала * aParLW13[ 5] = Chast // Начальная частота свип-сигнала * aParLW13[ 6] = Faza // Фаза свип-сигнала * aParLW13[ 7] = KZat_Ampl // Коэффициент затухания амплитуды * aParLW13[ 8] = KZat_Chast // Коэффициент затухания частоты X1 := X2 + 110 Y1 := Y0 + Offset - Interval X2 := X1 + 220 Y2 := Y0 + Offset - 1 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Начальная ампилитуда свип-сигнала:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Ampl,15))) Y2 := Y0 + Offset - 2 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Начальная частота свип-сигнала:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Chast,15))) Y2 := Y0 + Offset - 3 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Фаза свип-сигнала:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Faza,15))) Y2 := Y0 + Offset - 4 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Коэффициент затухания амплитуды:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(KZat_Ampl,15,7))) Y2 := Y0 + Offset - 5 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Коэффициент возрастания частоты:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(KZat_Chast,15,7))) * *** Параметры гауссовского шума * aParLW13[ 9] = Mean // Среднее значение * aParLW13[10] = Sigma // Средне-квадратичное отклонение * aParLW13[11] = N_Izmer // Количество измерений знач.функции X1 := X2 + 100 Y1 := Y0 + Offset - Interval X2 := X1 + 225 Y2 := Y0 + Offset - 1 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Среднее значение шума:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Mean,15))) Y2 := Y0 + Offset - 2 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Амплитуда шума:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(Sigma,15))) Y2 := Y0 + Offset - 3 * Interval GraStringAt( oPS, { X1, Y2-4 }, "Количество измерений знач.функции:") GraStringAt( oPS, { X2, Y2-4 }, ALLTRIM(STR(N_Izmer,15,7))) ****** Надписи координатных осей ********************************* oFont := XbpFont():new():create("13.ArialBold") GraSetFont( oPS ,oFont ) AxName = "Ось X: Значения аргумента функции" GraStringAt( oPS, { X0+W_Wind/2-8*LEN(AxName)/2, Y0-45 }, AxName ) // Надпись оси Х AyName = "Ось Y: Значения функции" aMatrix := GraInitMatrix() GraRotate( oPS, aMatrix, 90, { X0-53, Y0+H_Wind/2-8*LEN(AyName)/2 }, GRA_TRANSFORM_ADD ) oPS:setGraTransform( aMatrix, GRA_TRANSFORM_REPLACE ) GraStringAt( oPS, { X0-53, Y0+H_Wind/2-8*LEN(AyName)/2 }, AyName ) // Надпись оси Y RETURN NIL ************************************************************************************************************** * Для формирования очередного числа последовательности используются различные алгебраические преобразования. * Одним из первых программных ГСЧ является метод средин квадратов, предложенный в 1946 г. Дж. фон Нейманом. * Этот ГСЧ формирует следующий элемент последовательности на основе предыдущего путем возведения его в квадрат * и выделения средних цифр полученного числа. Например, мы хотим получить 10-значное число и предыдущее число * равнялось 5772156649. Возводим его в квадрат и получаем 33317792380594909201; значит, следующим числом будет * 7923805949. Очевидным недостатком этого метода является зацикливание в случае, если очередное число будет * равно нулю. Кроме того, существуют и другие сравнительно короткие циклы. ************************************************************************************************************** ******** Программа генерации случайных чисел по модифицированному алгоритму Дж. фон Неймана ******** с внешним источником энтропии при запуске, в качестве которого используется значение таймера FUNCTION LC_RANDOM(r) r = ABS(VAL(SUBSTR(STR(SIN(DTOR(SQRT(ABS(LOG((1+r)^2))))),23,21),7,9)))/1000000000 DO WHILE r=0 r = ABS(VAL(SUBSTR(STR(SIN(DTOR(SQRT(ABS(LOG((1+r)^2))))),23,21),7,9)))/1000000000 ENDDO RETURN(r) ************************************************************************************************** FUNCTION Help_LW13() aHelp := {} AADD(aHelp, L('Данный режим предназначен для подготовки баз данных, позволяющих ')) AADD(aHelp, L('исследовать зашумленные когнитивные функции на примере затухающего ')) AADD(aHelp, L('свип-сигнала, т.е. гармонического сигнала с изменяющейся частотой. ')) AADD(aHelp, L('Параметры затухания и изменения частоты задаются в диалоге, как и ')) AADD(aHelp, L('характеристики шума. Шум используется гауссовский, т.е. подчиняющийся')) AADD(aHelp, L('нормальному распределению. После выполнения данного режима необходимо')) AADD(aHelp, L('выполнить режим 2.3.2.2 с параметрами "по умолчанию", которые также ')) AADD(aHelp, L('формируются в данном режиме. Затем надо выполнить режимы 3.4 и 4.5. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-5, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по лабораторной работе 2.04.') RETURN NIL ************************************************************************************************** ********************************************************************************************************* ******** Создать новое приложение, скопировать все файлы текущего приложения в новое, сделать его текущим ********************************************************************************************************* FUNCTION Copy_rec1_3() oScr := DC_WaitOn(L('Создано новое приложение и в него копируются файлы текущего приложения. Немного подождите!!!'),,,,,,,,,,,.F.) N_All = ADIR(M_PathAppl + "*.*") PRIVATE aFileNameAll[N_All] ADIR(M_PathAppl + "*.*", aFileNameAll ) // Имена ВСЕХ файлов в папке текущего приложения (без папок) ASORT(aFileNameAll) M_NameAppl = ALLTRIM(M_NameAppl)+L("-копия") // Наименование текущего приложения M_NewAppl = ADD_ZAPPL(M_NameAppl) // Создать новое приложение на основе текущего FOR j=1 TO LEN(aFileNameAll) Name_SS = M_PathAppl + aFileNameAll[j] Name_DD = M_NewAppl + aFileNameAll[j] * LB_Warning(L("Источник: "+Name_SS+", приемник: "+Name_DD) COPY FILE (Name_SS) TO (Name_DD) NEXT IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF DBGOTOP() DC_Impl(oScr) RETURN NIL ******** Удалить папку с БД текущего приложения ******** и запись о нем в БД Appls.dbf ******** Использовать рекурсию ZapDir() FUNCTION Del_Appl() // Найти текущее приложение M_Recno = -1 SELECT Appls DBGOTOP() DO WHILE .NOT. EOF() IF LEN(ALLTRIM(By_default)) > 0 M_Recno = RECNO() M_Name = ALLTRIM(Name_Appl) DELETE EXIT ENDIF DBSKIP(1) ENDDO // Удалить папку с БД удаляемого приложения IF M_Recno > 0 // Текущее приложение найдено ZapDir(STRTRAN(UPPER(ALLTRIM(Path_Appl)),"\SYSTEM\",""),.T.) LB_Warning(L('Приложение: "'+M_Name+'" успешно удалено!'), L("Сообщение о завершении операции" )) ELSE LB_Warning(L("Ни одно из приложений не задано текущим !")) ENDIF SELECT Appls PACK RETURN NIL ****************************************************************************************************** ******** Удалить все приложения и информацию о них в текущей папке системы ******** 1. Найти в папке AID_DATA текущей папки системы все дирректории с именами: "A0*" и удалить их ******** 2. Пересоздать БД Appls.dbf ******** Использовать рекурсию ZapDir() ****************************************************************************************************** FUNCTION Zap_Appls() DIRCHANGE(UPPER(ALLTRIM(Disk_dir))+"\AID_DATA\") PRIVATE aAppls := Directory("A0*.*","D") FOR j=1 TO LEN(aAppls) ZapDir(aAppls[ j, F_NAME ], .T.) NEXT ZapDir("Screenshots", .T.) DIRMAKE("Screenshots") DIRCHANGE(Disk_dir) GenDbfAppls() RETURN NIL ******************************************* ******** Удалить все файле в папке Inp_data ******************************************* FUNCTION Zap_InpData() * DIRCHANGE(UPPER(ALLTRIM(Disk_dir))+"\AID_DATA\Inp_data\") * N_All = ADIR("*.*") * PRIVATE aFileNameAll[N_All] * ADIR("*.*",aFileNameAll) // Имена ВСЕХ файлов в папке Inp_data * FOR j=1 TO LEN(aFileNameAll) * ERASE(aFileNameAll[j]) * NEXT * DIRCHANGE(Disk_dir) DIRCHANGE(UPPER(ALLTRIM(Disk_dir))+"\AID_DATA\") ZapDir('Inp_data', .T.);DIRMAKE("Inp_data") ZapDir('Screenshots', .T.);DIRMAKE("Screenshots") DIRCHANGE(Disk_dir) RETURN NIL ************************************************************************************ // Рекурсивное удаление непустой дирректории с непустыми поддиректориями от Auge_Ohr ************************************************************************************ *#include "Directry.ch" *#include "common.ch" *PROCEDURE Main() * ZapDir("C:\WORK\AID_DATA",.T.) *RETURN PROCEDURE ZapDir(cDir,lRecursive) LOCAL aFiles := Directory(cDir+"\"+"*.*","DHS") LOCAL iMax := LEN(aFiles) LOCAL i DEFAULT lRecursive TO .F. FOR i := 1 TO iMax IF aFiles[ i, F_ATTR ] = "D" IF aFiles[ i, F_NAME ] = "." .OR. ; aFiles[ i, F_NAME ] = ".." ELSE ZapDir(cDir+"\"+aFiles[ i, F_NAME],lRecursive) RemoveDir(cDir+"\"+aFiles[ i, F_NAME]) ENDIF ELSE FERASE(cDir+"\"+aFiles[ i, F_NAME]) ENDIF NEXT RemoveDir(cDir) RETURN ************************************************************************************ *********************************************************************************************************** ******** Генерация БД Appls.dbf ************* *********************************************************************************************************** FUNCTION GenDbfAppls() aSaveGenDbf := DC_DataSave() DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ********* Создать БД Appls.dbf и ее индексные массивы cFileName := "Appls.dbf" aStructure := { { "Kod_AdmApp", "N", 8, 0 }, ; { "Kod_Appl" , "N", 8, 0 }, ; { "By_default", "C", 1, 0 }, ; { "Name_Appl" , "C",250, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 }, ; { "Path_Appl" , "C",250, 0 } } DbCreate( cFileName, aStructure ) GenNtxAppls() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация индексных массивов БД Appls.dbf ************* FUNCTION GenNtxAppls() aSaveGN1 := DC_DataSave() IF .NOT. FILE("Appls.dbf") GenDbfAppls() ENDIF *USE Appls INDEX App_kapl, App_kapp, App_name, App_crea EXCLUSIVE NEW * 1 2 3 4 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW INDEX ON STR(Kod_AdmApp,8) TO App_kapl INDEX ON STR(Kod_appl,8) TO App_kapp INDEX ON Name_appl TO App_name INDEX ON CTOD(Date) TO App_crea CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN1 ) RETURN NIL ******** Генерация БД Users.dbf ************* FUNCTION GenDbfUsers() aSaveGenDbf := DC_DataSave() DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ********* Создать БД Users.dbf и ее индексные массивы cFileName := "Users.dbf" aStructure := { { "Kod_AdmApp", "N", 8, 0 }, ; { "Name_AdmAp", "C", 35, 0 }, ; { "Login_AdmA", "C", 10, 0 }, ; { "Passw_AdmA", "C", 10, 0 }, ; { "Passw_User", "C", 10, 0 }, ; { "ColorSchem", "C", 23, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( cFileName, aStructure ) GenNtxUsers() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 Zap_db1_2() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация индексных массивов БД Users.dbf ************* FUNCTION GenNtxUsers() aSaveGN2 := DC_DataSave() IF .NOT. FILE("Users.dbf") RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Users EXCLUSIVE NEW INDEX ON STR(Kod_AdmApp,8) TO Use_kod INDEX ON Name_AdmAp TO Use_name INDEX ON Login_AdmA+Passw_AdmA TO Use_LPAA INDEX ON "USER"+Passw_User TO Use_LPus INDEX ON Date TO Use_dreg CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN2 ) RETURN NIL ******** Генерация БД PathGrAp.dbf ************* FUNCTION GenDbfPaths() aSaveGenDbf := DC_DataSave() DIRCHANGE(Disk_dir) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ********* Создать БД PathGrAp.dbf и ее индексные массивы cFileName := "PathGrAp" aStructure := { { "Kod_GrApps", "N", 8, 0 }, ; { "By_default", "C", 1, 0 }, ; { "NameGrApps", "C",250, 0 }, ; { "PathGrApps", "C",250, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( cFileName, aStructure ) GenNtxPaths() M_ApplsPath := UPPER(ALLTRIM(Disk_dir))+"\AID_DATA" CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * USE PathGrAp INDEX Path_kod, PathDefa, PathName, PathCrea EXCLUSIVE NEW * * 1 2 3 4 USE PathGrAp EXCLUSIVE NEW APPEND BLANK REPLACE Kod_GrApps WITH 1 REPLACE By_default WITH "W" REPLACE NameGrApps WITH "Базовая группа приложений (по умолчанию)" REPLACE PathGrApps WITH M_ApplsPath REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN(M_ApplsPath) ******** Генерация индексных массивов БД Paths.dbf ************* FUNCTION GenNtxPaths() aSaveGN3 := DC_DataSave() IF .NOT. FILE("PathGrAp.dbf") GenDbfPaths() ENDIF *USE PathGrAp INDEX Path_kod, PathDefa, PathName, PathCrea EXCLUSIVE NEW * 1 2 3 4 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathGrAp EXCLUSIVE NEW INDEX ON STR(Kod_GrApps,8) TO Path_kod INDEX ON By_default TO PathDefa INDEX ON NameGrApps TO PathName INDEX ON CTOD(Date) TO PathCrea CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN3 ) RETURN NIL ******** Генерация БД Classes.dbf ************* FUNCTION GenDbfClass(mUpDate) aSaveGenDbf := DC_DataSave() * Flag = .F. * IF .NOT. FILE("Classes.dbf") * Flag = .T. * ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Classes.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "Kod_cls" , "N", 15, 0 }, ; // Код класса, т.е. градации классификационной шкалы { "Name_cls" , "C",250, 0 }, ; // Наименование класса, т.е. классификационной шкалы+"-"+градации классификационной шкалы { "Kod_ClSc" , "N", 15, 0 }, ; // Код классификационной шкалы { "N_ChrClSc", "N", 3, 0 }, ; // Количество символов в наименовании классификационной шкалы { "Min_GrInt", "N", 19, 7 }, ; // Минимальная граница интервала (значение) { "Max_GrInt", "N", 19, 7 }, ; // Максимальная граница интервала (значение) { "Avr_GrInt", "N", 19, 7 }, ; // Среднее значение интервала { "Int_inf" , "N", 19, 7 }, ; { "Sum_ii" , "N", 19, 7 }, ; { "Sii_perc" , "N", 19, 7 }, ; { "Rang" , "N", 15, 0 }, ; { "Abs" , "N", 15, 0 }, ; { "Perc_fiz" , "N", 19, 7 }, ; { "Universal", "N", 19, 7 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpdate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxClass() // Если БД Classes вообще нет, то создать ее (эта БД есть всегда) * IF Flag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Classes EXCLUSIVE NEW;ZAP SELECT Gr_ClSc DBGOTOP() cScrn := DC_WaitOn(L('Пересоздание базы данных классификационных шкал и градаций: "Classes.dbf"'),,,,,,,,,,,.F.) DO WHILE .NOT. EOF() mKodClSc = Kod_ClSc mKodGrCS = Kod_GrCS mNameGrCS = DelZeroNameGr(Name_GrCS) SELECT Classes DBGOTO(mKodGrCS) mIntInf = Int_Inf mAbs = Abs mPercFiz = Perc_fiz SELECT Class_Sc DBGOTO(mKodClSc) mNameClSc = Name_ClSc REPLACE Int_Inf WITH mIntInf REPLACE Abs WITH mAbs REPLACE Perc_fiz WITH mPercFiz // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(mNameClSc, UPPER(mNameGrCS)) = 0 mName = UPPER(ALLTRIM(mNameClSc))+"-"+ALLTRIM(mNameGrCS) ELSE mName = mNameGrCS ENDIF SELECT Classes APPEND BLANK REPLACE Kod_cls WITH mKodGrCS REPLACE Name_cls WITH mName REPLACE Kod_ClSc WITH mKodClSc // Код класс.шкалы REPLACE N_ChrClSC WITH LEN(ALLTRIM(mNameClSc)) // Кол-во символов в наим.класс.шкалы SELECT Gr_ClSc DBSKIP(1) ENDDO MinMaxGrClSc() DC_Impl(cScrn) * ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация индексных массивов БД Classes.dbf ************* FUNCTION GenNtxClass() IF .NOT. FILE("Classes.dbf") GenDbfClass(.F.) ENDIF *USE Classes INDEX Cls_kod, Cls_name, Cls_ini, Cls_abs EXCLUSIVE NEW CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW INDEX ON STR(Kod_cls,19) TO Cls_kod INDEX ON Name_cls TO Cls_name INDEX ON STR(99999999.9999999-Int_Inf,19, 7) TO Cls_ini INDEX ON STR(Abs,19) TO Cls_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL ******** Генерация БД Attributes.dbf ************* FUNCTION GenDbfAttr(mUpDate) aSaveGenDbf := DC_DataSave() // Если БД Attributes вообще нет, то создать ее * Flag = .F. * IF .NOT. FILE("Attributes.dbf") Flag = .T. * ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Attributes.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "Kod_atr" , "N", 15, 0 }, ; // Код признака, т.е. градации описательной шкалы { "Name_atr" , "C",250, 0 }, ; // Наименование признака, т.е. описательной шкалы+"-"+градации описательной шкалы { "Kod_OpSc" , "N", 15, 0 }, ; // Код описательной шкалы { "N_ChrOpSc", "N", 3, 0 }, ; // Количество символов в наименовании описательной шкалы { "Min_GrInt", "N", 19, 7 }, ; // Минимальная граница интервала (значение) { "Max_GrInt", "N", 19, 7 }, ; // Максимальная граница интервала (значение) { "Avr_GrInt", "N", 19, 7 }, ; // Среднее значение интервала { "Int_inf" , "N", 19, 7 }, ; { "Sum_ii" , "N", 19, 7 }, ; { "Sii_perc" , "N", 19, 7 }, ; { "Rang" , "N", 15, 0 }, ; { "Abs" , "N", 15, 0 }, ; { "Perc_fiz" , "N", 19, 7 }, ; { "Universal", "N", 19, 7 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpdate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxAttr() // Создать БД Attributes * IF Flag **************************************************************************************************** *Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time *nMax = N_InpFiles *Mess = L('2.3.2.6. Объединение нескольких файлов исходных данных в один' *@ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100 *DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT *oDialog:show() *nTime = 0 *DC_GetProgress(oProgress,0,nMax) *FOR ff=1 TO N_InpFiles * DC_GetProgress(oProgress, ++nTime, nMax) *NEXT **MsgBox('STOP') *DC_GetProgress(oProgress,nMax,nMax) *oDialog:Destroy() *Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time_Time **************************************************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW;ZAP SELECT Gr_OpSc DBGOTOP() cScrn := DC_WaitOn(L('Пересоздание базы данных описательных шкал и градаций: "Attributes.dbf"'),,,,,,,,,,,.F.) DO WHILE .NOT. EOF() mKodOpSc = Kod_OpSc mKodGrOS = Kod_GrOS mNameGrOS = Name_GrOS mIntInf = Int_Inf mAbs = Abs mPercFiz = Perc_fiz SELECT Opis_Sc DBGOTO(mKodOpSc) mNameOpSc = Name_OpSc // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(mNameOpSc, UPPER(mNameGrOS)) = 0 mName = UPPER(ALLTRIM(mNameOpSc))+"-"+ALLTRIM(mNameGrOS) ELSE mName = mNameGrOS ENDIF SELECT Attributes APPEND BLANK REPLACE Kod_atr WITH mKodGrOS REPLACE Name_atr WITH mName REPLACE Kod_OpSc WITH mKodOpSc // Код опис.шкалы REPLACE N_ChrOpSC WITH LEN(ALLTRIM(mNameOpSc)) // Кол-во символов в наим.опис.шкалы REPLACE Int_Inf WITH mIntInf REPLACE Abs WITH mAbs REPLACE Perc_fiz WITH mPercFiz SELECT Gr_OpSc DBSKIP(1) ENDDO MinMaxGrOpSc() DC_Impl(cScrn) * ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация индексных массивов БД Attributes.dbf ************* FUNCTION GenNtxAttr() aSaveGN4 := DC_DataSave() IF .NOT. FILE("Attributes.dbf") GenDbfAttr(.F.) ENDIF *USE Attributes INDEX Atr_kod, Atr_name, Atr_ini, Atr_abs EXCLUSIVE NEW CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW INDEX ON STR(Kod_atr,19) TO Atr_kod INDEX ON Name_atr TO Atr_name INDEX ON STR(99999999.9999999-Int_Inf,19, 7) TO Atr_ini INDEX ON STR(Abs,19) TO Atr_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN4 ) RETURN NIL ***************************************************************** ******** Перейти в папку выбранного приложения ******** Номер запускаемого режима, вида: mRegimOpen= "2.3.2.2()" ***************************************************************** FUNCTION ApplChange(mOpenFunct) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** * CloseAllWindows() // Закрыть все окна CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы mApplsPath = STRTRAN(M_ApplsPath,"\AID_DATA","") // Папка, на которую в БД прописан путь, как на папку с базами данных приложений mDiskDir = DISKNAME()+":\"+CURDIR() // Папка, в которой фактически находится система IF .NOT. FILE("PathGrAp.DBF") GenDbfPaths() ENDIF IF .NOT. FILE("Users.DBF") GenDbfUsers() ENDIF IF .NOT. FILE("Appls.DBF") GenDbfAppls() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathGrAp EXCLUSIVE NEW;N_GrAp = RECCOUNT() USE Appls EXCLUSIVE NEW;N_Appls = RECCOUNT() USE Users EXCLUSIVE NEW;N_Users = RECCOUNT() * LB_Warning(CURDIR());LB_Warning(STR(N_Appls,19)) * MsgBox(STR(N_GrAp)) IF N_GrAp = 0 // Если нет групп приложений - ничего не делать LB_Warning(L("В режиме 1.5 нет ни одной группы приложений !!!")) Running(.F.) RETURN(.T.) ENDIF IF N_Users = 0 // Если нет пользователей - ничего не делать LB_Warning(L("В режиме 1.2 не задано ни одного пользователя !!!")) Running(.F.) RETURN(.T.) ENDIF IF N_Appls = 0 // Если нет приложений - ничего не делать LB_Warning(L("В диспетчере приложений 1.3 нет ни одного приложения !!!")) Running(.F.) RETURN(.T.) ENDIF SELECT Appls // Если не сисадмин, то сделать фильтрацию по приложениям авторизованного администратора приложения // или администратора приложения, пароль для пользователей которого задан пользователем // Flag_SysAdmin := .F., M_KodSysAdmin := 0 // Flag_AdmAppl := .F., M_KodAdmAppls := 0 // Flag_User := .F., M_KodAdmAppls := 0 IF Flag_AdmAppl = .T. .OR. Flag_User = .T. SET FILTER TO M_KodAdmAppls = Kod_AdmApp * DBGOTOP();DBGOBOTTOM();DBGOTOP() ENDIF PUBLIC M_PathAppl := "" PUBLIC M_NameAppl := "" DBGOTOP() DO WHILE .NOT. EOF() IF LEN(ALLTRIM(By_default)) > 0 REPLACE By_default WITH "W" M_PathAppl = UPPER(ALLTRIM(Path_Appl)) M_NameAppl = ALLTRIM(Name_Appl) EXIT ENDIF DBSKIP(1) ENDDO IF LEN(ALLTRIM(M_PathAppl)) = 0 SELECT Users DBGOTOP() DO WHILE .NOT. EOF() IF M_KodAdmAppls = Kod_AdmApp M_NameAdmAppl = UPPER(ALLTRIM(Name_AdmAp)) EXIT ENDIF DBSKIP(1) ENDDO Mess = L("В диспетчере приложений 1.3 [#] не задал путь на текущее приложение!!!") Mess = STRTRAN(Mess, "#", M_NameAdmAppl) LB_Warning(Mess) Running(.F.) RETURN(.T.) ENDIF DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы // Записать M_NameAppl на диск * M_NameAppl = DC_ARestore("_NameAppl.arx") DC_ASave(M_NameAppl, "_NameAppl.arx") // Записать M_PathAppl на диск * M_PathAppl = DC_ARestore("_PathAppl.arx") DC_ASave(M_PathAppl, "_PathAppl.arx") DIRCHANGE(M_PathAppl) // Записать M_NameAppl на диск * M_NameAppl = DC_ARestore("_NameAppl.arx") DC_ASave(M_NameAppl, "_NameAppl.arx") // Записать M_PathAppl на диск * M_PathAppl = DC_ARestore("_PathAppl.arx") DC_ASave(M_PathAppl, "_PathAppl.arx") ************ Формирование минимального и максимального кодов градаций классификационных и описательных шкал * MinMaxGrClSc() * MinMaxGrOpSc() RETURN(.F.) *********************************************************************************************************** ******** 2.2. Описательные шкалы и градации (xdemo.exe, FUNCTION XSample_130(): sample 4, OneToMany2) *********************************************************************************************************** FUNCTION F2_2() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("2.2()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') ********** Среда f2_2() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc INDEX ON Kod_OpSc TO Opis_Sc CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Gr_OpSc NEW INDEX ON Kod_OpSc TO Gr_OpSc CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Kpr EXCLUSIVE NEW USE Rso_Kpr EXCLUSIVE NEW USE Opis_Sc INDEX Opis_Sc EXCLUSIVE NEW USE Gr_OpSc INDEX Gr_OpSc EXCLUSIVE NEW /* ----- Create ToolBar 2 ----- */ *@ 27.5, 1 DCTOOLBAR oToolBar SIZE 130, 1.5 @ 29.5, 1 DCTOOLBAR oToolBar SIZE 150, 1.5 DCADDBUTTON CAPTION L('Помощь') ; SIZE LEN(L("Помощь"))+2 ; ACTION {||Help22(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 2.2') ** Функции, доступные только сисадмину и администратору приложения IF Flag_SysAdmin .OR. Flag_AdmAppl DCADDBUTTON CAPTION L('Доб.шкалу') ; SIZE LEN(L("Доб.шкалу"))+1 ; ACTION {||Add_rec2_2s(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить шкалу') DCADDBUTTON CAPTION L('Доб.град.шкалы') ; SIZE LEN(L("Доб.град.шкалы")) ; ACTION {||Add_rec2_2g(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить градацию шкалы') DCADDBUTTON CAPTION L('Копир.шкалу') ; SIZE LEN(L("Копир.шкалу")) ; ACTION {||Copy_rec2_2s(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Копировать шкалу') DCADDBUTTON CAPTION L('Копир.град.шкалы') ; SIZE LEN(L("Копир.град.шкалы"))-1 ; ACTION {||Copy_rec2_2g(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Копировать градацию шкалы') DCADDBUTTON CAPTION L('Копир.шкалу с град.') ; SIZE LEN(L("Копир.шкалу с град."))-3 ; ACTION {||Copy_rec2_2s(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Копир.шкалу с град.') DCADDBUTTON CAPTION L('Удал.шкалу с град.') ; SIZE LEN(L("Удал.шкалу с град."))-3 ; ACTION {||Del_rec2_2s(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалалить шкалу с градациями') DCADDBUTTON CAPTION L('Удал.град.шкалы') ; SIZE LEN(L("Удал.град.шкалы"))-1 ; ACTION {||Del_rec2_2g(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить градацию шкалы') DCADDBUTTON CAPTION L('Перекодировать') ; SIZE LEN(L("Перекодировать")) ; ACTION {||Recode2_2sg(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Перекодировать') DCADDBUTTON CAPTION L('Очистить') ; SIZE LEN(L("Очистить"))+1 ; ACTION {||Zap_2_2sg(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Очистить базу данных') DCADDBUTTON CAPTION L('Графики прошлых сценариев') ; SIZE LEN(L("Графики прошлых сценариев"))-1 ; ACTION {||DrawScenarios('Atr'), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Отображение и запись в виде файлов графиков прошлых сценариев (сценариев значений факторов)') ENDIF /* ----- Create browse-1 ----- */ bScale := {|| Gr_OpSc->(DC_SetScope(0,Opis_Sc->KOD_OpSc)), ; Gr_OpSc->(DC_SetScope(1,Opis_Sc->KOD_OpSc)), ; Gr_OpSc->(DC_DbGoTop()), ; oBrowGrSc:refreshAll() } *@1, 0 DCBROWSE oBrowScale ALIAS 'Opis_Sc' SIZE 48,26 ; @1, 0 DCBROWSE oBrowScale ALIAS 'Opis_Sc' SIZE 58,28 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; // Редактирование БД Opis_Sc NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bScale), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowScale DCBROWSECOL FIELD Opis_Sc->KOD_OpSc HEADER L('Код шкалы' ) WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Opis_Sc->NAME_OpSc HEADER L('Наименование описательной шкалы') WIDTH 28 DCBROWSECOL FIELD Opis_Sc->INT_INF HEADER L('Информативность' ) WIDTH 1 /* ----- Create browse-2 ----- */ DCSETPARENT TO *@ 1,50 DCBROWSE oBrowGrSc ALIAS 'Gr_OpSc' SIZE 82,26 ; @ 1,60 DCBROWSE oBrowGrSc ALIAS 'Gr_OpSc' SIZE 92,28 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems; COLOR {||IIF(2*INT(Gr_OpSc->KOD_GrOS/2)==Gr_OpSc->KOD_GrOS,nil,{nil,GraMakeRGBColor({230,252,213})})} // Вывод строки цветом RGB ********************* * mPosR1 = AT('{', mScName)+1 * mPosR2 = mPosR1+2 * mPosG1 = mPosR2+2 * mPosG2 = mPosG1+2 * mPosB1 = mPosG2+2 * mPosB2 = mPosB1+2 * mRed = VAL(SUBSTR(mScName, mPosR1, mPosR2-mPosR1+1)) * mGreen = VAL(SUBSTR(mScName, mPosG1, mPosG2-mPosG1+1)) * mBlue = VAL(SUBSTR(mScName, mPosB1, mPosB2-mPosB1+1)) ********************* * mPosR1 = AT('{', Gr_OpSc->NAME_GrOS)+1 * mPosR2 = AT('{', Gr_OpSc->NAME_GrOS)+3 * mPosG1 = AT('{', Gr_OpSc->NAME_GrOS)+5 * mPosG2 = AT('{', Gr_OpSc->NAME_GrOS)+7 * mPosB1 = AT('{', Gr_OpSc->NAME_GrOS)+9 * mPosB2 = AT('{', Gr_OpSc->NAME_GrOS)+11 * mRed = VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+1, AT('{', Gr_OpSc->NAME_GrOS)+ 3-AT('{', Gr_OpSc->NAME_GrOS)+1+1)) * mGreen = VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+5, AT('{', Gr_OpSc->NAME_GrOS)+ 7-AT('{', Gr_OpSc->NAME_GrOS)+5+1)) * mBlue = VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+9, AT('{', Gr_OpSc->NAME_GrOS)+11-AT('{', Gr_OpSc->NAME_GrOS)+9+1)) ********************* DCSETPARENT oBrowGrSc DCBROWSECOL FIELD Gr_OpSc->KOD_GrOS HEADER L('Код градации' ) WIDTH 1 PROTECT {|| .T. }; COLOR {||IIF(AT('SPECTRINTERV:',Opis_Sc->NAME_OpSc)=0,nil,{nil,GraMakeRGBColor({VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+1, AT('{', Gr_OpSc->NAME_GrOS)+ 3-AT('{', Gr_OpSc->NAME_GrOS)+1+1)),VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+5, AT('{', Gr_OpSc->NAME_GrOS)+ 7-AT('{', Gr_OpSc->NAME_GrOS)+5+1)),VAL(SUBSTR(Gr_OpSc->NAME_GrOS, AT('{', Gr_OpSc->NAME_GrOS)+9, AT('{', Gr_OpSc->NAME_GrOS)+11-AT('{', Gr_OpSc->NAME_GrOS)+9+1))})})} // Вывод поля цветом RGB DCBROWSECOL FIELD Gr_OpSc->NAME_GrOS HEADER L('Наименование градации описательной шкалы') WIDTH 48.5 DCBROWSECOL FIELD Gr_OpSc->INT_INF HEADER L('Информативность' ) WIDTH 1 DCBROWSECOL FIELD Gr_OpSc->ABS HEADER L('N объектов об.выб.(абс)' ) WIDTH 3 DCBROWSECOL FIELD Gr_OpSc->PERC_FIZ HEADER L('N объектов об.выб.(%)' ) WIDTH 3 DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE cTitle = L('2.2. Описательные шкалы и градации. Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE cTitle ; EVAL {|o|SetAppFocus(oBrowScale:GetColumn(1))} GenDbfAttr(.F.) // Пересоздать БД описательных шкал и градаций ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ****** END OF EXAMPLE *********************** ************************************************************************************************** FUNCTION Help22() aHelp := {} AADD(aHelp, L('Режим: "2.2. ОПИСАТЕЛЬНЫЕ ШКАЛЫ И ГРАДАЦИИ" обеспечивает ручной ввод ')) AADD(aHelp, L('и корректировку описательных шкал и градаций. При этом градации являются, вообще ')) AADD(aHelp, L('говоря, не альтернативными и в разных шкалах может быть разное количество градаций, ')) AADD(aHelp, L('номинальных, порядковых и числовых типов (в интервальной форме) измеряемых в ')) AADD(aHelp, L('различных единицах измерения. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('КНОПКИ УПРАВЛЕНИЯ: ')) AADD(aHelp, L('- [Доб.шкалу]: добавить описательную шкалу; ')) AADD(aHelp, L('- [Доб.град.шкалы]: добавить градацию описательной шкалы; ')) AADD(aHelp, L('- [Копир.шкалу]: копировать текущую описательную шкалу; ')) AADD(aHelp, L('- [Копир.град.шкалы]: копировать текущую градацию описательной шкалы; ')) AADD(aHelp, L('- [Копир.шкалу с град.]: копировать текущую описательную шкалу со всеми градациями; ')) AADD(aHelp, L('- [Удал.шкалу с град.]: удалить текущую описательную шкалу со всеми градациями; ')) AADD(aHelp, L('- [Удал.град.шкалы]: удалить текущую градацию описательной шкалы; ')) AADD(aHelp, L('- [Перекодировать]: перекодировать все описательные шкалы и градации по возрастанию;')) AADD(aHelp, L('- [Очистить]: удалить все описательные шкалы и градации. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Текущей является шкала или градация, на которой установлен курсор. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT @0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-15, LEN(aHelp)-0.5 s=1;d=0.9;FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 2.2. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Сортировка по заданному столбцу в режиме 1.3. (xdemo.exe FUNCTION XDemo_4 ( oDialog, lMDI, lGui )) FUNCTION Sort2_2() LOCAL nChoice := 1, oAppWindow, oCrt, oParent DC_Gui(.t.) SetColor('W+/N') CLS SetColor('N/W,W+/B') @ 5,20 CLEAR TO 19,60 @ 5,20 TO 19,60 *USE Users INDEX Use_kod, Use_name, Use_LPAA, Use_LPus, Use_dreg EXCLUSIVE NEW * 1 2 3 4 5 @ 7,25 PROMPT L('Код администратора приложения') @ 9,25 PROMPT L('Имя администратора приложения') @11,25 PROMPT L('Дата регистрации ') @13,25 PROMPT L('Exit ') MENU TO nChoice DO CASE CASE nChoice = 1 SET ORDER TO 1 CASE nChoice = 2 SET ORDER TO 2 CASE nChoice = 3 SET ORDER TO 5 CASE nChoice = 6 .OR. nChoice = 0 ENDCASE IF Valtype(oCrt) = 'O' .AND. oCrt:status()>0 oCrt:Destroy() SetAppWindow( oAppWindow ) ENDIF RETURN nil ******** Удалить текущую шкалу и ее градации FUNCTION DEL_REC2_2s() // Проверить является ли БД Opis_Sc текущей и если нет - выдать сообщение и выйти M_Kod = Kod_OpSc SELECT Opis_Sc DELETE PACK SELECT Gr_OpSc DELETE FOR M_Kod = Kod_OpSc PACK SELECT Opis_Sc RETURN NIL ******** Удалить текущую градацию FUNCTION DEL_REC2_2g() // Проверить является ли БД Gr_OpSc текущей и если нет - выдать сообщение и выйти DELETE PACK RETURN NIL ******** Скопировать описательную шкалу FUNCTION COPY_REC2_2S() SELECT Opis_Sc a := {} FOR j=1 TO FCOUNT() AADD(a, FIELDGET(j)) NEXT APPEND BLANK FOR j=1 TO LEN(a) FIELDPUT(j, a[j]) NEXT REPLACE Kod_OpSc WITH RECNO() RETURN NIL ******** Скопировать градацию описательной шкалы FUNCTION COPY_REC2_2G() SELECT Gr_OpSc a := {} FOR j=1 TO FCOUNT() AADD(a, FIELDGET(j)) NEXT APPEND BLANK FOR j=1 TO LEN(a) FIELDPUT(j, a[j]) NEXT REPLACE Kod_GrOS WITH RECNO() RETURN NIL ******** Скопировать описательную шкалу со всеми градациями FUNCTION COPY_REC2_2SG() LOCAL Getlist := {}, oProgress, oDialog SELECT Opis_Sc M_KodOS_Old = Kod_OpSc a := {} FOR j=1 TO FCOUNT() AADD(a, FIELDGET(j)) NEXT APPEND BLANK FOR j=1 TO LEN(a) FIELDPUT(j, a[j]) NEXT REPLACE Kod_OpSc WITH RECNO() M_KodOS_New = Kod_OpSc SELECT Gr_OpSc Mess = L('2.2. Копирование описательной шкалы со всеми градациями') @ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT RecCount() COLOR GRA_CLR_BLUE PERCENT EVERY 100 DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT oDialog:show() nMax = RECCOUNT() nTime = 0 DC_GetProgress(oProgress,0,nMax) FOR r=1 TO nMax DBGOTO(r) IF M_KodOS_Old = Kod_OpSc a := {} FOR j=1 TO FCOUNT() AADD(a, FIELDGET(j)) NEXT APPEND BLANK FOR j=1 TO LEN(a) FIELDPUT(j, a[j]) NEXT REPLACE Kod_OpSc WITH M_KodOS_New ENDIF DC_GetProgress(oProgress, ++nTime, nMax) NEXT DC_GetProgress(oProgress,nMax,nMax) oDialog:Destroy() RETURN NIL ******** Добавить шкалу в конец БД FUNCTION Add_rec2_2s() SELECT Opis_Sc APPEND BLANK REPLACE Kod_OpSc WITH RECNO() RETURN NIL ******** Добавить градацию шкалы в конец БД FUNCTION Add_rec2_2g() SELECT Opis_Sc M_KodOpSc = Kod_OpSc SELECT Gr_OpSc APPEND BLANK REPLACE Kod_OpSc WITH M_KodOpSc REPLACE Kod_GrOS WITH RECNO() // Сформировать количество градаций данной шкалы на момент добавления записи RETURN NIL ******** Очистить БД FUNCTION ZAP_2_2SG() SELECT Opis_Sc;ZAP SELECT Gr_OpSc;ZAP RETURN NIL ******** Перекодировать БД описательных шкал и градаций, обучающей и распознаваемой выборки FUNCTION RECODE2_2SG() LOCAL Getl := {}, oProgr, oDial aSaveRECODE2_2SG := DC_DataSave() SELECT Gr_OpSc;N_Gos = RECCOUNT() SELECT Obi_Kpr;N_Okp = RECCOUNT() SELECT Rso_Kpr;N_Rkp = RECCOUNT() Mess = L('2.2. Перекодирование описательных шкал и градаций, обуч.и расп.выборки') @ 4,5 DCPROGRESS oProgr SIZE 80,1.1 MAXCOUNT RecCount() COLOR GRA_CLR_BLUE PERCENT EVERY 100 DCREAD GUI TITLE Mess PARENT @oDial FIT EXIT oDial:show() nMax = 3*N_Gos+N_Okp+N_Rkp nTime = 0 SELECT Gr_OpSc INDEX ON STR(Kod_OpSc,19)+STR(Kod_GrOS,19) TO Gos_kos aKodGOS_Old := {} aKodGOS_New := {} M_KodGrOS = 0 DBGOTOP() Flag = .F. DC_GetProgress(oProgr,0,nMax) DO WHILE .NOT. EOF() AADD(aKodGOS_Old, Kod_GrOS) AADD(aKodGOS_New, ++M_KodGrOS) IF Kod_GrOS <> M_KodGrOS Flag = .T. // Необходимо перекодирование ENDIF DC_GetProgress(oProgr, ++nTime, nMax) DBSKIP(1) ENDDO IF .NOT. Flag LB_Warning(L("В перекодировании нет необходимости!"), L("Информационное сообщение" )) ELSE // Перекодирование описательных шкал и градаций и сортировка БД градаций описательных шкал SELECT Gr_OpSc SET ORDER TO DBGOTOP() DO WHILE .NOT. EOF() Pos = ASCAN(aKodGOS_Old, Kod_GrOS) IF Pos > 0 REPLACE Rang WITH aKodGOS_New[Pos] ENDIF DC_GetProgress(oProgr, ++nTime, nMax) DBSKIP(1) ENDDO DbSort( "Temp.dbf", {"Rang" } ) // Физическая сортировка БД по составному ключу SELECT Gr_OpSc USE Temp EXCLUSIVE NEW DBGOTOP() DO WHILE .NOT. EOF() M_Recno = RECNO() M_Rang = Rang M_KodGrOS = Kod_GrOS a := {} FOR j=1 TO FCOUNT() AADD(a, FIELDGET(j)) NEXT SELECT Gr_OpSc DBGOTO(M_Recno) FOR j=1 TO LEN(a) FIELDPUT(j, a[j]) NEXT REPLACE Kod_GrOS WITH M_Rang REPLACE Rang WITH M_KodGrOS DC_GetProgress(oProgr, ++nTime, nMax) SELECT Temp DBSKIP(1) ENDDO CLOSE Temp SELECT Gr_OpSc INDEX ON Kod_OpSc TO Gr_OpSc // Перекодирование обучающей выборки SELECT Obi_Kpr DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO FCOUNT() Pos = ASCAN(aKodGOS_Old, FIELDGET(j)) IF Pos > 0 FIELDPUT(j, aKodGOS_New[Pos]) ENDIF NEXT DC_GetProgress(oProgr, ++nTime, nMax) DBSKIP(1) ENDDO // Перекодирование распознаваемой выборки SELECT Rso_Kpr DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO FCOUNT() Pos = ASCAN(aKodGOS_Old, FIELDGET(j)) IF Pos > 0 FIELDPUT(j, aKodGOS_New[Pos]) ENDIF NEXT DC_GetProgress(oProgr, ++nTime, nMax) DBSKIP(1) ENDDO ENDIF DC_GetProgress(oProgr,nMax,nMax) oDial:Destroy() DC_DataRest( aSaveRECODE2_2SG ) RETURN NIL // Информационное сообщение *LB_Warning(Mess) *LB_Inform("Ура! Получилось!") // Сообщение об ошибке *LB_Warning(L("Нет папки! Создайте!", "Сообщение об ошибке" ) * GenDbfClSc(.F.) // Классификационные шкалы ######### * GenDbfGrClSc(.F.) // Градации классификационных шкал ######### * GenDbfClass(.F.) // Классификационные шкалы и градации * GenDbfOpSc(.F.) // Описательные шкалы * GenDbfGrOpSc(.F.) // Градации описательных шкал * GenDbfAttr(.F.) // Описательные шкалы и градации ######### ******** Генерация БД описательных шкал FUNCTION GenDbfOpSc(mUpdate) aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Opis_Sc.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "KOD_OpSc" , "N", 15, 0 }, ; { "NAME_OpSc" , "C",250, 0 }, ; { "INT_INF" , "N", 19, 7 }, ; { "SUM_II" , "N", 19, 7 }, ; { "SII_PERC" , "N", 19, 7 }, ; { "RANG" , "N", 15, 0 }, ; { "ABS" , "N", 15, 0 }, ; { "PERC_FIZ" , "N", 19, 7 }, ; { "Sum_ZnGr" , "N", 19, 7 }, ; { "N_GrOpSc" , "N", 15, 0 }, ; { "KodGr_min" , "N", 15, 0 }, ; // Минимальный код градаций описательной шкалы { "KodGr_max" , "N", 15, 0 }, ; // Максимальный код градаций описательной шкалы { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpdate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxOpSc() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Создание индексных массивов БД описательных шкал FUNCTION GenNtxOpSc() aSaveGN5 := DC_DataSave() IF .NOT. FILE("Opis_Sc.dbf") GenDbfOpSc(.F.) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc EXCLUSIVE NEW INDEX ON STR(Kod_OpSc,19) TO Ops_kod INDEX ON Name_OpSc TO Ops_name INDEX ON STR(99999999.9999999-Int_Inf,19, 7) TO Ops_ini INDEX ON STR(Abs,19) TO Ops_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN5 ) RETURN NIL ******** Генерация БД классификационных шкал FUNCTION GenDbfClSc(mUpDate) aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Class_Sc.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "KOD_ClSc" , "N", 15, 0 }, ; { "NAME_ClSc" , "C",250, 0 }, ; { "INT_INF" , "N", 19, 7 }, ; { "SUM_II" , "N", 19, 7 }, ; { "SII_PERC" , "N", 19, 7 }, ; { "RANG" , "N", 15, 0 }, ; { "ABS" , "N", 15, 0 }, ; { "PERC_FIZ" , "N", 19, 7 }, ; { "Sum_ZnGr" , "N", 19, 7 }, ; { "N_GrClSc" , "N", 15, 0 }, ; { "KodGr_min" , "N", 15, 0 }, ; // Минимальный код градаций описательной шкалы { "KodGr_max" , "N", 15, 0 }, ; // Максимальный код градаций описательной шкалы { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpdate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxClSc() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Создание индексных массивов БД классификационных шкал FUNCTION GenNtxClSc() aSaveGN5 := DC_DataSave() IF .NOT. FILE("Class_Sc.dbf") GenDbfClSc(.F.) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW INDEX ON STR(Kod_ClSc,19) TO ClSc_kod INDEX ON Name_ClSc TO ClSc_name INDEX ON STR(99999999.9999999-Int_Inf,19, 7) TO Clsc_ini * 123456789012345678 * 12345678901.123456 * 10 19 INDEX ON STR(Abs,19) TO ClSc_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN5 ) RETURN NIL ******** Генерация БД градаций классификационных шкал FUNCTION GenDbfGrClSc(mUpDate) aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Gr_ClSc.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "KOD_ClSc" , "N", 15, 0 }, ; { "KOD_GrCS" , "N", 15, 0 }, ; { "NAME_GrCS" , "C",250, 0 }, ; { "Delete" , "C", 1, 0 }, ; { "INT_INF" , "N", 19, 7 }, ; { "SUM_II" , "N", 19, 7 }, ; { "SII_PERC" , "N", 19, 7 }, ; { "RANG" , "N", 21, 0 }, ; { "ABS" , "N", 21, 0 }, ; { "PERC_FIZ" , "N", 19, 7 }, ; { "Universal" , "N", 19, 7 }, ; { "KodGrCSOld", "N", 15, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpDate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxGrClSc() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Создание индексных массивов БД градаций описательных шкал FUNCTION GenNtxGrClSc() IF .NOT. FILE("Gr_OpSc.dbf") GenDbfGrOpSc(.F.) ENDIF * MsgBox( Disk_dir ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Gr_ClSc EXCLUSIVE NEW INDEX ON STR(Kod_GrCS,19) TO Gcs_kod INDEX ON Name_GrCS TO Gcs_name *INDEX ON STR(99999999.9999999-Int_Inf, 19, 7) TO Gcs_ini * 123456789012345678 * 1234567890.1234567 * 10 19 INDEX ON STR(Abs,19) TO Gcs_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL ******** Генерация БД градаций описательных шкал FUNCTION GenDbfGrOpSc(mUpdate) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Gr_OpSc.dbf" IF .NOT. FILE(cFileName) mUpDate = .F. ENDIF aStructure := { { "KOD_OpSc" , "N", 15, 0 }, ; { "KOD_GrOS" , "N", 15, 0 }, ; { "NAME_GrOS", "C",250, 0 }, ; { "INT_INF" , "N", 19, 7 }, ; { "SUM_II" , "N", 19, 7 }, ; { "SII_PERC" , "N", 19, 7 }, ; { "RANG" , "N", 15, 0 }, ; { "ABS" , "N", 15, 0 }, ; { "PERC_FIZ" , "N", 19, 7 }, ; { "Universal", "N", 19, 7 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } IF mUpDate DC_DBFILE( DC_SETDCLIP(),cFileName, ,,,'DBFNTX',, aStructure) ELSE DbCreate( cFileName, aStructure ) ENDIF GenNtxGrOpSc() RETURN NIL ******** Создание индексных массивов БД градаций описательных шкал FUNCTION GenNtxGrOpSc() IF .NOT. FILE("Gr_OpSc.dbf") GenDbfGrOpSc(.F.) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Gr_OpSc EXCLUSIVE NEW INDEX ON STR(Kod_GrOS,19) TO Gos_kod INDEX ON Name_GrOS TO Gos_name INDEX ON STR(99999999.9999999-Int_Inf,19, 7) TO Gos_ini INDEX ON STR(Abs,19) TO Gos_abs CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL *********************************************************************************************************** ********* 2.3.1. Ручной ввод-корректировка обучающей выборки *********************************************************************************************************** FUNCTION F2_3_1() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("2.3.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF IF FILE("Obi_Zag.dbf") // БД заголовков обучающей выборки ** Переиндексировать БД Obi_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oiz_kod.ntx" ) .OR.; .NOT. FILE("Oiz_name.ntx") .OR.; .NOT. FILE("Obi_Zag.ntx" ) GenNtxObiZag() ENDIF ELSE GenDbfObiZag() ENDIF IF FILE("Obi_Kcl.dbf") // БД классов обучающей выборки ** Переиндексировать БД Obi_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oic_kod.ntx") .OR.; .NOT. FILE("Obi_Kcl.ntx") GenNtxObiKcl() ENDIF ELSE GenDbfObiKcl() ENDIF IF FILE("Obi_Kpr.dbf") // БД признаков обучающей выборки ** Переиндексировать БД Obi_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Obi_Kpr.ntx") GenNtxObiKpr() ENDIF ELSE GenDbfObiKpr() ENDIF IF FILE("Rso_Zag.dbf") // БД заголовков распознаваемой выборки ** Переиндексировать БД Rso_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roz_kod.ntx" ) .OR.; .NOT. FILE("Roz_name.ntx") .OR.; .NOT. FILE("Rso_Zag.ntx" ) GenNtxRsoZag() ENDIF ELSE GenDbfRsoZag() ENDIF IF FILE("Rso_Kcl.dbf") // БД классов распознаваемой выборки ** Переиндексировать БД Rso_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roc_kod.ntx") .OR.; .NOT. FILE("Rso_Kcl.ntx") GenNtxRsoKcl() ENDIF ELSE GenDbfRsoKcl() ENDIF IF FILE("Rso_Kpr.dbf") // БД признаков распознаваемой выборки ** Переиндексировать БД Rso_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Rso_Kpr.ntx") GenNtxRsoKpr() ENDIF ELSE GenDbfRsoKpr() ENDIF dbeSetDefault('DBFNTX') ***** Совпадают ли номера записей объектов обучающей выборки с их кодами? ***** Если нет, то перенумеровать их? CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag EXCLUSIVE NEW;N_Zag = RECCOUNT() USE Obi_Kcl EXCLUSIVE NEW;N_Kcl = RECCOUNT() USE Obi_Kpr EXCLUSIVE NEW;N_Kpr = RECCOUNT() SELECT Obi_Zag mFlagErr = .F. FOR j=RECCOUNT() TO 1 STEP -1 IF Kod_obj <> RECNO() mFlagErr = .T. EXIT ENDIF NEXT IF mFlagErr mRecode := 1 @ 1, 1 DCGROUP oGroup1 CAPTION L('Перекодировать объекты обучающей выборки?' ) SIZE 60, 10 @ 1, 1 DCSAY L('Коды объектов обучающей выборки должны совпадать с номерами записей,' ) PARENT oGroup1 @ 2, 1 DCSAY L('но они не совпадают. По-видимому, это связано с некорректым удалением') PARENT oGroup1 @ 3, 1 DCSAY L('некоторых объектов обучающей выборки. Есть два способа это исправить:') PARENT oGroup1 @ 4, 1 DCSAY L('1. Перекодировать обучающую выборку прямо сейчас.' ) PARENT oGroup1 @ 5, 1 DCSAY L('2. В режиме 5.10 выгрузить исходные данные в файл: "Inp_data.dbf",' ) PARENT oGroup1 @ 6, 1 DCSAY L(' а затем ввести их в систему в режиме 2.3.2.2.' ) PARENT oGroup1 @7.5, 1 DCRADIO mRecode VALUE 1 PROMPT L('Исправить нумерацию' ) PARENT oGroup1 @8.5, 1 DCRADIO mRecode VALUE 2 PROMPT L('Ничего не делать' ) PARENT oGroup1 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('2.3.1. Ввод-корректировка обучающей выборки') IF mRecode = 1 nMax = N_Zag + N_Kcl + N_Kpr Mess = L('2.3.1. Исправление кодирования обучающей выборки.') @ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT nMax COLOR GRA_CLR_CYAN PERCENT EVERY 100 DCREAD GUI TITLE Mess PARENT @oDialog FIT EXIT oDialog:show() nTime = 0 DC_GetProgress(oProgress,0,nMax) SELECT Obi_Zag DBGOBOTTOM() mKodMax = Kod_obj PRIVATE aKodOldNew[MAX(mKodMax, RECCOUNT())] SELECT Obi_Zag DBGOTOP() DO WHILE .NOT. EOF() mKodObj = Kod_obj aKodOldNew[mKodObj] = RECNO() REPLACE Kod_obj WITH aKodOldNew[mKodObj] DC_GetProgress(oProgress, ++nTime, nMax) DBSKIP(1) ENDDO SELECT Obi_Kcl DBGOTOP() DO WHILE .NOT. EOF() mKodObj = Kod_obj REPLACE Kod_obj WITH aKodOldNew[mKodObj] DC_GetProgress(oProgress, ++nTime, nMax) DBSKIP(1) ENDDO SELECT Obi_Kpr DBGOTOP() DO WHILE .NOT. EOF() mKodObj = Kod_obj REPLACE Kod_obj WITH aKodOldNew[mKodObj] DC_GetProgress(oProgress, ++nTime, nMax) DBSKIP(1) ENDDO * MsgBox('STOP') DC_GetProgress(oProgress,nMax,nMax) oDialog:Destroy() ENDIF ENDIF **************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX ON Kod_Obj TO Obi_Zag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Kcl NEW INDEX ON Kod_Obj TO Obi_Kcl CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Kpr NEW INDEX ON Kod_Obj TO Obi_Kpr CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX Obi_Zag EXCLUSIVE USE Obi_Kcl INDEX Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr INDEX Obi_Kpr EXCLUSIVE NEW USE Rso_Zag INDEX Rso_Zag EXCLUSIVE NEW USE Rso_Kcl INDEX Rso_Kcl EXCLUSIVE NEW USE Rso_Kpr INDEX Rso_Kpr EXCLUSIVE NEW /* ----- Create ToolBar ----- */ d = 8 @ 27.5, 0 DCTOOLBAR oToolBar SIZE 143, 1.5 DCADDBUTTON CAPTION L('Помощь') ; SIZE LEN(L("Помощь"))+2 ; ACTION {||Help231(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 2.3.1') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Скопировать обуч.выб.в расп.'); SIZE LEN(L("Скопировать обуч.выб.в расп."))-5, 1.5 ; ACTION {||CopyOiRo(.T.,1,1,1,"",1,1), DC_GetRefresh(GetList)}; PARENT oToolBar ; TOOLTIP L('Скопировать обучающую выборку в распознаваемую') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить объект') ; SIZE LEN(L("Добавить объект"))+0, 1.5 ; ACTION {||Add_Obj2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить объект') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить классы') ; SIZE LEN(L("Добавить классы"))-0, 1.5 ; ACTION {||Add_Kcl2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить строку классов') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить признаки') ; SIZE LEN(L("Добавить признаки"))-1, 1.5 ; ACTION {||Add_Kpr2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить строку признаков') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить объект') ; SIZE LEN(L("Удалить объект"))-0, 1.5 ; ACTION {||Del_Obj2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить объект') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить классы') ; SIZE LEN(L("Удалить классы"))-0, 1.5 ; ACTION {||Del_Kcl2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить строку классов') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить признаки') ; SIZE LEN(L("Удалить признаки"))+0, 1.5 ; ACTION {||Del_Kpr2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить строку признаков') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Очистить БД') ; SIZE LEN(L("Очистить БД"))+2, 1.5 ; ACTION {||Zap_db2_3_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Очистить базу данных') /* ----- Create browse-1: Главная БД Obi_Zag.dbf ----- */ bZag := {|| Obi_Kpr->(DC_SetScope(0,Obi_Zag->Kod_Obj)), ; Obi_Kpr->(DC_SetScope(1,Obi_Zag->Kod_Obj)), ; Obi_Kpr->(DC_DbGoTop()) , ; oBrowKpr:refreshAll() , ; Obi_Kcl->(DC_SetScope(0,Obi_Zag->Kod_Obj)), ; Obi_Kcl->(DC_SetScope(1,Obi_Zag->Kod_Obj)), ; Obi_Kcl->(DC_DbGoTop()) , ; oBrowKcl:refreshAll() } d = 10 @ 1, 0 DCBROWSE oBrowZag ALIAS 'Obi_Zag' SIZE 133+d,12.5 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; // Редактирование БД Obi_Zag.dbf NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bZag), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowZag DCBROWSECOL FIELD Obi_Zag->Kod_Obj HEADER L('Код объекта' ) WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Obi_Zag->Name_obj HEADER L('Наименование объекта') WIDTH 54.5+d-4 DCBROWSECOL FIELD Obi_Zag->Date HEADER L('Дата' ) WIDTH 10.4 PROTECT {|| .T. } DCBROWSECOL FIELD Obi_Zag->Time HEADER L('Время' ) WIDTH 9.5 PROTECT {|| .T. } /* Create browse-2: БД Obi_Kcl.dbf, связанная отношением "Один ко многим" с БД Obi_Zag.dbf*/ DCSETPARENT TO @14, 0 DCBROWSE oBrowKcl ALIAS 'Obi_Kcl' SIZE 51,13 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKcl DCBROWSECOL FIELD Obi_Kcl->Kod_Obj HEADER L('Код объекта') WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Obi_Kcl->Cls1 HEADER L('Класс 1' ) WIDTH 5 DCBROWSECOL FIELD Obi_Kcl->Cls2 HEADER L('Класс 2' ) WIDTH 5 DCBROWSECOL FIELD Obi_Kcl->Cls3 HEADER L('Класс 3' ) WIDTH 5 DCBROWSECOL FIELD Obi_Kcl->Cls4 HEADER L('Класс 4' ) WIDTH 5 /* Create browse-3: БД Obi_Kpr.dbf, связанная отношением "Один ко многим" с БД Obi_Zag.dbf*/ DCSETPARENT TO @14,54 DCBROWSE oBrowKpr ALIAS 'Obi_Kpr' SIZE 79+d,13 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKpr DCBROWSECOL FIELD Obi_Kpr->Kod_Obj HEADER L('Код объекта') WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Obi_Kpr->Atr1 HEADER L('Признак 1' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr2 HEADER L('Признак 2' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr3 HEADER L('Признак 3' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr4 HEADER L('Признак 4' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr5 HEADER L('Признак 5' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr6 HEADER L('Признак 6' ) WIDTH 6 DCBROWSECOL FIELD Obi_Kpr->Atr7 HEADER L('Признак 7' ) WIDTH 6 DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE cTitle = L('2.3.1. Ручной ввод-корректировка обучающей выборки. Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE cTitle ; EVAL {|o|SetAppFocus(oBrowZag:GetColumn(1))} ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ****** END OF EXAMPLE *********************** ************************************************************************************************** FUNCTION Help231() aHelp := {} AADD(aHelp, L('Режим: "2.3.1. РУЧНОЙ ВВОД-КОРРЕКТИРОВКА ОБУЧАЮЩЕЙ ВЫБОРКИ", ')) AADD(aHelp, L('предназначен для ввода определений объектов обучающей выборки, ')) AADD(aHelp, L('т.е. для описания конкретных объектов предметной области путем ')) AADD(aHelp, L('указания более общих категорий, к которым они относятся (прина- ')) AADD(aHelp, L('длежность к классам), а также указания специфических признаков, ')) AADD(aHelp, L('отличающих данные конкретные объекты от других объектов этих ')) AADD(aHelp, L('же классов. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Коды классов и признаков указываются в соответствии с классифи- ')) AADD(aHelp, L('кационными и описательными шкалами и градациями. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Формирование обучающей выборки является последним этапом форма- ')) AADD(aHelp, L('лизации предметной области, после выполнения которого все готово')) AADD(aHelp, L('для выполнения следующего этапа системно-когнитивного анализа: ')) AADD(aHelp, L('синтеза и верификации семантической информационной модели пред- ')) AADD(aHelp, L('метной области. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-0, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 2.3.1.') RETURN NIL ************************************************************************************************** *************************************************************************************** ******** Скопировать обучающую выборку в распознаваемую ******** Для организации диалога использован пример XSample_184() из xdemo.exe *************************************************************************************** FUNCTION CopyOiRo(Dialog, nRadio1, nRadio2, nRadio3, Regim, mN1, mN2) LOCAL GetList[0], GetOptions, lCheck1, lCheck2, oGroup1, oGroup2, M_KodObj, lOk **SET TAG TO COMMAND aSaveCopOR := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) // Диалог задания параметров режима копирования обуч.выборки в распознаваемую IF Dialog CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX Obi_Zag EXCLUSIVE NEW nRadio1 := 1 nRadio2 := 1 nRadio3 := 1 N_CopyObj = 0 mN1 = 1 mN2 = RECCOUNT() @ 0, 0 DCGROUP oGroup1 CAPTION L('Какие объекты обуч.выборки копировать:' ) SIZE 45, 6.7 @ 7, 0 DCGROUP oGroup2 CAPTION L('Удалять ли из обуч.выборки скопированные объекты?') SIZE 45, 3.7 @11, 0 DCGROUP oGroup3 CAPTION L('Стирать или дополнять распознаваемую выборку:' ) SIZE 45, 4.0 @ 0,47 DCGROUP oGroup4 CAPTION L('Числовые параметры:' ) SIZE 28, 6.7 @ 7,47 DCGROUP oGroup5 CAPTION L('Пояснение:' ) SIZE 28, 8.0 @ 1, 1 DCRADIO nRadio1 VALUE 1 PROMPT L('Копировать всю обучающую выборку ') PARENT oGroup1 @ 2, 1 DCRADIO nRadio1 VALUE 2 PROMPT L('Копировать только текущий объект ') PARENT oGroup1 @ 3, 1 DCRADIO nRadio1 VALUE 3 PROMPT L('Копировать каждый N-й объект ') PARENT oGroup1 @ 4, 1 DCRADIO nRadio1 VALUE 4 PROMPT L('Копировать N случайных объектов ') PARENT oGroup1 @ 5, 1 DCRADIO nRadio1 VALUE 5 PROMPT L('Копировать все объекты от N1 до N2 ') PARENT oGroup1 @ 1, 1 DCRADIO nRadio2 VALUE 1 PROMPT L('Не удалять ') PARENT oGroup2 @ 2, 1 DCRADIO nRadio2 VALUE 2 PROMPT L('Удалять ') PARENT oGroup2 @ 1, 1 DCRADIO nRadio3 VALUE 1 PROMPT L('Стирать расп.выборку перед копированием ') PARENT oGroup3 @ 2, 1 DCRADIO nRadio3 VALUE 2 PROMPT L('Дополнять распознаваемую выборку ') PARENT oGroup3 @ 3, 0.2 DCSAY L(" ") GET N_CopyObj PARENT oGroup4 PICTURE "#########" EDITPROTECT {|| .NOT.nRadio1=3 } HIDE {|| .NOT.nRadio1=3 } @ 4, 0.2 DCSAY L(" ") GET N_CopyObj PARENT oGroup4 PICTURE "#########" EDITPROTECT {|| .NOT.nRadio1=4 } HIDE {|| .NOT.nRadio1=4 } @ 5, 0.2 DCSAY L(" ") GET mN1 PARENT oGroup4 PICTURE "#########" EDITPROTECT {|| .NOT.nRadio1=5 } HIDE {|| .NOT.nRadio1=5 } @ 5,13.5 DCSAY L(" ") GET mN2 PARENT oGroup4 PICTURE "#########" EDITPROTECT {|| .NOT.nRadio1=5 } HIDE {|| .NOT.nRadio1=5 } @ 1, 1 DCSAY L("Данный режим основан на идеях ") PARENT oGroup5 @ 2, 1 DCSAY L("бутстрепной статистики и готовит") PARENT oGroup5 @ 3, 1 DCSAY L("данные для измерения внутренней ") PARENT oGroup5 @ 4, 1 DCSAY L("и внешней, интегральной и диффе-") PARENT oGroup5 @ 5, 1 DCSAY L("ренциальной достоверности стат. ") PARENT oGroup5 @ 6, 1 DCSAY L("моделей и моделей знаний" ) PARENT oGroup5 @ 6.7, 15.6 DCPUSHBUTTON ; PARENT oGroup5 ; CAPTION L('Подробнее') ; SIZE LEN(L('Подробнее'))+1, 0.9 ; ACTION {||Help_OiRo()} DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('2.3.1. Копирование обучающей выборки в распознаваемую') *************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.F.) RETURN NIL ENDIF *************************************************** ENDIF ******************************************************** ** Скопировать просто как файлы и переименовать ******** ******************************************************** IF nRadio1=1 .AND. nRadio2=1 .AND. nRadio3=1 * oScr := DC_WaitOn(L('Идет процесс копирования обучающей выборки в распознаваемую. Немного подождите!'),,,,,,,,,,,.F.) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций COPY FILE ("Obi_Zag.dbf") TO ("Rso_Zag.dbf") COPY FILE ("ObI_Kcl.dbf") TO ("Rso_Kcl.dbf") COPY FILE ("Obi_Kpr.dbf") TO ("Rso_Kpr.dbf") * DC_Impl(oScr) DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ENDIF ******************************************************** aFileName := {"Obi_Zag.dbf",; "ObI_Kcl.dbf",; "Obi_Kpr.dbf",; "Rso_Zag.dbf",; "Rso_Kcl.dbf",; "Rso_Kpr.dbf" } // Проверка наличия всех файлов обуч.выборки Flag = .F. FOR j=1 TO 6 IF .NOT. FILE(aFileName[j]) // Существует ли исходный файл Flag = .T. EXIT ENDIF NEXT // Если все исходные файлы существуют, то копирование их в расп.выборку IF Flag LB_Warning(L("Отсутсвуют БД обучающей и распознаваемой выборки!!!")) Running(.F.) RETURN NIL ENDIF IF nRadio1 = 2 // Копировать только текущий объект обуч.выборки SELECT Obi_zag M_KodObj = Kod_obj ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX Obi_Zag EXCLUSIVE NEW;N0_ObiZag = RECCOUNT() USE Obi_Kcl INDEX Obi_Kcl EXCLUSIVE NEW;N0_ObiKcl = RECCOUNT() USE Obi_Kpr INDEX Obi_Kpr EXCLUSIVE NEW;N0_ObiKpr = RECCOUNT() USE Rso_Zag INDEX Rso_Zag EXCLUSIVE NEW USE Rso_Kcl INDEX Rso_Kcl EXCLUSIVE NEW USE Rso_Kpr INDEX Rso_Kpr EXCLUSIVE NEW IF N0_ObiZag = 0 LB_Warning(L("База данных заголовков объектов обучающей выборки пуста !!!")) Flag = .T. ENDIF IF N0_ObiKcl = 0 LB_Warning(L("База данных кодов классов объектов обучающей выборки пуста !!!")) Flag = .T. ENDIF IF N0_ObiKpr = 0 LB_Warning(L("База данных кодов признаков объектов обучающей выборки пуста !!!")) Flag = .T. ENDIF IF Flag DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ENDIF // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego Ar_RndObj := {} DO CASE CASE nRadio1 = 1 // Копировать всю обучающую выборку SELECT Obi_zag;N_ObiZag = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() SELECT Obi_Kcl;N_ObiKcl = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() SELECT Obi_Kpr;N_ObiKpr = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() CASE nRadio1 = 2 // Копировать только текущий объект SELECT Obi_zag SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiZag SELECT Obi_Kcl SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKcl SELECT Obi_Kpr SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKpr CASE nRadio1 = 3 // Копировать каждый N-й объект IF 0 < N_CopyObj .AND. N_CopyObj <= N0_ObiZag SELECT Obi_zag // Если код объекта обуч.выборки нацело делится на N_CopyObj, то копировать этот объект SET FILTER TO Kod_obj = N_CopyObj*INT(Kod_obj/N_CopyObj) DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiZag SELECT Obi_Kcl // Если код объекта обуч.выборки нацело делится на N_CopyObj, то копировать этот объект SET FILTER TO Kod_obj = N_CopyObj*INT(Kod_obj/N_CopyObj) DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKcl SELECT Obi_Kpr // Если код объекта обуч.выборки нацело делится на N_CopyObj, то копировать этот объект SET FILTER TO Kod_obj = N_CopyObj*INT(Kod_obj/N_CopyObj) DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKpr ELSE Mess = L("Каждый N-й объект обуч.выборки, где N = # !!!") Mess = STRTRAN(Mess,"#", ALLTRIM(STR(N_ObiZag,19))) LB_Warning(Mess) ENDIF CASE nRadio1 = 4 // Копировать N случайных объектов (по-другому отобр.прогн.времени исп.) // Сформировать массив кодов случайных объектов обучающей выборки без повторов из N элементов DO WHILE LEN(Ar_RndObj) < N_CopyObj // В массиве еще нет N_CopyObj элементов? // Случайный номер записи от 1 до N0_ObiZag (N0_ObiZag - кол-во объектов обуч.выборки) M_KodObj = 1+INT(RANDOM()%N0_ObiZag) IF ASCAN(Ar_RndObj, M_KodObj) = 0 // Номер этого объекта еще не разыгрывался? AADD (Ar_RndObj, M_KodObj) ENDIF ENDDO ASORT(Ar_RndObj) * DC_DebugQout( Ar_RndObj ) K_cls = N0_ObiKcl / N0_ObiZag // Сколько строк в БД кодов классов приходится в среднем на один объект обуч.выборки K_gos = N0_ObiKpr / N0_ObiZag // Сколько строк в БД кодов признаков приходится в среднем на один объект обуч.выборки N_ObiZag = N_CopyObj // Количество случайно выбранных объектов N_ObiKcl = K_cls * N_CopyObj // Оценка числа записей в БД кодов классов, приходящихся на случайно выбранные объекты N_ObiKpr = K_gos * N_CopyObj // Оценка числа записей в БД кодов признаков, приходящихся на случайно выбранные объекты CASE nRadio1 = 5 // Копировать все объекты, начиная с N-го SELECT Obi_zag DBGOTO(mN1);M_KodObj1 = Kod_obj DBGOTO(mN2);M_KodObj2 = Kod_obj SET FILTER TO M_KodObj1 <= Kod_Obj .AND. Kod_Obj <= M_KodObj2 DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiZag SELECT Obi_Kcl SET FILTER TO M_KodObj1 <= Kod_Obj .AND. Kod_Obj <= M_KodObj2 DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKcl SELECT Obi_Kpr SET FILTER TO M_KodObj1 <= Kod_Obj .AND. Kod_Obj <= M_KodObj2 DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_ObiKpr ENDCASE DO CASE CASE nRadio3 = 1 // Стирать расп.выборку перед копированием SELECT Rso_Zag;ZAP SELECT Rso_Kcl;ZAP SELECT Rso_Kpr;ZAP M_MaxKodObj = 0 CASE nRadio3 = 2 // Дополнять расп.выборку SELECT Rso_zag DBGOBOTTOM() M_MaxKodObj = Kod_Obj ENDCASE Ar_KodObjOld := {} // Коды объектов исходной выборки Ar_KodObjNew := {} // Коды объектов результирующей выборки IF Dialog // Задание максимальной величины параметра Time DO CASE CASE nRadio2=1 // Не удалять из обуч.выборки скопированные объекты Wsego = N0_ObiZag + N0_ObiKcl + N0_ObiKpr + 3 // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105, 6.5 PARENT oTabPage1 @ 8,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105, 5.0 PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // Зарезервировано для названия операции, если диалог @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // 1/4: Obi_Zag @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // 2/4: Obi_Kcl @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // 3/4: Obi_Kpr @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // 4/4: Переиндексация CASE nRadio2=2 // Удалять из обуч.выборки скопированные объекты Wsego = N0_ObiZag + N0_ObiKcl + N0_ObiKpr + 3 + (N0_ObiZag - N_ObiZag) + (N0_ObiKcl - N_ObiKcl) + (N0_ObiKpr - N_ObiKpr) + 6 // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,11.5 PARENT oTabPage1 @13,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105, 5.0 PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // Зарезервировано для названия операции, если диалог @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // 1/9: Obi_Zag @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // 2/9: Obi_Kcl @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // 3/9: Obi_Kpr @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // 4/9: Удаление скопированных объектов из обучающей выборки - 3 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" // 5/9: Перекодирование БД заголовков объектов обуч.выборки @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // 6/9: Перекодирование БД кодов классов объектов обуч.выборки @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // 7/9: Перекодирование БД кодов признаков объектов обуч.выборки @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // 8/9: Переиндексация баз данных обучающей выборки - 3 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 9/9: Переиндексация ENDCASE Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('2.3.1. Копирование обучающей выборки в распознаваемую') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() // Завершение подготовки данных для отображения графического прогресс-бар ENDIF // Копирование обуч.выборки в распознаваемую s = 1 IF Dialog aSay[ s++]:SetCaption(L('ОПЕРАЦИЯ: КОПИРОВАНИЕ ОБУЧАЮЩЕЙ ВЫБОРКИ В РАСПОЗНАВАЕМУЮ')) // Почему-то копирует не подмножество, а всю об.выборку целиком (когда GPU) <<<===################################### ENDIF aSay[s]:SetCaption(L("1/"+IF(nRadio2=1,'4','9')+": Копирование базы заголовков обучающей выборки")) SELECT Obi_zag // ***************************************************** DBGOTOP() DO WHILE .NOT. EOF() IF ( nRadio1 = 4 .AND. ASCAN(Ar_RndObj, Kod_obj) > 0 ) .OR. nRadio1 <> 4 AADD(Ar_KodObjOld, Kod_obj) AADD(Ar_KodObjNew, ++M_MaxKodObj) // Если дополнять БД, то 1-й код следующий за последним Ar := {};FOR j=1 TO FCOUNT();AADD(Ar, FIELDGET(j));NEXT SELECT Rso_zag APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) NEXT SELECT Obi_zag IF nRadio2=2;DELETE;ENDIF ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("2/"+IF(nRadio2=1,'4','9')+": Копирование базы кодов классов обучающей выборки")) SELECT Obi_Kcl // ******************************************************** DBGOTOP() DO WHILE .NOT. EOF() IF ( nRadio1 = 4 .AND. ASCAN(Ar_RndObj, Kod_obj) > 0 ) .OR. nRadio1 <> 4 Ar := {};FOR j=1 TO FCOUNT();AADD(Ar, FIELDGET(j));NEXT SELECT Rso_Kcl APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) NEXT SELECT Obi_Kcl IF nRadio2=2;DELETE;ENDIF ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("3/"+IF(nRadio2=1,'4','9')+": Копирование базы кодов признаков обучающей выборки")) SELECT Obi_Kpr // ********************************************************** DBGOTOP() DO WHILE .NOT. EOF() IF ( nRadio1 = 4 .AND. ASCAN(Ar_RndObj, Kod_obj) > 0 ) .OR. nRadio1 <> 4 Ar := {};FOR j=1 TO FCOUNT();AADD(Ar, FIELDGET(j));NEXT SELECT Rso_Kpr APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) NEXT SELECT Obi_Kpr IF nRadio2=2;DELETE;ENDIF ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) IF nRadio2=2 // 4-8 делать и отображать только, если это задано ################################# aSay[s]:SetCaption(L("4/9: Удаление скопированных объектов из обучающей выборки")) IF nRadio2=2;SELECT Obi_zag;PACK;ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF IF nRadio2=2;SELECT Obi_Kcl;PACK;ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF IF nRadio2=2;SELECT Obi_Kpr;PACK;ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("5/9: Перекодирование БД заголовков объектов обуч.выборки")) M_MaxKodObj = 0 Ar_KodObjOld := {} // Коды объектов исходной выборки Ar_KodObjNew := {} // Коды объектов результирующей выборки SELECT Obi_zag // **************************************************** SET FILTER TO RECALL ALL DBGOTOP() DO WHILE .NOT. EOF() IF nRadio2=2 AADD(Ar_KodObjOld, Kod_obj) AADD(Ar_KodObjNew, ++M_MaxKodObj) // Если дополнять БД, то 1-й код следующий за последним REPLACE Kod_obj WITH M_MaxKodObj ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("6/9: Перекодирование БД кодов классов объектов обуч.выборки")) SELECT Obi_Kcl // **************************************************** SET FILTER TO RECALL ALL DBGOTOP() DO WHILE .NOT. EOF() IF nRadio2=2 Pos = ASCAN(Ar_KodObjOld, Kod_obj) REPLACE Kod_obj WITH Ar_KodObjNew[Pos] ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("7/9: Перекодирование БД кодов признаков объектов обуч.выборки")) SELECT Obi_Kpr // **************************************************** SET FILTER TO RECALL ALL DBGOTOP() DO WHILE .NOT. EOF() IF nRadio2=2 Pos = ASCAN(Ar_KodObjOld, Kod_obj) REPLACE Kod_obj WITH Ar_KodObjNew[Pos] ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) aSay[s]:SetCaption(L("8/9: Переиндексация баз данных обучающей выборки")) IF nRadio2=2;GenNtxObiZag();ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF IF nRadio2=2;GenNtxObiKcl();ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF IF nRadio2=2;GenNtxObiKpr();ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) ENDIF // 5-9 делать и отображать только, если это задано ####################################### aSay[s]:SetCaption(IF(nRadio2=1,'4','9')+"/"+IF(nRadio2=1,'4','9')+L(": Переиндексация баз данных распознаваемой выборки")) GenNtxRsoZag() IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF GenNtxRsoKcl() IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF GenNtxRsoKpr() IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[s]:SetCaption(aSay[s++]:caption+L(" - Готово ")) IF Dialog aSay[ 1]:SetCaption(aSay[ 1]:caption+L(" - Готово ")) // Заключительные операции и деструктурирование окна отображения графического Progress-bar Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("КОПИРОВАНИЕ ОБУЧАЮЩЕЙ ВЫБОРКИ В РАСПОЗНАВАЕМУЮ ЗАВЕРШЕНО УСПЕШНО!!!")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ELSE FOR j=2 TO IF(nRadio2=1,5,10);aSay[j]:SetCaption(L(" "));NEXT ENDIF DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ************************************************************************************************** FUNCTION Help_OiRo() aHelp := {} AADD(aHelp, L('Различные режимы копирования обучающей выборки в распознаваемую обеспечивают подготовку ')) AADD(aHelp, L('исходных данных для измерения внутренней и внешней дифференциальной и интегральной ')) AADD(aHelp, L('достоверности статистической модели или модели знаний. Достоверность модели представляет')) AADD(aHelp, L('собой ее способность правильно определять принадлежность объектов (по их признакам) к тем')) AADD(aHelp, L('классам, к которым они фактически относятся, и непринадлежность к другим классам, к ')) AADD(aHelp, L('которым они фактически не относятся (это и есть распознавание или идентификация). При ')) AADD(aHelp, L('этом распознаваться могут как объекты входящие в обучающую выборку, так и не входящие в ')) AADD(aHelp, L('нее. В первом случае определяется внутренняя достоверность модели, а во втором - внешняя ')) AADD(aHelp, L('достоверность. Различают интегральную достоверность модели, рассчитываемую по итогам ')) AADD(aHelp, L('распознавания объектов на всей совокупности классов, и дифференциальную достоверность, ')) AADD(aHelp, L('т.е. достоверность идентификации объектов с конкретными классами распознавания. Для ')) AADD(aHelp, L('расчета внутренней достоверности скопируйте обучающую выборку в распознаваемую, выполните')) AADD(aHelp, L('режим пакетного распознавания и получите отчет по достоверности его результатов. Если ')) AADD(aHelp, L('внутренняя достоверность модели высокая, то имеет смысл проверять внешнюю, т.е. ')) AADD(aHelp, L('проверять гипотезу о репрезентативности обучающей выборки по отношению к некоторой ')) AADD(aHelp, L('генеральной совокупности, более широкой, чем она сама. Для расчета внешней достоверности ')) AADD(aHelp, L('модели необходимо скопировать объекты из обучающей выборки в распознаваемую с удалением ')) AADD(aHelp, L('скопированных объектов из обучающей выборки, а затем (в режиме 3.4) выполнить пересинтез ')) AADD(aHelp, L('модели и контрольное распознавание (в режиме 4.1.2), после чего получить отчет по его ')) AADD(aHelp, L('достоверности. Для комплексного исследования внутренней и внешней достоверности всех ')) AADD(aHelp, L('моделей предназначен режим 3.5. Отметим, что при увеличении объема обучающей выборки ')) AADD(aHelp, L('различие между внутренней и внешней достоверностью модели уменьшается пропорционально ')) AADD(aHelp, L('уменьшению веса или влияния каждого конкретного объекта на формирование обобщенной модели')) AADD(aHelp, L('предметной области. ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-8, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('2.3.1. Копирование обучающей выборки в распознаваемую') RETURN NIL ************************************************************************************************** ******** Добавить объект в конец БД Obi_Zag.dbf FUNCTION Add_Obj2_3_1() SELECT Obi_Zag DBGOBOTTOM() M_KodObj = Kod_Obj APPEND BLANK REPLACE Kod_Obj WITH M_KodObj+1 REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH Time() Add_Kcl2_3_1() Add_Kpr2_3_1() SELECT Obi_Zag DBGOBOTTOM() DC_GetRefresh(GetList) RETURN NIL ******** Добавить строку классов в конец БД Obi_Kcl.dbf FUNCTION Add_Kcl2_3_1() SELECT Obi_Zag M_KodObj = Kod_Obj SELECT Obi_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj DBGOTOP() DC_GetRefresh(GetList) RETURN NIL ******** Добавить строку признаков в конец БД Obi_Kpr.dbf FUNCTION Add_Kpr2_3_1() SELECT Obi_Zag M_KodObj = Kod_Obj SELECT Obi_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj DBGOTOP() DC_GetRefresh(GetList) RETURN NIL ******** Удалить текущую запись в БД Obi_Zag.dbf ******** и связанные с ней записи БД Obi_Kcl.dbf и Obi_Kpr.dbf FUNCTION Del_Obj2_3_1() SELECT Obi_Zag M_Recno = RECNO() M_Kod_obj = Kod_Obj DELETE PACK // Удалить связанные БД SELECT Obi_Kcl DELETE FOR M_Kod_obj = Kod_Obj PACK SELECT Obi_Kpr DELETE FOR M_Kod_obj = Kod_Obj PACK SELECT Obi_Zag DBGOTO(M_Recno) RETURN NIL ******** Удалить текущую запись в БД Obi_Kcl.dbf FUNCTION Del_Kcl2_3_1() SELECT Obi_Kcl M_Recno = RECNO() DELETE PACK DBGOTO(M_Recno) RETURN NIL ******** Удалить текущую запись в БД Obi_Kpr.dbf FUNCTION Del_Kpr2_3_1() SELECT Obi_Kpr M_Recno = RECNO() DELETE PACK DBGOTO(M_Recno) RETURN NIL ******** Очистить БД FUNCTION Zap_db2_3_1() SELECT Obi_Zag;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH Time() SELECT Obi_Kcl;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 SELECT Obi_Kpr;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 RETURN NIL ******** Генерация БД заголовков обучающей выборки FUNCTION GenDbfObiZag() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Obi_Zag.dbf" aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj", "C", 65, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8 , 0 } } DbCreate( cFileName, aStructure ) GenNtxObiZag() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация БД кодов классов обучающей выборки FUNCTION GenDbfObiKcl() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "ObI_Kcl.dbf" aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Cls1" , "N", 15, 0 }, ; { "Cls2" , "N", 15, 0 }, ; { "Cls3" , "N", 15, 0 }, ; { "Cls4" , "N", 15, 0 } } DbCreate( cFileName, aStructure ) GenNtxObiKcl() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация БД кодов признаков обучающей выборки FUNCTION GenDbfObiKpr() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Obi_Kpr.dbf" aStructure := { { "Kod_Obj", "N", 15, 0 }, ; { "Atr1" , "N", 15, 0 }, ; { "Atr2" , "N", 15, 0 }, ; { "Atr3" , "N", 15, 0 }, ; { "Atr4" , "N", 15, 0 }, ; { "Atr5" , "N", 15, 0 }, ; { "Atr6" , "N", 15, 0 }, ; { "Atr7" , "N", 15, 0 } } DbCreate( cFileName, aStructure ) GenNtxObiKpr() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Создание индексных массивов БД заголовков объектов обучающей выборки FUNCTION GenNtxObiZag() aSaveGN7 := DC_DataSave() IF .NOT. FILE("Obi_Zag.dbf") GenDbfOpSc(.F.) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag EXCLUSIVE NEW INDEX ON STR(Kod_Obj,15) TO Oiz_kod INDEX ON Name_Obj TO Oiz_name INDEX ON Kod_Obj TO Obi_Zag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN7 ) RETURN NIL ******** Создание индексных массивов БД кодов классов обучающей выборки FUNCTION GenNtxObiKcl() aSaveGN8 := DC_DataSave() IF .NOT. FILE("Obi_Kcl.dbf") GenDbfObiKcl() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Kcl EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Oic_kod INDEX ON Kod_Obj TO Obi_Kcl CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN8 ) RETURN NIL ******** Создание индексных массивов БД кодов признаков обучающей выборки FUNCTION GenNtxObiKpr() aSaveGN9 := DC_DataSave() IF .NOT. FILE("Obi_Kpr.dbf") GenDbfObiKpr() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Kpr EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Oip_kod INDEX ON Kod_Obj TO Obi_Kpr CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGN9 ) RETURN NIL *********************************************************************************************************** ********* 5.1. Конвертер приложения: Old => New ********* (отображение стадии процесса с очень точным адаптивным прогнозированием времени исполнения: ********* FUNCTION XSample_56() и XSample_14() xdemo.exe) ********* ВСЕ БД СОРТИРОВАТЬ ПО ВОЗРАСТАНИЮ КОДОВ !!! *********************************************************************************************************** FUNCTION F5_1() LOCAL GetList := {}, oMainDlg LOCAL oProgress, oDialog, lOk := .t., oButton, nEvent, mp1, mp2, oXbp PUBLIC aSay[10], Mess98, Mess99 Running(.T.) ******** Добавить в БД Appls.dbf запись для нового приложения IF .NOT. FILE("Appls.dbf") LB_Warning(L("отсутствует БД приложений. Перейдите в диспетчер приложений (режим 1.3)!","5.1. Конвертер приложения: Old => New" )) Running(.F.) RETURN NIL ENDIF **SET TAG TO COMMAND aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Appls EXCLUSIVE NEW SELECT Appls DBGOTOP() DO WHILE .NOT. EOF() REPLACE By_default WITH "" DBSKIP(1) ENDDO M_NewAppl = ADD_ZAPPL('Новое приложение, конвертированное из БД системы "ЭЙДОС-12.5". Это название желательно скорректировать') DIRCHANGE(M_ApplsPath) // Перейти в папку с БД приложений IF FILEDATE("OldAppls",16) = CTOD("//") DIRMAKE("OldAppls") Mess = L('В папке с БД приложений "#" не было директории OldAppls для БД старой модели и она была создана!') Mess = STRTRAN(Mess, "#", UPPER(ALLTRIM(M_ApplsPath))) LB_Warning(Mess, L("5.1. Конвертер приложения: Old => New" )) ELSE DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: GenDbfClSc(.F.) // Классификационные шкалы ######### GenDbfGrClSc(.F.) // Градации классификационных шкал ######### GenDbfClass(.F.) // Классификационные шкалы и градации GenDbfOpSc(.F.) // Описательные шкалы GenDbfGrOpSc(.F.) // Градации описательных шкал GenDbfAttr(.F.) // Описательные шкалы и градации ######### GenDbfObiZag() // Заголовки объектов обучающей выборки GenDbfObiKcl() // Коды классов объектов обучающей выборки GenDbfObiKpr() // Коды признаков объектов обучающей выборки GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели и проверить ее наличие IF .NOT. FILE("OBJECT.DBF" ) .OR. ; .NOT. FILE("PRIZ_OB.DBF" ) .OR. ; .NOT. FILE("PRIZ_PER.DBF") .OR. ; .NOT. FILE("PRIZ_PER.DBT") .OR. ; .NOT. FILE("OBINFZAG.DBF") .OR. ; .NOT. FILE("OBINFKPR.DBF") .OR. ; .NOT. FILE("RSANKZAG.DBF") .OR. ; .NOT. FILE("RSANKKPR.DBF") Mess1 = 'В папке старой модели "#\OldAppls" должны быть файлы:' Mess1 = STRTRAN(Mess1, "#", UPPER(ALLTRIM(M_ApplsPath))) Mess2 = 'OBJECT.DBF, PRIZ_OB.DBF, PRIZ_PER.DBF,PRIZ_PER.DBT,' Mess3 = 'OBINFZAG.DBF, OBINFKPR.DBF, RSANKZAG.DBF, RSANKKPR.DBF' Mess4 = 'Скопируйте их из старого приложения и повторите данный режим' DCMSGBOX Mess1, ; Mess2, ; Mess3, ; Mess4 ; TITLE L("Сообщение об ошибке в режиме 5.1"); FONT "10.Arial" ; BUTTONS {'Выйти из режима'} CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Object EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Priz_ob EXCLUSIVE NEW;N_Pro = RECCOUNT() USE Priz_per EXCLUSIVE NEW;N_Prp = RECCOUNT() USE ObInfZag EXCLUSIVE NEW;N_OiZag = RECCOUNT() // БД используется 2 раза USE ObInfKpr EXCLUSIVE NEW;N_OiKpr = RECCOUNT() USE RsAnkZag EXCLUSIVE NEW;N_RoZag = RECCOUNT() // БД используется 2 раза USE RsAnkKpr EXCLUSIVE NEW;N_RoKpr = RECCOUNT() // Задание максимальной величины параметра Time Wsego = N_Obj + N_Pro + N_Prp + 2*N_OiZag + N_OiKpr + 2*N_RoZag + N_RoKpr // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,11.5 ; PARENT oTabPage1 @13,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('5.1. Конвертер приложения из стандарта БД системы "Эйдос-12.5" в стандарт "Эйдос-Х++"') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() Time_Progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // Конвертирование БД классификационных шкал и градаций aSay[ 1]:SetCaption(L("Шаг 1-й из 9. Конвертирование БД классификационных шкал и градаций")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Object EXCLUSIVE NEW INDEX ON STR(Kod,4) TO Obj_kod CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Classes EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Object INDEX Obj_kod EXCLUSIVE NEW SELECT Object;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod M_Name = Name DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Classes APPEND BLANK REPLACE Kod_cls WITH M_Kod REPLACE Name_cls WITH M_Name IF M_Kod <> RECNO() Mess = L("При конвертировании справочника классов не совпали коды и номера записей !!!") LB_Warning(Mess) ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Object DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 1]:SetCaption(aSay[ 1]:caption+L(" - Готово ")) // Конвертирование БД описательных шкал и градаций // Шкалы aSay[ 2]:SetCaption(L("Шаг 2-й из 9. Конвертирование БД описательных шкал")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_ob EXCLUSIVE NEW INDEX ON STR(Kod,4) TO Prob_kod CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Opis_Sc EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_ob INDEX Prob_kod EXCLUSIVE NEW SELECT Priz_ob;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod M_Name = Name DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Opis_Sc APPEND BLANK REPLACE Kod_OpSc WITH M_Kod REPLACE Name_OpSc WITH M_Name IF M_Kod <> RECNO() Mess = L("При конвертировании описательных шкал не совпали коды и номера записей !!!") LB_Warning(Mess) ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Priz_ob DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 2]:SetCaption(aSay[ 2]:caption+L(" - Готово ")) // Градации aSay[ 3]:SetCaption(L("Шаг 3-й из 9. Конвертирование БД градаций описательных шкал")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_per EXCLUSIVE NEW INDEX ON STR(Kod_ob_pr,4)+STR(Kod,4) TO Prop_kod CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Gr_OpSc EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_per INDEX Prop_kod EXCLUSIVE NEW SELECT Priz_per;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod M_Name = Name M_KodObPr = Kod_ob_pr DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Gr_OpSc APPEND BLANK REPLACE Kod_GrOS WITH M_Kod REPLACE Kod_OpSc WITH M_KodObPr REPLACE Name_GrOS WITH M_Name IF M_Kod <> RECNO() Mess = L("При конвертировании градаций описательных шкал не совпали коды и номера записей !!!") LB_Warning(Mess) ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Priz_per DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 3]:SetCaption(aSay[ 3]:caption+L(" - Готово ")) // Конвертирование БД обучающей выборки // Заголовки aSay[ 4]:SetCaption(L("Шаг 4-й из 9. Конвертирование БД заголовков объектов обучающей выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE ObInfZag EXCLUSIVE NEW INDEX ON STR(Kod_ist,19) TO Oiz_kist CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Obi_Zag EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE ObInfZag INDEX Oiz_kist EXCLUSIVE NEW SELECT ObInfZag;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_KodObj = Kod_ist M_NameObj = Name_ist DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Obi_Zag APPEND BLANK REPLACE Kod_Obj WITH M_KodObj REPLACE Name_Obj WITH M_NameObj REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT ObInfZag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 4]:SetCaption(aSay[ 4]:caption+L(" - Готово ")) // Коды классов aSay[ 5]:SetCaption(L("Шаг 5-й из 9. Конвертирование БД кодов классов объектов обучающей выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Obi_Kcl EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE ObInfZag EXCLUSIVE NEW DBGOTOP() DO WHILE .NOT. EOF() M_KodObj = Kod_ist Ar_Kcl := {} FOR j=3 TO FCOUNT()-4 Mv = FIELDGET(j) IF Mv > 0 AADD(Ar_Kcl, Mv) ELSE EXIT ENDIF NEXT ****** Запись массива кодов классов из Ar_Kcl[] в БД Obi_Kcl DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Obi_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(Ar_Kcl) > 0 k=1 FOR j=1 TO LEN(Ar_Kcl) IF k <= 4 FIELDPUT(1+k++,Ar_Kcl[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,Ar_Kcl[j]) ENDIF NEXT ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT ObInfZag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 5]:SetCaption(aSay[ 5]:caption+L(" - Готово ")) // Коды признаков aSay[ 6]:SetCaption(L("Шаг 6-й из 9. Конвертирование БД кодов признаков объектов обучающей выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE ObInfKpr EXCLUSIVE NEW // Рассортировать старую БД кодов признаков ObInfKpr.dbf по коду источника INDEX ON STR(Kod_ist,19) TO Oik_Kist CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Obi_Kpr EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE ObInfKpr INDEX Oik_Kist EXCLUSIVE NEW SELECT ObInfKpr;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() Ar_Kpr := {} M_KodistOld = Kod_ist DO WHILE M_KodistOld = Kod_ist .AND. .NOT. EOF() // Цикл накопления кодов признаков одного объекта M_KodObj = Kod_ist FOR j=2 TO FCOUNT()-1 Mv = FIELDGET(j) IF Mv > 0 AADD(Ar_Kpr, Mv) ENDIF NEXT DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO ****** Запись массива кодов признаков из Ar_Kpr[] в БД Obi_Kpr DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Obi_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(Ar_Kpr) > 0 k=1 FOR j=1 TO LEN(Ar_Kpr) IF k <= 7 FIELDPUT(1+k++,Ar_Kpr[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,Ar_Kpr[j]) ENDIF NEXT ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT ObInfKpr ENDDO aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Готово ")) // Конвертирование БД распознаваемой выборки // Заголовки aSay[ 7]:SetCaption(L("Шаг 7-й из 9. Конвертирование БД заголовков объектов распознаваемой выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkZag EXCLUSIVE NEW INDEX ON STR(Kod_ist,19) TO Roz_kist CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Rso_Zag EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkZag INDEX Roz_kist EXCLUSIVE NEW SELECT RsAnkZag;SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_KodObj = Kod_ist M_NameObj = Name_ist DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Rso_Zag APPEND BLANK REPLACE Kod_Obj WITH M_KodObj REPLACE Name_Obj WITH M_NameObj REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT RsAnkZag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Готово ")) // Коды классов aSay[ 8]:SetCaption(L("Шаг 8-й из 9. Конвертирование БД кодов классов объектов распознаваемой выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Rso_Kcl EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkZag EXCLUSIVE NEW DBGOTOP() DO WHILE .NOT. EOF() M_KodObj = Kod_ist Ar_Kcl := {} FOR j=3 TO FCOUNT()-4 Mv = FIELDGET(j) IF Mv > 0 AADD(Ar_Kcl, Mv) ELSE EXIT ENDIF NEXT ****** Запись массива кодов классов из Ar_Kcl[] в БД Obi_Kcl DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Rso_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(Ar_Kcl) > 0 k=1 FOR j=1 TO LEN(Ar_Kcl) IF k <= 4 FIELDPUT(1+k++,Ar_Kcl[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,Ar_Kcl[j]) ENDIF NEXT ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT RsAnkZag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово ")) // Коды признаков aSay[ 9]:SetCaption(L("Шаг 9-й из 9. Конвертирование БД кодов признаков объектов распознаваемой выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkKpr EXCLUSIVE NEW // Рассортировать старую БД кодов признаков RsAnkKpr.dbf по коду источника INDEX ON STR(Kod_ist,19) TO Roz_Kist CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели USE Rso_Kpr EXCLUSIVE;ZAP DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkKpr INDEX Roz_Kist EXCLUSIVE NEW SELECT RsAnkKpr SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() Ar_Kpr := {} M_KodistOld = Kod_ist DO WHILE M_KodistOld = Kod_ist .AND. .NOT. EOF() // Цикл накопления кодов признаков одного объекта M_KodObj = Kod_ist FOR j=2 TO FCOUNT()-1 Mv = FIELDGET(j) IF Mv > 0 AADD(Ar_Kpr, Mv) ENDIF NEXT DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO ****** Запись массива кодов признаков из Ar_Kpr[] в БД Obi_Kpr DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели SELECT Rso_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj IF LEN(Ar_Kpr) > 0 k=1 FOR j=1 TO LEN(Ar_Kpr) IF k <= 7 FIELDPUT(1+k++,Ar_Kpr[j]) ELSE k=1 APPEND BLANK REPLACE Kod_Obj WITH M_KodObj FIELDPUT(1+k++,Ar_Kpr[j]) ENDIF NEXT ENDIF DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT RsAnkKpr ENDDO aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово ")) aSay[10]:SetCaption(L('Переиндексация всех БД созданного приложения')) DIRCHANGE(M_NewAppl) // Перейти в папку с БД новой модели и создать БД формализации предметной области: GenNtxClass() // Классификационные шкалы и градации GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки aSay[10]:SetCaption(aSay[10]:caption+L(' - Готово ')) Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("КОНВЕРТИРОВАНИЕ ПРИЛОЖЕНИЯ ИЗ СТАРОГО СТАНДАРТА БД В НОВЫЙ ЗАВЕРШЕНО УСПЕШНО!!!")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************** ********* 5.2. Конвертер приложения: New => Old ********* Основные базы данных текущего приложения перобразуется к старому стандарту в папку OldAppls *********************************************************************************************************** FUNCTION F5_2() LOCAL GetList := {}, oMainDlg LOCAL oProgress, oDialog, lOk := .t., oButton, nEvent, mp1, mp2, oXbp PUBLIC aSay[10], Mess98, Mess99 Running(.T.) **SET TAG TO COMMAND aSave_adds := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(M_PathAppl) // Перейти в папку текущего приложения // Удалить и создать папку для старого приложения (это проще, чем стирать файлы внутри нее) DIRCHANGE(M_ApplsPath) // Перейти в папку с БД приложений ZapDir("OldAppls",.T.) DIRMAKE("OldAppls") // Перейти в папку с БД старой модели и создать там файлы баз данных старого стандарта DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") GenDBFobj_old() GenDBFprp_old() GenDBFpro_old() * GenDBFAbs_old() * GenDBFInf_old() GenObiZag_old() // Создание БД обучающей и распознаваемой выборки GenObiKpr_old() // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego * Classes.dbf => OBJECT.DBF * Opis_Sc.dbf => PRIZ_OB.DBF * Gr_OpSc.dbf => PRIZ_PER.DBF * Obi_Zag.dbf, ObI_Kcl.dbf => OBINFZAG.DBF * Obi_Kpr.dbf => OBINFKPR.DBF * Rso_Zag.dbf, Rso_Kcl.dbf => RSANKZAG.DBF * Rso_Kpr.dbf => RSANKKPR.DBF * Abs.dbf => Abs.dbf // Для запуска модуля визуализации когнитивных функций * Inf.dbf => Inf.dbf DIRCHANGE(M_PathAppl) // Перейти в папку текущего приложения CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW;N_OpSc = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_GrOS = RECCOUNT() USE Obi_Zag EXCLUSIVE NEW;N_OiZag = RECCOUNT() USE ObI_Kcl EXCLUSIVE NEW;N_OiCls = RECCOUNT() USE Obi_Kpr EXCLUSIVE NEW;N_OiKpr = RECCOUNT() USE Rso_Zag EXCLUSIVE NEW;N_RoZag = RECCOUNT() USE Rso_Kcl EXCLUSIVE NEW;N_RoCls = RECCOUNT() USE Rso_Kpr EXCLUSIVE NEW;N_RoKpr = RECCOUNT() USE Abs EXCLUSIVE NEW;N_Abs = RECCOUNT() USE Inf EXCLUSIVE NEW;N_Inf = RECCOUNT() // Задание максимальной величины параметра Time Wsego = N_Cls+N_OpSc+N_GrOS+2*N_OiZag+2*N_RoZag+N_Abs+N_Inf // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,10.5 ; PARENT oTabPage1 @12,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage2 s = 1 PRIVATE aSay[11] @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('5.2. Конвертер приложения из стандарта БД системы "Эйдос-Х++" в стандарт "Эйдос-12.5"') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() Time_Progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // Конвертирование БД классификационных шкал и градаций aSay[ 1]:SetCaption(L("Шаг 1-й из 9. Конвертирование БД классификационных шкал и градаций")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Object EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Classes EXCLUSIVE NEW SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) M_Name = FIELDGET(2) DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Object APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(2, M_Name) DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Classes DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 1]:SetCaption(aSay[ 1]:caption+L(" - Готово ")) // Конвертирование БД описательных шкал и градаций // Шкалы aSay[ 2]:SetCaption(L("Шаг 2-й из 9. Конвертирование БД описательных шкал")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_ob EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW SELECT Opis_Sc DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) M_Name = FIELDGET(2) SELECT Gr_OpSc SET FILTER TO Kod_OpSc = M_Kod Ar_GrOS := {} DBGOTOP() DO WHILE .NOT. EOF() AADD(Ar_GrOS, Kod_GrOS) DBSKIP(1) ENDDO DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Priz_ob APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(2, M_Name) FOR j=1 TO LEN(Ar_GrOS) FIELDPUT(2+j, Ar_GrOS[j]) NEXT DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Opis_Sc DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 2]:SetCaption(aSay[ 2]:caption+L(" - Готово ")) // Градации aSay[ 3]:SetCaption(L("Шаг 3-й из 9. Конвертирование БД градаций описательных шкал")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE Priz_per EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Gr_OpSc EXCLUSIVE NEW SELECT Gr_OpSc DBGOTOP() DO WHILE .NOT. EOF() M_KodOpSc = FIELDGET(1) M_KodGrOS = FIELDGET(2) M_NameGrOS = FIELDGET(3) DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Priz_per APPEND BLANK FIELDPUT(1, M_KodGrOS ) FIELDPUT(2, M_NameGrOS) FIELDPUT(3, M_KodOpSc ) DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Gr_OpSc DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 3]:SetCaption(aSay[ 3]:caption+L(" - Готово ")) // Конвертирование БД обучающей выборки // Заголовки aSay[ 4]:SetCaption(L("Шаг 4-й из 9. Конвертирование БД заголовков и кодов классов объектов обучающей выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE OBINFZAG EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Obi_zag EXCLUSIVE NEW USE Obi_kcl EXCLUSIVE NEW SELECT Obi_zag DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) M_Name = FIELDGET(2) SELECT Obi_kcl SET FILTER TO Kod_obj = M_Kod Ar_kcl := {} DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO 5 Fv = FIELDGET(j) IF Fv > 0 AADD(Ar_kcl, Fv) ENDIF NEXT DBSKIP(1) ENDDO DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT OBINFZAG APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(2, M_Name) FOR j=1 TO LEN(Ar_kcl) FIELDPUT(2+j, Ar_kcl[j]) NEXT DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Obi_zag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 4]:SetCaption(aSay[ 4]:caption+L(" - Готово ")) // Коды признаков aSay[ 5]:SetCaption(L("Шаг 5-й из 9. Конвертирование БД кодов признаков объектов обучающей выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE OBINFKPR EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Obi_zag EXCLUSIVE NEW USE Obi_kpr EXCLUSIVE NEW SELECT Obi_zag DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) SELECT Obi_kpr SET FILTER TO Kod_obj = M_Kod Ar_kpr := {} DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO 8 Fv = FIELDGET(j) IF Fv > 0 AADD(Ar_kpr, Fv) ENDIF NEXT DBSKIP(1) ENDDO * DC_DebugQout( Ar_kpr ) *** Занести массив кодов признаков в БД ObI_Kpr IF LEN(Ar_Kpr) > 0 DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT OBINFKPR APPEND BLANK FIELDPUT(1, M_Kod ) k=1 FOR j=1 TO LEN(Ar_Kpr) IF k <= 11 FIELDPUT(1+k++,Ar_Kpr[j]) ELSE k=1 APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(1+k++,Ar_Kpr[j]) ENDIF NEXT ENDIF DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Obi_zag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 5]:SetCaption(aSay[ 5]:caption+L(" - Готово ")) // Конвертирование БД распознаваемой выборки // Заголовки aSay[ 6]:SetCaption(L("Шаг 6-й из 9. Конвертирование БД заголовков и кодов классов объектов распознаваемой выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkZAG EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Rso_zag EXCLUSIVE NEW USE Rso_kcl EXCLUSIVE NEW SELECT Rso_zag DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) M_Name = FIELDGET(2) SELECT Rso_kcl SET FILTER TO Kod_obj = M_Kod Ar_kcl := {} DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO 5 Fv = FIELDGET(j) IF Fv > 0 AADD(Ar_kcl, Fv) ENDIF NEXT DBSKIP(1) ENDDO DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT RsAnkZAG APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(2, M_Name) FOR j=1 TO LEN(Ar_kcl) FIELDPUT(2+j, Ar_kcl[j]) NEXT DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Rso_zag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Готово ")) // Коды признаков aSay[ 7]:SetCaption(L("Шаг 7-й из 9. Конвертирование БД кодов признаков объектов распознаваемой выборки")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели USE RsAnkKPR EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Rso_zag EXCLUSIVE NEW USE Rso_kpr EXCLUSIVE NEW SELECT Rso_zag DBGOTOP() DO WHILE .NOT. EOF() M_Kod = FIELDGET(1) SELECT Rso_kpr SET FILTER TO Kod_obj = M_Kod Ar_kpr := {} DBGOTOP() DO WHILE .NOT. EOF() FOR j=2 TO 8 Fv = FIELDGET(j) IF Fv > 0 AADD(Ar_kpr, Fv) ENDIF NEXT DBSKIP(1) ENDDO * DC_DebugQout( Ar_kpr ) *** Занести массив кодов признаков в БД ObI_Kpr IF LEN(Ar_Kpr) > 0 DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT RsAnkKPR APPEND BLANK FIELDPUT(1, M_Kod ) k=1 FOR j=1 TO LEN(Ar_Kpr) IF k <= 11 FIELDPUT(1+k++,Ar_Kpr[j]) ELSE k=1 APPEND BLANK FIELDPUT(1, M_Kod ) FIELDPUT(1+k++,Ar_Kpr[j]) ENDIF NEXT ENDIF DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Rso_zag DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Готово ")) aSay[ 8]:SetCaption(L("Шаг 8-й из 9. Конвертирование БД абсолютных частот Abs.dbf")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели GenDBFAbs_old() USE Abs_old EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Abs EXCLUSIVE NEW SELECT Abs DBGOTOP() DO WHILE .NOT. EOF() Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Abs_old APPEND BLANK FIELDPUT(1, Ar[1]) FOR j=3 TO LEN(Ar) FIELDPUT(j-1, Ar[j]) NEXT DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Abs DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово ")) aSay[ 9]:SetCaption(L("Шаг 9-й из 9. Конвертирование БД абсолютных частот Inf.dbf")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели GenDBFInf_old() USE Inf_old EXCLUSIVE NEW;ZAP DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели USE Inf EXCLUSIVE NEW SELECT Inf DBGOTOP() DO WHILE .NOT. EOF() Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели SELECT Inf_old APPEND BLANK FIELDPUT(1, Ar[1]) FOR j=3 TO LEN(Ar) FIELDPUT(j-1, Ar[j]) NEXT DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели SELECT Inf DBSKIP(1) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDDO aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово ")) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(UPPER(ALLTRIM(M_ApplsPath))+"\OldAppls") // Перейти в папку с БД старой модели RenameFile( "Abs_old.dbf", "Abs.dbf" ) RenameFile( "Inf_old.dbf", "Inf.dbf" ) DIRCHANGE(M_PathAppl) // Перейти в папку текущей модели Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("КОНВЕРТИРОВАНИЕ ПРИЛОЖЕНИЯ ИЗ НОВОГО СТАНДАРТА БД В СТАРЫЙ ЗАВЕРШЕНО УСПЕШНО!!!")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************** ****** Графический прогресс-бар (на основе примера XSample_14() xdemo.exe) *********************************************************************************************************** STATIC FUNCTION Time_Progress (Time_Progress, Wsego, oProgress, lOk ) LOCAL nMaxCount := Wsego xtime = Time_Progress ** Отображение занимает очень много времени, поэтому ** Если Wsego > 100 показывать прогресс не для всех х, ** а только для таких, которые нацело делятся на Wsego/100 * IF xtime = 0 .OR. xtime = Wsego .OR. Wsego < 100 // Всегда показывать прогресс в начале и конце процесса IF xtime = 0 .OR. xtime = Wsego .OR. Wsego < 10 // Всегда показывать прогресс в начале и конце процесса ELSE // и для малого числа событий: Wsego < 100 Wsego100 = ROUND(Wsego/100,0) IF xtime <> Wsego100*INT(xtime/Wsego100) RETURN lOk ENDIF ENDIF *** Индикация времени исполнения ***** Процесс может идти больше суток, поэтому для определения ***** во всех случаях вычисляется время, прошедшее с начала года * T_Mess1 = L("Начало:")+" "+TIME() // Начало ***** Прошло секунд с начала процесса PUBLIC T_Mess2 := "ch:mi:se" Sec_2 = (DOY(DATE())-1)*86400+SECONDS() - Sec_1 ch2 = INT(Sec_2/3600) // Часы mm2 = INT(Sec_2/60)-ch2*60 // Минуты cc2 = Sec_2-ch2*3600-mm2*60 // Секунды T_Mess2 = L("Прошло:")+" "+ALLTRIM(STRTRAN(T_Mess2,"ch",STR(ch2,19))) T_Mess2 = STRTRAN(T_Mess2,"mi",STRTRAN(STR(mm2,2)," ","0")) T_Mess2 = STRTRAN(T_Mess2,"se",STRTRAN(STR(cc2,2)," ","0")) *@19,2 SAY T_Mess2+L(" всего: ")+ALLTRIM(STR(Sec_2,17))+L(" сек.") PUBLIC T_Mess3 := "ch:mi:se" // Осталось Sec_3 = Sec_2*Wsego/xtime // Прогн.длит.исп. в секундах ch3 = INT(Sec_3/3600) // Часы mm3 = INT(Sec_3/60)-ch3*60 // Минуты cc3 = Sec_3-ch3*3600-mm3*60 // Секунды T_Mess3 = ALLTRIM(STRTRAN(T_Mess3,"ch",STR(ch3,19))) T_Mess3 = STRTRAN(T_Mess3,"mi",STRTRAN(STR(mm3,2)," ","0")) T_Mess3 = STRTRAN(T_Mess3,"se",STRTRAN(STR(cc3,2)," ","0")) *@20,2 SAY T_Mess3+L(" всего: ")+ALLTRIM(STR(Sec_3,17))+L(" сек.") PUBLIC T_Mess4 := "ch:mi:se" // Окончание Sec_4 = Sec_1 + Sec_3 - (DOY(DATE())-1)*86400 ch4 = INT(Sec_4/3600) // Часы mm4 = INT(Sec_4/60)-ch4*60 // Минуты cc4 = Sec_4-ch4*3600-mm4*60 // Секунды T_Mess4 = L("Окончание:")+" "+ALLTRIM(STRTRAN(T_Mess4,"ch",STR(ch4,19))) T_Mess4 = STRTRAN(T_Mess4,"mi",STRTRAN(STR(mm4,2)," ","0")) T_Mess4 = STRTRAN(T_Mess4,"se",STRTRAN(STR(cc4,2)," ","0")) *@21,2 SAY T_Mess4+L(" всего:) "+ALLTRIM(STR(Sec_4,17L())+" сек.с нач.суток") PUBLIC T_Mess5 := "Средн.время обработки 1-го объекта: ch:mi:se" Sec_5 = Sec_2/xtime ch5 = INT(Sec_5/3600) // Часы mm5 = INT(Sec_5/60)-ch5*60 // Минуты cc5 = Sec_5-ch5*3600-mm5*60 // Секунды T_Mess5 = ALLTRIM(STRTRAN(T_Mess5,"ch",STR(ch5,19))) T_Mess5 = STRTRAN(T_Mess5,"mi",STRTRAN(STR(mm5,2)," ","0")) T_Mess5 = STRTRAN(T_Mess5,"se",STRTRAN(STR(cc5,2)," ","0")) *@22,2 SAY T_Mess5+L(" всего: ")+ALLTRIM(STR(Sec_5,17))+L(" сек.") PUBLIC T_Mess6 := "ch:mi:se" // Осталось Sec_6 = Sec_3 - Sec_2 ch6 = INT(Sec_6/3600) // Часы mm6 = INT(Sec_6/60)-ch6*60 // Минуты cc6 = Sec_6-ch6*3600-mm6*60 // Секунды T_Mess6 = L("Осталось:")+" "+ALLTRIM(STRTRAN(T_Mess6,"ch",STR(ch6,19))) T_Mess6 = STRTRAN(T_Mess6,"mi",STRTRAN(STR(mm6,2)," ","0")) T_Mess6 = STRTRAN(T_Mess6,"se",STRTRAN(STR(cc6,2)," ","0")) *@23,2 SAY T_Mess6+L(" всего: ")+ALLTRIM(STR(Sec_6,17))+L(" сек.") Mess98 = T_Mess1+SPACE(142-LEN(T_Mess1)-LEN(T_Mess4))+T_Mess4 // Начало, окончание (прогноз) 145 oSay98:SetCaption(Mess98);oSay98:SetCaption(oSay98:caption) Mess99 = T_Mess2+SPACE(144-LEN(T_Mess2)-LEN(T_Mess6))+T_Mess6 // Прошло, осталось (прогноз) 146 oSay99:SetCaption(Mess99);oSay99:SetCaption(oSay99:caption) DC_GetProgress( oProgress, Time_Progress, Wsego ) // Отображение графического Progress-bar * Sec_1 // Начало * Sec_4 // Окончание * Sec_2 // Прошло секунд с начала процесса * Sec_6 // Осталось секунд до окончания * mTimeProgress=ROUND(Sec_2/(Sec_2+Sec_6)*100,0) * DC_GetProgress( oProgress, mTimeProgress, 100 ) // Отображение графического Progress-bar * DC_GetProgress( oProgress, ROUND(Sec_2,0), ROUND(Sec_2+Sec_6,0) ) // Отображение графического Progress-bar * MsgBox(STR(ROUND(Sec_2,0))+STR(ROUND(Sec_2+Sec_6,0))) * MsgBox(STR(mTimeProgress)) * MILLISEC(1000) * K=100/Wsego;mTimeProgress=ROUND(K*Time_Progress,0) * DC_GetProgress( oProgress, mTimeProgress, 100 ) // Отображение графического Progress-bar DC_AppEvent( @lOk, 0, .01 ) RETURN lOk ****************************************************************************************************************************************** ******** Ускоренный синтез всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} ****************************************************************************************************************************************** FUNCTION F3_1() Running(.T.) IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF F3_5('GPU','Sint','3.1') // Синтез всех моделей Running(.F.) RETURN lOk ****************************************************************************************************************************************** ******** Верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} ******** на графическом процессоре (GPU) с использованием параллельных вычислений ****************************************************************************************************************************************** FUNCTION F3_2(mDialog) Running(.T.) IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF F3_5('GPU','Rec','3.2') // Верификация всех моделей ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN lOk ******************************************************************************************************************************************************** ******** Ускоренный синтез и верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} ******** на графическом процессоре (GPU) с использованием параллельных вычислений ******************************************************************************************************************************************************** FUNCTION F3_3() F3_5('GPU','SintRec','3.3') // Синтез и верификация всех моделей RETURN lOk *********************************************************************************************************** FUNCTION F3_4() F4_1_3_6('3.4.') RETURN lOk *********************************************************************************************************** ******** 3.1. Накопление абсолютных частот ############################################################### *********************************************************************************************************** FUNCTION F3_1CPU(Dialog, TP, Ws, oP, lO, Regim ) LOCAL GetList := {}, oMainDlg, lCancelled := .F. LOCAL oProgress, oDialog, lOk := .t., oButton, nEvent, mp1, mp2, oXbp Running(.T.) Time_Progress = TP Wsego = Ws oProgress = oP lOk = lO IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF Dialog IF ApplChange("3.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF ELSE IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ENDIF IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF .NOT. FILE("Gr_ClSc.dbf") // БД градаций класс.шкал GenNtxGrClSc() ENDIF IF .NOT. FILE("Attributes.dbf") // БД наименований и градаций описательных шкал GenDbfAttr(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx") GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF IF FILE("Obi_Zag.dbf") // БД заголовков обучающей выборки ** Переиндексировать БД Obi_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oiz_kod.ntx" ) .OR.; .NOT. FILE("Oiz_name.ntx") .OR.; .NOT. FILE("Obi_Zag.ntx" ) GenNtxObiZag() ENDIF ELSE GenDbfObiZag() ENDIF IF FILE("Obi_Kcl.dbf") // БД классов обучающей выборки ** Переиндексировать БД Obi_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oic_kod.ntx") .OR.; .NOT. FILE("Obi_Kcl.ntx") GenNtxObiKcl() ENDIF ELSE GenDbfObiKcl() ENDIF IF FILE("Obi_Kpr.dbf") // БД признаков обучающей выборки ** Переиндексировать БД Obi_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Obi_Kpr.ntx") GenNtxObiKpr() ENDIF ELSE GenDbfObiKpr() ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Obi_Zag EXCLUSIVE NEW;N_Obj = RECCOUNT() mFlagErr = .F. DO CASE CASE N_Cls = 0 LB_Warning(L("База абсолютных частот не может быть создана, т.к. справочник классов пуст !!!")) mFlagErr = .T. CASE N_Gos = 0 LB_Warning(L("База абсолютных частот не может быть создана, т.к. справочник признаков пуст !!!")) mFlagErr = .T. CASE N_Obj = 0 LB_Warning(L("База абсолютных частот не может быть создана, т.к. обучающая выборка пуста !!!")) mFlagErr = .T. ENDCASE IF mFlagErr ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ********************************************************************************* IF Dialog // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego Wsego = N_Obj + ; // 5/8: Расчет базы абсолютных частот - ABS - Обработка #/$ объекта обучающей выборки N_Cls + ; // 6/8: Занесение информации в БД Abs.dbf по итоговым строкам и столбцам 2*N_Cls + ; // 7/8: Перенос информации из БД Abs.dbf в БД классов Classes и Gr_ClSc 2*N_Gos // 8/8: Перенос информации из БД Abs.dbf в БД признаков Attributes и Gr_OpSc // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,10.5 ; PARENT oTabPage1 @12,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Зарезервировано для названия операции @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lCancelled:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('3.1. Формирование базы абсолютных частот'); PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ENDIF ********************************************************************************* // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей IF Dialog aSay[ 2]:SetCaption(L('ОПЕРАЦИЯ: СИНТЕЗ СТАТ.МОДЕЛИ "ABS" (РАСЧЕТ МАТРИЦЫ АБСОЛЮТНЫХ ЧАСТОТ):')) ENDIF aSay[ 3]:SetCaption(L("1/8: Создание базы абсолютных частот - ABS")) GenDBFAbs() aSay[ 3]:SetCaption(aSay[ 3]:caption+L(" - Готово ")) aSay[ 4]:SetCaption(L("2/8: Переиндексация базы заголовков объектов обучающей выборки: Obi_Zag.dbf")) GenNtxObiZag() aSay[ 4]:SetCaption(aSay[ 4]:caption+L(" - Готово ")) aSay[ 5]:SetCaption(L("3/8: Переиндексация базы кодов классов объектов обучающей выборки: ObI_Kcl.dbf")) GenNtxObiKcl() aSay[ 5]:SetCaption(aSay[ 5]:caption+L(" - Готово ")) aSay[ 6]:SetCaption(L("4/8: Переиндексация базы кодов признаков объектов обучающей выборки: Obi_Kpr.dbf")) GenNtxObiKpr() aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Готово ")) ******************** ПРОЦЕСС ФОРМИРОВАНИЯ БД ABS.DBF mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Obi_Zag INDEX Oiz_kod EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Obi_Kcl INDEX Oic_kod EXCLUSIVE NEW USE Obi_Kpr INDEX Oip_kod EXCLUSIVE NEW * ########################################################################### // Открытие текстовых баз данных ******************************************** *DC_ASave(aStructure, "_AbsStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_AbsStruct.arx") ***** Массивы для учета заполненных строк и столбцов для ускорения просчета ***** "Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" ***** Возможно, если их использовать, изменятся результаты рассчетов (надо проверить) PRIVATE aStrEmpty[N_Gos] // .T., если строка не пустая и .F. - если пустая PRIVATE aColEmpty[N_Cls] // .T., если колонка не пустая и .F. - если пустая AFILL(aStrEmpty,.F.) AFILL(aColEmpty,.F.) DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только после расчета Abs.txt, а при расчете остальных БД только считывать DC_ASave(aColEmpty, "_aColEmpty.arx") *aStrEmpty = DC_ARestore("_aStrEmpty.arx") *aColEmpty = DC_ARestore("_aColEmpty.arx") ***** Формирование пустой записи ******************************************* N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } PRIVATE nHandle[LEN(Ar_Model)] FOR z=1 TO 1 nHandle[z] := FOpen( Ar_Model[z]+".txt", FO_READWRITE ) // Открыть все текстовые базы данных ######################################## NEXT **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Итоговые строки и столбцы PRIVATE Ar_SummaObj[3+N_Cls] // Строка "Сумма числа объектов по классам" AFILL(Ar_SummaObj,0) Summa_Obj = 0 // Сумма Obj по всей БД Abs.txt Summa_Nij = 0 // Сумма Nij по всей БД Abs.txt PRIVATE Ar_Summ_i[N_Gos], Ar_Summ_j[N_Cls+5] // N_Cls + 1-коды, 2-наименования, 3-Summ, 4-Sred, 5-Disp PRIVATE Ar_Sred_i[N_Gos], Ar_Sred_j[N_Cls+5] PRIVATE Ar_Disp_i[N_Gos], Ar_Disp_j[N_Cls+5] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) IF Dialog // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ENDIF SELECT Obi_Zag N_Obj = RECCOUNT() // №1, N_Obj ################################ mNumPP = 0 N_ALL = N_Obj * №1 mMess = L('5/8: Расчет модели "ABS". Стадия исполнения:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) SET ORDER TO 1 DBGOTOP() Mess = L(' ') DO WHILE .NOT. EOF() // Начало цикла по объектам обучающей выборки // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 7]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(7, mMess, N_ALL) * DC_CompleteEvents() // Обработка события Cancel M_KodObj = Kod_Obj // Код объекта обучающей выборки // Формирование массива кодов признаков текущего объекта обучающей выборки SELECT Obi_Kpr;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T Ar_Kpr := {} DO WHILE M_KodObj = Kod_Obj .AND. .NOT. EOF() // Начало цикла по записям БД кодов классов текущего объекта FOR j=2 TO 8 M_Kpr = FIELDGET(j) IF VALTYPE(M_Kpr) = "N" IF 0 < M_Kpr .AND. M_Kpr <= N_Gos AADD(Ar_Kpr, M_Kpr) ENDIF ENDIF NEXT DBSKIP(1) ENDDO ENDIF // Формирование массива кодов классов текущего объекта обучающей выборки SELECT Obi_Kcl;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T Ar_Kcl := {} DO WHILE M_KodObj = Kod_Obj .AND. .NOT. EOF() // Начало цикла по записям БД кодов классов текущего объекта FOR j=2 TO 5 M_Kcl = FIELDGET(j) IF VALTYPE(M_Kcl) = "N" IF 0 < M_Kcl .AND. M_Kcl <= N_Cls AADD(Ar_Kcl, M_Kcl) ENDIF ENDIF NEXT DBSKIP(1) ENDDO ENDIF // Суммирование 1 в ячейки БД Abs.dbf, соответствующие строкам и столбцам, // а также в строку и столбец "Сумма" и строку: Кол-во объектов по классам" IF LEN(Ar_Kcl) > 0 .AND. LEN(Ar_Kpr) > 0 FOR i=1 TO LEN(Ar_Kpr) For j=1 TO LEN(Ar_Kcl) String = LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], Ar_Kpr[i], 2+Ar_Kcl[j] ) // Считывание поля из БД (корректная) ####### String = STR(VAL(String)+1, aInfStruct[2+Ar_Kcl[j],3],aInfStruct[2+Ar_Kcl[j],4] ) // Ячейка [i,j]++ Flag_err = LC_FieldPut( Ar_Model[1]+".txt", nHandle[1], Ar_Kpr[i], 2+Ar_Kcl[j], String ) // Запись поля в БД (корректная) ############ Ar_Summ_j[Ar_Kcl[j]] = Ar_Summ_j[Ar_Kcl[j]] + 1 // Строка "Сумма абс.частот" по столбцам Ar_Summ_i[Ar_Kpr[i]] = Ar_Summ_i[Ar_Kpr[i]] + 1 // Столбец "Сумма абс.частот" по строкам Summa_Nij++ // Сумма Nij по всей БД Abs.txt aColEmpty[Ar_Kcl[j]] = .T. // .T., если колонка не пустая и .F. - если пустая aStrEmpty[Ar_Kpr[i]] = .T. // .T., если строка не пустая и .F. - если пустая NEXT NEXT For j=1 TO LEN(Ar_Kcl) Ar_SummaObj[Ar_Kcl[j]] = Ar_SummaObj[Ar_Kcl[j]] + 1 // Строка "Сумма числа объектов по классам" Summa_Obj++ // Сумма Obj по всей БД Abs.dbf NEXT ENDIF // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF SELECT Obi_zag DBSKIP(1) ENDDO aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Готово ")) ************** Прерывание процесса по нажатию Cancel ############################################## *IF lCancelled // Прерывание процесса по нажатию Cancel * LB_Warning(L("Процесс формирования базы абсолютных частот был прерван пользователем !!!")) * oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar * oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This * DC_AppEvent( @lOk ) * oDialog:Destroy() * FClose( nHandle[1] ) // Закрытие текстовой базы данных ############################## * ************************************************************** * ***** БД, открытые перед запуском главного меню * ***** Восстанавливать их после выхода из функций главного меню * ************************************************************** * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW * ************************************************************** * Running(.F.) * RETURN( Time_Progress ) *ENDIF // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей aSay[ 8]:SetCaption(L("6/8: Занесение информации в БД Abs.dbf по итоговым строкам и столбцам")) mMess = L("6/8: Занесение информации в БД Abs.dbf по итоговым строкам и столбцам:") mNumPP = 0 N_ALL = N_Cls * №1 DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только здесь, а при расчете остальных БД только считывать DC_ASave(aColEmpty, "_aColEmpty.arx") *aStrEmpty = DC_ARestore("_aStrEmpty.arx") *aColEmpty = DC_ARestore("_aColEmpty.arx") PostCalcINF(1) // Дорасчет и занесение сумм, средних и ср.кв.откл. // Суммарное кол-во объектов j-го класса FOR j=1 TO N_Cls // №1, N_Cls ################################ * aSay[ 8]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(8, mMess, N_ALL) String = STR(Ar_SummaObj[j], aInfStruct[2+j,3], aInfStruct[2+j,4]) LC_FieldPut( Ar_Model[1]+".txt", nHandle[1], 4+N_Gos, 2+j, String ) // Запись поля в БД (корректная) ############ IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT // Сумма числа Obj по всей БД Abs.dbf String = STR(Summa_Obj, aInfStruct[3+N_Cls,3], aInfStruct[3+N_Cls,4]) LC_FieldPut( Ar_Model[1]+".txt", nHandle[1], 4+N_Gos,3+N_Cls, String ) // Запись поля в БД (корректная) ############ aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово ")) // ########################################################################################################################## aSay[ 9]:SetCaption(L("7/8: Перенос информации из БД Abs.dbf в БД классов Classes и Gr_ClSc")) mMess = L("7/8: Перенос информации из БД Abs.dbf в БД классов Classes и Gr_ClSc:") mNumPP = 0 N_ALL = N_Cls + N_Cls * №1 №2 SELECT Classes FOR j = 1 TO N_Cls // №1, N_Cls ################################ * aSay[ 9]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(9, mMess, N_ALL) DBGOTO(j) REPLACE Abs WITH Ar_SummaObj[j] // Кол-во объектов обучающей выборки, относящихся к j-му классу (абс.) REPLACE Perc_fiz WITH Ar_SummaObj[j]/N_Obj*100 // Кол-во объектов обучающей выборки, относящихся к j-му классу (%) IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT SELECT Gr_ClSc FOR j = 1 TO N_Cls // №2, N_Cls ################################ * aSay[ 9]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(9, mMess, N_ALL) DBGOTO(j) REPLACE Abs WITH Ar_SummaObj[j] // Кол-во объектов обучающей выборки, относящихся к j-му классу (абс.) REPLACE Perc_fiz WITH Ar_SummaObj[j]/N_Obj*100 // Кол-во объектов обучающей выборки, относящихся к j-му классу (%) IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово ")) aSay[10]:SetCaption(L("8/8: Перенос информации из БД Abs.dbf в БД признаков Attributes и Gr_OpSc")) mMess = L("8/8: Перенос информации из БД Abs.dbf в БД признаков Attributes и Gr_OpSc:") mNumPP = 0 N_ALL = N_Gos + N_Gos * №1 №2 SELECT Attributes FOR i = 1 TO N_Gos // №1, N_Gos ################################ * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) DBGOTO(i) REPLACE Abs WITH Ar_Summ_i[i] // Кол-во объектов обучающей выборки, имеющих i-й признак (абс.) REPLACE Perc_fiz WITH Ar_Summ_i[i]/N_Obj*100 // Кол-во объектов обучающей выборки, имеющих i-й признак (%) IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT SELECT Gr_OpSc FOR i = 1 TO N_Gos // №2, N_Gos ################################ * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) DBGOTO(i) REPLACE Abs WITH Ar_Summ_i[i] // Кол-во объектов обучающей выборки, имеющих i-й признак (абс.) REPLACE Perc_fiz WITH Ar_Summ_i[i]/N_Obj*100 // Кол-во объектов обучающей выборки, имеющих i-й признак (%) IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[10]:SetCaption(aSay[10]:caption+L(" - Готово ")) // ########################################################################################################################## aCalcInf[1] = .T. DC_ASave(aCalcInf, "_CalcInf.arx") // Запись информации о расчете Abs.txt IF Dialog aSay[ 2]:SetCaption(aSay[ 2]:caption+L(" - Готово ")) Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("БАЗА АСБОЛЮТНЫХ ЧАСТОТ ABS.TXT СФОРМИРОВАНА !")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF FClose( nHandle[1] ) // Закрытие текстовой базы данных ###################################### ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN( Time_Progress ) ******************************************************** ******** Создание БД абсолютных частот Abs.dbf ******************************************************** FUNCTION GenDBFAbsOld(mLenName) aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() IF N_Cls * N_Gos = 0 LB_Warning(L("БД абсолютных частот не может быть создана, т.к. БД классов и признаков пусты !!!")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN(.F.) ENDIF IF N_Cls > 1500 Mess = L('БД абсолютных частот не может быть создана, т.к. в модели # классов, что более 1500 !') Mess = STRTRAN(Mess, "#", ALLTRIM(STR(N_Cls))) LB_Warning(Mess, L('Создание БД абсолютных частот Abs.dbf')) ENDIF CREATE Struc APPEND BLANK REPLACE Field_name WITH "Kod_Pr",; Field_type WITH "N",; Field_len WITH 15,; Field_dec WITH 0 APPEND BLANK REPLACE Field_name WITH "Name",; Field_type WITH "C",; Field_len WITH mLenName; Field_dec WITH 0 FOR j = 1 TO N_Cls APPEND BLANK REPLACE Field_name WITH "CLS"+ALLTRIM(STR(j,19)),; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 1 NEXT APPEND BLANK REPLACE Field_name WITH "SUMMA",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 0 APPEND BLANK REPLACE Field_name WITH "SREDN",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 APPEND BLANK REPLACE Field_name WITH "DISP",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 ****** Создаем базу абсолютных частот CREATE Abs FROM Struc CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ERASE Struc.dbf ***** Заполнение БД Abs.dbf пустыми записями CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW INDEX ON STR(Kod_opsc,19) TO Kod_OpSc CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Gr_OpSc EXCLUSIVE NEW INDEX ON STR(Kod_opsc,19)+STR(Kod_gros,19) TO Kod_GrOs // Вставить наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация, шкалы и градации сортировать по их кодам CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc INDEX Kod_OpSc EXCLUSIVE NEW USE Gr_OpSc INDEX Kod_GrOs EXCLUSIVE NEW USE Abs EXCLUSIVE NEW FOR i=1 TO N_Gos SELECT Abs APPEND BLANK REPLACE Kod_pr WITH RECNO() M_KodGrOs = Kod_pr SELECT Gr_OpSc;DBGOTO(i) M_NameGrOS = ALLTRIM(Name_GrOS) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF SELECT Abs REPLACE Name WITH M_Name NEXT APPEND BLANK // Запись N_Gos+1 - строка: "Сумма", REPLACE Name WITH "Сумма числа признаков" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+2 - "Среднее" REPLACE Name WITH "Среднее" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+3 - "Среднеквадратичное отклонение", "Редукция класса" REPLACE Name WITH "Среднеквадратичное отклонение" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+4 - Количество объектов обучающей выборки,относящихся к данному классу REPLACE Name WITH "Сумма числа объектов обуч.выборки" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT DC_DataRest( aSaveGenDbf ) Running(.F.) RETURN(.T.) ******************************************************** ******** Создание БД абсолютных частот Abs.txt ######### ******************************************************** FUNCTION GenDBFAbs() aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW;N_Atr = RECCOUNT() USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_sc EXCLUSIVE NEW IF N_Cls * N_Gos = 0 LB_Warning(L("БД абсолютных частот не может быть создана, т.к. БД классов и признаков пусты !!!")) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы Running(.F.) RETURN(.F.) ENDIF * ########################################################################### *DC_ASave(aInfStruct, "_AbsStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_AbsStruct.arx") ************************************************* DB_name = "Abs.txt" nHandle := FCreate( DB_name, FC_NORMAL ) // Создание БД (если она была, то все равно создается пустая) IF nHandle = -1 MsgBox(L("Файл: "+DB_name+" не может быть создан. Ошибка: ")+FERROR()) RETURN NIL ENDIF ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) LC_DbCreate( DB_name, nHandle, Lc_buf, N_Gos+4 ) // Создание БД.txt, содержащей N_Rec пустых записей ############ *nHandle := FOpen( DB_name, FO_READWRITE ) // Открытие базы данных ############################################ **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Вставить наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация, шкалы и градации сортировать по их кодам CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW FOR i=1 TO N_Gos String = STR(i, aInfStruct[1,3],0) LC_FieldPut( DB_name, nHandle, i, 1, String ) // Запись поля в БД (корректная) ##################### SELECT Gr_OpSc;DBGOTO(i) M_NameGrOS = ALLTRIM(Name_GrOS) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF String = SUBSTR(M_Name,1,aInfStruct[2,3]) LC_FieldPut( DB_name, nHandle, i, 2, String ) // Запись поля в БД (корректная) ##################### NEXT LC_FieldPut( DB_name, nHandle, N_Gos+1, 2, "Сумма числа признаков" ) LC_FieldPut( DB_name, nHandle, N_Gos+2, 2, "Среднее" ) LC_FieldPut( DB_name, nHandle, N_Gos+3, 2, "Среднеквадратичное отклонение" ) LC_FieldPut( DB_name, nHandle, N_Gos+4, 2, "Сумма числа объектов обуч.выборки" ) FClose( nHandle ) // Закрытие текстовой базы данных ###################################### DC_DataRest( aSaveGenDbf ) RETURN(.T.) *********************************************************************************************************** ******** 3.2. Расчет условных и безусловных процентных распределений Prc1.txt, Prc2.txt ################## *********************************************************************************************************** FUNCTION F3_2CPU(Dialog, TP, Ws, oP, lO, Regim ) LOCAL GetList := {}, oMainDlg, lCancelled := .F. LOCAL oProgress, oDialog, lOk := .t., oButton, nEvent, mp1, mp2, oXbp Running(.T.) Time_Progress = TP Wsego = Ws oProgress = oP lOk = lO IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF Dialog IF ApplChange("3.2()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF ELSE IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения PUBLIC aSaveMainM := DC_ARestore("_SaveMainM.arx") // Восстановление вычислительной среды (открытые и текущие БД и индексы) с диска DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.F.) RETURN NIL ENDIF ENDIF IF .NOT. FILE("Abs.txt") // БД абс.частот IF .NOT. GenDbfAbs() Running(.F.) RETURN NIL ENDIF ENDIF ****** Задание на расчет моделей знаний IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aCalcInf = DC_ARestore("_CalcInf.arx") IF aCalcInf[1] = .F. LB_Warning(L('Режим 3.2 "Расчет условных и безусловных процентных распределений" не может быть выполнен, т.к. для этого сначала необходимо сформировать базу абсолютных частот в режиме 3.1 !!!')) Running(.F.) RETURN NIL ENDIF ELSE LB_Warning(L('Режим 3.2 "Расчет условных и безусловных процентных распределений" не может быть выполнен, т.к. для этого сначала необходимо сформировать базу абсолютных частот в режиме 3.1 !!!')) Running(.F.) RETURN NIL ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW *********************************************************************** IF Dialog // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego Wsego = N_Gos // Задание максимальной величины параметра Time // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,4.5 ; PARENT oTabPage1 @ 6,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lCancelled:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('3.1.1.2. Расчет условных и безусловных процентных распределений'); PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ENDIF *********************************************************************** IF Dialog aSay[ 3]:SetCaption(L('ОПЕРАЦИЯ: СОЗДАНИЕ БАЗ УСЛОВНЫХ И БЕЗУСЛОВНЫХ ПРОЦЕНТНЫХ РАСПРЕДЕЛЕНИЙ - PRC1, PRC2:')) ENDIF aSay[ 4]:SetCaption(L("1/2: Создание баз данных: PRC1 и PRC2.")) GenDBFPrc() aSay[ 4]:SetCaption(aSay[ 4]:caption+L(" - Готово ")) ******** ПРОЦЕСС ФОРМИРОВАНИЯ БД PRC1.DBF и PRC2.DBF mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // №1, N_Cls ################################ USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() // №2, N_Gos ################################ USE Opis_Sc EXCLUSIVE NEW * ########################################################################### // Открытие текстовых баз данных ******************************************** *DC_ASave(aInfStruct, "_PrcStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_PrcStruct.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) Ar_Model := { "Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } PRIVATE nHandle[LEN(Ar_Model)] FOR z=1 TO 3 nHandle[z] := FOpen( Ar_Model[z]+".txt", FO_READWRITE ) // Открыть все текстовые базы данных ######################################## NEXT **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Итоговые строки и столбцы PRIVATE Nij[N_Cls+5] // i-я строка базы абс.частот PRIVATE Nj[N_Cls+5] // Строка "Сумма числа признаков по классам" базы абс.частот PRIVATE NObj[N_Cls+5] // Строка "Сумма числа объектов по классам" базы абс.частот AFILL(Nij,0) AFILL(Nj,0) AFILL(NObj,0) PRIVATE Ar_Sum1_i[N_Gos], Ar_Sum1_j[N_Cls] // N_Cls + 1-коды, 2-наименования, 3-Summ, 4-Sred, 5-Disp PRIVATE Ar_Sum2_i[N_Gos], Ar_Sum2_j[N_Cls] // N_Cls + 1-коды, 2-наименования, 3-Summ, 4-Sred, 5-Disp PRIVATE Ar_Summ_i[N_Gos], Ar_Summ_j[N_Cls] // N_Cls + 1-коды, 2-наименования, 3-Summ, 4-Sred, 5-Disp PRIVATE Ar_Sred_i[N_Gos], Ar_Sred_j[N_Cls] PRIVATE Ar_Disp_i[N_Gos], Ar_Disp_j[N_Cls] AFILL(Ar_Sum1_i, 0) AFILL(Ar_Sum1_j, 0) AFILL(Ar_Sum2_i, 0) AFILL(Ar_Sum2_j, 0) AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) *DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только после расчета Abs.txt, а при расчете остальных БД только считывать *DC_ASave(aColEmpty, "_aColEmpty.arx") aStrEmpty = DC_ARestore("_aStrEmpty.arx") aColEmpty = DC_ARestore("_aColEmpty.arx") ****** Занести строки БД ABS.TXT в массивы mNumPP = 0 N_ALL = N_Cls + N_Gos + N_Cls + N_Gos + N_Cls + N_Gos + N_Gos + N_Cls + N_Gos + N_Cls * №1 №2 №3 №4 №5 №6 №7 №8 №9 №10 mMess = L('2/2: Расчет усл.и безусл.процентных распределений PRC1 и PRC2:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) FOR j=1 TO N_Cls // №1, N_Cls ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) * IF aColEmpty[j] Nj[j] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+1, 2+j )) NObj[j] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+4, 2+j )) * ENDIF NEXT IF Dialog // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ENDIF // Цикл по строкам Abs.txt ******* FOR i=1 TO N_Gos // №2, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) * DC_CompleteEvents() // Обработка события Cancel * ************* Прерывание процесса по нажатию Cancel ############################################## * IF lCancelled // Прерывание процесса по нажатию Cancel * LB_Warning(L("Процесс формирования баз условных и безусловных процентных распределений был прерван пользователем !!!")) * oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar * oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This * DC_AppEvent( @lOk ) * oDialog:Destroy() * FOR z=1 TO 3 * FClose( nHandle[z] ) // Закрытие dbf и txt баз данных ###################################### * NEXT * ************************************************************** * ***** БД, открытые перед запуском главного меню * ***** Восстанавливать их после выхода из функций главного меню * ************************************************************** * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW * ************************************************************** * Running(.F.) * RETURN( Time_Progress ) * ENDIF * ************* Прерывание процесса по нажатию Cancel ############################################## * // Продолжение процесса * IF aStrEmpty[i] // Формирование массива распределения абс.частот встреч признака по классам из БД ABS.TXT FOR j=1 TO N_Cls * IF aColEmpty[j] Nij[j] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], i, 2+j )) * ENDIF NEXT For j=1 TO N_Cls IF Nj[j] <> 0 .AND. Nij[j] <> 0 Iij = Nij[j]/Nj[j]*100 String = STR(Iij, aInfStruct[j+2,3], aInfStruct[2+j,4] ) LC_FieldPut( Ar_Model[2]+".txt", nHandle[2], i, 2+j, String ) Ar_Sum1_j[j] = Ar_Sum1_j[j] + Iij // Расчет строки "Сумма" Ar_Sum1_i[i] = Ar_Sum1_i[i] + Iij // Расчет столбца "Сумма" ENDIF NEXT For j=1 TO N_Cls IF NObj[j] <> 0 .AND. Nij[j] <> 0 Iij = Nij[j]/NObj[j]*100 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) LC_FieldPut( Ar_Model[3]+".txt", nHandle[3], i, 2+j, String ) Ar_Sum2_j[j] = Ar_Sum2_j[j] + Iij // Расчет строки "Сумма" Ar_Sum2_i[i] = Ar_Sum2_i[i] + Iij // Расчет столбца "Сумма" ENDIF NEXT * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT *** Расчет и занесение итоговых строк FOR j=1 TO LEN(Ar_Sum1_j) // №3, N_Cls ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ar_Summ_j[j] = Ar_Sum1_j[j] NEXT FOR i=1 TO LEN(Ar_Sum1_i) // №4, N_Gos ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ar_Summ_i[i] = Ar_Sum1_i[i] NEXT PostCalcINF(2) FOR j=1 TO LEN(Ar_Sum2_j) // №5, N_Cls ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ar_Summ_j[j] = Ar_Sum2_j[j] NEXT FOR i=1 TO LEN(Ar_Sum2_i) // №6, N_Gos ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ar_Summ_i[i] = Ar_Sum2_i[i] NEXT PostCalcINF(3) *** ####################################################################################################### *** Посчитать и занести в файлы Prc1.txt Prc2.txt наим.и знач.строк и столбцов безусловных вероятностей (вместо сумм), *** а в PostCalcINF() не записывать этих столбцов (использовать их только в массивах), если z=2 или z=3. N = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+1, N_Cls+3 )) // Сумма числа признаков из Abs.txt NObj = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+4, N_Cls+3 )) // Сумма числа объектов из Abs.txt *** Prc1.txt ****************************** IF N > 0 *** Запись столбца "Безусловная вероятность" For i=1 TO N_Gos // №7, N_Gos ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ni = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], i, N_Cls+3 )) // Сумма Ni из Abs.txt IF Ni <> 0 String = STR(Ni/N*100, aInfStruct[N_Cls+3,3], aInfStruct[N_Cls+3,4] ) LC_FieldPut( Ar_Model[2]+".txt", nHandle[2], i, N_Cls+3, String ) ENDIF NEXT ***** Запись строки "Безусловная вероятность" For j=1 TO N_Cls // №8, N_Cls ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Nj = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+1, 2+j )) // Сумма Nj из Abs.txt IF Nj <> 0 String = STR(Nj/N*100, aInfStruct[2+j,3], aInfStruct[2+j,4] ) LC_FieldPut( Ar_Model[2]+".txt", nHandle[2], N_Gos+4, 2+j, String ) ENDIF NEXT ENDIF *** Prc2.txt ****************************** *** Запись столбца "Безусловная вероятность" IF NObj > 0 *** Запись столбца "Безусловная вероятность" FOR i=1 TO N_Gos // №9, N_Gos ################################ * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Ni = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], i, N_Cls+3 )) // Сумма Ni из Abs.txt IF Ni <> 0 String = STR(Ni/NObj*100, aInfStruct[N_Cls+3,3], aInfStruct[N_Cls+3,4] ) LC_FieldPut( Ar_Model[3]+".txt", nHandle[3], i, N_Cls+3, String ) ENDIF NEXT ***** Запись строки "Безусловная вероятность" FOR j=1 TO N_Cls // №10, N_Cls ############################### * aSay[ 5]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(5, mMess, N_ALL) Nj = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+4, 2+j )) // Сумма NObj_j из Abs.txt IF Nj <> 0 String = STR(Nj/NObj*100, aInfStruct[2+j,3], aInfStruct[2+j,4] ) LC_FieldPut( Ar_Model[3]+".txt", nHandle[3], N_Gos+4, 2+j, String ) ENDIF NEXT ENDIF aSay[ 5]:SetCaption(aSay[ 5]:caption+L(" - Готово ")) aCalcInf[2] = .T. aCalcInf[3] = .T. DC_ASave(aCalcInf, "_CalcInf.arx") // Запись информации о расчете Prc1 и Prc2 IF Dialog Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("Расчет баз условных и безусловных процентных распределений Prc1.txt и Prc2.txt завершен !")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF FOR z=1 TO 3 FClose( nHandle[z] ) // Закрытие dbf и txt баз данных ###################################### NEXT ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN( Time_Progress ) ******************************************************************** ******** Создание БД условных и безусловных процентных распределений ******************************************************************** FUNCTION GenDBFPrcOld(mLenName) aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() IF N_Cls * N_Gos = 0 LB_Warning(L("Базы процентных распределений не могут быть созданы, т.к. БД классов и признаков пусты !!!")) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF IF N_Cls > 1500 Mess = L('Базы процентных распределений, т.к. в модели # классов, что более 1500 !') Mess = STRTRAN(Mess, "#", ALLTRIM(STR(N_Cls))) LB_Warning(Mess, L('Создание БД абсолютных частот Abs.dbf')) ENDIF * 12345678901234567890123 * 123.1234567890123456789 CREATE Struc APPEND BLANK REPLACE Field_name WITH "Kod_Pr",; Field_type WITH "N",; Field_len WITH 15,; Field_dec WITH 0 APPEND BLANK REPLACE Field_name WITH "Name",; Field_type WITH "C",; Field_len WITH mLenName; Field_dec WITH 0 FOR j = 1 TO N_Cls APPEND BLANK REPLACE Field_name WITH "CLS"+ALLTRIM(STR(j,19)),; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 NEXT APPEND BLANK REPLACE Field_name WITH "SUMMA",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 APPEND BLANK REPLACE Field_name WITH "SREDN",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 APPEND BLANK REPLACE Field_name WITH "DISP",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 ****** Создаем базу абсолютных частот CREATE Prc1 FROM Struc CREATE Prc2 FROM Struc CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ERASE Struc.dbf ***** Заполнение БД Abs.dbf пустыми записями CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW INDEX ON STR(Kod_opsc,19) TO Kod_OpSc // Вставить в БД Prc1.dbf и Prc2.dbf коды признаков и наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc INDEX Kod_OpSc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Abs EXCLUSIVE NEW USE Prc1 EXCLUSIVE NEW USE Prc2 EXCLUSIVE NEW FOR i=1 TO N_Gos SELECT Gr_OpSc;DBGOTO(i) M_KodGrOs = Kod_GrOs M_NameGrOS = ALLTRIM(Name_GrOs) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF SELECT Prc1 APPEND BLANK REPLACE Kod_pr WITH M_KodGrOs REPLACE Name WITH M_Name * FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT SELECT Prc2 APPEND BLANK REPLACE Kod_pr WITH M_KodGrOs REPLACE Name WITH M_Name * FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT NEXT SELECT Prc1 APPEND BLANK // Запись N_Gos+1 - строка: "Сумма", REPLACE Name WITH "Сумма" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+2 - "Среднее" REPLACE Name WITH "Среднее" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+3 - "Среднеквадратичное отклонение", "Редукция класса" REPLACE Name WITH "Среднеквадратичное отклонение" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT SELECT Prc2 APPEND BLANK // Запись N_Gos+1 - строка: "Сумма", REPLACE Name WITH "Сумма" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+2 - "Среднее" REPLACE Name WITH "Среднее" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+3 - "Среднеквадратичное отклонение", "Редукция класса" REPLACE Name WITH "Среднеквадратичное отклонение" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN NIL ******************************************************************************** ******** Создание БД условных и безусловных процентных распределений ########### ******************************************************************************** FUNCTION GenDBFPrc() aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW IF N_Cls * N_Gos = 0 LB_Warning(L("Базы процентных распределений не могут быть созданы, т.к. БД классов и признаков пусты !!!")) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF * ########################################################################### *DC_ASave(aInfStruct, "_PrcStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_PrcStruct.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) ******** Создать БД ********************* DB_name1 = "Prc1.txt" nHandle1 := FCreate( DB_name1, FC_NORMAL ) // Создание БД (если она была, то все равно создается пустая) IF nHandle1 = -1 MsgBox(L("Файл: "+DB_name1+" не может быть создан. Ошибка:")+FERROR()) RETURN NIL ENDIF LC_DbCreate( DB_name1, nHandle1, Lc_buf, N_Gos+3 ) // Создание БД.txt, содержащей N_Rec пустых записей ############ DB_name2 = "Prc2.txt" nHandle2 := FCreate( DB_name2, FC_NORMAL ) // Создание БД (если она была, то все равно создается пустая) IF nHandle2 = -1 MsgBox("Файл: "+DB_name2+" не может быть создан. Ошибка:"+FERROR()) RETURN NIL ENDIF LC_DbCreate( DB_name2, nHandle2, Lc_buf, N_Gos+3 ) // Создание БД.txt, содержащей N_Rec пустых записей ############ *nHandle := FOpen( DB_name, FO_READWRITE ) // Открытие базы данных ############################################ **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Вставить в БД Prc1.txt и Prc2.txt коды признаков и наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW FOR i=1 TO N_Gos String = STR(i, aInfStruct[1,3],0) LC_FieldPut( DB_name1, nHandle1, i, 1, String ) // Запись поля в БД (корректная) ##################### LC_FieldPut( DB_name2, nHandle2, i, 1, String ) // Запись поля в БД (корректная) ##################### SELECT Gr_OpSc;DBGOTO(i) M_NameGrOS = ALLTRIM(Name_GrOS) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF String = SUBSTR(M_Name,1,aInfStruct[2,3]) LC_FieldPut( DB_name1, nHandle1, i, 2, String ) // Запись поля в БД (корректная) ##################### LC_FieldPut( DB_name2, nHandle2, i, 2, String ) // Запись поля в БД (корректная) ##################### NEXT LC_FieldPut( DB_name1, nHandle1, N_Gos+1, 2, "Сумма" ) LC_FieldPut( DB_name1, nHandle1, N_Gos+2, 2, "Среднее" ) LC_FieldPut( DB_name1, nHandle1, N_Gos+3, 2, "Среднеквадратичное отклонение" ) LC_FieldPut( DB_name1, nHandle1, N_Gos+4, 2, "Безусловная вероятность" ) LC_FieldPut( DB_name2, nHandle2, N_Gos+1, 2, "Сумма" ) LC_FieldPut( DB_name2, nHandle2, N_Gos+2, 2, "Среднее" ) LC_FieldPut( DB_name2, nHandle2, N_Gos+3, 2, "Среднеквадратичное отклонение" ) LC_FieldPut( DB_name2, nHandle2, N_Gos+4, 2, "Безусловная вероятность" ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций FClose( nHandle1 ) // Закрытие текстовой базы данных ###################################### FClose( nHandle2 ) // Закрытие текстовой базы данных ###################################### DC_DataRest( aSaveGenDbf ) RETURN NIL ******************************************************************** ******** Создание баз знаний с различными частными критериями знаний ******************************************************************** FUNCTION GenDBFInfOld(mLenName) aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() IF N_Cls * N_Gos = 0 LB_Warning(L("базы знаний не могут быть созданы, т.к. БД классов и признаков пусты !!!")) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF IF N_Cls > 1500 Mess = L('Базы знаний не могут быть созданы, т.к. в модели # классов, что более 1500 !') Mess = STRTRAN(Mess, "#", ALLTRIM(STR(N_Cls))) LB_Warning(Mess, L('Создание БД абсолютных частот Abs.dbf')) ENDIF * 12345678901234567890123 * 1234567.123456789012345 CREATE Struc APPEND BLANK REPLACE Field_name WITH "Kod_Pr",; Field_type WITH "N",; Field_len WITH 15,; Field_dec WITH 0 APPEND BLANK REPLACE Field_name WITH "Name",; Field_type WITH "C",; Field_len WITH mLenName; Field_dec WITH 0 FOR j = 1 TO N_Cls APPEND BLANK REPLACE Field_name WITH "CLS"+ALLTRIM(STR(j,19)),; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 NEXT APPEND BLANK REPLACE Field_name WITH "SUMMA",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 APPEND BLANK REPLACE Field_name WITH "SREDN",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 APPEND BLANK REPLACE Field_name WITH "DISP",; Field_type WITH "N",; Field_len WITH 19,; Field_dec WITH 7 ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) Ar_Model := {"Abs","Prc1","Prc2","Inf","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } FOR z=4 TO LEN(Ar_Model) M_Inf = Ar_Model[z] CREATE (M_Inf) FROM Struc NEXT CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ERASE Struc.dbf ***** Заполнение БД Abs.dbf пустыми записями CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW INDEX ON STR(Kod_opsc,19) TO Kod_OpSc // Вставить в БД Inf#.dbf коды признаков и наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация, // а также итоговые строки в одну БД, а остальные скопировать как файлы CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc INDEX Kod_OpSc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Abs EXCLUSIVE NEW USE Inf EXCLUSIVE NEW FOR i=1 TO N_Gos SELECT Gr_OpSc;DBGOTO(i) M_KodGrOs = Kod_GrOS M_NameGrOS = ALLTRIM(Name_GrOS) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF SELECT Inf // Имя БЗ брать из переменной APPEND BLANK REPLACE Kod_pr WITH M_KodGrOs REPLACE Name WITH M_Name * FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT NEXT APPEND BLANK // Запись N_Gos+1 - строка: "Сумма", REPLACE Name WITH "Сумма" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+2 - "Среднее" REPLACE Name WITH "Среднее" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT APPEND BLANK // Запись N_Gos+3 - "Среднеквадратичное отклонение", "Редукция класса" REPLACE Name WITH "Среднеквадратичное отклонение" *FOR j=3 TO FCOUNT();FIELDPUT(j,0);NEXT // Сделать в цикле, формируя имя базы знаний CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций FOR z=5 TO LEN(Ar_Model) M_Inf = Ar_Model[z]+".dbf" COPY FILE ("Inf.dbf") TO (M_Inf) NEXT CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN NIL ********************************************************* ******** Создание файлов структур баз данных всех моделей ********************************************************* FUNCTION CreateStructAll() // Создание файлов структур баз данных всех моделей IF .NOT. FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf LB_Warning(L("Необходимо создать, задать или выбрать хотя бы одно текущее приложение !!!")) RETURN (-1) ENDIF IF .NOT. FILE("Attributes.dbf") // БД градаций опис.шкал: Attributes.dbf LB_Warning(L("Необходимо создать, задать или выбрать хотя бы одно текущее приложение !!!")) RETURN (-1) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // Определить максимальную длину наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация mLenNameMax = 33 SELECT Attributes DBGOTOP() DO WHILE .NOT. EOF() mLenNameMax = MAX(mLenNameMax, LEN(ALLTRIM(Name_atr))) DBSKIP(1) ENDDO ********** Структура создаваемой базы Abs.dbf ********************** aInfStruct := { { "Kod_pr", "N", 15, 0},; // 1 { "Name" , "C",mLenNameMax, 0} } // 2 FOR j=1 TO N_Cls FieldName = "N"+ALLTRIM(STR(j,15)) AADD(aInfStruct, { FieldName, "N", 19, 1 }) NEXT AADD(aInfStruct, { "Summa", "N", 19, 1 }) AADD(aInfStruct, { "Sredn", "N", 19, 7 }) AADD(aInfStruct, { "Disp" , "N", 19, 7 }) DC_ASave(aInfStruct, "_AbsStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать *aInfStruct = DC_ARestore("_AbsStruct.arx") ********** Структура создаваемой базы Prc#.dbf, Inf#.dbf *********** aInfStruct := { { "Kod_pr", "N", 15, 0},; // 1 { "Name" , "C",mLenNameMax, 0} } // 2 FOR j=1 TO N_Cls FieldName = "N"+ALLTRIM(STR(j,15)) AADD(aInfStruct, { FieldName, "N", 19, 7 }) NEXT AADD(aInfStruct, { "Summa", "N", 19, 7 }) AADD(aInfStruct, { "Sredn", "N", 19, 7 }) AADD(aInfStruct, { "Disp" , "N", 19, 7 }) DC_ASave(aInfStruct, "_PrcStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать *aInfStruct = DC_ARestore("_PrcStruct.arx") DC_ASave(aInfStruct, "_InfStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать *aInfStruct = DC_ARestore("_InfStruct.arx") RETURN (mLenNameMax) ******************************************************************************* ******** Создание баз знаний с различными частными критериями знаний ########## ******************************************************************************* FUNCTION GenDBFInf() aSaveGenDbf := DC_DataSave() IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) RETURN NIL ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF IF FILE("Classes.dbf") // БД градаций класс.шкал: Classes.dbf ** Переиндексировать БД Calsses.dbf, если не хватает какого-нибудь индексного массива IF FILE("Cls_kod.ntx" ).AND.; FILE("Cls_name.ntx").AND.; FILE("Cls_ini.ntx" ).AND.; FILE("Cls_abs.ntx" ) ELSE GenNtxClass() ENDIF ****** Если БД Classes.dbf есть, то загрузить ее структуру в массив ELSE GenDbfClass(.F.) ENDIF IF FILE("Opis_Sc.dbf") // БД описательных шкал ** Переиндексировать БД Opis_Sc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Ops_kod.ntx" ).OR.; .NOT. FILE("Ops_name.ntx").OR.; .NOT. FILE("Ops_ini.ntx" ).OR.; .NOT. FILE("Ops_abs.ntx" ) GenNtxOpSc() ENDIF ELSE GenDbfOpSc(.F.) ENDIF IF FILE("Gr_OpSc.dbf") // БД градаций описательных шкал ** Переиндексировать БД Gr_OpSc.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Gos_kod.ntx" ).OR.; .NOT. FILE("Gos_name.ntx").OR.; .NOT. FILE("Gos_ini.ntx" ).OR.; .NOT. FILE("Gos_abs.ntx" ) GenNtxGrOpSc() ENDIF ELSE GenDbfGrOpSc(.F.) ENDIF dbeSetDefault('DBFNTX') mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Attributes EXCLUSIVE NEW USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW IF N_Cls * N_Gos = 0 LB_Warning(L("базы знаний не могут быть созданы, т.к. БД классов и признаков пусты !!!")) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы RETURN NIL ENDIF * ########################################################################### *DC_ASave(aInfStruct, "_InfStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_InfStruct.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } PRIVATE nHandle[LEN(Ar_Model)] FOR z=4 TO LEN(Ar_Model) IF aCalcInf[z] // Создавать только заданные БД, т.к. они могут быть очень большого размера DB_name = Ar_Model[z]+".txt" nHandle[z] := FCreate( DB_name, FC_NORMAL ) // Создание БД (если она была, то все равно создается пустая) IF nHandle[z] = -1 MsgBox("Файл: "+DB_name+" не может быть создан. Ошибка:"+FERROR()) RETURN NIL ENDIF LC_DbCreate( DB_name, nHandle[z], Lc_buf, N_Gos+3 ) // Создание БД.txt, содержащей N_Rec пустых записей ############ ENDIF NEXT *nHandle := FOpen( DB_name, FO_READWRITE ) // Открытие базы данных ######################################## **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Вставить в БД Inf#.txt коды признаков и наименования: ОПИСАТЕЛЬНАЯ ШКАЛА-градация CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW FOR i=1 TO N_Gos String = STR(i, aInfStruct[1,3],0) FOR z=4 TO LEN(Ar_Model) IF aCalcInf[z] // Создавать только заданные БД, т.к. они могут быть очень большого размера DB_name = Ar_Model[z]+".txt" LC_FieldPut( DB_name, nHandle[z], i, 1, String ) // Запись поля в БД (корректная) ##################### ENDIF NEXT SELECT Gr_OpSc;DBGOTO(i) M_NameGrOS = ALLTRIM(Name_GrOS) M_KodOpSc = Kod_OpSc SELECT Opis_Sc;DBGOTO(M_KodOpSc) M_NameOS = UPPER(ALLTRIM(Name_OpSc)) // Если в названии градации уже включено наим.шкалы, то повторно не включать его IF AT(M_NameOS, UPPER(M_NameGrOS)) = 0 M_Name = M_NameOS+"-"+M_NameGrOS ELSE M_Name = M_NameGrOS ENDIF String = SUBSTR(M_Name,1,aInfStruct[2,3]) FOR z=4 TO LEN(Ar_Model) IF aCalcInf[z] // Создавать только заданные БД, т.к. они могут быть очень большого размера DB_name = Ar_Model[z]+".txt" LC_FieldPut( DB_name, nHandle[z], i, 2, M_Name ) // Запись поля в БД (корректная) ##################### ENDIF NEXT NEXT FOR z=4 TO LEN(Ar_Model) IF aCalcInf[z] // Создавать только заданные БД, т.к. они могут быть очень большого размера DB_name = Ar_Model[z]+".txt" LC_FieldPut( DB_name, nHandle[z], N_Gos+1, 2, "Сумма" ) LC_FieldPut( DB_name, nHandle[z], N_Gos+2, 2, "Среднее" ) LC_FieldPut( DB_name, nHandle[z], N_Gos+3, 2, "Среднеквадратичное отклонение" ) ENDIF NEXT CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций FOR z=4 TO LEN(Ar_Model) IF aCalcInf[z] // Создавать только заданные БД, т.к. они могут быть очень большого размера FClose( nHandle[z] ) // Закрытие текстовой базы данных ###################################### ENDIF NEXT DC_DataRest( aSaveGenDbf ) RETURN NIL *************************************************************************** // Дорасчет строки и столбца "Сумма", "Среднее", "Средн.квадр.отклонение" // для открытой стат.модели или модели знаний (заданной SELECT) // и перенос Int_Inf (Disp) в Attributes и Gr_ClSc ######### F5_6() ####### *************************************************************************** FUNCTION PostCalcINFold() *** Запись столбца "Сумма" For i=1 TO N_Gos DBGOTO(i) FIELDPUT(3+N_Cls, Ar_Summ_i[i]) // Запись столбца "Сумма" NEXT ***** Запись строки "Сумма" Summa_all = 0 DBGOTO(N_Gos+1) For j=1 TO N_Cls FIELDPUT(2+j, Ar_Summ_j[j]) // Запись строки "Сумма" Summa_all = Summa_all + Ar_Summ_j[j] NEXT FIELDPUT(3+N_Cls, Summa_all) // Запись углового элемента "Сумма" Sredn_all = Summa_all/(N_Cls*N_Gos) DBGOTO(N_Gos+2) FIELDPUT(4+N_Cls, Sredn_all) // Запись углового элемента "Среднее" *** Расчет средних по строкам FOR i = 1 TO N_Gos DBGOTO(i) Ar_Sred_i[i] = Ar_Summ_i[i]/N_Cls FIELDPUT(4+N_Cls,Ar_Sred_i[i]) // "Среднее" по строке NEXT ****** Расчет средних по столбцам DBGOTO(N_Gos+2) // "Среднее" строка FOR j = 1 TO N_Cls Ar_Sred_j[j] = Ar_Summ_j[j]/N_Gos FIELDPUT(2+j,Ar_Sred_j[j]) // "Среднее" строка NEXT *** Расчет и запись столбца значимости признаков (градаций описательных шкал) FOR i = 1 TO N_Gos DBGOTO(i) FOR j = 1 TO N_Cls Iij=FIELDGET(2+j) // Информативность-элемент (i,j) Ar_Disp_i[i] = Ar_Disp_i[i] + (Ar_Sred_i[i]-Iij)^2 NEXT Ar_Disp_i[i] = SQRT(Ar_Disp_i[i]/(N_Cls-1)) // Средн.квадр.отклонение Iij по признаку FIELDPUT(5+N_Cls,Ar_Disp_i[i]) NEXT **** Расчет степени редукции классов Disp_all = 0 // угловой элемент "Дисперсия" FOR j = 1 TO N_Cls FOR i = 1 TO N_Gos DBGOTO(i) Iij=FIELDGET(2+j) // Информативность-элемент (i,j) Ar_Disp_j[j] = Ar_Disp_j[j]+(Ar_Sred_j[j]-Iij)^2 Disp_all = Disp_all + (Sredn_all - Iij) ^ 2 NEXT DBGOTO(N_Gos+3) // "Дисперсия" строка Ar_Disp_j[j] = SQRT(Ar_Disp_j[j]/(N_Gos-1)) // Средн.квадр.отклонение Iij по классу FIELDPUT(2+j,Ar_Disp_j[j]) NEXT DBGOTO(N_Gos+3) // "Дисперсия" строка FIELDPUT(5+N_Cls,SQRT(Disp_all/(N_Cls*N_Gos-1))) // "Дисперсия" - угловой элемент RETURN NIL ********************************************************************************************************* ******** 3.3. Расчет заданных из 7 моделей знаний: ########### ******** Inf1~Prc1, Inf2~Prc2, Inf3-хи-квадрат, Inf4-roi~Prc1, Inf5-roi~Prc2, Inf6-Dp~Prc1, Inf7-Dp~Prc2 ******** для задания БЗ использован пример XSample_184() из xdemo.exe ########### ********************************************************************************************************* FUNCTION F3_3CPU(Dialog, TP, Ws, oP, lO, Regim ) LOCAL GetList[0], GetOptions, oGroup1, oGroup2, oGroup3, oMainDlg, oLastFocus LOCAL oProgress, oDialog, lOk := .t., oButton, nEvent, mp1, mp2, oXbp, lCancelled := .F. Running(.T.) Time_Progress = TP Wsego = Ws oProgress = oP lOk = lO IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF Dialog IF ApplChange("3.3()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ELSE IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ENDIF IF .NOT. FILE("Abs.txt") // БД абс.частот F3_1(.F.) ENDIF *IF .NOT. FILE("Prc1.txt") .OR.; // БД процентных распределений * .NOT. FILE("Prc2.txt") * F3_2(.F.) *ENDIF dbeSetDefault('DBFNTX') IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF ****** Задание на расчет баз знаний IF .NOT. FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aMess := {} AADD(aMess, L("Расчет заданных из 7 моделей знаний не может быть выполнен,") ) AADD(aMess, L("т.к. для этого необходимо сначала сформировать базы абсолютных частот в режиме 3.1")) AADD(aMess, L("и, для расчета моделей INF#, кроме INF3, усл.и безусл.проц.распр. в режиме 3.2 !!!")) LB_Warning(aMess, L("3.3. Расчет заданных из 7 моделей знаний")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF IF aCalcInf[1] = .F. aMess := {} AADD(aMess, L("Расчет заданных из 7 моделей знаний не может быть выполнен, т.к. для этого") ) AADD(aMess, L("необходимо сначала сформировать базу абсолютных частот ABS.DBF в режиме 3.1")) LB_Warning(aMess, L("3.3. Расчет заданных из 7 моделей знаний")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ***************************************************************************************************** IF Dialog IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE M_CurrInf = 0 DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF * LB_Warning(STR(M_CurrInf,19)) ****** Задание моделей знаний для расчета и задание текущей модели @ 0, 0 DCGROUP oGroup1 CAPTION L('Задайте, какие базы знаний рассчитывать') SIZE 68 ,8.5 @ 0,70 DCGROUP oGroup2 CAPTION L('Задайте текущую базу знаний' ) SIZE 28 ,8.5 @10, 0 DCGROUP oGroup3 CAPTION L('Как задавать параметры синтеза моделей' ) SIZE 98.5,6 @ 1, 3 DCCHECKBOX aCalcInf[ 4] PROMPT L('INF1 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC1') PARENT oGroup1 @ 2, 3 DCCHECKBOX aCalcInf[ 5] PROMPT L('INF2 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC2') PARENT oGroup1 @ 3, 3 DCCHECKBOX aCalcInf[ 6] PROMPT L('INF3 - частный критерий: Xи-квадрат, разности между факт.и ожид.абс.частотами ') PARENT oGroup1 @ 4, 3 DCCHECKBOX aCalcInf[ 7] PROMPT L('INF4 - частный критерий: ROI (Return On Investment); вероятности из PRC1 ') PARENT oGroup1 @ 5, 3 DCCHECKBOX aCalcInf[ 8] PROMPT L('INF5 - частный критерий: ROI (Return On Investment); вероятности из PRC2 ') PARENT oGroup1 @ 6, 3 DCCHECKBOX aCalcInf[ 9] PROMPT L('INF6 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC1 ') PARENT oGroup1 @ 7, 3 DCCHECKBOX aCalcInf[10] PROMPT L('INF7 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC2 ') PARENT oGroup1 @ 1, 3 DCRADIO M_CurrInf VALUE 4 PROMPT L('INF1') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 4] } HIDE {|| .NOT. aCalcInf[ 4] } @ 2, 3 DCRADIO M_CurrInf VALUE 5 PROMPT L('INF2') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 5] } HIDE {|| .NOT. aCalcInf[ 5] } @ 3, 3 DCRADIO M_CurrInf VALUE 6 PROMPT L('INF3') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 6] } HIDE {|| .NOT. aCalcInf[ 6] } @ 4, 3 DCRADIO M_CurrInf VALUE 7 PROMPT L('INF4') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 7] } HIDE {|| .NOT. aCalcInf[ 7] } @ 5, 3 DCRADIO M_CurrInf VALUE 8 PROMPT L('INF5') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 8] } HIDE {|| .NOT. aCalcInf[ 8] } @ 6, 3 DCRADIO M_CurrInf VALUE 9 PROMPT L('INF6') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[ 9] } HIDE {|| .NOT. aCalcInf[ 9] } @ 7, 3 DCRADIO M_CurrInf VALUE 10 PROMPT L('INF7') PARENT oGroup2 EDITPROTECT {|| .NOT. aCalcInf[10] } HIDE {|| .NOT. aCalcInf[10] } @ 8.7, 0 DCPUSHBUTTON ; CAPTION L('Вид частных критериев 7 моделей знаний') ; SIZE LEN(L('Вид частных критериев 7 моделей знаний')), 1 ; ACTION {||Help33()} @ 1, 3 DCSAY L('Задайте, какие базы знаний рассчитывать. Рекомендуется задать все, если это приемлемо по длительности расчетов. Затем') PARENT oGroup3 @ 2, 3 DCSAY L('задайте одну из моделей знаний, которая будет текущей после завершения синтеза моделей. В качестве текущей можно вы-') PARENT oGroup3 @ 3, 3 DCSAY L('брать только одну из баз знаний, которые заданы для расчета. До исследования достоверности моделей в режиме 3.5 реко-') PARENT oGroup3 @ 4, 3 DCSAY L('мендуется задавать для расчета и делать текущей базу знаний INF1. Подробнее смысл моделей знаний, применяемых в сис-') PARENT oGroup3 @ 5, 3 DCSAY L('теме "Эйдос-Х++", раскрыт в режиме 6.4. и публикациях, размещенных по адресу: http://www.twirpx.com/file/793311/ ') PARENT oGroup3 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; ADDBUTTONS; OPTIONS GetOptions ; MODAL ; TITLE L('3.3. Задание моделей знаний для расчета и работы (текущей)') ******************************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ******************************************************************** ***************************************************************************************************** DC_ASave(aCalcInf , "_CalcInf.arx") // Файл с информацией о том, создание каких моделей было задано DC_ASave(M_CurrInf, "_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей IF ASCAN(aCalcInf, .T.) = 0 LB_Warning(L("Необходимо задать хотя бы одну модель знаний для расчета !")) Running(.F.) RETURN NIL ENDIF IF M_CurrInf = 0 LB_Warning(L("Необходимо задать хотя бы одну модель знаний в качестве текущей !")) Running(.F.) RETURN NIL ELSE IF aCalcInf[M_CurrInf] = .F. LB_Warning(L("Модель знаний, заданная в качестве текущей, должна быть задана и для расчета !")) Running(.F.) RETURN NIL ENDIF ENDIF ELSE ENDIF // Диалог ***** Для расчета любой из моделей INF#, кроме модели INF3, необходим предварительный расчет PRC1 и PRC2 * Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } * 1 2 3 4 5 6 7 8 9 10 IF aCalcInf[4] .OR. aCalcInf[5] .OR. aCalcInf[7] .OR. aCalcInf[8] .OR. aCalcInf[9] .OR. aCalcInf[10] IF aCalcInf[2] = .F. .OR. aCalcInf[3] = .F. aMess := {} AADD(aMess, L("Расчет заданных из 7 моделей знаний не может быть выполнен, т.к. для этого")) AADD(aMess, L(" необходимо сначала сформировать базы и условных и безусловных процентных") ) AADD(aMess, L(" распределений PRC1.DBF и PRC2.DBF в режиме 3.2 !!!") ) LB_Warning(aMess, L("3.3. Расчет заданных из 7 моделей знаний")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ENDIF ***************************************************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() ***************************************************************************************************** IF Dialog // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego // Задание максимальной величины параметра Time Wsego = IF(aCalcInf[ 4],N_Gos,0)+; // Расчет и дорасчет модели IF(aCalcInf[ 5],N_Gos,0)+; IF(aCalcInf[ 6],N_Gos,0)+; IF(aCalcInf[ 7],N_Gos,0)+; IF(aCalcInf[ 8],N_Gos,0)+; IF(aCalcInf[ 9],N_Gos,0)+; IF(aCalcInf[10],N_Gos,0) // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,13.5 ; PARENT oTabPage1 @15,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Abs @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // Prc1, Prc2 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" // 2 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // 3 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // 4 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // 5 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 6 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[11] FONT "10.Helv" // 7 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[12] FONT "10.Helv" // 8 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[13] FONT "10.Helv" // 9 s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lCancelled:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('3.3. Расчет заданных из 7 моделей знаний') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ENDIF ***************************************************************************************************** IF Dialog aSay[ 4]:SetCaption(L('ОПЕРАЦИЯ: СОЗДАНИЕ БАЗ ЗНАНИЙ: "INF1 - INF7"')) ENDIF aSay[ 5]:SetCaption(L("1/9: Генерация баз знаний: INF1 - INF7. Немного подождите !!!")) GenDBFInf() aSay[ 5]:SetCaption(L('1/9: Генерация баз знаний: "INF1 - INF7"')) aSay[ 5]:SetCaption(aSay[ 5]:caption+L(" - Готово ")) mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // Количество классов (градаций классификационных шкал) USE Gr_ClSc EXCLUSIVE NEW USE Class_Sc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() // Количество признаков (градаций описательных шкал) USE Opis_Sc EXCLUSIVE NEW **** Текстовые базы данных ********************* *USE Abs EXCLUSIVE NEW // БД - матрица абсолютных частот (матрица сопряженности) *USE Prc1 EXCLUSIVE NEW // ИБ - матрица условных и безусловных процентных распределений признаков по классам *USE Prc2 EXCLUSIVE NEW // ИБ - матрица условных и безусловных процентных распределений признаков по объектам, относящися к классам *USE Inf EXCLUSIVE NEW // Текущая модель *USE Inf1 EXCLUSIVE NEW // БЗ-1 - Inf1~Prc1 *USE Inf2 EXCLUSIVE NEW // БЗ-2 - Inf2~Prc2 *USE Inf3 EXCLUSIVE NEW // БЗ-3 - Inf3-хи-квадрат *USE Inf4 EXCLUSIVE NEW // БЗ-4 - Inf4-roi~Prc1 *USE Inf5 EXCLUSIVE NEW // БЗ-5 - Inf5-roi~Prc2 *USE Inf6 EXCLUSIVE NEW // БЗ-6 - Inf6-Dp~Prc1 *USE Inf7 EXCLUSIVE NEW // БЗ-7 - Inf7-Dp~Prc2 * ########################################################################### // Открытие текстовых баз данных ******************************************** *DC_ASave(aInfStruct, "_InfStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_InfStruct.arx") *DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только после расчета Abs.txt, а при расчете остальных БД только считывать *DC_ASave(aColEmpty, "_aColEmpty.arx") aStrEmpty = DC_ARestore("_aStrEmpty.arx") aColEmpty = DC_ARestore("_aColEmpty.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) PUBLIC Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } PUBLIC nHandle[LEN(Ar_Model)] FOR z=1 TO LEN(Ar_Model) nHandle[z] := FOpen( Ar_Model[z]+".txt", FO_READWRITE ) // Открыть все текстовые базы данных ######################################## NEXT **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### // Добавить формирование класс.шкал и градаций // Добавить формирование опис.шкал и БД Attributes aSave3_3 := DC_DataSave() ***************************************************************************************************** ******* Общая часть для всех INF# DB_Name = Ar_Model[1]+".txt" // Суммарное количество фактов, учтенных в модели N1 = VAL(LC_FieldGet( DB_Name, nHandle[1], N_Gos+1, N_Cls+3 )) // факт - это встреча в обучающей выборке сочетания: класс х признак K1 = LOG(N_Cls)/LOG(N1)/LOG(2) // Нормировочный коэффициент для INF1 N2 = VAL(LC_FieldGet( DB_Name, nHandle[1], N_Gos+4, N_Cls+3 )) // Суммарное количество объектов обучающей выборки, учтенных в модели K2 = LOG(N_Cls)/LOG(N2)/LOG(2) // Нормировочный коэффициент для INF2 // Итоговые строки и столбцы ******* Для рассчета хи-квадрат PRIVATE Nij[N_Cls] // i-я строка базы абс.частот PRIVATE Ni[N_Gos] // Столбец "Сумма числа признаков" базы абс.частот PRIVATE Nj[N_Cls] // Строка "Сумма числа признаков" базы абс.частот PRIVATE Ar_Pij[N_Cls+5] PRIVATE Ar_Summ_i[N_Gos+3], Ar_Summ_j[N_Cls+5] // N_Cls + 1-коды, 2-наименования, 3-Summ, 4-Sred, 5-Disp PRIVATE Ar_Sred_i[N_Gos+3], Ar_Sred_j[N_Cls+5] PRIVATE Ar_Disp_i[N_Gos+3], Ar_Disp_j[N_Cls+5] ***************************************************************************************** **** Проверка диалога *FOR j=1 TO LEN(aCalcInf) * IF aCalcInf[j] * LB_Warning(L("Задан Расчет модели знаний: "+ALLTRIM(STR(j,19))) * ELSE * LB_Warning(L("Расчет модели знаний: "+ALLTRIM(STR(j,19))+" не задан") * ENDIF *NEXT *LB_Warning(L("Текущей задана модель: "+STR(M_CurrInf,19)) ** ################################################################################# ** В БУДУЩЕМ РАСЧЕТ ВСЕХ INF# СДЕЛАТЬ НЕПОСРЕДСТВЕННО НА ОСНОВЕ ABS.DBF ############ ** ################################################################################# IF aCalcInf[1+3] IF Dialog // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ENDIF AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("2/9: Расчет модели знаний INF1 с частным критерием А.Харкевича PRC1:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 6]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(6, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls * IF aColEmpty[j] Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = K1*LOG(Ar_Pij[j]/Pi) // Расчет и запись Iij // ВСЕ СЧИТАТЬ НЕПОСРЕДСТВЕННО НА ОСНОВЕ БД ABS.DBF ################# ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[4]+".txt", nHandle[4], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Дорасчет")) aCalcInf[4] = .T.;PostCalcINF(4) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=1+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Текущая")) ENDIF aSay[ 6]:SetCaption(aSay[ 6]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[2+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("3/9: Расчет модели знаний INF2 с частным критерием А.Харкевича PRC2:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 7]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(7, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls * IF aColEmpty[j] Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = K2*LOG(Ar_Pij[j]/Pi) // Расчет и запись Iij ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[5]+".txt", nHandle[5], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Дорасчет")) aCalcInf[5] = .T.;PostCalcINF(5) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=2+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Текущая")) ENDIF aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[3+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) ***** Строка Nj: "Сумма числа признаков всего по классу" AFILL(Nj,0) FOR j=1 TO N_Cls * IF aColEmpty[j] Nj[j] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+1, 2+j )) * ENDIF NEXT ***** Строка Ni "Сумма числа признаков по признаку" AFILL(Ni,0) FOR i=1 TO N_Gos * IF aStrEmpty[i] Ni[i] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], i, N_Cls+3 )) * ENDIF NEXT N = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], N_Gos+1, N_Cls+3 )) mMess = L("4/9: Расчет модели знаний INF3 - Xи-квадрат:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 8]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(8, mMess, N_ALL) * IF aStrEmpty[i] AFILL(Nij,0) FOR j=1 TO N_Cls * IF aColEmpty[j] Nij[j] = VAL(LC_FieldGet( Ar_Model[1]+".txt", nHandle[1], i, 2+j )) * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF N <> 0 Iij = Nij[j]-(Ni[i]*Nj[j])/N IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[6]+".txt", nHandle[6], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF * ENDIF NEXT * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Дорасчет")) aCalcInf[6] = .T.;PostCalcINF(6) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=3+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Текущая")) ENDIF aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[4+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("5/9: Расчет модели знаний INF4 - ROI (Return On Investment) - PRC1:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[ 9]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(9, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls * IF aColEmpty[j] Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = Ar_Pij[j]/Pi - 1 // Расчет и запись Iij ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[7]+".txt", nHandle[7], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Дорасчет")) aCalcInf[7] = .T.;PostCalcINF(7) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=4+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Текущая")) ENDIF aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[5+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("6/9: Расчет модели знаний INF5 - ROI (Return On Investment) - PRC2:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls * IF aColEmpty[j] Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = Ar_Pij[j]/Pi - 1 // Расчет и запись Iij ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[8]+".txt", nHandle[8], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[10]:SetCaption(aSay[10]:caption+L(" - Дорасчет")) aCalcInf[8] = .T.;PostCalcINF(8) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=5+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[10]:SetCaption(aSay[10]:caption+L(" - Текущая")) ENDIF aSay[10]:SetCaption(aSay[10]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[6+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("7/9: Расчет модели знаний INF6 - Разность усл.и безусл.вероятн. - PRC1:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls * IF aColEmpty[j] Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[2]+".txt", nHandle[2], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса * ENDIF NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = Ar_Pij[j] - Pi // Расчет и запись Iij ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[9]+".txt", nHandle[9], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT aSay[11]:SetCaption(aSay[11]:caption+L(" - Дорасчет")) aCalcInf[9] = .T.;PostCalcINF(9) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=6+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[11]:SetCaption(aSay[11]:caption+L(" - Текущая")) ENDIF aSay[11]:SetCaption(aSay[11]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ***************************************************************************************** IF aCalcInf[7+3] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) mMess = L("8/9: Расчет модели знаний INF7 - Разность усл.и безусл.вероятн. - PRC2:") mNumPP = 0 N_ALL = N_Gos * №1 FOR i=1 TO N_Gos // №1, N_Gos ################################ // Стадия исполнения отображается всегда, даже когда задан режим "без диалога" (Dialog=.F.) // Под диалогом понимается диалог задания моделей для синтеза и выбор текущей * aSay[12]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(12, mMess, N_ALL) * IF aStrEmpty[i] Pi = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, N_Cls+3 )) // Безусловная вероятность встречи i-го признака IF Pi > 0 AFILL(Ar_Pij, 0) FOR j=1 TO N_Cls Ar_Pij[j] = VAL(LC_FieldGet( Ar_Model[3]+".txt", nHandle[3], i, 2+j )) // Условные вероятности встречи i-го признака у объектов j-го класса NEXT For j=1 TO N_Cls * IF aColEmpty[j] IF Pi <> 0 IF Ar_Pij[j]/Pi > 0 ************************* Iij = Ar_Pij[j] - Pi // Расчет и запись Iij ************************* IF Iij <> 0 String = STR(Iij, aInfStruct[2+j,3], aInfStruct[2+j,4] ) // ##################### LC_FieldPut( Ar_Model[10]+".txt", nHandle[10], i, 2+j, String ) Ar_Summ_j[j] = Ar_Summ_j[j] + Iij // Расчет строки и углового элемента "Сумма" Ar_Summ_i[i] = Ar_Summ_i[i] + Iij // Расчет i-го элемента столбца "Сумма" ENDIF ENDIF ENDIF * ENDIF NEXT ENDIF * ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_progress, Wsego, oProgress, lOk );ENDIF NEXT * MsgBox( "0 "+CURDIR() ) aSay[12]:SetCaption(aSay[12]:caption+L(" - Дорасчет")) aCalcInf[10] = .T.;PostCalcINF(10) // Дорасчет сумм, средних и ср.кв.откл. IF M_CurrInf=7+3 // Сделать данную модель баз знаний текущей (без диалога) F5_6(M_CurrInf,.F.,"3_3");DC_DataRest( aSave3_3 ) aSay[12]:SetCaption(aSay[12]:caption+L(" - Текущая")) ENDIF aSay[12]:SetCaption(aSay[12]:caption+L(" - Готово ")) ENDIF ***************************************************************************************** ****** Переиндексация БД классов и признаков (закрывает все БД, поэтому в самом конце, ****** хотя можно сохранять и восстанавливать вычислительную среду) aSay[13]:SetCaption(L("9/9: Переиндексация БД классификационных и описательных шкал и градаций")) *MsgBox( "1 "+CURDIR() ) GenNtxClass() *MsgBox( "2 "+CURDIR() ) GenNtxGrClSc() // ################################################################### *MsgBox( "3 "+CURDIR() ) GenNtxOpSc() *MsgBox( "4 "+CURDIR() ) GenNtxGrOpSc() aSay[13]:SetCaption(aSay[13]:caption+L(" - Готово ")) ***************************************************************************************** DC_ASave(aCalcInf, "_CalcInf.arx") // Запись информации о расчете моделей IF Dialog Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы oSay97:SetCaption(L("РАСЧЕТ ВСЕХ ЗАДАННЫХ БАЗ ЗНАНИЙ СИCТЕМЫ ЭЙДОС-X++ ЗАВЕРШЕН !")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF FOR z=1 TO LEN(Ar_Model) FClose( nHandle[z] ) // Закрытие dbf и txt баз данных ###################################### NEXT ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN( Time_Progress ) *********************************************************************************************** // Дорасчет строки и столбца "Сумма", "Среднее", "Средн.квадр.отклонение" ####### // для текущей стат.модели или модели знаний (заданной F5_6()) ####### // и перенос Int_Inf (Disp) в Attributes, Opis_Sc, Gr_OpSc и Classes, Class_Sc, Gr_ClSc ####### *********************************************************************************************** FUNCTION PostCalcINF(z) LOCAL oPr, oDial Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } *oScr := DC_WaitOn(L('Дорасчет строки и столбца "Сумма", "Среднее", "Средн.квадр.отклонение". Немного подождите!!!'),,,,,,,,,,,.F.) *DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только после расчета Abs.txt, а при расчете остальных БД только считывать *DC_ASave(aColEmpty, "_aColEmpty.arx") aStrEmpty = DC_ARestore("_aStrEmpty.arx") aColEmpty = DC_ARestore("_aColEmpty.arx") nMax = N_Gos + N_Cls + N_Cls + N_Gos + N_Cls + N_Gos + N_Cls - IF(z=2 .OR. z=3, N_Gos, 0) * 1 2 3 4 5 6 7 nMess = L('Дорасчет итоговых строк и столбцов в модели: "')+UPPER(Ar_Model[z])+'"' @ 5,4 DCPROGRESS oPr SIZE 80,1.0 MAXCOUNT nMax COLOR BD_TLCGOLD PERCENT EVERY 100 DCREAD GUI TITLE nMess PARENT @oDial FIT EXIT oDial:show() nTime = 0 DC_GetProgress(oPr,0,nMax) IF z = 2 .OR. z = 3 ELSE *** Запись столбца "Сумма" For i=1 TO N_Gos // №1, N_Gos, #################################################### IF Ar_Summ_i[i] <> 0 String = STR(Ar_Summ_i[i], aInfStruct[N_Cls+3,3], aInfStruct[N_Cls+3,4] ) // Запись столбца "Сумма" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], i, N_Cls+3, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT ENDIF ***** Запись строки "Сумма" For j=1 TO N_Cls // №2, N_Cls, #################################################### IF Ar_Summ_j[j] <> 0 String = STR(Ar_Summ_j[j], aInfStruct[2+j,3], aInfStruct[2+j,4] ) // Запись строки "Сумма" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+1, 2+j, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT ***** Рассчет углового элемента "Сумма" Summa_all = 0 For j=1 TO N_Cls // №3, N_Cls, #################################################### Summa_all = Summa_all + Ar_Summ_j[j] NEXT Sredn_all = Summa_all/(N_Cls*N_Gos) IF Summa_all <> 0 String = STR(Summa_all, aInfStruct[N_Cls+3,3], aInfStruct[N_Cls+3,4] ) // Запись углового элемента "Сумма" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+1, N_Cls+3, String ) String = STR(Sredn_all, aInfStruct[N_Cls+4,3], aInfStruct[N_Cls+4,4] ) // Запись углового элемента "Среднее" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+2, N_Cls+4, String ) ENDIF *** Расчет средних по строкам FOR i = 1 TO N_Gos // №4, N_Gos, #################################################### Ar_Sred_i[i] = Ar_Summ_i[i]/N_Cls IF Ar_Sred_i[i] <> 0 String = STR(Ar_Sred_i[i], aInfStruct[N_Cls+4,3], aInfStruct[N_Cls+4,4] ) // Запись столбца "Среднее" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], i, N_Cls+4, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT ****** Расчет средних по столбцам FOR j = 1 TO N_Cls // №5, N_Cls, #################################################### Ar_Sred_j[j] = Ar_Summ_j[j]/N_Gos IF Ar_Sred_j[j] <> 0 String = STR(Ar_Sred_j[j], aInfStruct[N_Cls+4,3], aInfStruct[N_Cls+4,4] ) // Запись строки "Среднее" LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+2, 2+j, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT *** Расчет и запись столбца значимости признаков (градаций описательных шкал) FOR i = 1 TO N_Gos // №6, N_Gos, ############################################## FOR j = 1 TO N_Cls Iij = 0 * DC_DebugQout( aStrEmpty[i] ) * DC_DebugQout( aColEmpty[j] ) * IF aStrEmpty[i] .AND. aColEmpty[j] Iij = VAL(LC_FieldGet( Ar_Model[z]+".txt", nHandle[z], i, 2+j )) // Информативность-элемент (i,j) * ENDIF Ar_Disp_i[i] = Ar_Disp_i[i] + (Ar_Sred_i[i]-Iij)^2 NEXT Ar_Disp_i[i] = SQRT(Ar_Disp_i[i]/(N_Cls-1)) // Средн.квадр.отклонение Iij по признаку IF Ar_Disp_i[i] <> 0 String = STR(Ar_Disp_i[i], aInfStruct[N_Cls+5,3], aInfStruct[N_Cls+5,4] ) // Запись столбца "Ср.кв.откл." LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], i, N_Cls+5, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT **** Расчет степени редукции классов Disp_all = 0 // угловой элемент "Дисперсия" FOR j = 1 TO N_Cls // №7, N_Cls, ############################################## FOR i = 1 TO N_Gos Iij = 0 * IF aStrEmpty[i] .AND. aColEmpty[j] Iij = VAL(LC_FieldGet( Ar_Model[z]+".txt", nHandle[z], i, 2+j )) // Информативность-элемент (i,j) * ENDIF Ar_Disp_j[j] = Ar_Disp_j[j]+(Ar_Sred_j[j]-Iij)^2 Disp_all = Disp_all + (Sredn_all - Iij) ^ 2 NEXT Ar_Disp_j[j] = SQRT(Ar_Disp_j[j]/(N_Gos-1)) // Средн.квадр.отклонение Iij по классу IF Ar_Disp_j[j] <> 0 String = STR(Ar_Disp_j[j], aInfStruct[N_Cls+5,3], aInfStruct[N_Cls+5,4] ) // Запись строки "Ср.кв.откл." LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+3, 2+j, String ) ENDIF DC_GetProgress(oPr, ++nTime, nMax) NEXT IF Disp_all <> 0 String = STR(SQRT(Disp_all/(N_Cls*N_Gos-1)), aInfStruct[N_Cls+5,3], aInfStruct[N_Cls+5,4] ) // "Дисперсия" - угловой элемент LC_FieldPut( Ar_Model[z]+".txt", nHandle[z], N_Gos+3, N_Cls+5, String ) ENDIF DC_GetProgress(oPr,nMax,nMax) oDial:Destroy() *DC_Impl(oScr) *MsgBox(Ar_Model[z]) RETURN NIL ********************************************************************************************************** ******** Помощь по режиму 3_3: смысл частных критериев знаний, применяемых в системе "Эйдос-Х++" ********************************************************************************************************** FUNCTION Help33() aSaveH3_3 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы cFile = "_Priv_Criteria.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 4574097 DC_PrintPreviewAcrobat( '_Priv_Criteria.pdf', 'Help 3.3: смысл частных критериев знаний, применяемых в системе "Эйдос-Х++' ) ELSE Mess = L('Файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файлы LB_Warning(Mess) ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF DIRCHANGE(Disk_dir) DC_DataRest( aSaveH3_3 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.F.) RETURN NIL *********************************************************************************************************** ********* 4.1.1. Ручной ввод-корректировка распознаваемой выборки ********* режим сисадмина точно такой-же, как режим "2.3.1. Ввод-корректровка обучающей выборки", ********* а для администратора приложений и пользователей надо убрать возможность просмотра ********* и корректировки кодов классов и, соответственно, по-другому расположить окна *********************************************************************************************************** FUNCTION F4_1_1() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("4.1.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF IF FILE("Obi_Zag.dbf") // БД заголовков обучающей выборки ** Переиндексировать БД Obi_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oiz_kod.ntx" ) .OR.; .NOT. FILE("Oiz_name.ntx") .OR.; .NOT. FILE("Obi_Zag.ntx" ) GenNtxObiZag() ENDIF ELSE GenDbfObiZag() ENDIF IF FILE("Obi_Kcl.dbf") // БД классов обучающей выборки ** Переиндексировать БД Obi_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oic_kod.ntx") .OR.; .NOT. FILE("Obi_Kcl.ntx") GenNtxObiKcl() ENDIF ELSE GenDbfObiKcl() ENDIF IF FILE("Obi_Kpr.dbf") // БД признаков обучающей выборки ** Переиндексировать БД Obi_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Obi_Kpr.ntx") GenNtxObiKpr() ENDIF ELSE GenDbfObiKpr() ENDIF IF FILE("Rso_Zag.dbf") // БД заголовков распознаваемой выборки ** Переиндексировать БД Rso_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roz_kod.ntx" ) .OR.; .NOT. FILE("Roz_name.ntx") .OR.; .NOT. FILE("Rso_Zag.ntx" ) GenNtxRsoZag() ENDIF ELSE GenDbfRsoZag() ENDIF IF FILE("Rso_Kcl.dbf") // БД классов распознаваемой выборки ** Переиндексировать БД Rso_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roc_kod.ntx") .OR.; .NOT. FILE("Rso_Kcl.ntx") GenNtxRsoKcl() ENDIF ELSE GenDbfRsoKcl() ENDIF IF FILE("Rso_Kpr.dbf") // БД признаков распознаваемой выборки ** Переиндексировать БД Rso_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Rso_Kpr.ntx") GenNtxRsoKpr() ENDIF ELSE GenDbfRsoKpr() ENDIF dbeSetDefault('DBFNTX') IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag INDEX ON Kod_Obj TO Rso_Zag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kcl NEW INDEX ON Kod_Obj TO Rso_Kcl CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kpr NEW INDEX ON Kod_Obj TO Rso_Kpr CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX Obi_Zag EXCLUSIVE USE Obi_Kcl INDEX Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr INDEX Obi_Kpr EXCLUSIVE NEW USE Rso_Zag INDEX Rso_Zag EXCLUSIVE NEW USE Rso_Kcl INDEX Rso_Kcl EXCLUSIVE NEW USE Rso_Kpr INDEX Rso_Kpr EXCLUSIVE NEW /* ----- Create ToolBar ----- */ d = 12 @ 27.5, 0 DCTOOLBAR oToolBar SIZE 143, 1.5 DCADDBUTTON CAPTION L('Помощь') ; SIZE LEN(L("Помощь"))+4 ; ACTION {||Help411(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Помощь по режиму 4.1.1') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Скопировать расп.выб.в обуч.') ; SIZE LEN(L("Скопировать обуч.выб.в расп."))-3, 1.5 ; ACTION {||CopyRoOi4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Скопировать распознаваемую выборку в обучающую') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить объект') ; SIZE LEN(L("Добавить объект"))+1, 1.5 ; ACTION {||Add_Obj4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить объект') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Добавить признаки') ; SIZE LEN(L("Добавить признаки"))+1, 1.5 ; ACTION {||Add_Kpr4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Добавить строку признаков') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить объект') ; SIZE LEN(L("Удалить объект"))+2, 1.5 ; ACTION {||Del_Obj4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить объект') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить классы') ; SIZE LEN(L("Удалить классы"))+2, 1.5 ; ACTION {||Del_Kcl4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить строку классов') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Удалить признаки') ; SIZE LEN(L("Удалить признаки"))+1, 1.5 ; ACTION {||Del_Kpr4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Удалить строку признаков') @ DCGUI_ROW, DCGUI_COL + d DCPUSHBUTTON CAPTION L('Очистить БД') ; SIZE LEN(L("Очистить БД"))+2, 1.5 ; ACTION {||Zap_db4_1_1(), DC_GetRefresh(GetList)} ; PARENT oToolBar ; TOOLTIP L('Очистить базу данных') /* ----- Create browse-1: Главная БД Rso_Zag.dbf ----- */ bZag := {|| Rso_Kpr->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; Rso_Kpr->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; Rso_Kpr->(DC_DbGoTop()) , ; oBrowKpr:refreshAll() , ; Rso_Kcl->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; Rso_Kcl->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; Rso_Kcl->(DC_DbGoTop()) , ; oBrowKcl:refreshAll() } d = 10 @ 1, 0 DCBROWSE oBrowZag ALIAS 'Rso_Zag' SIZE 133+d,12.5 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; // Редактирование БД Rso_Zag.dbf NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bZag), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowZag DCBROWSECOL FIELD Rso_Zag->Kod_Obj HEADER L('Код объекта' ) WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Rso_Zag->Name_obj HEADER L('Наименование объекта') WIDTH 54.5+d-4 DCBROWSECOL FIELD Rso_Zag->Date HEADER L('Дата' ) WIDTH 10.4 PROTECT {|| .T. } DCBROWSECOL FIELD Rso_Zag->Time HEADER L('Время' ) WIDTH 9.5 PROTECT {|| .T. } /* Create browse-2: БД Rso_Kcl.dbf, связанная отношением "Один ко многим" с БД Rso_Zag.dbf*/ DCSETPARENT TO @14, 0 DCBROWSE oBrowKcl ALIAS 'Rso_Kcl' SIZE 51,13 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKcl DCBROWSECOL FIELD Rso_Kcl->Kod_Obj HEADER L('Код объекта') WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Rso_Kcl->Cls1 HEADER L('Класс 1' ) WIDTH 5 DCBROWSECOL FIELD Rso_Kcl->Cls2 HEADER L('Класс 2' ) WIDTH 5 DCBROWSECOL FIELD Rso_Kcl->Cls3 HEADER L('Класс 3' ) WIDTH 5 DCBROWSECOL FIELD Rso_Kcl->Cls4 HEADER L('Класс 4' ) WIDTH 5 /* Create browse-3: БД Rso_Kpr.dbf, связанная отношением "Один ко многим" с БД Rso_Zag.dbf*/ DCSETPARENT TO @14,54 DCBROWSE oBrowKpr ALIAS 'Rso_Kpr' SIZE 79+d,13 ; EDIT xbeBRW_ItemSelected MODE DCGUI_BROWSE_EDITDOWN ; NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKpr DCBROWSECOL FIELD Rso_Kpr->Kod_Obj HEADER L('Код объекта') WIDTH 1 PROTECT {|| .T. } DCBROWSECOL FIELD Rso_Kpr->Atr1 HEADER L('Признак 1' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr2 HEADER L('Признак 2' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr3 HEADER L('Признак 3' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr4 HEADER L('Признак 4' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr5 HEADER L('Признак 5' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr6 HEADER L('Признак 6' ) WIDTH 6 DCBROWSECOL FIELD Rso_Kpr->Atr7 HEADER L('Признак 7' ) WIDTH 6 DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE IF Flag_SysAdmin cTitle = L('4.1.1. Ручной ввод-корректировка распознаваемой выборки (режим сисадмина). Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' ELSE cTitle = L('4.1.1. Ручной ввод-корректировка распознаваемой выборки. Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' ENDIF DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE cTitle ; EVAL {|o|SetAppFocus(oBrowZag:GetColumn(1))} ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ****** END OF EXAMPLE *********************** ************************************************************************************************** FUNCTION Help411() aHelp := {} AADD(aHelp, L('Режим: "4.1.1. РУЧНОЙ ВВОД-КОРРЕКТИРОВКА РАСПОЗНАВАЕМОЙ ВЫБОРКИ",')) AADD(aHelp, L('предназначен для указания признаков конкретных объектов. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Коды признаков указываются в соответствии с описательными шкалами')) AADD(aHelp, L('и градациями. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('Формирование распознаваемой выборки является последним этапом ')) AADD(aHelp, L('перед распознаванием объектов (режим 4.1.2), в котором описания ')) AADD(aHelp, L('объектов их признаками будут использованы для определения степени')) AADD(aHelp, L('их принадлежности к обобщеным категориям (классам). ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-0, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 4.1.1. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ******** Скопировать распознаваемую выборку в обучающую ******** Для организации диалога использован пример XSample_184() из xdemo.exe FUNCTION CopyRoOi4_1_1() LOCAL GetList[0], GetOptions, lCheck1, lCheck2, nRadio1, nRadio2, ; oGroup1, oGroup2, M_KodObj, lOk nRadio1 := 2 nRadio2 := 2 @ 0, 0 DCGROUP oGroup1 CAPTION L('Что копировать') SIZE 40,4 @ 0,42 DCGROUP oGroup2 CAPTION L('Стирать или дополнять') SIZE 40,4 @ 1,2 DCRADIO nRadio1 VALUE 1 PROMPT L('Копировать всю базу данных' ) PARENT oGroup1 // nRadio1 := 1 @ 2,2 DCRADIO nRadio1 VALUE 2 PROMPT L('Копировать только текущий объект') PARENT oGroup1 // nRadio1 := 2 @ 1,2 DCRADIO nRadio2 VALUE 1 PROMPT L('Стирать обучающую выборку' ) PARENT oGroup2 // nRadio2 := 1 @ 2,2 DCRADIO nRadio2 VALUE 2 PROMPT L('Дополнять обучающую выборку' ) PARENT oGroup2 // nRadio2 := 2 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS ; MODAL ; TITLE L('4.1.1. Параметры копирования распознаваемой выборки в обучающую') ******************************************************************** * DCREAD GUI ; * TO lExit ; IF lExit ** Button Ok ELSE RETURN NIL ENDIF ******************************************************************** *LB_Warning(L("Радио1:"+STR(nRadio1,3)+" Радио2:"+STR(nRadio2,3)) SELECT Rso_zag IF nRadio1 = 2 M_KodObj = Kod_obj ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Obi_Zag INDEX Obi_Zag EXCLUSIVE USE Obi_Kcl INDEX Obi_Kcl EXCLUSIVE NEW USE Obi_Kpr INDEX Obi_Kpr EXCLUSIVE NEW USE Rso_Zag INDEX Rso_Zag EXCLUSIVE NEW USE Rso_Kcl INDEX Rso_Kcl EXCLUSIVE NEW USE Rso_Kpr INDEX Rso_Kpr EXCLUSIVE NEW // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego DO CASE CASE nRadio1 = 1 SELECT Rso_zag;N_RsoZag = RECCOUNT() SELECT Rso_Kcl;N_RsoKcl = RECCOUNT() SELECT Rso_Kpr;N_RsoKpr = RECCOUNT() CASE nRadio1 = 2 SELECT Rso_zag SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_RsoZag SELECT Rso_Kcl SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_RsoKcl SELECT Rso_Kpr SET FILTER TO M_KodObj = Kod_obj DBGOTOP();DBGOBOTTOM();DBGOTOP() COUNT TO N_RsoKpr ENDCASE Wsego = N_RsoZag + N_RsoKcl + N_RsoKpr // Задание максимальной величины параметра Time Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,5.5 ; PARENT oTabPage1 @ 7,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // Obi_Zag @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Obi_Kcl @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // Obi_Kpr @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // Переиндексация s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('4.1.1. Копирование распознаваемой выборки в обучающую') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() // Завершение подготовки данных для отображения графического прогресс-бар DO CASE CASE nRadio2 = 1 SELECT Obi_zag;ZAP SELECT Obi_Kcl;ZAP SELECT Obi_Kpr;ZAP CASE nRadio2 = 2 SELECT Obi_zag DBGOBOTTOM() M_MaxKodObj = Kod_Obj+1 Ar_KodObjOld := {} // Коды объектов исходной выборки Ar_KodObjNew := {} // Коды объектов результирующей выборки ENDCASE aSay[ 1]:SetCaption(L("Шаг 1-й из 4. Копирование базы заголовков распознаваемой выборки")) SELECT Rso_zag SET ORDER TO DBGOTOP() DO WHILE .NOT. EOF() IF nRadio2 = 2 AADD(Ar_KodObjOld, Kod_obj) AADD(Ar_KodObjNew, M_MaxKodObj++) // Если дополнять БД, то 1-й код следующий за последним ENDIF Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Obi_zag APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) IF nRadio2 = 2 Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) SELECT Rso_zag DBSKIP(1) ENDDO aSay[ 1]:SetCaption(aSay[ 1]:caption+L(" - Готово ")) aSay[ 2]:SetCaption(L("Шаг 2-й из 4. Копирование базы кодов классов распознаваемой выборки")) SELECT Rso_Kcl DBGOTOP() DO WHILE .NOT. EOF() Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Obi_Kcl APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) IF nRadio2 = 2 Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) SELECT Rso_Kcl DBSKIP(1) ENDDO aSay[ 2]:SetCaption(aSay[ 2]:caption+L(" - Готово ")) aSay[ 3]:SetCaption(L("Шаг 3-й из 4. Копирование базы кодов признаков распознаваемой выборки")) SELECT Rso_Kpr DBGOTOP() DO WHILE .NOT. EOF() Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Obi_Kpr APPEND BLANK FOR j=1 TO FCOUNT() FIELDPUT(j,Ar[j]) IF nRadio2 = 2 Pos = ASCAN(Ar_KodObjOld, Ar[1]) FIELDPUT(1, Ar_KodObjNew[Pos]) ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) SELECT Rso_Kpr DBSKIP(1) ENDDO aSay[ 3]:SetCaption(aSay[ 3]:caption+L(" - Готово ")) aSay[ 4]:SetCaption(L("Шаг 4-й из 4. Переиндексация обучающей выборки")) SELECT Obi_zag INDEX ON STR(Kod_Obj,19) TO Oiz_kod INDEX ON Name_Obj TO Oiz_name INDEX ON Kod_Obj TO Obi_zag SELECT Obi_Kcl INDEX ON STR(Kod_Obj,19) TO Oic_kod INDEX ON Kod_Obj TO Obi_Kcl SELECT Obi_Kpr INDEX ON STR(Kod_Obj,19) TO Oip_kod INDEX ON Kod_Obj TO Obi_Kpr aSay[ 4]:SetCaption(aSay[ 4]:caption+L(" - Готово ")) // Заключительные операции и деструктурирование окна отображения графического Progress-bar aSay[ 8]:SetCaption(L("КОПИРОВАНИЕ РАСПОЗНАВАЕМОЙ ВЫБОРКИ В ОБУЧАЮЩУЮ ЗАВЕРШЕНО УСПЕШНО!!!")) aSay[ 8]:SetCaption(aSay[ 8]:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() RETURN NIL ******** Добавить объект в конец БД Rso_Zag.dbf FUNCTION Add_Obj4_1_1() SELECT Rso_Zag DBGOBOTTOM() M_KodObj = Kod_Obj APPEND BLANK REPLACE Kod_Obj WITH M_KodObj+1 REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH Time() Add_Kcl4_1_1() Add_Kpr4_1_1() SELECT Rso_Zag DBGOBOTTOM() DC_GetRefresh(GetList) RETURN NIL ******** Добавить строку классов в конец БД Rso_Kcl.dbf FUNCTION Add_Kcl4_1_1() SELECT Rso_Zag M_KodObj = Kod_Obj SELECT Rso_Kcl APPEND BLANK REPLACE Kod_Obj WITH M_KodObj RETURN NIL ******** Добавить строку признаков в конец БД Rso_Kpr.dbf FUNCTION Add_Kpr4_1_1() SELECT Rso_Zag M_KodObj = Kod_Obj SELECT Rso_Kpr APPEND BLANK REPLACE Kod_Obj WITH M_KodObj RETURN NIL ******** Удалить текущую запись в БД Rso_Zag.dbf ******** и связанные с ней записи БД Rso_Kcl.dbf и Rso_Kpr.dbf FUNCTION Del_Obj4_1_1() SELECT Rso_Zag M_Recno = RECNO() M_Kod_obj = Kod_Obj DELETE PACK // Удалить связанные БД SELECT Rso_Kcl DELETE FOR M_Kod_obj = Kod_Obj PACK SELECT Rso_Kpr DELETE FOR M_Kod_obj = Kod_Obj PACK SELECT Rso_Zag DBGOTO(M_Recno) RETURN NIL ******** Удалить текущую запись в БД Rso_Kcl.dbf FUNCTION Del_Kcl4_1_1() SELECT Rso_Kcl M_Recno = RECNO() DELETE PACK DBGOTO(M_Recno) RETURN NIL ******** Удалить текущую запись в БД Rso_Kpr.dbf FUNCTION Del_Kpr4_1_1() SELECT Rso_Kpr M_Recno = RECNO() DELETE PACK DBGOTO(M_Recno) RETURN NIL ******** Очистить БД FUNCTION Zap_db4_1_1() SELECT Rso_Zag;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH Time() SELECT Rso_Kcl;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 SELECT Rso_Kpr;ZAP APPEND BLANK REPLACE Kod_Obj WITH 1 RETURN NIL ******** Генерация БД заголовков обучающей выборки FUNCTION GenDbfRsoZag() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Rso_Zag.dbf" aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj", "C", 65, 0 }, ; { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8 , 0 } } DbCreate( cFileName, aStructure ) GenNtxRsoZag() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация БД кодов классов обучающей выборки FUNCTION GenDbfRsoKcl() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Rso_Kcl.dbf" aStructure := { { "Kod_Obj", "N", 15, 0 }, ; { "Cls1" , "N", 15, 0 }, ; { "Cls2" , "N", 15, 0 }, ; { "Cls3" , "N", 15, 0 }, ; { "Cls4" , "N", 15, 0 } } DbCreate( cFileName, aStructure ) GenNtxRsoKcl() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Генерация БД кодов признаков обучающей выборки FUNCTION GenDbfRsoKpr() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций cFileName := "Rso_Kpr.dbf" aStructure := { { "Kod_Obj", "N", 15, 0 }, ; { "Atr1" , "N", 15, 0 }, ; { "Atr2" , "N", 15, 0 }, ; { "Atr3" , "N", 15, 0 }, ; { "Atr4" , "N", 15, 0 }, ; { "Atr5" , "N", 15, 0 }, ; { "Atr6" , "N", 15, 0 }, ; { "Atr7" , "N", 15, 0 } } DbCreate( cFileName, aStructure ) GenNtxRsoKpr() DC_DataRest( aSaveGenDbf ) RETURN NIL ******** Создание индексных массивов БД заголовков объектов обучающей выборки FUNCTION GenNtxRsoZag() *aSaveGN10 := DC_DataSave() IF .NOT. FILE("Rso_Zag.dbf") GenDbfOpSc(.F.) ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Roz_kod INDEX ON Name_Obj TO Roz_name INDEX ON Kod_Obj TO Rso_zag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *DC_DataRest( aSaveGN10 ) RETURN NIL ******** Создание индексных массивов БД кодов классов обучающей выборки FUNCTION GenNtxRsoKcl() *aSaveGN11 := DC_DataSave() IF .NOT. FILE("Rso_Kcl.dbf") GenDbfRsoKcl() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kcl EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Roc_kod INDEX ON Kod_Obj TO Rso_Kcl CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *DC_DataRest( aSaveGN11 ) RETURN NIL ******** Создание индексных массивов БД кодов признаков обучающей выборки FUNCTION GenNtxRsoKpr() *aSaveGN12 := DC_DataSave() IF .NOT. FILE("Rso_Kpr.dbf") GenDbfRsoKpr() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kpr EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Rop_kod INDEX ON Kod_Obj TO Rso_Kpr CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *DC_DataRest( aSaveGN12 ) RETURN NIL ******************************************************************************************** ******** 5.6. Выбрать модель и сделать ее текущей ########## ******************************************************************************************** ****** Этот перенос и дорасчет делать только для ТЕКУЩЕЙ модели (по умолчанию: INF1) ****** в режиме задания текущей модели (а отсюда его убрать): ****** 0. Задать текущую стат.модель или модель знаний ****** 2. Выполнить перенос информации из текущей модели в Attributes, Opis_Sc, Gr_OpSc и Classes, Class_Sc, Gr_ClSc ####### ****** - добавить формирование класс.шкал и градаций (если они уже созданы в 2.1) ****** - добавить формирование и перенос Int_Inf (Disp) в Attributes и Gr_ClSc ########## ****** 3. Сделать расчет значимости описательных шкал на основе INF. ****** 4. Сделать расчет значимости классификационных шкал на основе INF. ****** 5. Привести в соответствие файл о текущей модели: DC_ASave(M_CurrInf, "_CurrInf.arx") ******************************************************************************************** FUNCTION F5_6(M_CurrInf, Dialog, Regim) LOCAL GetList[0], lOk Running(.T.) *IF M_CurrInf = 1 ** IF Dialog * LB_Warning(L('База абсолютных частот "ABS" не может быть задана в качестве текущей!')) ** ENDIF * Running(.F.) * RETURN NIL *ENDIF IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF Dialog IF ApplChange("5.6()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF ELSE IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения PUBLIC aSaveMainM := DC_ARestore("_SaveMainM.arx") // Восстановление вычислительной среды (открытые и текущие БД и индексы) с диска DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) Running(.F.) RETURN NIL ENDIF ENDIF IF .NOT. FILE("Abs.txt") // БД абс.частот LB_Warning(L("Проведите рассчет матрицы абсолютных частот Abs в режиме 3.1!")) Running(.F.) RETURN NIL ENDIF IF .NOT. FILE("Prc1.txt") .OR.; // БД процентных распределений .NOT. FILE("Prc2.txt") LB_Warning(L("Проведите рассчет матриц условных и безусловных процентных распределений Prc1 и Prc2 в режиме 3.2 !")) Running(.F.) RETURN NIL ENDIF IF .NOT. FILE("Inf1.txt") .OR.; // БЗ-1 .NOT. FILE("Inf2.txt") .OR.; .NOT. FILE("Inf3.txt") .OR.; .NOT. FILE("Inf4.txt") .OR.; .NOT. FILE("Inf5.txt") .OR.; .NOT. FILE("Inf6.txt") .OR.; .NOT. FILE("Inf7.txt") LB_Warning(L("Если нужно проведите рассчет баз знаний Inf1-Inf7 в режиме 3.3!")) Running(.F.) RETURN NIL ENDIF dbeSetDefault('DBFNTX') ****** Задание на расчет баз знаний IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aCalcInf = DC_ARestore("_CalcInf.arx") ELSE LB_Warning(L("Необходимо выполнить расчет баз знаний в режиме 3.3.!")) Running(.F.) RETURN NIL ENDIF IF Dialog IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF ENDIF IF Dialog ******************************************************************************************* ****** 0. Задать текущую стат.модель или модель знаний ******************************************************************************************* ****** Задание текущей модели @ 0,0 DCGROUP oGroup1 CAPTION L('Задайте текущую стат.модель или модель знаний') SIZE 90,13.5 @14,0 DCGROUP oGroup2 CAPTION L('Как задавать параметры синтеза моделей' ) SIZE 90, 5.0 @ 1,1 DCSAY L('Статистические базы:' ) PARENT oGroup1 @ 2,3 DCRADIO M_CurrInf VALUE 1 PROMPT L('1. ABS - частный критерий: количество встреч сочетаний: "класс-признак" у объектов обуч.выборки') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 1] } HIDE {|| .NOT. aCalcInf[ 1] } @ 3,3 DCRADIO M_CurrInf VALUE 2 PROMPT L('2. PRC1 - частный критерий: усл. вероятность i-го признака среди признаков объектов j-го класса ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 2] } HIDE {|| .NOT. aCalcInf[ 2] } @ 4,3 DCRADIO M_CurrInf VALUE 3 PROMPT L('3. PRC2 - частный критерий: условная вероятность i-го признака у объектов j-го класса ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 3] } HIDE {|| .NOT. aCalcInf[ 3] } @ 5.2,1 DCSAY L('Системно-когнитивные модели (Базы знаний):' ) PARENT oGroup1 @ 6,3 DCRADIO M_CurrInf VALUE 4 PROMPT L('4. INF1 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC1 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 4] } HIDE {|| .NOT. aCalcInf[ 4] } @ 7,3 DCRADIO M_CurrInf VALUE 5 PROMPT L('5. INF2 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC2 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 5] } HIDE {|| .NOT. aCalcInf[ 5] } @ 8,3 DCRADIO M_CurrInf VALUE 6 PROMPT L('6. INF3 - частный критерий: Xи-квадрат, разности между фактическими и ожидаемыми абс.частотами ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 6] } HIDE {|| .NOT. aCalcInf[ 6] } @ 9,3 DCRADIO M_CurrInf VALUE 7 PROMPT L('7. INF4 - частный критерий: ROI (Return On Investment); вероятности из PRC1 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 7] } HIDE {|| .NOT. aCalcInf[ 7] } @10,3 DCRADIO M_CurrInf VALUE 8 PROMPT L('8. INF5 - частный критерий: ROI (Return On Investment); вероятности из PRC2 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 8] } HIDE {|| .NOT. aCalcInf[ 8] } @11,3 DCRADIO M_CurrInf VALUE 9 PROMPT L('9. INF6 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC1 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[ 9] } HIDE {|| .NOT. aCalcInf[ 9] } @12,3 DCRADIO M_CurrInf VALUE 10 PROMPT L('10.INF7 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC2 ') PARENT oGroup1 EDITPROTECT {|| .NOT. aCalcInf[10] } HIDE {|| .NOT. aCalcInf[10] } @1,3 DCSAY L('В качестве текущей можно задать любую из ранее расчитанных в режимах 3.1, 3.2, 3.3 или 3.4 стат. моделей') PARENT oGroup2 @2,3 DCSAY L('и моделей знаний, но до исследования достоверности моделей в режиме 3.5 рекомендуется выбрать в качестве') PARENT oGroup2 @3,3 DCSAY L('текущей базу знаний INF1. Смысл моделей знаний, применяемых в системе "Эйдос-Х++" раскрыт в публикациях,') PARENT oGroup2 @4,3 DCSAY L('размещенных по адресам: http://lc.kubagro.ru/aidos/index.htm, http://www.twirpx.com/file/793311/ ') PARENT oGroup2 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS; MODAL ; TITLE L('5.6. Выбрать модель и сделать ее текущей') ******************************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ******************************************************************** Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } M_Inf = UPPER(Ar_Model[M_CurrInf]) mFlagErr = .F. * IF M_CurrInf = 1 * LB_Warning(L('База абсолютных частот "ABS" не может быть задана в качестве текущей! ')) * mFlagErr = .T. * ENDIF IF 1 <= M_CurrInf .AND. M_CurrInf <= 10 ELSE LB_Warning(L("Необходимо задать одну из моделей в качестве текущей !!! ")) mFlagErr = .T. ENDIF IF mFlagErr ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF *************************************** DC_ASave(aCalcInf , "_CalcInf.arx") // Файл с информацией о том, создание каких моделей было задано DC_ASave(M_CurrInf, "_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей StrFile(STR(M_CurrInf,3), "_CurrInf.txt") // Файл с информацией о том, какая модель задана текущей ******************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_Gcs = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_Csc = RECCOUNT() USE Attributes EXCLUSIVE NEW;N_Atr = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW;N_Osc = RECCOUNT() // Задание максимальной величины параметра Time Wsego = N_Gos+N_Cls+; // 1/7: Копирование в массивы итоговых строк и столбцов текущей модели N_Cls+; // 2/7: Перенос информации из текущей модели в базы классов: Classes и Gr_ClSc N_Gos+; // 3/7: Перенос информации из текущей модели в базы признаков: Attributes и Gr_OpSc N_Osc+N_Csc+; // 4/7: Расчет значимости класс.и опис.шкал - Сброс сумматоров N_Gos+N_Osc+; // 5/7: Расчет значимости класс.и опис.шкал - Накопление данных N_Cls+N_Csc+; N_Osc+N_Csc // 6/7: Расчет значимости класс.и опис.шкал - Дорасчет // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,9.5 ; PARENT oTabPage1 @11,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" // Зарезервировано под название операции @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // 2 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // 3 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 4 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[11] FONT "10.Helv" // 5 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[12] FONT "10.Helv" // 6 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[13] FONT "10.Helv" // 7 s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('5.6. Выбрать модель и сделать ее текущей') ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ENDIF ***************************************************************************************************** mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Gr_ClSc EXCLUSIVE NEW;N_Gcs = RECCOUNT() USE Class_Sc EXCLUSIVE NEW;N_Csc = RECCOUNT() USE Attributes EXCLUSIVE NEW;N_Atr = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW;N_Osc = RECCOUNT() *USE Abs EXCLUSIVE NEW // БД - матрица абсолютных частот (матрица сопряженности) *USE Prc1 EXCLUSIVE NEW // ИБ - матрица условных и безусловных процентных распределений *USE Prc2 EXCLUSIVE NEW // ИБ - матрица условных и безусловных процентных распределений *USE Inf EXCLUSIVE NEW // Текущая модель *USE Inf1 EXCLUSIVE NEW // БЗ-1 - Inf1~Prc1 *USE Inf2 EXCLUSIVE NEW // БЗ-2 - Inf2~Prc2 *USE Inf3 EXCLUSIVE NEW // БЗ-3 - Inf3-хи-квадрат *USE Inf4 EXCLUSIVE NEW // БЗ-4 - Inf4-roi~Prc1 *USE Inf5 EXCLUSIVE NEW // БЗ-5 - Inf5-roi~Prc2 *USE Inf6 EXCLUSIVE NEW // БЗ-6 - Inf6-Dp~Prc1 *USE Inf7 EXCLUSIVE NEW // БЗ-7 - Inf7-Dp~Prc2 * ########################################################################### // Открытие текстовых баз данных ******************************************** *DC_ASave(aInfStruct, "_InfStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_InfStruct.arx") *DC_ASave(aStrEmpty, "_aStrEmpty.arx") // Записывать только после расчета Abs.txt, а при расчете остальных БД только считывать *DC_ASave(aColEmpty, "_aColEmpty.arx") aStrEmpty = DC_ARestore("_aStrEmpty.arx") aColEmpty = DC_ARestore("_aColEmpty.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) IF Regim = "MainMenu" .OR. Regim = "3_5" ****** Создаем стат.базы и базы знаний (7 по частным критериям знаний) PUBLIC Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } M_Inf = UPPER(Ar_Model[M_CurrInf]) PUBLIC nHandle[LEN(Ar_Model)] nHandle[ 1] := FOpen( Ar_Model[ 1]+".txt", FO_READWRITE ) // Открыть БД Abs.txt IF M_CurrInf > 1 nHandle[M_CurrInf] := FOpen( Ar_Model[M_CurrInf]+".txt", FO_READWRITE ) // Открыть БД, выбранную в качестве текущей ###### ENDIF ENDIF **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### IF Dialog // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() ENDIF IF Dialog Mess = L('ОПЕРАЦИЯ: ПРИСВОЕНИЕ МОДЕЛИ "#" СТАТУСА ТЕКУЩЕЙ МОДЕЛИ:') Mess = STRTRAN(Mess, "#", M_Inf ) aSay[ 6]:SetCaption(Mess) ENDIF ******************************************************************************************* ****** 1. Скопировать Abs, Prc# или INF#. ******************************************************************************************* IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 7]:SetCaption(L('1/7: Копирование в массивы итоговых строк и столбцов текущей модели')) ENDIF // Итоговые строки и столбцы PRIVATE Ar_Summ_i[N_Gos], Ar_Summ_j[N_Cls+5] // 1-коды, 2-наименования, N_Cls+3-Summ, N_Cls+4-Sred, N_Cls+5-Disp PRIVATE Ar_Sred_i[N_Gos], Ar_Sred_j[N_Cls+5] PRIVATE Ar_Disp_i[N_Gos], Ar_Disp_j[N_Cls+5] AFILL(Ar_Summ_i, 0) AFILL(Ar_Summ_j, 0) AFILL(Ar_Sred_i, 0) AFILL(Ar_Sred_j, 0) AFILL(Ar_Disp_i, 0) AFILL(Ar_Disp_j, 0) FOR i=1 TO N_Gos Ar_Summ_i[i] = VAL(LC_FieldGet( Ar_Model[ 1]+".txt", nHandle[ 1], i, 3+N_Cls )) * Ar_Sred_i[i] = VAL(LC_FieldGet( Ar_Model[M_CurrInf]+".txt", nHandle[M_CurrInf], i, 4+N_Cls )) Ar_Disp_i[i] = VAL(LC_FieldGet( Ar_Model[M_CurrInf]+".txt", nHandle[M_CurrInf], i, 5+N_Cls )) IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF NEXT FOR j=1 TO N_Cls Ar_Summ_j[j] = VAL(LC_FieldGet( Ar_Model[ 1]+".txt", nHandle[ 1], 1+N_Gos, 2+j )) * Ar_Sred_j[j] = VAL(LC_FieldGet( Ar_Model[M_CurrInf]+".txt", nHandle[M_CurrInf], 2+N_Gos, 2+j )) Ar_Disp_j[j] = VAL(LC_FieldGet( Ar_Model[M_CurrInf]+".txt", nHandle[M_CurrInf], 3+N_Gos, 2+j )) * MsgBox(STR(j)+STR(Ar_Summ_j[j])+STR(Ar_Sred_j[j])+STR(Ar_Disp_j[j])) IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF NEXT IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 7]:SetCaption(aSay[ 7]:caption+L(" - Готово")) ENDIF ******************************************************************************************** ****** 2. Выполнить перенос информации из INF# в Classes, Gr_OpSc. ******************************************************************************************** IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 8]:SetCaption(L("2/7: Перенос информации из текущей модели в базы классов: Classes и Gr_ClSc")) ENDIF ****** Перенос в БД классов FOR j = 1 TO N_Cls SELECT Classes;DBGOTO(j) REPLACE Int_inf WITH Ar_Disp_j[j] // Степень редукции j-го класса REPLACE Abs WITH Ar_Summ_j[j] // Кол-во признаков j-го класса SELECT Gr_ClSc;DBGOTO(j) REPLACE Int_inf WITH Ar_Disp_j[j] // Степень редукции j-го класса REPLACE Abs WITH Ar_Summ_j[j] // Кол-во признаков j-го класса IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF NEXT IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово")) ENDIF ***** Перенос Инт.инф. в БД признаков (градаций описательных шкал) IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 9]:SetCaption(L("3/7: Перенос информации из текущей модели в базы признаков: Attributes и Gr_OpSc")) ENDIF FOR i = 1 TO N_Gos SELECT Attributes;DBGOTO(i) REPLACE Int_inf WITH Ar_Disp_i[i] // Значимость признака (градации описательной шкалы) ######################################### REPLACE Abs WITH Ar_Summ_i[i] // Кол-во i-х признаков в выборке SELECT Gr_OpSc;DBGOTO(i) REPLACE Int_inf WITH Ar_Disp_i[i] // Значимость признака (градации описательной шкалы) REPLACE Abs WITH Ar_Summ_i[i] // Кол-во i-х признаков в выборке IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF NEXT IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово")) ENDIF ******************************************************************************************* ****** 3. Сделать расчет значимости классификационных и описательных шкал на основе INF# ******************************************************************************************** ****** Расчет значимости описательных шкал: ****** 1. Значимость шкалы равна СРЕДНЕЙ значимости ее градаций (признаков) ****** 2. Значимость шкалы равна СУММАРНОЙ значимости ее градаций (признаков) ****** Подготовка данных для расчета значимости классификационных и описательных шкал ****** Сброс сумматоров IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[10]:SetCaption(L("4/7: Расчет значимости описательных шкал - Сброс сумматоров")) ENDIF SELECT Opis_Sc DBGOTOP() DO WHILE .NOT.EOF() REPLACE Sum_ZnGr WITH 0 REPLACE N_GrOpSc WITH 0 IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO ****** Сброс сумматоров IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[10]:SetCaption(L("4/7: Расчет значимости классификационных шкал - Сброс сумматоров")) ENDIF SELECT Class_Sc DBGOTOP() DO WHILE .NOT.EOF() REPLACE Sum_ZnGr WITH 0 REPLACE N_GrClSc WITH 0 IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[10]:SetCaption(L("4/7: Расчет значимости класс.и опис.шкал-Сброс сумматоров - Готово")) ENDIF ****** Накопление исходных данных для расчета значимости описательных шкал IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[11]:SetCaption(L("5/7: Расчет значимости описательных шкал - Накопление данных")) ENDIF SELECT Gr_OpSc DBGOTOP() DO WHILE .NOT.EOF() M_Recno = RECNO() M_KodOpSc = Kod_OpSc M_ZnGrOpS = Int_inf SELECT Opis_Sc DBGOTO(M_KodOpSc) M_SumZnGr = Sum_ZnGr M_NGrOpSc = N_GrOpSc REPLACE Sum_ZnGr WITH M_SumZnGr + M_ZnGrOpS REPLACE N_GrOpSc WITH M_NGrOpSc + 1 SELECT Gr_OpSc DBGOTO(M_Recno) IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO SELECT Opis_Sc mKodGrOS = 1 DBGOTOP() DO WHILE .NOT.EOF() REPLACE KodGr_Min WITH mKodGrOS mKodGrOS = mKodGrOS + N_GrOpSc - 1 REPLACE KodGr_Max WITH mKodGrOS++ IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO ****** Накопление исходных данных для расчета значимости классификационных шкал IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[11]:SetCaption(L("5/7: Расчет значимости классификационных шкал - Накопление данных")) ENDIF SELECT Gr_ClSc DBGOTOP() DO WHILE .NOT.EOF() M_Recno = RECNO() M_KodClSc = Kod_ClSc M_ZnGrClS = Int_inf SELECT Class_Sc DBGOTO(M_KodClSc) M_SumZnGr = Sum_ZnGr M_NGrClSc = N_GrClSc REPLACE Sum_ZnGr WITH M_SumZnGr + M_ZnGrClS REPLACE N_GrClSc WITH M_NGrClSc + 1 SELECT Gr_ClSc DBGOTO(M_Recno) IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO SELECT Class_Sc mKodGrCS = 1 DBGOTOP() DO WHILE .NOT.EOF() REPLACE KodGr_Min WITH mKodGrCS mKodGrCS = mKodGrCS + N_GrClSc - 1 REPLACE KodGr_Max WITH mKodGrCS++ IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[11]:SetCaption(L("5/7: Расчет значимости класс.и опис.шкал-Накопление данных - Готово")) ENDIF ****** Расчет значимости описательных шкал IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[12]:SetCaption(L("6/7: Расчет значимости описательных шкал - Дорасчет")) ENDIF SELECT Opis_Sc DBGOTOP() DO WHILE .NOT.EOF() REPLACE Int_inf WITH Sum_ZnGr / N_GrOpSc IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO ****** Расчет значимости классификационных шкал IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[12]:SetCaption(L("6/7: Расчет значимости классификационных шкал - Дорасчет")) ENDIF SELECT Class_Sc DBGOTOP() DO WHILE .NOT.EOF() REPLACE Int_inf WITH Sum_ZnGr / N_GrClSc IF Regim<>"3_3";IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF;ENDIF DBSKIP(1) ENDDO IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[12]:SetCaption(L("6/7: Расчет значимости класс.и опис.шкал-Дорасчет - Готово")) ENDIF ******************************************************************************************* ****** 4. Привести в соответствие файл о текущей модели: DC_ASave(M_CurrInf, "_CurrInf.arx") ******************************************************************************************** IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[13]:SetCaption(L("7/7: Запись информации о текущей модели")) ENDIF DC_ASave(M_CurrInf, "_CurrInf.arx") IF Regim = "3_3" .OR. Regim = "3_5" ELSE aSay[13]:SetCaption(aSay[13]:caption+L(" - Готово")) ENDIF IF 1 <= M_CurrInf .AND. M_CurrInf <= 10 ELSE LB_Warning(L("Необходимо задать одну из моделей в качестве текущей !!! ")) Running(.F.) RETURN NIL ENDIF IF Dialog IF M_CurrInf <= 3 Mess = L('Выбор стат.модели "#" в качестве текущей прошел успешно!!!') ELSE Mess = L('Выбор модели знаний "#" в качестве текущей прошел успешно!!!') ENDIF Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы Mess = STRTRAN(Mess,"#", UPPER(M_Inf)) oSay97:SetCaption(Mess) oSay97:SetCaption(oSay97:Caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF Regim = "MainMenu" .OR. Regim = "3_5" FClose( nHandle[ 1] ) // Закрытие текущей базы данных ############################## FClose( nHandle[M_CurrInf] ) // Закрытие текущей базы данных ############################## ENDIF ********* Прописывает для числовых шкал в БД Classes и Attributes минимальное, максимальное и среднее значение всех градаций MinMaxAvr() IF Regim = "MainMenu" ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** ENDIF Running(.F.) RETURN NIL *********************************************************************************************************** ******** 4.5. Визуализация когнитивных функций *********************************************************************************************************** FUNCTION F4_5() LOCAL GetList[0], lOk Running(.T.) IF ApplChange("4.5()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF ConvTXTtoDBF() // Преобразование Abs, Prc#, Inf# из TXT в DBF IF FILEDATE("Cogn_fun",16) = CTOD("//") DIRMAKE("Cogn_fun") aMess := {} AADD(aMess, L('В папке текущего приложения: "')+ALLTRIM(M_PathAppl)+'"') AADD(aMess, L('не было директории "Cogn_fun" для когнитивных функций и она была создана!')) LB_Warning(aMess, L('4.5. Визуализация когнитивных функций системы "Эйдос-Х++"' )) ENDIF DIRCHANGE(Disk_dir) // Перейти в папку системы CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций @ 0.0,0 DCGROUP oGroup1 CAPTION L('Что такое когнитивная функция:') SIZE 94,22.0 @ 22.5,0 DCGROUP oGroup2 CAPTION L('Задайте нужный режим:' ) SIZE 94, 4.2 s=1 @s,1 DCSAY L('Визуализация прямых, обратных, позитивных, негативных, полностью и частично редуцированных когнитивных функций ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('Когнитивная функция представляет собой графическое отображение силы и направления влияния различных значений ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('некоторого фактора на переходы объекта управления в будущие состояния, соответствующие классам. Когнитивные ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('функции представляют собой новый перспективный инструмент отражения и наглядной визуализации закономерностей ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('и эмпирических законов. Разработка содержательной научной интерпретации когнитивных функций представляет собой ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('способ познания природы, общества и человека. Когнитивные функции могут быть: прямые, отражающие зависимость ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('классов от признаков, обобщающие информационные портреты признаков; обратные, отражающие зависимость признаков ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('от классов, обобщающие информационные портреты классов; позитивные, показывающие чему способствуют система ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('детерминации; негативные, отражающие чему препятствуют система детерминации; средневзвешенные, отражающие ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('совокупное влияние всех значений факторов на поведение объекта (причем в качестве весов наблюдений используется') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('количество информации в значении аргумента о значениях функции) различной степенью редукции или степенью ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('детерминации, которая отражает в графической форме (в форме полосы) количество знаний в аргументе о значении ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('функции и является аналогом и обобщением доверительного интервала. Если отобразить подматрицу матрицы знания, ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('отображая цветом силу и направление влияния каждой градации некоторой описательной шкалы на переход объекта в ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('состояния, соответствующие классам некоторой классификационной шкалы, то получим нередуцированную когнитивную ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('функцию. Когнитивные функции являются наиболее развитым средством изучения причинно-следственных зависимостей ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('в моделируемой предметной области, предоставляемым системой "Эйдос". Необходимо отметить, что на вид функций ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('влияния математической моделью АСК-анализа не накладывается никаких ограничений, в частности, они могут быть ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('и не дифференцируемые. ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L(' ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('Луценко Е.В. Метод визуализации когнитивных функций - новый инструмент исследования эмпирических данных большой') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('размерности / Е.В. Луценко, А.П. Трунев, Д.К. Бандык // Политематический сетевой электронный научный журнал ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('Кубанского государственного аграрного университета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('КубГАУ, 2011. - №03(67). С. 240 - 282. - Шифр Информрегистра: 0421100012\0077. , 2,688 у.п.л. - Режим доступа: ') PARENT oGroup1;s=s+0.8 @s,1 DCSAY L('http://ej.kubagro.ru/2011/03/pdf/18.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2011/03/pdf/18.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} // .T. - внешняя программа запускается, а главная исполняется дальше, .F. - главная ждет окончания внешней программы @1.0, 1 DCPUSHBUTTON CAPTION L('Визуализации когнитивных функций' ) SIZE 43, 1.1 PARENT oGroup2 ACTION {||LC_RunShell("_4_5.exe",104905919)} FONT "10.HelvBold" @2.5, 1 DCPUSHBUTTON CAPTION L('Литератур.ссылки на работы по когнитивным функциям' ) SIZE 43, 1.1 PARENT oGroup2 ACTION {||Publ_CognFun()} @1.0, 48 DCPUSHBUTTON CAPTION L('Литератур.ссылки на работы по когнитивным функциям' ) SIZE 44, 1.1 PARENT oGroup2 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/Works_on_cognitive_functions.htm")} @2.5, 48 DCPUSHBUTTON CAPTION L('Литератур.ссылки на работы по управлению знаниями' ) SIZE 44, 1.1 PARENT oGroup2 ACTION {||DC_SpawnUrl("http://lc.kubagro.ru/aidos/Works_on_identification_presentation_and_use_of_knowledge.htm")} DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE L('4.5. Визуализация когнитивных функций') ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************************************************************** FUNCTION Publ_CognFun() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions * DCSETFONT TO '10.Arial' s=0;d=0.8 @s,1 DCSAY L('Луценко Е.В. АСК-анализ как метод выявления когнитивных функциональных зависимостей в многомерных зашумленных фрагментированных данных ') SAYSIZE 0;s=s+d @s,1 DCSAY L('/ Е.В. Луценко // Политематический сетевой электронный научный журнал Кубанского государственного аграрного университета (Научный журнал ') SAYSIZE 0;s=s+d @s,1 DCSAY L('КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2005. - №03(11). С. 181 - 199. 1,188 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2005/03/pdf/19.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2005/03/pdf/19.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Системно-когнитивный анализ функций и восстановление их значений по признакам аргумента на основе априорной информации (интел- ') SAYSIZE 0;s=s+d @s,1 DCSAY L('лектуальные технологии интерполяции, экстраполяции, прогнозирования и принятия решений по картографическим базам данных) / Е.В. Луценко // ') SAYSIZE 0;s=s+d @s,1 DCSAY L('Политематический сетевой электронный научный журнал Кубанского государственного аграрного университета (Научный журнал КубГАУ) [Электронный ') SAYSIZE 0;s=s+d @s,1 DCSAY L('ресурс]. - Краснодар: КубГАУ, 2009. - №07(51). С. 130 - 154. - Шифр Информрегистра: 0420900012\0066. 1,562 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2009/07/pdf/06.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2009/07/pdf/06.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Управление агропромышленным холдингом на основе когнитивных функций связи результатов работы холдинга и характеристик его пред- ') SAYSIZE 0;s=s+d @s,1 DCSAY L('приятий / Е.В. Луценко, В.И. Лойко, О.А. Макаревич // Политематический сетевой электронный научный журнал Кубанского государственного аграр-') SAYSIZE 0;s=s+d @s,1 DCSAY L('ного университета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2009. - №10(54). С.248 - 260. - Шифр Информрегистра: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('0420900012\0111. 0,812 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2009/10/pdf/15.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2009/10/pdf/15.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Когнитивные функции как адекватный инструмент для формального представления причинно-следственных зависимостей / Е.В. Луценко ') SAYSIZE 0;s=s+d @s,1 DCSAY L('// Политематический сетевой электронный научный журнал Кубанского государственного аграрного университета (Научный журнал КубГАУ) [Электрон- ') SAYSIZE 0;s=s+d @s,1 DCSAY L('ный ресурс]. - Краснодар: КубГАУ, 2010. - №09(63). С.1 - 23. - Шифр Информрегистра: 0421000012\0233. 1,438 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2010/09/pdf/01.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2010/09/pdf/01.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Трунев А.П. Автоматизированный системно-когнитивный анализ влияния тел Солнечной системы на движение полюса Земли и визуализация причинно- ') SAYSIZE 0;s=s+d @s,1 DCSAY L('следственных зависимостей в виде когнитивных функций / А.П. Трунев, Е.В. Луценко, Д.К. Бандык // Политематический сетевой электронный ') SAYSIZE 0;s=s+d @s,1 DCSAY L('научный журнал Кубанского государственного аграрного университета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2011. ') SAYSIZE 0;s=s+d @s,1 DCSAY L('- №01(65). С. 232 - 258. - Шифр Информрегистра: 0421100012\0002. 1,688 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2011/01/pdf/20.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2011/01/pdf/20.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Метод визуализации когнитивных функций - новый инструмент исследования эмпирических данных большой размерности / Е.В. Луценко, ') SAYSIZE 0;s=s+d @s,1 DCSAY L('А.П. Трунев, Д.К. Бандык // Политематический сетевой электронный научный журнал Кубанского государственного аграрного университета (Научный ') SAYSIZE 0;s=s+d @s,1 DCSAY L('журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2011. - №03(67). С.240 - 282. - Шифр Информрегистра: 0421100012\0077. 2,688 у.п.л. ') SAYSIZE 0;s=s+d @s,1 DCSAY L('- Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2011/03/pdf/18.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2011/03/pdf/18.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Развитие интеллектуальной системы "Эйдос-астра", снимающее ограничения на размерность баз знаний и разрешение когнитивных функций ') SAYSIZE 0;s=s+d @s,1 DCSAY L('/ Е.В. Луценко, А.П. Трунев, Е.А. Трунев // Политематический сетевой электронный научный журнал Кубанского государственного аграрного универси-') SAYSIZE 0;s=s+d @s,1 DCSAY L('тета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2011. - №05(69). С. 353 - 377. - Шифр Информрегистра: 0421100012\0159. ') SAYSIZE 0;s=s+d @s,1 DCSAY L('1,562 у.п.л. - Режим доступа: ') SAYSIZE 0 @s,1 DCSAY L('http://ej.kubagro.ru/2011/05/pdf/31.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2011/05/pdf/31.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Применение СК-анализа и системы "Эйдос" для синтеза когнитивной матричной передаточной функции сложного объекта управления на основе') SAYSIZE 0;s=s+d @s,1 DCSAY L('эмпирических данных / Е.В. Луценко, В.Е. Коржаков // Политематический сетевой электронный научный журнал Кубанского государственного аграрного ') SAYSIZE 0;s=s+d @s,1 DCSAY L('университета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2012. - №01(75). С. 681 - 714. 2,125 у.п.л. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2012/01/pdf/53.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2012/01/pdf/53.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Луценко Е.В. Когнитивные функции как обобщение классического понятия функциональной зависимости на основе теории информации в системной нечеткой ') SAYSIZE 0;s=s+d @s,1 DCSAY L('интервальной математике / Е.В. Луценко, А.И. Орлов // Политематический сетевой элек-тронный научный журнал Кубанского государственного аграрного') SAYSIZE 0;s=s+d @s,1 DCSAY L('университета (Научный журнал КубГАУ) [Электронный ресурс].-Краснодар:КубГАУ,2014.-№01(095).С.122-183.-IDA[article ID]:0951401007. -Режим доступа:') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://ej.kubagro.ru/2014/01/pdf/07.pdf') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://ej.kubagro.ru/2014/01/pdf/07.pdf', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d ++s @s,1 DCSAY L('Орлов А.И., Луценко Е.В. Системная нечеткая интервальная математика. Монография (научное издание). - Краснодар, КубГАУ. 2014. - 600 с. ') SAYSIZE 0;s=s+d @s,1 DCSAY L('ISBN 978-5-94672-757-0. - Режим доступа: ') SAYSIZE 0;s=s+d @s,1 DCSAY L('http://lc.kubagro.ru/aidos/aidos14_OL/index.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/aidos14_OL/index.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} SAYSIZE 0;s=s+d DCREAD GUI FIT MODAL TITLE L('Подборка публикаций по когнитивным функциям') RETURN NIL *********************************************************************************************************************************************************** *********************************************************************************************************** ******** 1.7. Задание размера главного окна в пикселях *********************************************************************************************************** FUNCTION F1_7() Running(.T.) IF .NOT. Flag_SysAdmin LB_Warning(L("Эта функция доступна только сисадмину!")) Running(.F.) RETURN NIL ENDIF ** Если ранее параметры главного окна не были заданы - то задать 1024 х 769, ** если были - то использовать те, которые были заданы IF FILE("_MainWind.arx") Ar_MainWind = DC_ARestore("_MainWind.arx") W_MainWind = Ar_MainWind[1] H_MainWind = Ar_MainWind[2] ELSE Ar_MainWind[1] = 1024 Ar_MainWind[2] = 769 W_MainWind = Ar_MainWind[1] H_MainWind = Ar_MainWind[2] DC_ASave(Ar_MainWind, "_MainWind.arx") ENDIF @0,0 DCSAY L("Ширина главного окна системы в пикселях:");@0,33 DCSAY GET W_MainWind @1,0 DCSAY L("Высота главного окна системы в пикселях:");@1,33 DCSAY GET H_MainWind * 0123456789012345678901234567890123456789 * 10 20 30 DCREAD GUI FIT ADDBUTTONS TITLE L('1.7. Задание размера главного окна') // Проверка корректности заданных параметров IF 640 <= W_MainWind .AND. W_MainWind <= 1900 ELSE W_MainWind = 1024 ENDIF IF 480 <= H_MainWind .AND. H_MainWind <= 1024 ELSE H_MainWind = 769 ENDIF Ar_MainWind[1] = W_MainWind Ar_MainWind[2] = H_MainWind DC_ASave(Ar_MainWind, "_MainWind.arx") Running(.F.) RETURN NIL *********************************************************************************************************** ******** Создание баз результатов распознавания для расчетов *********************************************************************************************************** FUNCTION GenDbfRspC() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; * { "Kod_cls" , "N", 15, 0 }, ; * { "Korr" , "N", 19, 7 }, ; * { "Sum_inf" , "N", 19, 7 }, ; * { "Fakt" , "C", 1, 0 }, ; * { "Date" , "C", 10, 0 }, ; * { "Time" , "C", 8, 0 } } aStructure := { { "Kod_Obj" , "N", 9, 0 }, ; { "Kod_cls" , "N", 9, 0 }, ; { "Korr" , "N", 15, 7 }, ; // 123456789012 { "Sum_inf" , "N", 15, 7 }, ; // -999.1234567 { "Fakt" , "C", 1, 0 } } DbCreate( "Rasp.dbf", aStructure ) *GenNtxRasp() DC_DataRest( aSaveGenDbf ) RETURN NIL ************************************************************************************************************ ******** 4.1.2. Пакетное распознавание в текущей базе знаний ############## ******* Распознаются по очереди все объекты распознаваемой выборки в базе знаний, ############## ******* заданной текущей в режиме 5.6 ############## ******* Почему-то ОЧЕНЬ медленно, на много медленнее, чем при запуске из 3.5. Может быть из-за прогресс-бар? ************************************************************************************************************ // В режиме распознавания сделать формирование БД итогов: Rsp_it1k, Rsp_it2k, Rsp_it1i, Rsp_it2i, // достоверность в итогах считать по-другому: ср.кв.откл. уровней сходства деленное на теор.максимальное ср.кв.откл. в % // После расчета записать БД Rsp_it2k, Rsp_it2i с именами: Rsp_it2k_###, Rsp_it2i_###, где ### - наименование модели FUNCTION F4_1_2(mNumModel, Dialog, Regim, mProcessor) LOCAL lOk, lCancelled := .F. Running(.T.) *MsgBox(mProcessor) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("4.1.2()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF mFlagErr = .F. // Проверка существования распознаваемой выборки и исходных баз знаний IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aCalcInf = DC_ARestore("_CalcInf.arx") ELSE LB_Warning(L("Распознавание не может быть проведено, т.к. не просчитаны модели в 3-й подсистеме !!! ", '4.1.2. Пакетное распознавание' )) mFlagErr = .T. ENDIF * FOR j=1 TO LEN(aCalcInf) * IF aCalcInf[j] * MsgBox(STR(j)) * ENDIF * NEXT IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE LB_Warning(L("Распознавание не может быть проведено, т.к. нет информации о том, какая модель знаний является текущей !!! ")) mFlagErr = .T. ENDIF IF 1 <= mNumModel .AND. mNumModel <= 10 Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } IF aCalcInf[mNumModel] M_CurrInf = mNumModel ELSE Mess = L('Распознавание не может быть проведено, т.к. заданная модель: "#" не просчитана в 3-й подсистеме !!! ') Mess = STRTRAN(Mess, "#", Ar_Model[mNumModel]+".txt" ) LB_Warning(Mess, L('4.1.2. Пакетное распознавание' )) mFlagErr = .T. ENDIF ELSE mNumModel = M_CurrInf // Если модель задана некорректно - использовать текущую ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag INDEX Roz_kod EXCLUSIVE NEW;N_Obj = RECCOUNT() IF N_Obj = 0 aMess := {} AADD(amess, L("Распознавание не может быть проведено, т.к. распознаваемая выборка пуста !!! ")) AADD(amess, L("Заполнить ее можно в программных интерфейсах (API) в подсистеме 2.3.2 и режиме 4.1.1.")) AADD(amess, L("Также в режимах 3.2, 3.3. и 3.5 в распознаваемую выборку копируется обучающая выборка.")) LB_Warning(aMess) mFlagErr = .T. ENDIF IF .NOT. aCalcInf[M_CurrInf] LB_Warning(L("Распознавание не может быть проведено, т.к. не создана база знаний, заданная как текущая !!! ")) mFlagErr = .T. ENDIF IF mFlagErr ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF IF Dialog IF FILE("_RaspInf.arx") // Файл с информацией о том, в какой модели было проведено распознавание M_RaspInf = DC_ARestore("_RaspInf.arx") Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } IF M_CurrInf <> M_RaspInf Mess = L("Распознавание проводилось ранее в модели: #, отличающейся от текущей: $") Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) Mess = STRTRAN(Mess, "$", Ar_Model[M_CurrInf]) LB_Warning(Mess, L("Информационное сообщение")) ELSE Mess = L("В этой модели # распознавание уже проводилось ранее") Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) LB_Warning(Mess, L("Информационное сообщение")) ENDIF ELSE LB_Warning(L("Распознавание проводится впервые !!!"), L("Информационное сообщение")) ENDIF ENDIF IF FILE("Rso_Zag.dbf") // БД заголовков распознаваемой выборки ** Переиндексировать БД Rso_Zag.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roz_kod.ntx" ) .OR.; .NOT. FILE("Roz_name.ntx") .OR.; .NOT. FILE("Rso_Zag.ntx" ) GenNtxRsoZag() ENDIF ELSE GenDbfRsoZag() ENDIF IF FILE("Rso_Kcl.dbf") // БД классов распознаваемой выборки ** Переиндексировать БД Rso_Kcl.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Roc_kod.ntx") .OR.; .NOT. FILE("Rso_Kcl.ntx") GenNtxRsoKcl() ENDIF ELSE GenDbfRsoKcl() ENDIF IF FILE("Rso_Kpr.dbf") // БД признаков распознаваемой выборки ** Переиндексировать БД Rso_Kpr.dbf, ** если не хватает хотя бы одного какого-нибудь индексного массива IF .NOT. FILE("Oip_kod.ntx") .OR.; .NOT. FILE("Rso_Kpr.ntx") GenNtxRsoKpr() ENDIF ELSE GenDbfRsoKpr() ENDIF nRadioP = IF(mProcessor='CPU', 1, 2) * nRadioP = 2 IF Dialog @0,0 DCGROUP oGroup1 CAPTION L('На каком процессоре выполнять распознавание:') SIZE 57, 3.7 @1.0, 2 DCRADIO nRadioP VALUE 1 PROMPT L('На центральном процессоре (CPU)') PARENT oGroup1 @2.0, 2 DCRADIO nRadioP VALUE 2 PROMPT L('На графическом процессоре (GPU)') PARENT oGroup1 DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS; MODAL ; TITLE L('4.1.2. Пакетное распознавание в текущей модели') mProcessor = IF(nRadioP=1,'CPU','GPU') ***************************************************************** IF lExit ** Button Ok ELSE ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ***************************************************************** ENDIF dbeSetDefault('DBFNTX') // Создать базы результатов распознавания для расчетов и визуализации, а также итогов распознавания GenDbfRspC() // Для расчетов GenDbfRspV(mNumModel) // Для визуализации GenDbfRspIt() // Для итогов IF Regim = '3_5' .OR. Regim = '3_3' .OR. Regim = '4_1_2' // ЭТО ДЕЛАТЬ ТОЛЬКО ЕСЛИ ПРОВОДИТСЯ ПАКЕТНОЕ РАСПОЗНАВАНИЕ ВО ВСЕХ МОДЕЛЯХ (может быть еще в режиме 3.3.). ***** Создание БД для исследования зависимости ***** количества совпадений результатов распознавания с фактом ***** для различных по величине параметров сходства ПО ОБОИМ ИНТЕГРАЛЬНЫМ КРИТЕРИЯМ ***** Это аргументированный ответ на вопрос о том, отражает ли уровень сходства ***** распознаваемых объектов с классами фактическую принадлежность этих объектов к классам, ***** т.е. можно ли рассматривать уровень сходства объектов с классами как работоспособный ***** количественный критерий дейсвительно отражающий степень принадлежности объектов к классам ***** и самооценку системы по достоверности распознавания объекта, т.е. степени надежности решения об отнесении его к классу aModName := {L('1. ABS -частн.крит.: кол-во встреч сочетаний: "класс-признак" у объектов обуч.выборки '),; L('2. PRC1-частн.крит.: усл. вероятность i-го признака среди признаков объектов j-го класса'),; L('3. PRC2-частн.крит.: усл. вероятность i-го признака у объектов j-го класса '),; L('4. INF1-частн.крит.: кол-во знаний по А.Харкевичу; вероятности из PRC1 '),; L('5. INF2-частн.крит.: кол-во знаний по А.Харкевичу; вероятности из PRC2 '),; L('6. INF3-частн.крит.: Xи-квадрат, разности между фактическими и ожидаемыми абс.частотами '),; L('7. INF4-частн.крит.: ROI (Return On Investment); вероятности из PRC1 '),; L('8. INF5-частн.крит.: ROI (Return On Investment); вероятности из PRC2 '),; L('9. INF6-частн.крит.: разн.усл.и безусл.вероятностей; вероятности из PRC1 '),; L('10.INF7-частн.крит.: разн.усл.и безусл.вероятностей; вероятности из PRC2 ') } mMaxLen = -9999 FOR j=1 TO LEN(aModName) mMaxLen = MAX(mMaxLen, LEN(ALLTRIM(aModName[j]))) NEXT aStructure := { { "Name" , "C",mMaxLen, 0} } // 1 FOR j=1 TO 201 FieldName = "N"+ALLTRIM(STR(j,15)) AADD(aStructure, { FieldName , "N", 15, 0 }) NEXT DbCreate( "DostRasp.dbf", aStructure ) // БД для объединения БД достоверности расп.в текущей модели M_DostRsp := "DostRsp"+ALLTRIM(STR(M_CurrInf,3)) // Имя текущей БД достоверности распознавания в текущей модели DbCreate( M_DostRsp, aStructure ) A_ursx := {} // Массив уровней сходства в диапазоне: {-100%, 0, +100%} всего с нулем 201 элемент // для поиска позиции для суммирования *************** МАССИВЫ для разных инт.критериев: *************** - ИСТИННО-ПОЛОЖИТЕЛЬНЫЕ ########## A_TPk := {} A_TPi := {} *************** - ИСТИННО-ОТРИЦАТЕЛЬНЫЕ ########## A_TNk := {} A_TNi := {} *************** - ЛОЖНО-ПОЛОЖИТЕЛЬНЫЕ ########## A_FPk := {} A_FPi := {} *************** - ЛОЖНО-ОТРИЦАТЕЛЬНЫЕ ########## A_FNk := {} A_FNi := {} *************** ИХ ВСЕ ПОКАЗЫВАТЬ ОТДЕЛЬНО FOR j=-100 TO +100 AADD(A_ursx , j) AADD(A_TPk, 0) AADD(A_TNk, 0) AADD(A_FPk, 0) AADD(A_FNk, 0) AADD(A_TPi, 0) AADD(A_TNi, 0) AADD(A_FPi, 0) AADD(A_FNi, 0) NEXT ENDIF ***** Переиндексация CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Roz_kod CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kcl EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Roc_kod CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Kpr EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19) TO Rop_kod ******** Создаем стат.базы и базы знаний (7 по частным критериям знаний) Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } PRIVATE nHandle[LEN(Ar_Model)] AFILL(nHandle, 0) mModelName = Ar_Model[M_CurrInf]+".txt" IF .NOT. FILE(mModelName) // БД заголовков распознаваемой выборки aMess := {} AADD(aMess, L('Распознавание не может быть проведено,')) AADD(aMess, L('т.к. отсутствует текущая база знаний: "#"!')) AADD(aMess, L('Создайте ее в 3-й подсистеме! ')) aMess[1] = STRTRAN(aMess[1], "#", mModelName) LB_Warning(aMess, L('4.1.2. Пакетное распознавание')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF // Провести пакетное распознавание mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // Количество классов (градаций классификационных шкал) USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() // Количество признаков (градаций описательных шкал) USE Opis_Sc EXCLUSIVE NEW USE Rso_Zag INDEX Roz_kod EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Rso_Kcl INDEX Roc_kod EXCLUSIVE NEW USE Rso_Kpr INDEX Rop_kod EXCLUSIVE NEW USE Rasp EXCLUSIVE NEW;ZAP;N_Rasp = N_Obj * N_Cls IF Regim = '3_5' .OR. Regim = '3_3' .OR. Regim = '4_1_2' // ЭТО ДЕЛАТЬ ТОЛЬКО ЕСЛИ ПРОВОДИТСЯ ПАКЕТНОЕ РАСПОЗНАВАНИЕ ВО ВСЕХ МОДЕЛЯХ (может быть еще в режиме 3.3.). USE (M_DostRsp) EXCLUSIVE NEW;ZAP ENDIF * USE Inf EXCLUSIVE NEW // Распознавание вести в текущей модели ################################################################ * ########################################################################### // Открытие текстовых баз данных ******************************************** *DC_ASave(aInfStruct, "_InfStruct.arx") // Когда БД создается - записывать структуру, когда открывается - считывать aInfStruct = DC_ARestore("_InfStruct.arx") ************************************************* ***** Формирование пустой записи N_Col = N_Cls+5 // Число полей CrLf = CHR(13)+CHR(10) // Конец строки (записи) Lc_buf = "" FOR j=1 TO N_Col * S = IF(j=2*INT(j/2),"#","X") // Для отладки S = " " // Для работы Lc_buf = Lc_buf + REPLICATE(S, aInfStruct[j,3]) NEXT Lc_buf = Lc_buf + CrLf Len_LcBuf = LEN(Lc_buf) nHandle[M_CurrInf] := FOpen( Ar_Model[M_CurrInf]+".txt", FO_READWRITE ) // Открыть текущую базу знаний ################################### **** Рассчет массива начальных позиций полей в строке PRIVATE aPos[N_Col] aPos[1] = 1 FOR j=2 TO N_Col aPos[j] = aPos[j-1] + aInfStruct[j-1,3] NEXT * ########################################################################### PRIVATE Ar_Lok[N_Gos] // Создание массива-локатора ****** Создание массива: значение элемента с индексом-кодом класса является код класс.шкалы SELECT Classes PRIVATE aKodClSc[N_Cls] DBGOTOP() DO WHILE .NOT. EOF() aKodClSc[Kod_cls] = Kod_ClSc DBSKIP(1) ENDDO ********************************************************************************* IF Dialog // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego // Задание максимальной величины параметра Time Что-здесь не так, время рассчитывается ошибочно ############################################## Wsego8 = N_Obj // По шагам 1-11 * Wsego9 = N_Rasp * Wsego10 = N_Obj+N_Rasp+(5+N_Obj)*2 * Wsego11 = N_Rasp * Wsego12 = N_Rasp * Wsego13 = N_Obj * Wsego14 = N_Obj+N_Obj*2 * Wsego15 = N_Rasp * Wsego16 = N_Rasp * Wsego17 = N_Cls * Wsego18 = N_Cls+N_Cls*2 * Wsego = Wsego8+Wsego9+Wsego10+Wsego11+Wsego12+Wsego13+Wsego14+Wsego15+Wsego16+Wsego17+Wsego18 Wsego = Wsego8 + 17 Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,13.5 ; PARENT oTabPage1 @15,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105,5.0 ; PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // Зарезервировано под наименование операции @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // 2 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 3 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[11] FONT "10.Helv" // 4 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[12] FONT "10.Helv" // 5 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[13] FONT "10.Helv" // 6 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[14] FONT "10.Helv" // 7 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[15] FONT "10.Helv" // 8 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[16] FONT "10.Helv" // 9 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[17] FONT "10.Helv" // 10 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[18] FONT "10.Helv" // 11 s++ @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1+INT(Wsego/nEvery) ; // Кол-во обновлений изображения MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION L('&Cancel') ; ACTION {||lCancelled:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE L('4.1.2. Пакетное распознавание. Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() // Завершение подготовки данных для отображения графического прогресс-бар ENDIF ********************************************************************************* IF Dialog Mess = L('ОПЕРАЦИЯ: ПАКЕТНОЕ РАСПОЗНАВАНИЕ В ТЕКУЩЕЙ МОДЕЛИ "#":') Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_CurrInf])) aSay[ 7]:SetCaption(Mess) ENDIF *MsgBox(STR(N_Obj)) *MsgBox(mProcessor) DO CASE CASE mProcessor = 'CPU' // ЕСЛИ ЗАДАНО, ТО ВЕРИФИКАЦИЯ МОДЕЛЕЙ НА CPU ****** Это если CPU <===############## ****** Сделать массивы средних и ср.кв.откл.по классам PRIVATE aSrCls[N_Cls] PRIVATE aDiCls[N_Cls] AFILL(aSrCls, 0) AFILL(aDiCls, 0) FOR j = 1 TO N_Cls aSrCls[j] = VAL(LC_FieldGet(mModelName, nHandle[M_CurrInf], N_Gos+2, j+2)) // SREDN по классу из БД текущей модели NEXT FOR j = 1 TO N_Cls aDiCls[j] = VAL(LC_FieldGet(mModelName, nHandle[M_CurrInf], N_Gos+3, j+2)) // DISP по классу из БД текущей модели NEXT // Цикл по объектам распознаваемой выборки и их распознавание ======================================== SELECT Rso_zag SET ORDER TO 1 DBGOTOP() mNumPP = 0 N_ALL = RECCOUNT() mMess = L('1/11: CPU-распознавание объектов распознаваемой выборки:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) DO WHILE .NOT. EOF() // Цикл по объектам распознаваемой выборки * aSay[ 8]:SetCaption(mMess+' '+ALLTRIM(STR(++M_NObj/N_RsObj*100,15,7))+'%') PercTimeVisio(8, mMess, N_ALL) M_KodObj = Kod_obj // Сброс массива-локатора кодов признаков распознаваемого объекта AFILL(Ar_Lok,0) M_SumLok = 0 // Сумма 1 и 0 массива-локатора SELECT Rso_Kpr;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T ******** Цикл по признакам одного объекта DO WHILE M_KodObj = Kod_obj .AND. .NOT. EOF() FOR j=2 TO 8 M_Kpr = FIELDGET(j) IF 0 < M_Kpr .AND. M_Kpr <= N_Gos // Проверка на корректность кода признака // Если признак указан у объкта несколько раз, значит он у него и встречается несколько раз, // например буква "о" в слове "молоко" встречатся 3 раза * DC_DebugQout( M_Kpr ) Ar_Lok[M_Kpr] = Ar_Lok[M_Kpr] + 1 ++M_SumLok // Сумма 1 и 0 массива-локатора ENDIF NEXT DBSKIP(1) ENDDO ENDIF ******* Массив кодов классов, к которым ФАКТИЧЕСКИ относится данный объект PRIVATE Ar_Kcl := {} SELECT Rso_Kcl;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T ******** Цикл по классам одного объекта DO WHILE M_KodObj = Kod_obj .AND. .NOT. EOF() FOR j=2 TO 5 M_Kcl = FIELDGET(j) IF 0 < M_Kcl .AND. M_Kcl <= N_Cls // Проверка на корректность кода класса AADD(Ar_Kcl, M_Kcl) ENDIF NEXT DBSKIP(1) ENDDO ENDIF * // Проверка правильности выборки кодов классов и признаков * Mess = L("Код распознаваемого объекта: "+ALLTRIM(STR(M_KodObj,19))+". Коды классов: " * FOR j=1 TO LEN(Ar_Kcl) * Mess = Mess+ALLTRIM(STR(Ar_Kcl[j],19))+" " * NEXT * Mess = Mess + ". Коды признаков: " * FOR j=1 TO LEN(Ar_Lok) * IF Ar_Lok[j] > 0 * Mess = Mess+ALLTRIM(STR(j,19))+" " * ENDIF * NEXT * LB_Warning(Mess) // Использование полученных массивов собственно для распознавания ***** Расчет среднего и дисперсии массива-локатора M_SrObj = M_SumLok/N_Gos // Среднее 1 и 0 массива-локатора M_DiObj = 0 // Дисперсия 1 и 0 массива-локатора FOR i=1 TO N_Gos M_DiObj = M_DiObj + ( M_SrObj - Ar_Lok[i]) ^ 2 NEXT M_DiObj = SQRT( M_DiObj / (N_Gos - 1)) // Дорасчет дисперсии 1 и 0 массива-локатора * DC_DebugQout( { Alias(), IndexOrd() } ) IF M_DiObj > 0 // Объект описан aKod_obj := {} aKod_cls := {} aKorr := {} aSum_inf := {} aDate := {} aTime := {} aFakt := {} FOR j = 1 TO N_Cls // Цикл по классам распознавания в Inf IF aDiCls[j] > 0 // Сформирован ли класс распознавания ? ****** Расчет нормированной к 100% корреляции массивов ****** локатора источника и информативностей признаков класса ****** (ИНТЕГРАЛЬНЫЙ КРИТЕРИЙ СХОДСТВА) ********************* ****** и суммы информативностей имеющихся у объекта признаков M_SumInf = 0 // Сумма информативностей признаков, имеющихся в описании объекта M_Kov = 0 // Ковариация между образом объекта и классом FOR i=1 TO N_Gos Iij = VAL(LC_FieldGet(mModelName, nHandle[M_CurrInf], i, 2+j)) // Iij из БД текущей модели M_Kov = M_Kov + (Ar_Lok[i] - M_SrObj) * (Iij - aSrCls[j]) M_SumInf = M_SumInf + Ar_Lok[i] * Iij // Надо нормировать как Korr, но это можно сделать только тогда, когда все будет посчитано <===############## NEXT * IF M_SumInf <> 0 M_Kov = 100 * M_Kov / N_Gos M_Korr = M_Kov / (M_DiObj * aDiCls[j] ) // Корреляция между образом объекта и классом * IF ABS(M_Korr) <= 100 AADD(aKod_obj, M_KodObj) AADD(aKod_cls, j ) AADD(aKorr , M_Korr ) AADD(aSum_inf, M_SumInf) AADD(aDate , DTOC(DATE())) AADD(aTime , TIME()) *** Если распознаваемый объект ФАКТИЧЕСКИ относится к классу *** с кодом j, то поставить символ "√" в поле БД Rasp *** иначе поставить там пробел IF ASCAN(Ar_Kcl, j) > 0 AADD(aFakt, "√") ELSE AADD(aFakt, " ") ENDIF * ENDIF * ENDIF ENDIF NEXT ****** Записать результаты распознавания в БД Rasp SELECT Rasp // Если сделать массивы для полей БД Rasp IF LEN(aKod_obj) > 0 FOR j=1 TO LEN(aKod_obj) APPEND BLANK // и записывать результаты распознавания вне цикла по Inf, то все очень ускорится, но тогда будет ограничение на размерность по памяти ################### REPLACE Kod_obj WITH aKod_obj[j] REPLACE Kod_cls WITH aKod_cls[j] * REPLACE Kod_ClSc WITH aKodClSc[aKod_cls[j]] // Надо перед записью значения в базу данных определять поместиться оно или нет и не пытаться его записывать, если оно не поместится IF LEN(ALLTRIM(STR(aKorr[j] ,19,7))) <= 15 REPLACE Korr WITH aKorr[j] ENDIF IF LEN(ALLTRIM(STR(aSum_inf[j],19,7))) <= 15 REPLACE Sum_inf WITH aSum_inf[j] // <===###################### При очень большом объеме распознаваемой выборки не хватает размера поля. * ELSE * REPLACE Sum_inf WITH aSum_inf[j] ENDIF * REPLACE Date WITH aDate[j] * REPLACE Time WITH aTime[j] REPLACE Fakt WITH aFakt[j] NEXT ENDIF ENDIF IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rso_zag DBSKIP(1) ENDDO * SELECT Rasp * DELETE FOR ABS(Korr) > 100 * PACK ***** Распознавание на CPU закончено // <===########## CASE mProcessor = 'GPU' // ВЕРИФИКАЦИЯ МОДЕЛЕЙ НА GPU. ПОДГОТОВИТЬ НУЖНЫЕ БАЗЫ ДЛЯ ПРОДОЛЖЕНИЯ РАБОТЫ НА ОСНОВЕ БД, СОЗДАННЫХ GPU-МОДУЛЕМ РАСПОЗНАВАНИЯ aSay[ 8]:SetCaption(L('1/11: GPU-Распознавание (идентификация)'+' '+ALLTRIM(STR(N_Obj))+' '+'объектов распознаваемой выборки')) ****** Формирование и запись txt-файла параметров модуля GPU-модуля распознавания **************** cFile = "Model_rec_settings.txt" // <===######################################################## aPar := {} * AADD(aPar,'Show_progress *') AADD(aPar,'Show_progress') AADD(aPar,'Show_statistics_(milliseconds) 0') AADD(aPar,'Recognition_in_model_Abs '+IF(mNumModel= 1,'*','')) AADD(aPar,'Recognition_in_model_Prc1 '+IF(mNumModel= 2,'*','')) AADD(aPar,'Recognition_in_model_Prc2 '+IF(mNumModel= 3,'*','')) AADD(aPar,'Recognition_in_model_Inf1 '+IF(mNumModel= 4,'*','')) AADD(aPar,'Recognition_in_model_Inf2 '+IF(mNumModel= 5,'*','')) AADD(aPar,'Recognition_in_model_Inf3 '+IF(mNumModel= 6,'*','')) AADD(aPar,'Recognition_in_model_Inf4 '+IF(mNumModel= 7,'*','')) AADD(aPar,'Recognition_in_model_Inf5 '+IF(mNumModel= 8,'*','')) AADD(aPar,'Recognition_in_model_Inf6 '+IF(mNumModel= 9,'*','')) AADD(aPar,'Recognition_in_model_Inf7 '+IF(mNumModel=10,'*','')) AADD(aPar,'_') DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы Эйдос ERASE(cFile) CrLf = CHR(13)+CHR(10) // Конец строки (записи) mPar = '';FOR j=1 TO LEN(aPar);mPar=mPar+aPar[j]+CrLf;NEXT StrFile(mPar,cFile) ************************************************************************************************** LC_RunShell("Model_rec.exe", 90392051) // GPU-модуль распознавания * Переименавать базу результатов распознавания в текущей модели в БД Rasp.dbf PUBLIC FlagRsp := .T. // .T. - удалось полностью записать базу данных результатов (она меньше 2Гб), .F. - не удалось (база больше 2Гб) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(M_PathAppl) // Перейти в папку текущего приложения mNameRspOld = M_PathAppl+'Rasp_'+LOWER(Ar_Model[mNumModel])+'.dbf' mNameRspNew = M_PathAppl+'Rasp.dbf' IF FILE(mNameRspNew) ERASE(mNameRspNew) ENDIF FRENAME(mNameRspOld,mNameRspNew) DO WHILE FILE(mNameRspOld) // Ожидание переименования файла ENDDO IF Regim<>"3_5";Time_Progress = Time_Progress+N_Obj;lOk = Time_Progress (Time_Progress, Wsego, oProgress, lOk );ENDIF ***** Распознавание на GPU закончено // <===########## ENDCASE ********** ДАЛЬШЕ ВСЕ ОДИНАКОВО НА CPU И GPU ********************************************************* CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * MsgBox(STR(FILESIZE("Rasp.dbf"))) ******************************************************** ** Можно ли вообще обрабатывать БД Rasp.dbf ************ ******************************************************** IF FILESIZE("Rasp.dbf") > 2 * 1024 ^ 3 // ПЕРЕД ОТКРЫТИЕМ ЭТОЙ БАЗЫ ДАННЫХ ПРОВЕРЯТЬ, МЕНЬШЕ ЛИ ОНА 2 ГБ. ЕСЛИ БОЛЬШЕ - ВЫДАВАТЬ СООБЩЕНИЕ О НЕОБХОДИМОСТИ ЗАДАТЬ ПАРАМЕТР, УМЕНЬШАЮЩИЙ ЧИСЛО ЗАПИСЕЙ ТАК, ЧТОБЫ БД БЫЛА < 2ГБ aMess := {} AADD(aMess, L('Размер БД результатов распознавания Rasp.dbf=# байт, что недопустимо.' )) AADD(aMess, L('Необходимо задать такое значение параметра удаления незначимых результатов' )) AADD(aMess, L('распознавания в режиме 3.5 или такое количество объектов распознаваемой выборки,')) AADD(aMess, L('чтобы база данных результатов распознавания Rasp.dbf стала меньше 2 Гб!' )) AADD(aMess, L('Корректное продолжение работы системы невозможно и работа будет прервана.' )) aMess[1] = STRTRAN(aMess[1], "#", ALLTRIM(STR(FILESIZE("Rasp.dbf")))) LB_Warning(aMess, L('4.1.2. Пакетное распознавание')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) * RETURN NIL CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций QUIT ENDIF mPerDel = VAL(FileStr('_PerDel.txt')) * MsgBox(STR(mPerDel)) ******************************************************** ** Возможно ли вообще обрабатывать БД Rasp.dbf ********* ******************************************************** IF mPerDel < 100 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций COPY FILE ("Rasp.dbf") TO ("Rasp_old.dbf") USE Rasp EXCLUSIVE NEW;N_Rec = RECCOUNT() * INDEX ON STR(9999999.9999999-ABS(Sum_inf),19,7) TO Rsp_sinf INDEX ON STR(9999999.9999999-ABS(Korr ),19,7) TO Rsp_sinf DELETE FOR RECNO() > INT( 0.01 * mPerDel * N_Rec ) .AND. LEN(ALLTRIM(FAKT)) = 0 PACK ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // Количество классов (градаций классификационных шкал) USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() // Количество признаков (градаций описательных шкал) USE Opis_Sc EXCLUSIVE NEW USE Rso_Zag INDEX Roz_kod EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Rso_Kcl INDEX Roc_kod EXCLUSIVE NEW USE Rso_Kpr INDEX Rop_kod EXCLUSIVE NEW USE Rasp EXCLUSIVE NEW // ПЕРЕД ОТКРЫТИЕМ ЭТОЙ БД ПРОВЕРЯТЬ, МЕНЬШЕ ЛИ ОНА 2 ГБ. ЕСЛИ БОЛЬШЕ - ВЫДАВАТЬ СООБЩЕНИЕ О НЕОБХОДИМОСТИ ЗАДАТЬ ПАРАМЕТР, УМЕНЬШАЮЩИЙ ЧИСЛО ЗАПИСЕЙ ТАК, ЧТОБЫ БД БЫЛА < 2ГБ IF Regim = '3_5' .OR. Regim = '3_3' .OR. Regim = '4_1_2' // ЭТО ДЕЛАТЬ ТОЛЬКО ЕСЛИ ПРОВОДИТСЯ ПАКЕТНОЕ РАСПОЗНАВАНИЕ ВО ВСЕХ МОДЕЛЯХ (может быть еще в режиме 3.3.). USE (M_DostRsp) EXCLUSIVE NEW ENDIF aSay[ 8]:SetCaption(aSay[ 8]:caption+L(" - Готово ")) // Конец цикла по объектам распознаваемой выборки и их распознавания ================================= aSay[ 9]:SetCaption(L("2/11: Исследование распределений уровней сходства верно и ошиб.идент.объектов")) // Нормировка уровней сходства Korr и Sum_inf к 100% в БД Rasp (делать ее всегда) <===################# SELECT Rasp N_ALL = RECCOUNT() * 2 mNumPP = 0 mMess = L('2/11: Расчет распределений уровней сходства верно и ошиб.идент.объектов:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) INDEX ON STR(ABS(Korr) ,19,7) TO Rsp_korr DBGOBOTTOM();M_MaxKorr = ABS(Korr) INDEX ON STR(ABS(Sum_inf),19,7) TO Rsp_sinf DBGOBOTTOM();M_MaxSinf = ABS(Sum_inf) SET ORDER TO DBGOTOP() DO WHILE .NOT. EOF() PercTimeVisio(9, mMess, N_ALL) mKorr = Korr /M_MaxKorr*100 * mKorr = IF(mKorr>100,+100,mKorr) * mKorr = IF(mKorr<100,-100,mKorr) mSumInf = Sum_Inf/M_MaxSinf*100 REPLACE Korr WITH mKorr // Не хватает размера поля <===############### REPLACE Sum_inf WITH mSumInf DBSKIP(1) ENDDO // Завершение нормировки уровней сходства Korr и Sum_inf к 100% в БД Rasp (делать ее всегда) IF Regim = '3_5' .OR. Regim = '3_3' .OR. Regim = '4_1_2' // ЭТО ДЕЛАТЬ ТОЛЬКО ЕСЛИ ПРОВОДИТСЯ ПАКЕТНОЕ РАСПОЗНАВАНИЕ ВО ВСЕХ МОДЕЛЯХ (может быть еще в режиме 3.3.). // и подсчет количества различных уровней сходства // для верно и ошибочно идентифицированных и неидентифицированных объектов // Нормировка уровней сходства Korr и Sum_inf r 100% в БД Rasp * SELECT Rasp * INDEX ON STR(ABS(Korr) ,19,7) TO Rsp_korr * INDEX ON STR(ABS(Sum_inf),19,7) TO Rsp_sinf * CLOSE Rasp * USE Rasp INDEX Rsp_korr, Rsp_sinf EXCLUSIVE NEW * SELECT Rasp * SET ORDER TO 1;DBGOBOTTOM();M_MaxKorr = ABS(Korr) * SET ORDER TO 2;DBGOBOTTOM();M_MaxSinf = ABS(Sum_inf) M_Num = 0 N_TK = 0 // Количество верно идентифицированных и неидентифицированных объектов (Korr) N_FK = 0 // Количество ошибочно идентифицированных и неидентифицированных объектов (Korr) N_TI = 0 // Количество верно идентифицированных и неидентифицированных объектов (Sum_inf) N_FI = 0 // Количество ошибочно идентифицированных и неидентифицированных объектов (Sum_inf) UrSx_Tk = 0 // Средний уровень сходства (Korr) верно идентифицированных и неидентифицированных объектов UrSx_Ti = 0 // Средний уровень сходства (Sum_inf) верно идентифицированных и неидентифицированных объектов UrSx_Fk = 0 // Средний уровень сходства (Korr) ошибочно идентифицированных и неидентифицированных объектов UrSx_Fi = 0 // Средний уровень сходства (Sum_inf) ошибочно идентифицированных и неидентифицированных объектов SELECT Rasp SET ORDER TO DBGOTOP() DO WHILE .NOT. EOF() * aSay[ 9]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(9, mMess, N_ALL) * REPLACE Korr WITH Korr /M_MaxKorr*100 * REPLACE Sum_inf WITH Sum_Inf/M_MaxSinf*100 PosK = ASCAN(A_ursx, ROUND(Korr ,0)) // Инт.крит. - Корреляция PosI = ASCAN(A_ursx, ROUND(Sum_Inf,0)) // Инт.крит. - Сумма IF PosK * PosI > 0 DO CASE CASE LEN(ALLTRIM(Fakt)) > 0 // Фактически объект относится к классу DO CASE CASE Korr > 0 // Объект верно отнесен к классу ++N_TK A_TPk[PosK] = A_TPk[PosK] + 1 // Истинно-положительное решение UrSx_Tk = UrSx_Tk + ABS(Korr) // Сумма уровней сходства (Korr) верно идентифицированных и неидентифицированных объектов CASE Korr <=0 // Объект ошибочно не отнесен к классу ++N_FK A_FNk[PosK] = A_FNk[PosK] + 1 // Ложно отрицательное решение UrSx_Fk = UrSx_Fk + ABS(Korr) // Сумма уровней сходства (Korr) ошибочно идентифицированных и неидентифицированных объектов ENDCASE DO CASE CASE Sum_Inf > 0 // Объект верно отнесен к классу ++N_TI A_TPi[PosI] = A_TPi[PosI] + 1 // Истинно-положительное решение UrSx_Ti = UrSx_Ti + ABS(Sum_Inf) // Сумма уровней сходства (Sum_inf) верно идентифицированных и неидентифицированных объектов CASE Sum_Inf <=0 // Объект ошибочно не отнесен к классу ++N_FI A_FNi[PosI] = A_FNi[PosI] + 1 // Ложно отрицательное решение UrSx_Fi = UrSx_Fi + ABS(Sum_Inf) // Сумма уровней сходства (Sum_inf) ошибочно идентифицированных и неидентифицированных объектов ENDCASE CASE LEN(ALLTRIM(Fakt)) = 0 // Фактически объект не относится к классу DO CASE CASE Korr > 0 // Объект ошибочно отнесен к классу ++N_FK A_FPk[PosK] = A_FPk[PosK] + 1 // Ложно-положительное решение UrSx_Fk = UrSx_Fk + ABS(Korr) // Сумма уровней сходства (Korr) ошибочно идентифицированных и неидентифицированных объектов CASE Korr <=0 // Объект верно не отнесен к классу ++N_TK A_TNk[PosK] = A_TNk[PosK] + 1 // Истинно-отрицательное решение UrSx_Tk = UrSx_Tk + ABS(Korr) // Сумма уровней сходства (Korr) верно идентифицированных и неидентифицированных объектов ENDCASE DO CASE CASE Sum_Inf > 0 // Объект ошибочно отнесен к классу ++N_FI A_FPi[PosI] = A_FPi[PosI] + 1 // Ложно-положительное решение UrSx_Fi = UrSx_Fi + ABS(Sum_Inf) // Сумма уровней сходства (Sum_inf) ошибочно идентифицированных и неидентифицированных объектов CASE Sum_Inf <=0 // Объект верно не отнесен к классу ++N_TI A_TNi[PosI] = A_TNi[PosI] + 1 // Истинно-отрицательное решение UrSx_Ti = UrSx_Ti + ABS(Sum_Inf) // Сумма уровней сходства (Sum_inf) верно идентифицированных и неидентифицированных объектов ENDCASE ENDCASE ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ***** Создание БД для исследования зависимости ***** количества совпадений результатов распознавания с фактом ***** для различных по величине параметров сходства ПО ОБОИМ ИНТЕГРАЛЬНЫМ КРИТЕРИЯМ ***** ПО ОБОИМ ИНТЕГРАЛЬНЫМ КРИТЕРИЯМ ***** Это аргументированный ответ на вопрос о том, отражает ли уровень сходства ***** распознаваемых объектов с классами фактическую принадлежность этих объектов к классам, ***** т.е. можно ли рассматривать уровень сходства объектов с классами как работоспособный ***** количественный критерий дейсвительно отражающий степень принадлежности объектов к классам. ***** Ответ на этот вопрос положительный, т.к. у верно идентифицированных объектов уровень сходства ***** закономерно и значительно выше, чем у ошибочо идентифицированных. ****** Занесение информации в БД // Массив количества результатов распознавания для различных уровей сходства: {-100%, 0, +100%} // для случаев идентификации с классом, к которому объекты фактически относятся √ // Массив количества результатов распознавания для различных уровей сходства: {-100%, 0, +100%} // для случаев идентификации с классом, к которому объекты фактически не относятся " " PRIVATE aModName[10] // Частные критерии, которыми и отличаются друг от друга модели aModName := {L('1. ABS - частный критерий: количество встреч сочетаний: "класс-признак" у объектов обуч.выборки'),; L('2. PRC1 - частный критерий: усл. вероятность i-го признака среди признаков объектов j-го класса '),; L('3. PRC2 - частный критерий: условная вероятность i-го признака у объектов j-го класса '),; L('4. INF1 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC1 '),; L('5. INF2 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC2 '),; L('6. INF3 - частный критерий: Xи-квадрат, разности между фактическими и ожидаемыми абс.частотами '),; L('7. INF4 - частный критерий: ROI (Return On Investment); вероятности из PRC1 '),; L('8. INF5 - частный критерий: ROI (Return On Investment); вероятности из PRC2 '),; L('9. INF6 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC1 '),; L('10.INF7 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC2 ') } SELECT (M_DostRsp) APPEND BLANK REPLACE Name WITH UPPER(SUBSTR(aModName[M_CurrInf],1,255)) FOR M_IntKrit = 1 TO 2 // 1. Корреляция. 2. Сумма // Интегральные критерии DO CASE CASE M_CurrInf = 1 // Abs M_NameIntKrit = IF(M_IntKrit=1,"Корреляция абс.частот с обр.объекта","Сумма абс.частот по признакам объекта") CASE M_CurrInf = 2 .OR. M_CurrInf = 3 // Prc1, Prc2 M_NameIntKrit = IF(M_IntKrit=1,"Корреляция усл.отн.частот с обр.объекта","Сумма усл.отн.частот по признакам объекта") CASE M_CurrInf > 3 // Inf# M_NameIntKrit = IF(M_IntKrit=1,"Семантический резонанс знаний","Сумма знаний") ENDCASE APPEND BLANK REPLACE Name WITH "Интегральный критерий: "+UPPER(M_NameIntKrit) APPEND BLANK REPLACE Name WITH "Уровни сходства (Ур.Сх.) (%):" FOR j=1 TO LEN(A_ursx) FIELDPUT(1+j, A_ursx[j]) NEXT DO CASE CASE M_IntKrit = 1 // Корреляция APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинных решений (TP+TN)" FOR j=1 TO LEN(A_TPk) FIELDPUT(1+j, A_TPk[j]+A_TNk[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложных решений (FP+FN)" FOR j=1 TO LEN(A_FPk) FIELDPUT(1+j, A_FPk[j]+A_FNk[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинно-положительных решений (TP)" FOR j=1 TO LEN(A_TPk) FIELDPUT(1+j, A_TPk[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинно-отрицательных решений (TN)" FOR j=1 TO LEN(A_TNk) FIELDPUT(1+j, A_TNk[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложно-положительных решений (FP)" FOR j=1 TO LEN(A_FPk) FIELDPUT(1+j, A_FPk[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложно-отрицательных решений (FN)" FOR j=1 TO LEN(A_FNk) FIELDPUT(1+j, A_FNk[j]) NEXT CASE M_IntKrit = 2 // Сумма APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинных решений (TP+TN)" FOR j=1 TO LEN(A_TPi) FIELDPUT(1+j, A_TPi[j]+A_TNi[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложных решений (FP+FN)" FOR j=1 TO LEN(A_FPi) FIELDPUT(1+j, A_FPi[j]+A_FNi[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинно-положительных решений (TP)" FOR j=1 TO LEN(A_TPi) FIELDPUT(1+j, A_TPi[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства истинно-отрицательных решений (TN)" FOR j=1 TO LEN(A_TNi) FIELDPUT(1+j, A_TNi[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложно-положительных решений (FP)" FOR j=1 TO LEN(A_FPi) FIELDPUT(1+j, A_FPi[j]) NEXT APPEND BLANK REPLACE Name WITH "Част.распр.Уровней Сходства ложно-отрицательных решений (FN)" FOR j=1 TO LEN(A_FNi) FIELDPUT(1+j, A_FNi[j]) NEXT ENDCASE NEXT ENDIF // ЭТО ДЕЛАТЬ ТОЛЬКО ЕСЛИ ПРОВОДИТСЯ ПАКЕТНОЕ РАСПОЗНАВАНИЕ ВО ВСЕХ МОДЕЛЯХ (может быть еще в режиме 3.3.) IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[ 9]:SetCaption(aSay[ 9]:caption+L(" - Готово ")) ************************************************************************** // Переиндексация БД результатов распознавания и формирование БД Rsp1k.dbf, Rsp1i.dbf и Rsp2k.dbf, Rsp2i.dbf * ИМЕНА БАЗ ДАННЫХ РЕЗУЛЬТАТОВ РАСПОЗНАВАНИЯ ДЛЯ ВИЗУАЛИЗАЦИИ: * ============================================================================== * Интегральный критерий | Форма | Один объект | Один класс * | представления | много классов | много объектов * ------------------------------------------------------------------------------ * Семантический резонанс | Подробная наглядная | Rsp1k.dbf | Rsp2k.dbf Для расчета * Сумма информации | Подробная Наглядная | Rsp1i.dbf | Rsp2i.dbf и визуализации * ------------------------------------------------------------------------------ * Семантический резонанс | Итоговая наглядная | Rsp_IT1k.dbf | Rsp_IT2k.dbf Для расчета * Сумма информации | Итоговая наглядная | Rsp_IT1i.dbf | Rsp_IT2i.dbf * ------------------------------------------------------------------------------ * Оба инт.критерия | Итоговая наглядная | Rsp_IT1.dbf | Rsp_IT2.dbf Для визуализации * ------------------------------------------------------------------------------ * Семантический резонанс | Подробная сжатая | Rsp_ITk.dbf Для расчета * Сумма информации | Подробная сжатая | Rsp_ITi.dbf * ------------------------------------------------------------------------------ * Оба инт.критерия | Подробная сжатая | Rsp_IT.dbf Для визуализации * ------------------------------------------------------------------------------ * Факт принадлежности | Подробная сжатая | Rsp_ITf.dbf * ============================================================================== aSay[10]:SetCaption(L('3/11: Создание сжатых полных форм результатов распознавания по двум интегр.крит.')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() // Кол-во классов USE Rso_Zag EXCLUSIVE NEW;N_Obj = RECCOUNT() // Кол-во объектов расп.выборки USE Rasp EXCLUSIVE NEW;N_Rasp = RECCOUNT() // Кол-во строк в БД Rasp.dbf USE Rsp_ITk EXCLUSIVE NEW;ZAP // Подробная сжатая форма, инт.крит.-корреляция для расчета USE Rsp_ITi EXCLUSIVE NEW;ZAP // Подробная сжатая форма, инт.крит.-сумма инф. для расчета USE Rsp_IT EXCLUSIVE NEW;ZAP // Подробная сжатая форма, по двум инт.критериям для визуалиазции USE Rsp_ITf EXCLUSIVE NEW;ZAP // Подробная сжатая форма, факт принадл.объекта к классу для расчета ********************************** ****** Создать пустые БД с шапками ********************************** * Использовать не все объекты распознаваемой выборки из Rso_zag.dbf, а только те, которые * остались в БД Rasp.dbf после удаления из нее наименее достоверно идентифицированных объектов SELECT Rso_zag // №1, N_Obj <<<############################################# mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Obj + N_Rasp + N_Obj+5 + N_Obj+5 * №1 №2 №3 №4 mMess = L('3/11: Создание сжатых полных форм результатов распозн.по двум интегр.крит.:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) DBGOTOP() DO WHILE .NOT. EOF() * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) M_KodObj = Kod_obj M_NameObj = Name_obj SELECT Rsp_ITk // БД > 2 Гб <<<===############## APPEND BLANK // БД > 2 Гб <<<===############## REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH M_NameObj REPLACE Max_Value WITH -99999999 SELECT Rsp_ITi APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH M_NameObj REPLACE Max_Value WITH -99999999 SELECT Rsp_ITf APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH M_NameObj * FOR j=2 TO FCOUNT() * FIELDPUT(j," ") * NEXT SELECT Rso_zag * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_ITk APPEND BLANK REPLACE Name_obj WITH "MAX.ур.сход.класса с объектом" APPEND BLANK REPLACE Name_obj WITH "Код наиболее похожего объекта" APPEND BLANK REPLACE Name_obj WITH "MIN.ур.сход.класса с объектом" APPEND BLANK REPLACE Name_obj WITH "Код самого непохожего объекта" APPEND BLANK REPLACE Name_obj WITH "Дост: (MAX_ур.сх.-MIN_ур.сх)/2" SELECT Rsp_ITi APPEND BLANK REPLACE Name_obj WITH "MAX.ур.сход.класса с объектом" APPEND BLANK REPLACE Name_obj WITH "Код наиболее похожего объекта" APPEND BLANK REPLACE Name_obj WITH "MIN.ур.сход.класса с объектом" APPEND BLANK REPLACE Name_obj WITH "Код самого непохожего объекта" APPEND BLANK REPLACE Name_obj WITH "Дост: (MAX_ур.сх.-MIN_ур.сх)/2" // Раскидать результаты распознавания по матрицам, // Найти максимальные значения Ур.Сх. по строкам и столбцам // и поместить в них коды соответствующих классов и объектов PRIVATE aMaxValK[N_Cls] // Массив для поиска значений макс.ур.сх.по столбцам по корреляции PRIVATE aMaxKodK[N_Cls] // Массив кодов объектов с которыми у данного класса макс.ур.сх.по корреляции PRIVATE aMaxValI[N_Cls] // Массив для поиска макс.ур.сх.по столбцам по сумме инф. PRIVATE aMaxKodI[N_Cls] // Массив кодов объектов с которыми у данного класса макс.ур.сх.по сумме инф. AFILL(aMaxValK,-99999999) AFILL(aMaxKodK,-99999999) AFILL(aMaxValI,-99999999) AFILL(aMaxKodI,-99999999) PRIVATE aMinValK[N_Cls] // Массив для поиска значений мин.ур.сх.по столбцам по корреляции PRIVATE aMinKodK[N_Cls] // Массив кодов объектов с которыми у данного класса мин.ур.сх.по корреляции PRIVATE aMinValI[N_Cls] // Массив для поиска мин.ур.сх.по столбцам по сумме инф. PRIVATE aMinKodI[N_Cls] // Массив кодов объектов с которыми у данного класса мин.ур.сх.по сумме инф. AFILL(aMinValK,+99999999) AFILL(aMinKodK,+99999999) AFILL(aMinValI,+99999999) AFILL(aMinKodI,+99999999) SELECT Rasp // №2, N_Rasp <<<############################################ DBGOTOP() DO WHILE .NOT. EOF() * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) M_KodObj = Kod_obj M_KodCls = Kod_cls M_Korr = Korr M_SumInf = Sum_Inf M_Fakt = Fakt IF -100 <= M_Korr .AND. M_Korr <= +100 // Эта проверка сделана потому, что модуль распознавания на GPU иногда (очень редко) дает неверные результаты распознавания <===######### SELECT Rsp_ITk IF M_KodObj > 0 DBGOTO(M_KodObj) FIELDPUT(7+M_KodCls,M_Korr) // На CPU работает, а на GPU дает ошибку, что значение не помещается в поле <===######################################################### IF M_Korr > Max_Value REPLACE Max_Value WITH M_Korr // Макс.знач.ур.сходства REPLACE KodC_MaxV WITH M_KodCls // Код класса с которым у данного объекта Макс.знач.ур.сходства ENDIF IF M_Korr <= Min_Value REPLACE Min_Value WITH M_Korr // Мин.знач.ур.сходства REPLACE KodC_MinV WITH M_KodCls // Код класса с которым у данного объекта Мин.знач.ур.сходства ENDIF REPLACE Dost WITH (Max_Value-Min_Value)/2 // Достоверность IF M_Korr > aMaxValK[M_KodCls] aMaxValK[M_KodCls] = M_Korr // Макс.знач.ур.сходства aMaxKodK[M_KodCls] = M_KodObj // Код объекта с которым у данного класса Макс.знач.ур.сходства ENDIF IF M_Korr <= aMinValK[M_KodCls] aMinValK[M_KodCls] = M_Korr // Мин.знач.ур.сходства aMinKodK[M_KodCls] = M_KodObj // Код объекта с которым у данного класса Мин.знач.ур.сходства ENDIF SELECT Rsp_ITi DBGOTO(M_KodObj) FIELDPUT(7+M_KodCls,M_SumInf) IF M_SumInf > Max_Value REPLACE Max_Value WITH M_SumInf // Макс.знач.ур.сходства REPLACE KodC_MaxV WITH M_KodCls // Код класса с которым у данного объекта Макс.знач.ур.сходства ENDIF IF M_SumInf <= Min_Value REPLACE Min_Value WITH M_SumInf // Мин.знач.ур.сходства REPLACE KodC_MinV WITH M_KodCls // Код класса с которым у данного объекта Мин.знач.ур.сходства ENDIF REPLACE Dost WITH (Max_Value-Min_Value)/2 // Достоверность IF M_SumInf > aMaxValI[M_KodCls] aMaxValI[M_KodCls] = M_SumInf // Макс.знач.ур.сходства aMaxKodI[M_KodCls] = M_KodObj // Код объекта с которым у данного класса Макс.знач.ур.сходства ENDIF IF M_SumInf <= aMinValI[M_KodCls] aMinValI[M_KodCls] = M_SumInf // Мин.знач.ур.сходства aMinKodI[M_KodCls] = M_KodObj // Код объекта с которым у данного класса Мин.знач.ур.сходства ENDIF SELECT Rsp_ITf DBGOTO(M_KodObj) FIELDPUT(2+M_KodCls,M_Fakt) ENDIF ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rasp DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ****** Перенести массивы в БД SELECT Rsp_ITk DBGOTO(1+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMaxValK[j]) NEXT DBGOTO(2+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMaxKodK[j]) NEXT DBGOTO(3+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMinValK[j]) NEXT DBGOTO(4+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMinKodK[j]) NEXT DBGOTO(5+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, (aMaxValK[j]-aMinValK[j])/2) NEXT SELECT Rsp_ITi DBGOTO(1+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMaxValI[j]) NEXT DBGOTO(2+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMaxKodI[j]) NEXT DBGOTO(3+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMinValI[j]) NEXT DBGOTO(4+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, aMinKodI[j]) NEXT DBGOTO(5+N_Obj) FOR j=1 TO N_Cls FIELDPUT(7+j, (aMaxValI[j]-aMinValI[j])/2) NEXT // Объединение БД Rsp_ITk + Rsp_ITi => Rsp_IT для визуализации // Wsego = Wsego+(N_Obj+5)*2 SELECT Rsp_ITk // №3, N_Obj+5 <<<############################################# DBGOTOP() DO WHILE .NOT. EOF() * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_IT APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 1 // Инт.крит.-корреляция * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_ITk DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_ITi // №4, N_Obj+5 <<<#############################################???????? DBGOTOP() DO WHILE .NOT. EOF() * aSay[10]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(10, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_IT APPEND BLANK // <<<===########### вылетает, т.к. файл станвится больше 2 Гб FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 2 // Инт.крит.-сумма инф. * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_ITi DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[10]:SetCaption(aSay[10]:caption+L(" - Готово ")) aSay[11]:SetCaption(L('4/11: Создание подробной наглядной формы: "Объект-классы". Инт.крит.-корреляция')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rasp EXCLUSIVE NEW INDEX ON STR(Kod_Obj,19)+STR(99999999.9999999-Korr ,19,7)+STR(Kod_cls,19) TO RspK_obj // Один объект - много классов INDEX ON STR(Kod_Obj,19)+STR(99999999.9999999-Sum_inf,19,7)+STR(Kod_cls,19) TO RspI_obj // Один объект - много классов CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW ;N_Cls = RECCOUNT() // Кол-во классов USE Rso_Zag EXCLUSIVE NEW ;N_Obj = RECCOUNT() // Кол-во объектов расп.выборки USE Rasp INDEX RspK_obj, RspI_obj EXCLUSIVE NEW;N_Rasp = RECCOUNT() // Кол-во строк в БД Rasp.dbf mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Obj + N_Cls + N_Rasp + N_Rasp + N_Rasp * №1 №2 №3 №4 №5 mMess = L('4/11: Создание подр.нагл.формы: "Объект-классы". Инт.крит.-корреляция:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) USE Rsp_ITk EXCLUSIVE NEW // Подробная сжатая форма, инт.крит.-корреляция USE Rsp_ITi EXCLUSIVE NEW // Подробная сжатая форма, инт.крит.-сумма инф. USE Rsp_ITf EXCLUSIVE NEW // Подробная сжатая форма, факт принадл.объекта к классу USE Rsp1k EXCLUSIVE NEW;ZAP // Подробная наглядная форма, инт.крит.-корреляция ("Один объект - много классов") USE Rsp1i EXCLUSIVE NEW;ZAP // Подробная наглядная форма, инт.крит.-сумма инф. ("Один объект - много классов") USE Rsp_it1k EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-корреляция ("Объект - класс") USE Rsp_it1i EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-сумма инф. ("Объект - класс") USE Rsp_it1 EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-сумма инф. ("Объект - класс") для визуализации ****** Формирование массивов для исключения переключений БД и ускорения распознавания SELECT Rso_Zag // №1, N_Obj <<<############################################# PRIVATE aNameObj[N_Obj] mFlagErr = .T. DBGOTOP() DO WHILE .NOT. EOF() * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) IF Kod_obj <= N_Obj aNameObj[Kod_obj] = Name_obj ELSE IF mFlagErr mFlagErr = .F. aMess := {} AADD(aMess, L('В БД: "Rso_Zag.dbf" коды объектов распознаваемой выборки не соответствуют номерам записей.')) AADD(aMess, L('Скорее всего некоторые объекты распознаваемой выборки НЕКОРРЕКТНО удалены.') ) AADD(aMess, L('Базы данных приложения нарушены и полученные результаты будут некорректны!') ) LB_Warning(aMess, L('4.2.1. Пакетное распознавание' ) ) ENDIF ENDIF DBSKIP(1) ENDDO SELECT Classes // №2, N_Cls <<<############################################# PRIVATE aKodClSc[N_Cls] PRIVATE aNameCls[N_Cls] mFlagErr = .T. DBGOTOP() DO WHILE .NOT. EOF() * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) IF Kod_cls <= N_Cls aNameCls[Kod_cls] = DelZeroNameGr(Name_cls) aKodClSc[Kod_cls] = Kod_ClSc ELSE IF mFlagErr mFlagErr = .F. aMess := {} AADD(aMess, L('В БД: "Classes.dbf" коды классов не соответствуют номерам записей.') ) AADD(aMess, L('Скорее всего некоторые записи БД "Classes.dbf" НЕКОРРЕКТНО удалены.') ) AADD(aMess, L('Базы данных приложения нарушены и полученные результаты будут некорректны!')) LB_Warning(aMess, L('4.2.1. Пакетное распознавание' ) ) ENDIF ENDIF DBSKIP(1) ENDDO ****** Rsp1k: Один объект - много классов, интегральный критерий - Семантический резонанс PUBLIC FlagRsp := .T. // .T. - удалось полностью записать базу данных результатов (она меньше 2Гб), .F. - не удалось (база больше 2Гб) SELECT Rasp // №3, N_Rasp <<<############################################ SET ORDER TO 1 M_Num = 0 set printer to ("Rsp1k_"+Ar_Model[mNumModel]+".txt") ADDITIVE DBGOTOP() mKodObjRasp = Kod_obj DO WHILE .NOT. EOF() * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) mRecno = RECNO() M_KodObj = Kod_obj M_KodCls = Kod_cls M_Korr = Korr M_SumInf = Sum_inf M_Fakt = Fakt IF -100 <= M_Korr .AND. M_Korr <= +100 IF M_KodObj <= N_Obj .AND. M_KodCls <= N_Cls IF mKodObjRasp <> Kod_obj .AND. M_Num > 0 ?REPLICATE('~',LEN(mS1)) mKodObjRasp = Kod_obj ENDIF ?TABEXPAND(ALLTRIM(STR(M_KodObj)) +CHR(9)+' | ')+; ALLTRIM(aNameObj[M_KodObj])+SPACE(mLO-LEN(ALLTRIM(aNameObj[M_KodObj]))-2)+' | '+; TABEXPAND(ALLTRIM(STR(M_KodCls)) +CHR(9)+' | ')+; ALLTRIM(aNameCls[M_KodCls])+SPACE(mLC-LEN(ALLTRIM(aNameCls[M_KodCls])))+' | '+; TABEXPAND(ALLTRIM(STR(aKodClSc[M_KodCls])) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_Korr,15,7)) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_SumInf,15,7)) +CHR(9)+' | ')+; TABEXPAND(REPLICATE("■", 0.15*ABS(M_Korr)) +CHR(9)+' | ',16)+; M_Fakt+' | '+DTOC(DATE())+' | '+TIME()+' | '+; TABEXPAND(ALLTRIM(STR(++M_Num)) +CHR(9)+' | ') SELECT Rsp1k IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp1kFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DELETE FOR FILTER9 <> '#' PACK SET ORDER TO ENDIF SELECT Rsp1k APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH aNameObj[M_KodObj] REPLACE Kod_cls WITH M_KodCls REPLACE Kod_ClSc WITH aKodClSc[M_KodCls] REPLACE Name_cls WITH DelZeroNameGr(aNameCls[M_KodCls]) REPLACE Korr WITH M_Korr REPLACE Sum_inf WITH M_SumInf REPLACE Fakt WITH M_Fakt REPLACE Histogram WITH REPLICATE("|", ABS(M_Korr)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE Num WITH M_Num ENDIF ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rasp DBGOTO(mRecno) DBSKIP(1) ENDDO ?REPLICATE('=',LEN(mS1)) IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ****** Подготовка для отображения 9 записей с макс.модулем интегр.критерия сходства ****** и 2-х классов по каждой класс.шкале: с макс.и мин.уровнями сходства SELECT Rsp1k // №4, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp1kFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOTOP() IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) SELECT Rsp1k DELETE FOR FILTER9 <> '#' PACK ENDIF SELECT Rsp1k // №5, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(Kod_ClSc,15)+STR(9999999.9999999-Korr,19,7) TO Rsp1kFltr DBGOTOP() N = 0 mKodClSc = Kod_ClSc DO WHILE .NOT. EOF() * aSay[11]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(11, mMess, N_ALL) IF mKodClSc = Kod_ClSc IF N < 1 REPLACE FilterM WITH '#' ++N ENDIF ELSE DBSKIP(-1) mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' DBSKIP(1) N = 0 mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOBOTTOM();REPLACE FilterM WITH '#' DBGOTOP() aSay[11]:SetCaption(aSay[11]:caption+L(" - Готово ")) ****** Rsp1i: Один объект - много классов, интегральный критерий - суммарное количество информации aSay[12]:SetCaption(L('5/11: Создание подр.нагл.формы: "Объект-классы". Инт.крит.-сумма инф.')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Rasp + N_Rasp + N_Rasp * №1 №2 №3 mMess = L('5/11: Создание подр.нагл.формы: "Объект-классы". Инт.крит.-сумма инф.:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) SELECT Rasp // №1, N_Rasp <<<############################################ SET ORDER TO 2 M_Num = 0 set printer to ("Rsp1i_"+Ar_Model[mNumModel]+".txt") ADDITIVE DBGOTOP() mKodObjRasp = Kod_obj DO WHILE .NOT. EOF() * aSay[12]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(12, mMess, N_ALL) mRecno = RECNO() M_KodObj = Kod_obj M_KodCls = Kod_cls M_Korr = Korr M_SumInf = Sum_inf M_Fakt = Fakt IF -100 <= M_Korr .AND. M_Korr <= +100 IF M_KodObj <= N_Obj .AND. M_KodCls <= N_Cls IF mKodObjRasp <> Kod_obj .AND. M_Num > 0 ?REPLICATE('~',LEN(mS1)) mKodObjRasp = Kod_obj ENDIF ?TABEXPAND(ALLTRIM(STR(M_KodObj)) +CHR(9)+' | ')+; ALLTRIM(aNameObj[M_KodObj])+SPACE(mLO-LEN(ALLTRIM(aNameObj[M_KodObj]))-2)+' | '+; TABEXPAND(ALLTRIM(STR(M_KodCls)) +CHR(9)+' | ')+; ALLTRIM(aNameCls[M_KodCls])+SPACE(mLC-LEN(ALLTRIM(aNameCls[M_KodCls])))+' | '+; TABEXPAND(ALLTRIM(STR(aKodClSc[M_KodCls])) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_Korr,15,7)) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_SumInf,15,7)) +CHR(9)+' | ')+; TABEXPAND(REPLICATE("■", 0.15*ABS(M_SumInf)) +CHR(9)+' | ',16)+; M_Fakt+' | '+DTOC(DATE())+' | '+TIME()+' | '+; TABEXPAND(ALLTRIM(STR(++M_Num)) +CHR(9)+' | ') SELECT Rsp1i IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Sum_inf),19,7) TO Rsp1iFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DELETE FOR FILTER9 <> '#' PACK SET ORDER TO ENDIF SELECT Rsp1i APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH aNameObj[M_KodObj] REPLACE Kod_cls WITH M_KodCls REPLACE Kod_ClSc WITH aKodClSc[M_KodCls] REPLACE Name_cls WITH DelZeroNameGr(aNameCls[M_KodCls]) REPLACE Korr WITH M_Korr REPLACE Sum_inf WITH M_SumInf REPLACE Fakt WITH M_Fakt REPLACE Histogram WITH REPLICATE("|",ABS(M_SumInf)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE Num WITH M_Num ENDIF ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rasp DBGOTO(mRecno) DBSKIP(1) ENDDO ?REPLICATE('=',LEN(mS1)) IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ****** Подготовка для отображения 9 записей с макс.модулем интегр.критерия сходства ****** и 2-х классов по каждой класс.шкале: с макс.и мин.уровнями сходства SELECT Rsp1i // №2, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Sum_inf),19,7) TO Rsp1iFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() * aSay[12]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(12, mMess, N_ALL) IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOTOP() IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) SELECT Rsp1i DELETE FOR FILTER9 <> '#' PACK ENDIF SELECT Rsp1i // №3, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(Kod_ClSc,15)+STR(9999999.9999999-Korr,19,7) TO Rsp1iFltr DBGOTOP() N = 0 mKodClSc = Kod_ClSc DO WHILE .NOT. EOF() * aSay[12]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(12, mMess, N_ALL) IF mKodClSc = Kod_ClSc IF N < 1 REPLACE FilterM WITH '#' ++N ENDIF ELSE DBSKIP(-1) mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' DBSKIP(1) N = 0 mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOBOTTOM();REPLACE FilterM WITH '#' DBGOTOP() aSay[12]:SetCaption(aSay[12]:caption+L(" - Готово ")) ***** Сделать итоговые наглядные формы: "Объект-классы" aSay[13]:SetCaption(L('6/11: Создание итоговой наглядной формы: "Объект-класс". Инт.крит.-корреляция')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Obj+5 * №1 mMess = L('6/11: Создание итоговой наглядной формы: "Объект-класс". Инт.крит.-корреляция:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) SELECT Rsp_ITk // №1, N_Obj+5 <<<############################################ *INDEX ON STR(99999999.9999999-Dost,19,7) TO Rsp_ITk // Один объект - много классов DBGOTOP() DO WHILE .NOT. EOF() * aSay[13]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(13, mMess, N_ALL) M_KodObj = Kod_obj IF M_KodObj > 0 M_NameObj = Name_obj M_KodClsA = KodC_MaxV M_KorrA = Max_Value M_KodClsB = KodC_MinV M_KorrB = Min_Value M_Dost = Dost IF M_KodClsA <= 1500 .AND. M_KodClsB <= 1500 SELECT Classes DBGOTO(M_KodClsA) M_NameClsA = Name_cls DBGOTO(M_KodClsB) M_NameClsB = Name_cls SELECT Rsp_ITf DBGOTO(M_KodObj) M_Fakt = FIELDGET(2+M_KodClsA) SELECT Rsp_it1k APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH M_NameObj REPLACE Kod_clsA WITH M_KodClsA REPLACE Name_clsA WITH M_NameClsA REPLACE KorrA WITH M_KorrA REPLACE Fakt WITH M_Fakt REPLACE Kod_clsB WITH M_KodClsB REPLACE Name_clsB WITH M_NameClsB REPLACE KorrB WITH M_KorrB REPLACE Dost WITH M_Dost REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ENDIF SELECT Rsp_ITk DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[13]:SetCaption(aSay[13]:caption+L(" - Готово ")) aSay[14]:SetCaption(L('7/11: Создание итоговой наглядной формы: "Объект-класс". Инт.крит.-сумма инф.')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Obj+5 + N_Obj + N_Obj * №1 №2 №3 mMess = L('7/11: Создание итоговой наглядной формы: "Объект-класс". Инт.крит.-сумма инф.:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) SELECT Rsp_ITi // №1, N_Obj+5 <<<############################################ *INDEX ON STR(99999999.9999999-Dost,19,7) TO Rsp_ITi // Один объект - много классов ** 1234567890123456 DBGOTOP() DO WHILE .NOT. EOF() * aSay[14]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(14, mMess, N_ALL) M_KodObj = Kod_obj IF M_KodObj > 0 IF M_KodClsA <= 1500 .AND. M_KodClsB <= 1500 M_NameObj = Name_obj M_KodClsA = KodC_MaxV M_SumInfA = Max_Value M_KodClsB = KodC_MinV M_SumInfB = Min_Value M_Dost = Dost SELECT Classes DBGOTO(M_KodClsA) M_NameClsA = Name_cls DBGOTO(M_KodClsB) M_NameClsB = Name_cls SELECT Rsp_ITf DBGOTO(M_KodObj) M_Fakt = FIELDGET(2+M_KodClsA) M_Fakt = IF(VALTYPE(M_Fakt) = "C", M_Fakt, " ") SELECT Rsp_it1i APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH M_NameObj REPLACE Kod_clsA WITH M_KodClsA REPLACE Name_clsA WITH M_NameClsA REPLACE Sum_infA WITH M_SumInfA REPLACE Fakt WITH M_Fakt REPLACE Kod_clsB WITH M_KodClsB REPLACE Name_clsB WITH M_NameClsB REPLACE Sum_infB WITH M_SumInfB REPLACE Dost WITH M_Dost REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ENDIF SELECT Rsp_ITi DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF // Объединение итоговых наглядных форм "Объект-класс" для визуализации // Объединение БД Rsp_it1k + Rsp_it1i => Rsp_it1 для визуализации // Wsego = Wsego+N_Obj*2 SELECT Rsp_it1k // №2, N_Obj <<<############################################ DBGOTOP() DO WHILE .NOT. EOF() * aSay[14]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(14, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_it1 APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 1 // Инт.крит.-корреляция * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it1k DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it1i // №3, N_Obj <<<############################################ DBGOTOP() DO WHILE .NOT. EOF() * aSay[14]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(14, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_it1 APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 2 // Инт.крит.-сумма инф. * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it1i DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[14]:SetCaption(aSay[14]:caption+L(" - Готово ")) ***** Создание подробных наглядных форм: "Класс-объекты" aSay[15]:SetCaption(L('8/11: Создание подробной наглядной формы: "Класс-объекты". Инт.крит.-корреляция')) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rasp EXCLUSIVE NEW INDEX ON STR(Kod_cls,19)+STR(99999999.9999999-Korr ,19,7)+STR(Kod_Obj,19) TO RspK_cls // Один класс - много объектов INDEX ON STR(Kod_cls,19)+STR(99999999.9999999-Sum_inf,19,7)+STR(Kod_Obj,19) TO RspI_cls // Один класс - много объектов CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW ;N_Cls = RECCOUNT() // Кол-во классов USE Rso_Zag EXCLUSIVE NEW ;N_Obj = RECCOUNT() // Кол-во объектов расп.выборки USE Rasp INDEX RspK_cls, RspI_cls EXCLUSIVE NEW;N_Rasp = RECCOUNT() // Строк в БД asp.dbf mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Rasp + N_Rasp + N_Rasp * №1 №2 №3 mMess = L('8/11: Создание подробной наглядной формы: "Класс-объекты". Инт.крит.-корреляция:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) USE Rsp_ITk EXCLUSIVE NEW // Подробная сжатая форма, инт.крит.-корреляция USE Rsp_ITi EXCLUSIVE NEW // Подробная сжатая форма, инт.крит.-сумма инф. USE Rsp_ITf EXCLUSIVE NEW // Подробная сжатая форма, факт принадл.объекта к классу USE Rsp2k EXCLUSIVE NEW;ZAP // Подробная наглядная форма, инт.крит.-корреляция ("Один класс - много объектов") USE Rsp2i EXCLUSIVE NEW;ZAP // Подробная наглядная форма, инт.крит.-сумма инф. ("Один класс - много объектов") USE Rsp_it2k EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-корреляция ("Класс-объекты") USE Rsp_it2i EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-сумма инф. ("Класс-объекты") USE Rsp_it2 EXCLUSIVE NEW;ZAP // Итоговая наглядная форма, инт.крит.-сумма инф. ("Класс-объекты") для визуализации ****** Rsp2k: Один класс - много объектов, интегральный критерий - Семантический резонанс SELECT Rasp // №1, N_Rasp <<<############################################ SET ORDER TO 1 M_Num = 0 set printer to ("Rsp2k_"+Ar_Model[mNumModel]+".txt") ADDITIVE DBGOTOP() mKodClsRasp = Kod_cls DO WHILE .NOT. EOF() * aSay[15]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(15, mMess, N_ALL) mRecno = RECNO() M_KodObj = Kod_obj M_KodCls = Kod_cls M_Korr = Korr M_SumInf = Sum_inf M_Fakt = Fakt IF -100 <= M_Korr .AND. M_Korr <= +100 IF M_KodObj <= N_Obj .AND. M_KodCls <= N_Cls IF mKodClsRasp <> Kod_cls .AND. M_Num > 0 ?REPLICATE('~',LEN(mS1)) mKodClsRasp = Kod_cls ENDIF ?TABEXPAND(ALLTRIM(STR(M_KodObj)) +CHR(9)+' | ')+; ALLTRIM(aNameObj[M_KodObj])+SPACE(mLO-LEN(ALLTRIM(aNameObj[M_KodObj]))-2)+' | '+; TABEXPAND(ALLTRIM(STR(M_KodCls)) +CHR(9)+' | ')+; ALLTRIM(aNameCls[M_KodCls])+SPACE(mLC-LEN(ALLTRIM(aNameCls[M_KodCls])))+' | '+; TABEXPAND(ALLTRIM(STR(aKodClSc[M_KodCls])) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_Korr,15,7)) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_SumInf,15,7)) +CHR(9)+' | ')+; TABEXPAND(REPLICATE("■", 0.15*ABS(M_Korr)) +CHR(9)+' | ',16)+; M_Fakt+' | '+DTOC(DATE())+' | '+TIME()+' | '+; TABEXPAND(ALLTRIM(STR(++M_Num)) +CHR(9)+' | ') SELECT Rsp2k IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp2kFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DELETE FOR FILTER9 <> '#' PACK ENDIF SELECT Rsp2k APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH aNameObj[M_KodObj] REPLACE Kod_cls WITH M_KodCls REPLACE Kod_ClSc WITH aKodClSc[M_KodCls] REPLACE Name_cls WITH DelZeroNameGr(aNameCls[M_KodCls]) REPLACE Korr WITH M_Korr REPLACE Sum_inf WITH M_SumInf REPLACE Fakt WITH M_Fakt REPLACE Histogram WITH REPLICATE("|", ABS(M_Korr)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE Num WITH M_Num ENDIF ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rasp DBGOTO(mRecno) DBSKIP(1) ENDDO ?REPLICATE('=',LEN(mS1)) IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ****** Подготовка для отображения 9 записей с макс.модулем интегр.критерия сходства ****** и 2-х классов по каждой класс.шкале: с макс.и мин.уровнями сходства SELECT Rsp2k // №2, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp2kFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() * aSay[15]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(15, mMess, N_ALL) IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOTOP() IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) SELECT Rsp2k DELETE FOR FILTER9 <> '#' PACK ENDIF SELECT Rsp2k // №3, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(Kod_ClSc,15)+STR(9999999.9999999-Korr,19,7) TO Rsp2kFltr DBGOTOP() N = 0 mKodClSc = Kod_ClSc DO WHILE .NOT. EOF() * aSay[15]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(15, mMess, N_ALL) IF mKodClSc = Kod_ClSc IF N < 1 REPLACE FilterM WITH '#' ++N ENDIF ELSE DBSKIP(-1) mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' DBSKIP(1) N = 0 mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOBOTTOM();REPLACE FilterM WITH '#' DBGOTOP() aSay[15]:SetCaption(aSay[15]:caption+L(" - Готово ")) ****** Rsp2i: Один класс - много объектов, интегральный критерий - суммарное количество информации aSay[16]:SetCaption(L('9/11: Создание подробной наглядной формы: "Класс-объекты". Инт.крит.-сумма инф.')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = N_Rasp + N_Rasp + N_Rasp * №1 №2 №3 mMess = L('9/11: Создание подробной наглядной формы: "Класс-объекты". Инт.крит.-сумма инф.:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) SELECT Rasp // №1, N_Rasp <<<############################################ SET ORDER TO 2 M_Num = 0 set printer to ("Rsp2i_"+Ar_Model[mNumModel]+".txt") ADDITIVE DBGOTOP() mKodClsRasp = Kod_cls DO WHILE .NOT. EOF() * aSay[16]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(16, mMess, N_ALL) mRecno = RECNO() M_KodObj = Kod_obj M_KodCls = Kod_cls M_Korr = Korr M_SumInf = Sum_inf M_Fakt = Fakt IF -100 <= M_Korr .AND. M_Korr <= +100 IF M_KodObj <= N_Obj .AND. M_KodCls <= N_Cls IF mKodClsRasp <> Kod_cls .AND. M_Num > 0 ?REPLICATE('~',LEN(mS1)) mKodClsRasp = Kod_cls ENDIF ?TABEXPAND(ALLTRIM(STR(M_KodObj)) +CHR(9)+' | ')+; ALLTRIM(aNameObj[M_KodObj])+SPACE(mLO-LEN(ALLTRIM(aNameObj[M_KodObj]))-2)+' | '+; TABEXPAND(ALLTRIM(STR(M_KodCls)) +CHR(9)+' | ')+; ALLTRIM(aNameCls[M_KodCls])+SPACE(mLC-LEN(ALLTRIM(aNameCls[M_KodCls])))+' | '+; TABEXPAND(ALLTRIM(STR(aKodClSc[M_KodCls])) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_Korr,15,7)) +CHR(9)+' | ')+; TABEXPAND(ALLTRIM(STR(M_SumInf,15,7)) +CHR(9)+' | ')+; TABEXPAND(REPLICATE("■", 0.15*ABS(M_SumInf)) +CHR(9)+' | ',16)+; M_Fakt+' | '+DTOC(DATE())+' | '+TIME()+' | '+; TABEXPAND(ALLTRIM(STR(++M_Num)) +CHR(9)+' | ') SELECT Rsp2i IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp2iFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DELETE FOR FILTER9 <> '#' PACK SET ORDER TO ENDIF SELECT Rsp2i APPEND BLANK REPLACE Kod_obj WITH M_KodObj REPLACE Name_obj WITH aNameObj[M_KodObj] REPLACE Kod_cls WITH M_KodCls REPLACE Kod_ClSc WITH aKodClSc[M_KodCls] REPLACE Name_cls WITH DelZeroNameGr(aNameCls[M_KodCls]) REPLACE Korr WITH M_Korr REPLACE Sum_inf WITH M_SumInf REPLACE Fakt WITH M_Fakt REPLACE Histogram WITH REPLICATE("|",ABS(M_SumInf)) REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() REPLACE Num WITH M_Num ENDIF ENDIF * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rasp DBGOTO(mRecno) DBSKIP(1) ENDDO ?REPLICATE('=',LEN(mS1)) IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF ****** Подготовка для отображения 9 записей с макс.модулем интегр.критерия сходства ****** и 2-х классов по каждой класс.шкале: с макс.и мин.уровнями сходства SELECT Rsp2i // №2, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(9999999.9999999-ABS(Korr),19,7) TO Rsp2iFltr DBGOTOP() N = 0 mKodObj = Kod_obj DO WHILE .NOT. EOF() * aSay[16]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(16, mMess, N_ALL) IF mKodObj = Kod_obj IF N < 9 REPLACE Filter9 WITH '#' ++N ENDIF ELSE N = 0 mKodObj = Kod_obj REPLACE Filter9 WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOTOP() IF RECCOUNT()*720 > 1500000000 // Если БД достигает очень большого размера, то оставить только наиболее значимые записи FlagRsp := .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2 Гб), .F. - не удалось (база больше 2 Гб) SELECT Rsp2i DELETE FOR FILTER9 <> '#' PACK ENDIF SELECT Rsp2i // №3, N_Rasp <<<############################################ INDEX ON STR(Kod_Obj,15)+STR(Kod_ClSc,15)+STR(9999999.9999999-Korr,19,7) TO Rsp2iFltr DBGOTOP() N = 0 mKodClSc = Kod_ClSc DO WHILE .NOT. EOF() * aSay[16]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(16, mMess, N_ALL) IF mKodClSc = Kod_ClSc IF N < 1 REPLACE FilterM WITH '#' ++N ENDIF ELSE DBSKIP(-1) mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' DBSKIP(1) N = 0 mKodClSc = Kod_ClSc REPLACE FilterM WITH '#' ++N ENDIF DBSKIP(1) ENDDO DBGOBOTTOM();REPLACE FilterM WITH '#' DBGOTOP() aSay[16]:SetCaption(aSay[16]:caption+L(" - Готово ")) // Сделать БД наглядных итогов: "Класс-объекты" aSay[17]:SetCaption(L('10/11: Создание итоговой наглядной формы: "Класс-объекты". Инт.крит.-корреляция')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = MIN(N_Cls,1500) * №1 mMess = L('10/11: Создание итоговой наглядной формы: "Класс-объекты". Инт.крит.-корреляция:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) FOR M_KodCls=1 TO MIN(N_Cls,1500) // №1, MIN(N_Cls,1500) <<<############################################ * aSay[17]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(17, mMess, N_ALL) SELECT Classes DBGOTO(M_KodCls) M_NameCls = Name_cls SELECT Rsp_ITk DBGOTO(1+N_Obj);M_KorrA = FIELDGET(7+M_KodCls) DBGOTO(2+N_Obj);M_KodObjA = FIELDGET(7+M_KodCls) DBGOTO(3+N_Obj);M_KorrB = FIELDGET(7+M_KodCls) DBGOTO(4+N_Obj);M_KodObjB = FIELDGET(7+M_KodCls) DBGOTO(5+N_Obj);M_Dost = FIELDGET(7+M_KodCls) DBGOTO(M_KodObjA) M_NameObjA = Name_obj // Объект, с которым у данного класса макс.ур.сходства. Отображать красным DBGOTO(M_KodObjB) M_NameObjB = Name_obj // Объект, с которым у данного класса мин.ур.сходства. Отображать синим SELECT Rsp_ITf DBGOTO(M_KodObjA) M_Fakt = FIELDGET(2+M_KodCls) SELECT Rsp_it2k APPEND BLANK REPLACE Kod_cls WITH M_KodCls REPLACE Name_cls WITH M_NameCls REPLACE Kod_objA WITH M_KodObjA REPLACE Name_objA WITH M_NameObjA REPLACE KorrA WITH M_KorrA REPLACE Fakt WITH M_Fakt REPLACE Kod_objB WITH M_KodObjB REPLACE Name_objB WITH M_NameObjB REPLACE KorrB WITH M_KorrB REPLACE Dost WITH M_Dost REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF NEXT IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[17]:SetCaption(aSay[17]:caption+L(" - Готово ")) aSay[18]:SetCaption(L('11/11: Создание итоговой наглядной формы: "Класс-объекты". Инт.крит.-сумма инф.')) mNumPP = 0 // Для отображения стадии исполнения этапа N_ALL = MIN(N_Cls,1500) + N_Cls + N_Cls * №1 №2 №3 mMess = L('11/11: Создание итоговой наглядной формы: "Класс-объекты". Инт.крит.-сумма инф.:') PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) FOR M_KodCls=1 TO MIN(N_Cls,1500) // №1, MIN(N_Cls,1500) <<<############################################ * aSay[18]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(18, mMess, N_ALL) SELECT Classes DBGOTO(M_KodCls) M_NameCls = Name_cls SELECT Rsp_ITi DBGOTO(1+N_Obj);M_SumInfA = FIELDGET(7+M_KodCls) DBGOTO(2+N_Obj);M_KodObjA = FIELDGET(7+M_KodCls) DBGOTO(3+N_Obj);M_SumInfB = FIELDGET(7+M_KodCls) DBGOTO(4+N_Obj);M_KodObjB = FIELDGET(7+M_KodCls) DBGOTO(5+N_Obj);M_Dost = FIELDGET(7+M_KodCls) DBGOTO(M_KodObjA) M_NameObjA = Name_obj // Объект, с которым у данного класса макс.ур.сходства. Отображать красным DBGOTO(M_KodObjB) M_NameObjB = Name_obj // Объект, с которым у данного класса мин.ур.сходства. Отображать синим SELECT Rsp_ITf DBGOTO(M_KodObjA) M_Fakt = FIELDGET(2+M_KodCls) SELECT Rsp_it2i APPEND BLANK REPLACE Kod_cls WITH M_KodCls REPLACE Name_cls WITH M_NameCls REPLACE Kod_objA WITH M_KodObjA REPLACE Name_objA WITH M_NameObjA REPLACE Sum_InfA WITH M_SumInfA REPLACE Fakt WITH M_Fakt REPLACE Kod_objB WITH M_KodObjB REPLACE Name_objB WITH M_NameObjB REPLACE Sum_InfB WITH M_SumInfB REPLACE Dost WITH M_Dost REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF NEXT IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF // Объединение итоговых наглядных форм "Класс-объект" для визуализации // Объединение БД SELECT Rsp_it2k + Rsp_it2i => Rsp_it2 для визуализации // Wsego = Wsego+N_Cls*2 SELECT Rsp_it2k // №2, N_Cls <<<############################################ DBGOTOP() DO WHILE .NOT. EOF() * aSay[18]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(18, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_it2 APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 1 // Инт.крит.-корреляция * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it2k DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it2i // №3, N_Cls <<<############################################ DBGOTOP() DO WHILE .NOT. EOF() * aSay[18]:SetCaption(mMess+' '+ALLTRIM(STR(++mNumPP/N_ALL*100,15,7))+'%') PercTimeVisio(18, mMess, N_ALL) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT Rsp_it2 APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT REPLACE Int_krit WITH 2 // Инт.крит.-сумма инф. * IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF SELECT Rsp_it2i DBSKIP(1) ENDDO IF Regim<>"3_5";lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk );ENDIF aSay[18]:SetCaption(aSay[18]:caption+L(" - Готово ")) *MsgBox('STOP') ********** Закрыть процесс печати выходной формы Set device to screen Set printer off Set printer to Set console on DC_ASave(M_CurrInf, "_RaspInf.arx") // Сохранение информации о модели, в которой было проведено распознавание Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы IF Dialog ************************************************************************************************** oSay97:SetCaption(L("ПАКЕТНОЕ РАСПОЗНАВАНИЕ ОБЪЕКТОВ РАСПОЗНАВАЕМОЙ ВЫБОРКИ ЗАВЕРШЕНО УСПЕШНО !")) oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) oDialog:Destroy() ************************************************************************************************** ENDIF FClose( nHandle[M_CurrInf] ) // Закрытие dbf и txt баз данных ###################################### *IF Regim <> "3_5" IF FlagRsp = .F. // .T. - удалось полностью записать базу данных результатов (она меньше 2Гб), .F. - не удалось (база больше 2Гб) aMess := {} AADD(aMess, L('Не удалось полностью записать базы данных результатов распознавания: "Rsp##-XXX.dbf",' )) AADD(aMess, L('так как они оказались больше 2 Гб. Поэтому в базах данных "Rsp##-XXX.txt" оставлены ' )) AADD(aMess, L('только максимальные по подулю уровня сходства результаты, а полностью они будут в БД:')) AADD(aMess, L('"Rsp##-XXX.txt", где: "##" - {1k, 1i, 2k, 2i}, "XXX" - {Abs, Prc1, Prc2, Inf1 - Inf7}.')) LB_Warning(aMess, L("4.1.2. пакетное распознавание" )) ENDIF *ENDIF // После расчета записать БД Rsp_it2k, Rsp_it2i с именами: Rsp_it2k_###, Rsp_it2i_###, где ### - наименование модели Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций mName = 'Rsp2k_'+Ar_Model[mNumModel]+'.dbf' COPY FILE 'Rsp2k.dbf' TO (mName) mName = 'Rsp2i_'+Ar_Model[mNumModel]+'.dbf' COPY FILE 'Rsp2i.dbf' TO (mName) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL *********************************************************************************************************** ******** Создание баз результатов распознавания для визуализации *********************************************************************************************************** FUNCTION GenDbfRspV(mNumModel) aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW USE Obi_Zag EXCLUSIVE NEW PUBLIC mLC := 15 SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() mLC = MAX(mLC, LEN(ALLTRIM(Name_cls))) DBSKIP(1) ENDDO PUBLIC mLO := 15 SELECT Obi_Zag DBGOTOP() DO WHILE .NOT. EOF() mLO = MAX(mLO, LEN(ALLTRIM(Name_obj))) DBSKIP(1) ENDDO CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj" , "C",mLO, 0 }, ; { "Kod_cls" , "N", 15, 0 }, ; { "Name_cls" , "C",mLC, 0 }, ; { "Kod_ClSc" , "N", 15, 0 }, ; { "Korr" , "N", 19, 7 }, ; { "Sum_inf" , "N", 19, 7 }, ; { "Fakt" , "C", 1, 0 }, ; { "Histogram", "C",100, 0 }, ; { "Filter9" , "C", 1, 0 }, ; // Фильтр для отображения по только 9 записей с макс. модулем уровня схосдтва { "FilterM" , "C", 1, 0 }, ; // Фильтр для отображения по каждой шкале только 2 записей с макс.и мин. уровнями сходства { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 }, ; { "Num" , "N", 15, 0 } } DbCreate( "Rsp1k.dbf", aStructure ) DbCreate( "Rsp1i.dbf", aStructure ) DbCreate( "Rsp2k.dbf", aStructure ) DbCreate( "Rsp2i.dbf", aStructure ) *GenNtxRasp() DC_DataRest( aSaveGenDbf ) **** Создать текстовые файлы (для моделей очень больших размерностей) PUBLIC mS1 := 'Код | Наименование'+SPACE(mLO-13)+'| Код | Наименование'+SPACE(mLC-11)+'| Код класс| Резонанс | Сумма | Гистограмма |Фа | Дата | Время | Номер |' PUBLIC mS2 := 'объекта | объекта '+SPACE(mLO-13)+'| класса | класса '+SPACE(mLC-11)+'| шкалы | знаний | знаний | |кт | | | п/п |' set device to printer set printer on set console off Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } mn="Rsp1k_"+Ar_Model[mNumModel]+".txt";IF FILE(mn);ERASE(mn);ENDIF set printer to (mn) ?'РЕЗУЛЬТАТЫ РАСПОЗНАВАНИЯ: "ОБЪЕКТ-КЛАССЫ" С ИНТ.КРИТ."РЕЗОНАНС ЗНАНИЙ" В МОДЕЛИ: "'+Ar_Model[mNumModel]+'"' ?REPLICATE('=',LEN(mS1));?mS1;?mS2;?REPLICATE('=',LEN(mS1)) mn="Rsp1i_"+Ar_Model[mNumModel]+".txt";IF FILE(mn);ERASE(mn);ENDIF set printer to (mn) ?'РЕЗУЛЬТАТЫ РАСПОЗНАВАНИЯ: "ОБЪЕКТ-КЛАССЫ" С ИНТ.КРИТ."СУММА ЗНАНИЙ" В МОДЕЛИ: "'+Ar_Model[mNumModel]+'"' ?REPLICATE('=',LEN(mS1));?mS1;?mS2;?REPLICATE('=',LEN(mS1)) mn="Rsp2k_"+Ar_Model[mNumModel]+".txt";IF FILE(mn);ERASE(mn);ENDIF set printer to (mn) ?'РЕЗУЛЬТАТЫ РАСПОЗНАВАНИЯ: "КЛАСС-ОБЪЕКТЫ" С ИНТ.КРИТ."РЕЗОНАНС ЗНАНИЙ" В МОДЕЛИ: "'+Ar_Model[mNumModel]+'"' ?REPLICATE('=',LEN(mS1));?mS1;?mS2;?REPLICATE('=',LEN(mS1)) mn="Rsp2i_"+Ar_Model[mNumModel]+".txt";IF FILE(mn);ERASE(mn);ENDIF set printer to (mn) ?'РЕЗУЛЬТАТЫ РАСПОЗНАВАНИЯ: "КЛАСС-ОБЪЕКТЫ" С ИНТ.КРИТ."СУММА ЗНАНИЙ" В МОДЕЛИ: "'+Ar_Model[mNumModel]+'"' ?REPLICATE('=',LEN(mS1));?mS1;?mS2;?REPLICATE('=',LEN(mS1)) RETURN NIL *********************************************************************************************************** ******** Создание базы визуализации итоговых результатов распознавания *********************************************************************************************************** FUNCTION GenDbfRspIt() aSaveGenDbf := DC_DataSave() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() * USE Obi_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Rso_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() ***** Определение максимальной длины наименования класса mMaxLenNameCls = -9999 SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() nMLN = LEN(ALLTRIM(Name_cls)) mMaxLenNameCls = IF(mMaxLenNameCls < nMLN, nMLN, mMaxLenNameCls) DBSKIP(1) ENDDO ***** Определение максимальной длины имени объекта распознаваемой выборки mMaxLenNameObj = -9999 SELECT Rso_zag DBGOTOP() DO WHILE .NOT. EOF() nMLN = LEN(ALLTRIM(Name_obj)) mMaxLenNameObj = IF(mMaxLenNameObj < nMLN, nMLN, mMaxLenNameObj) DBSKIP(1) ENDDO CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ********** Rsp_it#.dbf уровень сходства объекта с классом: k-корреляция, i-сумма информации aStructure := { { "Kod_Obj" , "N", 15, 0},; // 1 { "Name_Obj" , "C",mMaxLenNameObj, 0},; // 2 { "Max_Value", "N", 19, 7},; // 3 { "KodC_MaxV", "N", 15, 0},; // 4 { "Min_Value", "N", 19, 7},; // 5 { "KodC_MinV", "N", 15, 0},; // 6 { "Dost" , "N", 19, 7} } // 7 (Max_Value-Min_Value)/2 FOR j=1 TO MIN(N_Cls, 1500) FieldName = "CLS"+ALLTRIM(STR(j,19)) AADD(aStructure, { FieldName , "N", 19, 7 }) NEXT DbCreate( "Rsp_itk.dbf", aStructure ) DbCreate( "Rsp_iti.dbf", aStructure ) ********** Rsp_it.dbf уровень сходства объекта с классом по двум инт.критериям aStructure := { { "Kod_Obj" , "N", 15, 0},; // 1 { "Name_Obj" , "C",mMaxLenNameObj, 0},; // 2 { "Max_Value", "N", 19, 7},; // 3 { "KodC_MaxV", "N", 15, 0},; // 4 { "Min_Value", "N", 19, 7},; // 5 { "KodC_MinV", "N", 15, 0},; // 6 { "Dost" , "N", 19, 7} } // 7 (Max_Value-Min_Value)/2 FOR j=1 TO MIN(N_Cls, 1500) FieldName = "CLS"+ALLTRIM(STR(j,19)) AADD(aStructure, { FieldName , "N", 19, 7 }) NEXT AADD(aStructure, { "Int_krit" , "N", 1, 0} ) // oRadio={1,2} DbCreate( "Rsp_it.dbf", aStructure ) ********** Rsp_itf.dbf фактическая принадлежность объекта к классу aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj", "C",mMaxLenNameObj, 0 } } FOR j=1 TO MIN(N_Cls, 1500) FieldName = "CLS"+ALLTRIM(STR(j,19)) AADD(aStructure, { FieldName , "C", 1, 0 }) NEXT DbCreate( "Rsp_itf.dbf", aStructure ) aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj" , "C",mMaxLenNameObj, 0 }, ; { "Kod_clsA" , "N", 15, 0 }, ; // Класс, с которым у данного объекта макс.ур.сходства { "Name_clsA", "C",mMaxLenNameCls, 0 }, ; // Отображать красным { "KorrA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_clsB" , "N", 15, 0 }, ; // Класс, с которым у данного объекта мин.ур.сходства { "Name_clsB", "C",mMaxLenNameCls, 0 }, ; // Отображать синим { "KorrB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( "Rsp_it1k.dbf", aStructure ) // Объект-классы aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj" , "C",mMaxLenNameObj, 0 }, ; { "Kod_clsA" , "N", 15, 0 }, ; // Класс, с которым у данного объекта макс.ур.сходства { "Name_clsA", "C",mMaxLenNameCls, 0 }, ; // Отображать красным { "Sum_infA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_clsB" , "N", 15, 0 }, ; // Класс, с которым у данного объекта мин.ур.сходства { "Name_clsB", "C",mMaxLenNameCls, 0 }, ; // Отображать синим { "Sum_infB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( "Rsp_it1i.dbf", aStructure ) aStructure := { { "Kod_Obj" , "N", 15, 0 }, ; { "Name_Obj" , "C",mMaxLenNameObj, 0 }, ; { "Kod_clsA" , "N", 15, 0 }, ; // Класс, с которым у данного объекта макс.ур.сходства { "Name_clsA", "C",mMaxLenNameCls, 0 }, ; // Отображать красным { "Ur_SxodA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_clsB" , "N", 15, 0 }, ; // Класс, с которым у данного объекта мин.ур.сходства { "Name_clsB", "C",mMaxLenNameCls, 0 }, ; // Отображать синим { "Ur_SxodB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 }, ; { "Int_krit" , "N", 1, 0 } } DbCreate( "Rsp_it1.dbf", aStructure ) aStructure := { { "Kod_cls" , "N", 15, 0 }, ; { "Name_cls" , "C",mMaxLenNameCls, 0 }, ; { "Kod_objA" , "N", 15, 0 }, ; // Объект, с которым у данного класса макс.ур.сходства { "Name_objA", "C",mMaxLenNameObj, 0 }, ; // Отображать красным { "KorrA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_objB" , "N", 15, 0 }, ; // Объект, с которым у данного класса мин.ур.сходства { "Name_objB", "C",mMaxLenNameObj, 0 }, ; // Отображать синим { "KorrB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( "Rsp_it2k.dbf", aStructure ) // Класс-объекты, инт.крит.-корреляция aStructure := { { "Kod_cls" , "N", 15, 0 }, ; { "Name_cls" , "C",mMaxLenNameCls, 0 }, ; { "Kod_objA" , "N", 15, 0 }, ; // Объект, с которым у данного класса макс.ур.сходства { "Name_objA", "C",mMaxLenNameObj, 0 }, ; // Отображать красным { "Sum_infA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_objB" , "N", 15, 0 }, ; // Объект, с которым у данного класса мин.ур.сходства { "Name_objB", "C",mMaxLenNameObj, 0 }, ; // Отображать синим { "Sum_infB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 } } DbCreate( "Rsp_it2i.dbf", aStructure ) // Класс-объекты, инт.крит.-сумма инф. aStructure := { { "Kod_cls" , "N", 15, 0 }, ; { "Name_cls" , "C",mMaxLenNameCls, 0 }, ; { "Kod_objA" , "N", 15, 0 }, ; // Объект, с которым у данного класса макс.ур.сходства { "Name_objA", "C",mMaxLenNameObj, 0 }, ; // Отображать красным { "Ur_SxodA" , "N", 19, 7 }, ; // Уровень сходства объекта с классом { "Fakt" , "C", 1, 0 }, ; { "Kod_objB" , "N", 15, 0 }, ; // Объект, с которым у данного класса мин.ур.сходства { "Name_objB", "C",mMaxLenNameObj, 0 }, ; // Отображать синим { "Ur_SxodB" , "N", 19, 7 }, ; { "Dost" , "N", 19, 7 }, ; // Из Rsp_it#.dbf { "Date" , "C", 10, 0 }, ; { "Time" , "C", 8, 0 }, ; { "Int_krit" , "N", 1, 0 } } DbCreate( "Rsp_it2.dbf", aStructure ) // Класс-объекты, инт.крит.-сумма инф. *GenNtxRsIt() DC_DataRest( aSaveGenDbf ) RETURN NIL ************************************************************************************************************* ******** 4.1.3.1. Визуализация результатов распознавания в подробной наглядной форме в отношении: ******** "Один объект - много классов" с двумя интегральными критериями сходства между конкретным ******** образом распознаваемого объекта и обобщенными образами классов: "Семантический резонанс ******** знаний" и "Сумма знаний" ************************************************************************************************************* FUNCTION F4_1_3_1() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("4.1.3.1()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aCalcInf = DC_ARestore("_CalcInf.arx") ELSE LB_Warning(L("Вывод результатов распознавания невозможен, т.к. в 3-й подсистеме не просчитаны модели !!! ")) Running(.F.) RETURN NIL ENDIF IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE LB_Warning(L("Вывод результатов распознавания невозможен, т.к. нет информации о том, какая модель текущая !!! ")) Running(.F.) RETURN NIL ENDIF IF FILE("_RaspInf.arx") // Файл с информацией о том, в какой модели было проведено распознавание M_RaspInf = DC_ARestore("_RaspInf.arx") Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } IF M_CurrInf <> M_RaspInf Mess = L("Результаты распознавания получены в модели модели: #, отличающейся от текущей: $") Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) Mess = STRTRAN(Mess, "$", Ar_Model[M_CurrInf]) LB_Warning(Mess, L("Информационное сообщение")) ELSE * Mess = L("Результаты распознавания соответствуют текущей модели #") * Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) * LB_Warning(Mess, L("Информационное сообщение")) ENDIF ELSE aMess := {} AADD(aMess, L("Вывод результатов распознавания невозможен, т.к. оно не проводилось !!!")) AADD(aMess, L("Необходимо выполнить распознавание обучающей выборки в режиме 3.5")) AADD(aMess, L("или распознаваемой выборки в режиме 4.1.2 !!!")) LB_Warning(aMess, L("Информационное сообщение")) RETURN NIL ENDIF // Проверка на наличие отображаемых баз данных результатов распознавания IF .NOT. FILE("Rso_Zag.dbf") LB_Warning(L("Нет распознаваемой выборки! Небходимо выполнить режим: 4.1.1 или создать ее другим способом!")) Running(.F.) RETURN NIL ENDIF IF .NOT. FILE("Rsp1k.dbf") LB_Warning(L("Нет баз данных визуализация результатов распознавания! Небходимо выполнить режим: 4.1.2!")) Running(.F.) RETURN NIL ENDIF IF .NOT. FILE("Rsp1i.dbf") LB_Warning(L("Нет баз данных визуализация результатов распознавания! Небходимо выполнить режим: 4.1.2!")) Running(.F.) RETURN NIL ENDIF dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag INDEX ON Kod_Obj TO Rso_Zag CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rsp1k NEW INDEX ON Kod_Obj TO Rsp1k CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rsp1i NEW INDEX ON Kod_Obj TO Rsp1i CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag INDEX Rso_Zag EXCLUSIVE USE Rsp1k INDEX Rsp1k EXCLUSIVE NEW USE Rsp1i INDEX Rsp1i EXCLUSIVE NEW /* ----- Create ToolBar ----- */ ***** Кнопки визу ********************************************************************** @ 27.5, 0 DCPUSHBUTTON CAPTION L('Помощь' ) SIZE 9,1.3 ACTION {||Help4131a() , DC_GetRefresh(GetList)} TOOLTIP L('Помощь по режиму' ) @ DCGUI_ROW, DCGUI_COL + 8 DCPUSHBUTTON CAPTION L('9 классов' ) SIZE 10,1.3 ACTION {||Fltr9On4131() , DC_GetRefresh(GetList)} TOOLTIP L('Показать 9 классов с максимальным модулем сходства' ) @ DCGUI_ROW, DCGUI_COL + 1 DCPUSHBUTTON CAPTION L('Классы с MaxMin УрСх' ) SIZE 19,1.3 ACTION {||FltrMOn4131(Rsp1k->Kod_Cls) , DC_GetRefresh(GetList)} TOOLTIP L('Показать по каждой классиф.шкале только по 2 класса с макс.и миним.уровнями сходства' ) @ DCGUI_ROW, DCGUI_COL + 1 DCPUSHBUTTON CAPTION L('9 классов с MaxMin УрСх' ) SIZE 21,1.3 ACTION {||Fltr9MOn4131(Rsp1k->Kod_Cls) , DC_GetRefresh(GetList)} TOOLTIP L('Показать по каждой классиф.шкале только по 2 класса с макс.и миним.уровнями сходства' ) @ DCGUI_ROW, DCGUI_COL + 1 DCPUSHBUTTON CAPTION L('ВСЕ классы' ) SIZE 11,1.3 ACTION {||Fltr9Off4131() , DC_GetRefresh(GetList)} TOOLTIP L('Показать все записи независимо от модуля сходства' ) @ DCGUI_ROW, DCGUI_COL + 8 DCPUSHBUTTON CAPTION L('ВКЛ. фильтр по класс.шкале') SIZE 24,1.3 ACTION {||FltrOnCls4131(Rsp1k->Kod_Cls) , DC_GetRefresh(GetList)} TOOLTIP L('Показать все классы только одной классиф.шкалы, на которой стоит курсор в верхнем правом окне') @ DCGUI_ROW, DCGUI_COL + 1 DCPUSHBUTTON CAPTION L('ВЫКЛ.фильтр по класс.шкале') SIZE 25,1.3 ACTION {||FltrOffCls4131() , DC_GetRefresh(GetList)} TOOLTIP L('Показать сходство и различия с классами всех классификационных шкал' ) @ DCGUI_ROW, DCGUI_COL + 8 DCPUSHBUTTON CAPTION L('Граф.диаграммы' ) SIZE 15,1.3 ACTION {||ChartOn4131(Rso_Zag->Kod_Obj, Rsp1k->Kod_Cls, Ar_Model[M_CurrInf]) , DC_GetRefresh(GetList)} TOOLTIP L('Вывод графической диаграммы прогнозируемых сценариев' ) **************************************************************** @1.0, 0 DCPUSHBUTTON ; CAPTION L('Распознаваемые объекты') ; SIZE 34.8, 1 ; ACTION {||Help4131b()} @1.0,38 DCPUSHBUTTON ; CAPTION L('Интегральный критерий сходства: "Семантический резонанс знаний"'); SIZE 99.7, 1 ; ACTION {||Help4131c()} @14.2,38 DCPUSHBUTTON ; CAPTION L('Интегральный критерий сходства: "Сумма знаний"'); SIZE 99.7, 1 ; ACTION {||Help4_1_3_1d()} **************************************************************** PRIVATE bColorBlockKor:={|| iif(Rsp1k->Korr>0 ,{GRA_CLR_RED,nil},iif(Rsp1k->Korr=0 ,{GRA_CLR_WHITE,nil},{GRA_CLR_BLUE,nil})) } // Клиффорд PRIVATE bColorBlockInf:={|| iif(Rsp1i->Sum_inf>0,{GRA_CLR_RED,nil},iif(Rsp1i->Sum_inf=0,{GRA_CLR_WHITE,nil},{GRA_CLR_BLUE,nil})) } // Клиффорд /* ----- Create browse-1: Главная БД Rso_Zag.dbf ----- */ *bZag := {|| Rsp1i->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; * Rsp1i->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; * Rsp1i->(DC_DbGoTop()) , ; * oBrowInf:refreshAll() , ; * Rsp1k->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; * Rsp1k->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; * Rsp1k->(DC_DbGoTop()) , ; * oBrowKor:refreshAll() } bZag := {|| Rsp1i->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; Rsp1i->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; Rsp1i->(DC_DbGoTop()) , ; oBrowInf:refreshAll() , ; Rsp1k->(DC_SetScope(0,Rso_Zag->Kod_Obj)), ; Rsp1k->(DC_SetScope(1,Rso_Zag->Kod_Obj)), ; Rsp1k->(DC_DbGoTop()) , ; oBrowKor:refreshAll() } @ 2, 0 DCBROWSE oBrowZag ALIAS 'Rso_Zag' SIZE 34.8,25.2 ; PRESENTATION DC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bZag), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowZag DCBROWSECOL FIELD Rso_Zag->Kod_Obj HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Rso_Zag->Name_obj HEADER L('Наим.объекта') WIDTH 14.5 DCBROWSECOL FIELD Rso_Zag->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Rso_Zag->Time HEADER L('Время' ) WIDTH 9 /* Create browse-2: БД Rsp1k.dbf, связанная отношением "Один ко многим" с БД Rso_Zag.dbf*/ DCSETPARENT TO @2, 38 DCBROWSE oBrowKor ALIAS 'Rsp1k' SIZE 99.7,12.0 ; PRESENTATION DC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKor DCBROWSECOL FIELD Rsp1k->Kod_Cls HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Rsp1k->Name_cls HEADER L('Наименование класса') WIDTH 30 DCBROWSECOL FIELD Rsp1k->Korr HEADER L('Сходство' ) WIDTH 6 DCBROWSECOL FIELD Rsp1k->Fakt HEADER L('Факт' ) WIDTH 1 DCBROWSECOL FIELD Rsp1k->Histogram HEADER L('Сходство' ) WIDTH 19 COLOR bColorBlockKor DCBROWSECOL FIELD Rsp1k->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Rsp1k->Time HEADER L('Время' ) WIDTH 9 /* Create browse-3: БД Rsp1i.dbf, связанная отношением "Один ко многим" с БД Rso_Zag.dbf*/ DCSETPARENT TO @15.2,38 DCBROWSE oBrowInf ALIAS 'Rsp1i' SIZE 99.7,12.0; PRESENTATION DC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowInf DCBROWSECOL FIELD Rsp1i->Kod_Cls HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Rsp1i->Name_cls HEADER L('Наименование класса') WIDTH 30 DCBROWSECOL FIELD Rsp1i->Sum_inf HEADER L('Сходство' ) WIDTH 6 DCBROWSECOL FIELD Rsp1i->Fakt HEADER L('Факт' ) WIDTH 1 DCBROWSECOL FIELD Rsp1i->Histogram HEADER L('Сходство' ) WIDTH 19 COLOR bColorBlockInf DCBROWSECOL FIELD Rsp1i->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Rsp1i->Time HEADER L('Время' ) WIDTH 9 SELECT Rso_Zag DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE cTitle = L('4.1.3.1. Визуализация результатов распознавания в отношении: "Объект-классы". Текущая модель: "')+UPPER(Ar_Model[M_CurrInf])+'"' DCREAD GUI ; FIT ; OPTIONS GetOptions ; MODAL ; TITLE cTitle ; EVAL {|o|SetAppFocus(oBrowZag:GetColumn(1))} ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ********** END OF EXAMPLE *********************** ************************************************************************************************** FUNCTION Help4131a() aHelp := {} AADD(aHelp, L('Режим: 4.1.3.1. ВИЗУАЛИЗАЦИЯ РЕЗУЛЬТАТОВ РАСПОЗНАВАНИЯ В ОТНОШЕНИИ: ')) AADD(aHelp, L('"ОДИН ОБЪЕКТ - МНОГО КЛАССОВ" предназначен для наглядной визуализации результатов ')) AADD(aHelp, L('распознавания, идентификации и прогнозирования, полученных с двумя интегральными ')) AADD(aHelp, L('критериями сходства между конкретным образом распознаваемого объекта и обобщенными ')) AADD(aHelp, L('образами классов: "Семантический резонанс" и "Сумма информации". При этом для ')) AADD(aHelp, L('каждого объекта распознаваемой выборки выводится список классов, ранжированный по ')) AADD(aHelp, L('убыванию интегрального критерия сходства. В начале этого списка расположены классы,')) AADD(aHelp, L('к которым распознаваемый объект, по-видимому, относится по своим признакам, а в ')) AADD(aHelp, L('конце - к которым он определенно не относится. ')) AADD(aHelp, L('КНОПКИ УПРАВЛЕНИЯ: ')) AADD(aHelp, L('- [9 классов]: Показать 9 классов с максимальным модулем сходства ')) AADD(aHelp, L('- [Классы с MaxMin УрСх]: Показать по каждой классификационной ')) AADD(aHelp, L(' шкале только по 2 класса с максимальным и минимальным уровнями сходства ')) AADD(aHelp, L('- [ВСЕ классы]: Показать все записи независимо от модуля сходства ')) AADD(aHelp, L('- [ВКЛ. фильтр по класс.шкале]: Показать все классы только одной классификационной ')) AADD(aHelp, L('шкалы, на которой стоит курсор в верхнем правом окне ')) AADD(aHelp, L('- [ВЫКЛ.фильтр по класс.шкале]: Показать сходство и различия с классами всех ')) AADD(aHelp, L('классификационных шкал ')) AADD(aHelp, L('- [Граф.диаграмма]: Графическая диаграмма прогнозируемых сценариев ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-10, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('Помощь по режиму: 4.1.3.1. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ************************************************************************************************** FUNCTION Help4131b() aHelp := {} AADD(aHelp, L('ПОЯСНЕНИЕ ПО СМЫСЛУ ТЕРМИНА: "РАСПОЗНАВАЕМАЯ ВЫБОРКА". ')) AADD(aHelp, L('Распознаваемая выборка представляет собой описания конкретных объектов, предъявляемых системе')) AADD(aHelp, L('"Эйдос-Х++" для распознавания, идентификации и прогнозирования. Эти описания вводятся в режиме')) AADD(aHelp, L('4.1.1 или формируются другим способом, и состоят из перечисления кодов признаков(градаций ')) AADD(aHelp, L('описательных шкал) каждого объекта в соответствии с справочниками описательных шкал и градаций')) AADD(aHelp, L('(режим 2.2). При этом коды могут быть приведены в любом порядке. Коды несуществующих ')) AADD(aHelp, L('признаков, в т.ч. 0, игнорируются. Используя модель знаний, созданную в 3-й подсистеме, ')) AADD(aHelp, L('система "Эйдос-Х++" для каждого распознаваемого объекта определяет степень сходства его ')) AADD(aHelp, L('конкретного образа с обобщенными образами всех классов. При этом используются два интегральных')) AADD(aHelp, L('критерия сходства: "Семантический резонанс знаний" и "Сумма знаний". ')) mHelpMax = -999;FOR h=1 TO LEN(aHelp);mHelpMax = MAX(mHelpMax, LEN(ALLTRIM(aHelp[h])));NEXT s=1;d=0.9;@0,0 DCGROUP oGroup1 CAPTION L(' ') SIZE mHelpMax-10, LEN(aHelp)*d+1.5 FOR h=1 TO LEN(aHelp);@s,2 DCSAY aHelp[h] SIZE 0 PARENT ogroup1;s=s+d;NEXT DCREAD GUI TO lExit FIT MODAL TITLE L('4.1.3.1. Смысл термина: "Распознаваемая выборка" (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** ***************************************************************************************** ******** Помощь по режиму 4.1.3.1: смысл интегрального критерия "Семантический ******** резонанс знаний" сходства распознаваемых объектов с классами системы "Эйдос-Х++" ***************************************************************************************** FUNCTION Help4131c() * SET TAG TO COMMAND aSaveH4131 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы cFile = "_Int_Criteria2.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 5431862 DC_PrintPreviewAcrobat( '_Int_Criteria2.pdf', 'Система "Эйдос-Х++"' ) ELSE Mess = L('Файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файлы LB_Warning(Mess) ENDIF DIRCHANGE(Disk_dir) IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF DC_DataRest( aSaveH4131 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ****************************************************************************** ******** Помощь по режиму 4.1.3.1: Смысл интегрального критерия "Сумма знаний" ******** сходства распознаваемых объектов с классами системы "Эйдос-Х++" ****************************************************************************** FUNCTION Help4_1_3_1d() * SET TAG TO COMMAND aSaveH4131 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы cFile = "_Int_Criteria1.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 4444184 DC_PrintPreviewAcrobat( '_Int_Criteria1.pdf', 'Система "Эйдос-Х++"' ) ELSE Mess = L('Файл: "#" поврежден и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) * Mess = STRTRAN(Mess, "#", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файлы LB_Warning(Mess) ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF DC_DataRest( aSaveH4131 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ***************************************************************************************************************** ******** Помощь по режиму 4.1.3.1: Смысл интегральных критериев: "Сумма знаний" и "Семантический резонанс знаний" ******** сходства распознаваемых объектов с классами системы "Эйдос-Х++" ***************************************************************************************************************** FUNCTION Help4131() DIRCHANGE(Disk_dir) cFile = "_Int_Criteria1.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 4444184 // <<<===############### DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF cFile = "_Int_Criteria2.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ENDIF // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 5431862 // <<<===############### DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF RETURN NIL ****************************************************************************** FUNCTION Search4_1_3_1() Razrab() RETURN NIL ******** Выбрать классификационную шкалу и сделать по ней фильтр ******************************* FUNCTION FltrOnCls4131(mKodClSc) // Код класс.шкалы брать прямо из базы Rsp1k.dbf из текущей записи SELECT Rsp1k // В этих базах для визуализации добавить поле с кодом класс.шкалы, чтобы можно было по нему делать фильтр mKodClSc = Kod_ClSc SET FILTER TO mKodClSc = Kod_ClSc DBGOTOP();DBGOBOTTOM();DBGOTOP() DC_GetRefresh(GetList) SELECT Rsp1i // В этих базах для визуализации добавить поле с кодом класс.шкалы, чтобы можно было по нему делать фильтр SET FILTER TO mKodClSc = Kod_ClSc DBGOTOP();DBGOBOTTOM();DBGOTOP() DC_GetRefresh(GetList) RETURN NIL ******** Отменить фильтр по классификационной шкале ******************************************** FUNCTION FltrOffCls4131() SELECT Rsp1k;SET FILTER TO;DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) SELECT Rsp1i;SET FILTER TO;DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) RETURN NIL ******** Отображать не более 9 записей на объект с максимальным модулем интегрального критерия FUNCTION Fltr9On4131() Fltr9Off4131() SELECT Rsp1k;SET FILTER TO Filter9 = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) SELECT Rsp1i;SET FILTER TO Filter9 = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) RETURN NIL ******** Отображать по каждой класс.шкале только по 2 класса: с Max.и Min.Ур.Сх. FUNCTION FltrMOn4131() Fltr9Off4131() SELECT Rsp1k;SET FILTER TO FilterM = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) SELECT Rsp1i;SET FILTER TO FilterM = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) RETURN NIL ******** Отображать не более 9 записей на объект с максимальным модулем интегрального критерия ******** по каждой класс.шкале только по 2 класса: с Max.и Min.Ур.Сх. FUNCTION Fltr9MOn4131() Fltr9Off4131() SELECT Rsp1k;SET FILTER TO Filter9 = '#' .AND. FilterM = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) SELECT Rsp1i;SET FILTER TO Filter9 = '#' .AND. FilterM = '#';DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) RETURN NIL ******** Выключить фильтр, т.е. показать все классы FUNCTION Fltr9Off4131() SELECT Rsp1k;SET FILTER TO;DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) SELECT Rsp1i;SET FILTER TO;DBGOTOP();DBGOBOTTOM();DBGOTOP();DC_GetRefresh(GetList) RETURN NIL FUNCTION PrintXLS4131() Razrab() RETURN NIL ****************************************************************************** ******************************************************************************************* ******** 4.1.3.2. Визуализация результатов распознавания в подробной наглядной форме в ******** отношении: "Один класс - много объектов" с двумя интегральными критериями ******** сходства между конкретным образом распознаваемого объекта и обобщенными ******** образами классов: "Семантический резонанс знаний" и "Сумма знаний" ******************************************************************************************* FUNCTION F4_1_3_2() LOCAL GetList := {}, GetOptions, oBrowUser, oBrowApp, bApp, bItems Running(.T.) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF IF ApplChange("4.1.3.2()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN NIL ENDIF IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее aCalcInf = DC_ARestore("_CalcInf.arx") ELSE LB_Warning(L("Вывод результатов распознавания невозможен, т.к. в 3-й подсистеме не просчитаны модели !!! ")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN NIL ENDIF IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE LB_Warning(L("Вывод результатов распознавания невозможен, т.к. нет информации о том, какая модель текущая !!! ")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN NIL ENDIF IF FILE("_RaspInf.arx") // Файл с информацией о том, в какой модели было проведено распознавание M_RaspInf = DC_ARestore("_RaspInf.arx") Ar_Model := {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" } IF M_CurrInf <> M_RaspInf Mess = L("Результаты распознавания получены в модели модели: #, отличающейся от текущей: $") Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) Mess = STRTRAN(Mess, "$", Ar_Model[M_CurrInf]) LB_Warning(Mess, L("Информационное сообщение")) ELSE * Mess = L("Результаты распознавания соответствуют текущей модели #") * Mess = STRTRAN(Mess, "#", Ar_Model[M_RaspInf]) * LB_Warning(Mess, L("Информационное сообщение")) ENDIF ELSE LB_Warning(L("Вывод результатов распознавания невозможен, т.к. оно не проводилось !!!"), L("Информационное сообщение")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN NIL ENDIF // Проверка на наличие отображаемых баз данных результатов распознавания IF .NOT. FILE("Classes.dbf") LB_Warning(L("Нет справочника классов! Небходимо выполнить режим: 2.1 или создать его другим способом!")) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы