// (C) Персональная интеллектуальная онлайн среда "ЭЙДОС-X Professional" (Система "Эйдос-Хpro"), ADS-mADStxt, beta-version, rel: 08.12.2022. // (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/__AidosALL.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 more 338 (http://aidos.byethost5.com/Source_data_applications/WebAppls.htm), respectively) (http://lc.kubagro.ru/aidos/Presentation_Aidos-online.pdf); *- it supports on-line environment of knowledge accumulation and is widely used all over the world (http://aidos.byethost5.com/map5.php); *- it provides multilingual interface support in 51 languages. The language databases are included in the installation and can be replenished automatically; *- 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 "adsdbe.ch" // ADSDBE = ADS SERVER ENGINE ******************** #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 "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" *#include "dll.ch" #define SW_HIDE 0 #define SW_NORMAL 1 #define SW_SHOWMINIMIZED 2 #define SW_SHOWMAXIMIZED 3 #define SW_MAXIMIZE 3 #define SW_SHOWNOACTIVATE 4 #define SW_SHOW 5 #define SW_MINIMIZE 6 #define SW_SHOWMINNOACTIVE 7 #define SW_SHOWNA 8 #define SW_RESTORE 9 #define SW_SHOWDEFAULT 10 #define SE_ERR_FNF 2 #define SE_ERR_PNF 3 #define SE_ERR_ACCESSDENIED 5 #define SE_ERR_OOM 8 #define SE_ERR_DLLNOTFOUND 32 #define SE_ERR_SHARE 6 #define SE_ERR_ASSOCINCOMPLETE 27 #define SE_ERR_DDETIMEOUT 28 #define SE_ERR_DDEFAIL 29 #define SE_ERR_DDEBUSY 30 #define SE_ERR_NOASSOC 31 #define ERROR_BAD_FORMAT 11 #pragma Library( "ASINet10.lib" ) // 2.0 // Для альтернативного и неальтернативного выбора в просмотре таблиц *#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 #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 // Return types of ADSDBE_TBL_MODE *#define ADSDBE_NTX 1 *#define ADSDBE_CDX 2 *#define ADSDBE_ADT 3 // Для опредедения разрешения монитора от Джимми #define DESKTOPVERTRES 117 #define DESKTOPHORZRES 118 // 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 * Для CSV=>DBF конвертера *#include "ot4xb.ch" // => ot4xb.dll => www.xbwin.com #ifndef CRLF #define CRLF chr(13)+chr(10) #endif * Klasse zum sequentiellen Einlesen groбer Dateien *#IF .t. // zum Einbinden in eigenes Projekt, .f. setzen ! MEMVAR dCBROWSE, dCEDIT, dCCOLOR STATIC snHdll // Для быстрой графики Роджера ******************************************************************************** PROCEDURE AppSys // Рабочий стол остается окном приложения RETURN ******************************************************************************** *************************************************************************** PROCEDURE DBESYS() // Overload the default DBESYS for your required DBE *************************************************************************** * IF .NOT. FILE('_ADS.txt') * PUBLIC mADStxt := 'OFF' // Advantage Database Server (ADS) не используется * StrFile(mADStxt, '_ADS.txt') * ELSE * mADStxt = FileStr('_ADS.txt') * IF mADStxt = 'OFF' .OR. mADStxt = 'ON' * ELSE * PUBLIC mADStxt := 'OFF' // Advantage Database Server (ADS) не используется * StrFile(mADStxt, '_ADS.txt') * ENDIF * ENDIF * MsgBox(mADStxt) * IF mADStxt = 'OFF' * IF ! DbeLoad( "NTXDBE") // load engine for DBF files * msgbox( "Database Engine NTXDBE not loaded" , "STOP" ) * QUIT * ENDIF * DbeBuild( "DBFNTX", "DBFDBE", "NTXDBE" ) // DBE=DBFNTX * DbeSetDefault("DBFNTX") // ADS OFF * ENDIF * IF mADStxt = 'ON' * MsgBox(mADStxt) * //----- FOXCDX: DBF-FPT-CDX * IF ! DbeLoad( "FOXDBE", .T.) // load engine for DBF files * msgbox( "Database Engine FOXDBE not loaded" , "STOP" ) * QUIT * ENDIF * IF ! DbeLoad( "CDXDBE", .T.) // load engine for DBF files * msgbox( "Database Engine CDXDBE not loaded" , "STOP" ) * QUIT * ENDIF * DbeBuild( "FOXCDX", "FOXDBE", "CDXDBE" ) // DBE=FOXCDX * *** DbeSetDefault("FOXCDX") // OFF * //----- DBFNTX: DBF-DBT-NTX * // ADS client engine and ALS Local Server engine exist * // Overload the default DBESYS for your required DBE * // system for working with DBF/NTX files on both server and client * IF ! DbeLoad( "DBFDBE") // load engine for DBF files * msgbox( "Database Engine DBFDBE not loaded" , "STOP" ) * QUIT * ENDIF * IF ! DbeLoad( "NTXDBE") // load engine for DBF files * msgbox( "Database Engine NTXDBE not loaded" , "STOP" ) * QUIT * ENDIF * DbeBuild( "DBFNTX", "DBFDBE", "NTXDBE" ) // DBE=DBFNTX * *** DbeSetDefault("DBFNTX") // OFF //----- ADSDBE: DBF-DBT-NTX // there must be ACE32.DLL otherwise it breaks here !!! // mora postojati ACE32.DLL inaиe ovde pukne !!! //----------------------------------------------------- IF ! DbeLoad( "ADSDBE", .F.) // load engine for ADS msgbox( "Database Engine ADSDBE not loaded" , "STOP" ) QUIT ENDIF *********************** DbeSetDefault("ADSDBE") // ON *********************** * ENDIF 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() IF .NOT. FILE('_ADS.txt') PUBLIC mADStxt := 'OFF' // Advantage Database Server (ADS) не используется StrFile(mADStxt, '_ADS.txt') ELSE mADStxt = FileStr('_ADS.txt') IF mADStxt = 'OFF' .OR. mADStxt = 'ON' ELSE PUBLIC mADStxt := 'OFF' // Advantage Database Server (ADS) не используется StrFile(mADStxt, '_ADS.txt') ENDIF ENDIF ADS_SERVER_START() DO CASE CASE mADStxt = 'OFF' DbeSetDefault("DBFNTX") // ADS OFF CASE mADStxt = 'ON' DbeSetDefault("ADSDBE") // ADS ON ENDCASE * BigData() // Функция для отладки работы с большими данными (DBF-файлы >>> 2 Gb) <<<===############################# CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций PUBLIC Disk_name := DISKNAME() PUBLIC Cur_dir := CURDIR() PUBLIC Disk_dir := Disk_name+":\"+Cur_dir // Путь на папку с системой * DIRCHANGE(Disk_dir) // Папка с исполнимым модулем системы Эйдос * *************************************************************************************************************** * ***** Если система Эйдос уже запущена выдать сообщение об этом и выйти **************************************** * ***** Предотвращение повторного запуска __aidos-x.exe ********************************************************* * RunShell('/C c:\Windows\System32\TaskList.exe /V /FO CSV > TaskList.csv',,.F.,.T.) // .F. - чтобы программа не продожалась дальше, пока не закончится перевод * aTaskList := {} // Все программы, запущенные на компьютере * nHandle := DC_txtOpen( 'TaskList.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(aTaskList, mModName) = 0 // Каждая программа запоминается только один раз * AADD (aTaskList, mModName) * ENDIF * ENDIF * DC_TxtSkip( nHandle, 1 ) * ENDDO * DC_TxtClose( nHandle ) ** LB_Warning(aTaskList, '(C°) Система "Эйдос-Х++"') * mFlagAidos = .F. // Система Эйдос не запущена * IF ASCAN(aTaskList, '__aidos-x.exe') = 0 // Каждая программа запускается только один раз * mFlagAidos = .T. // Система Эйдос уже запущена * ENDIF ** IF DC_IsAppRunning('XbpDialog', '(C) Система "Эйдос"', '__aidos-x.exe',.T.) * IF mFlagAidos * aMess := {} * AADD(aMess, 'Система "Эйдос" уже запущена в папке: "'+ConvToOemCP(ALLTRIM(Disk_dir))+'\"' ) * AADD(aMess, 'Нельзя запускать исполнимый модуль системы: "_aidos-x.exe"') * AADD(aMess, 'несколько раз, т.к. система будет пытаться одновременно ') * AADD(aMess, 'обращаться к одним и тем же базам данных, что вызывает ') * AADD(aMess, 'ошибку исполнения. ') * LB_Warning(aMess, '(C°) Система "Эйдос"') * QUIT * ENDIF * ***** Если система Эйдос уже запущена в данной папке выдать сообщение об этом и выйти ************************* * *************************************************************************************************************** ****************************************** ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения *** *** RECOVER // код обработки ошибки aMess := {} AADD(aMess, L('При распознавании была попытка превышения максимального допустимого объема БД 2 Гб.')) // НАПРИМЕР AADD(aMess, L('Необходимо уменьшить количество классов или/и объектов распознаваемой выборки !!! ')) AADD(aMess, L('Можно также исключить из результатов распознавания наименее достоверные (режим 3.5)')) LB_Warning(aMess) * EXIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый ****************************************** ****************************************** ***** Удаление старых версий файла START_AIDOS запуска и обновления системы Эйдос, если они есть <<<===####################### CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * aDir := Directory("*START_AIDOS-X*.exe") // С ADS не работает mNStartAidos = ADIR("*START_AIDOS-X*.exe") // С ADS работает PRIVATE aFileName[mNStartAidos], aFileSize[mNStartAidos], aFileDate[mNStartAidos], aFileTime[mNStartAidos] ADIR("*START_AIDOS-X*.exe", aFileName, aFileSize, aFileDate, aFileTime) * LB_Warning(aFileName, 'Эксперименты с "BigData.dbf"') aStructure := { { 'File_Num ', "C", 8, 0 }, ; { 'File_Name', "C", 40, 0 }, ; // ___START_AIDOS-X_2021_10_26.exe { 'File_Size', "N", 10, 0 }, ; { 'File_Date', "C", 8, 0 }, ; { 'File_Time', "C", 8, 0 }, ; { 'Delete ', "C", 1, 0 } } DbCreate( "StartAidos.dbf", aStructure, "DBFNTX" ) // ALL NB !!! * DbCreate( "StartAidos", aStructure ) // ALL NB !!! * USE ("StartAidos.dbf") NEW SHARED ALIAS "START_AIDOS" USE StartAidos EXCLUSIVE NEW IF LEN(aFileName) > 0 * FOR j := 1 TO Len(aDir) // С ADS не работает * APPEND BLANK * REPLACE File_Num WITH ALLTRIM(STR(j)) * REPLACE File_Name WITH aDir[j,F_NAME] * REPLACE File_Size WITH aDir[j,F_SIZE] * REPLACE File_Date WITH DTOS(aDir[j,F_WRITE_DATE]) * REPLACE File_Time WITH aDir[j,F_WRITE_TIME] * REPLACE Delete WITH 'Y' * NEXT FOR j := 1 TO Len(aFileName) // С ADS работает APPEND BLANK REPLACE File_Num WITH ALLTRIM(STR(j)) REPLACE File_Name WITH aFileName[j] REPLACE File_Size WITH aFileSize[j] REPLACE File_Date WITH DTOS(aFileDate[j]) REPLACE File_Time WITH aFileTime[j] REPLACE Delete WITH 'Y' NEXT INDEX ON File_Date+File_Time TO StartAidos DBGOBOTTOM() REPLACE Delete WITH 'N' mFileName = ALLTRIM(File_Name) * MsgBox(mFileName) DBGOTOP() DO WHILE .NOT. EOF() IF Delete = 'Y' ERASE(File_Name) ENDIF DBSKIP(1) ENDDO CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF mFileName <> "___START_AIDOS-X.exe" * COPY FILE (mFileName) TO ('___START_AIDOS-X.exe') // <<<===########################## Без ADS ADS_CopyFile(mFileName, '___START_AIDOS-X.exe', .F., .T.) // Скопировать новый файл запуска со стандартным именем и удалить новый файл с ADS ERASE(mFileName) ENDIF ENDIF ****************************************************************************************************************************** ** Если ранее язык интерфейса не был задан - то задать русский, ** если был - то использовать тот, который был задан ** Если нет языковых баз - то создать их и задать текущим русский язык * 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 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 ******************************************************************************************************** ****** Определить размеры экрана в пикселях разными способами и выбрать минимальные значения, но не нули ******************************************************************************************************** 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 = +4096 nHeight = +4096 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 * MsgBox('Шрифты установлены!') *************************************************************************************************************** ***** Если путь на папку с системой содержит русские символы (кириллицу) или пробел, то выдать сообщение и завершить работу ***** Допустимы только символы с кодами: 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) Система "Эйдос"')) ADS_SERVER_QUIT() QUIT ENDIF ***** Если путь на папку с системой содержит русские символы или пробел, то выдать сообщение и завершить работу *************************************************************************************************************** *************************************************************************************************************** ***** Если похоже, что система запущена из архива (в диск Disk_dir есть c:\Users\1\AppData\Local\Temp\_tc\), ***** то выдать сообщение и завершить работу IF AT('Users' , Disk_dir) > 0 .AND. ; 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) Система "Эйдос"')) ADS_SERVER_QUIT() QUIT ENDIF ***** Если похоже, что система запущена из архива, то выдать сообщение и завершить работу *************************************************************************************************************** *************************************************************************************************************** ***** Если похоже, что система запущена в папке загрузки (в диск Disk_dir есть c:\Users\1\Downloads ), ***** или на работчем столе (в диск Disk_dir есть c:\Users\1\Desktop, то выдать сообщение и завершить работу IF AT('Users' , Disk_dir) > 0 .AND. ; AT('Downloads', Disk_dir) > 0 .OR. ; AT('Desktop' , Disk_dir) > 0 .OR. ; AT('Загрузки' , Disk_dir) > 0 aMess := {} AADD(aMess, L('Система запущена в папке: "')+ConvToOemCP(ALLTRIM(Disk_dir))+'\"' ) AADD(aMess, ' ') 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, '(C) Система "Эйдос"') ADS_SERVER_QUIT() QUIT ENDIF ***** Если похоже, что система запущена из архива, то выдать сообщение и завершить работу *************************************************************************************************************** ****************************************************************************************************************************** ** Запуск procexp.exe, если он есть (вместо диспетчера задач, т.к. он может быть заблокирован, да и вообще хорошая вещь от MS) ** Проверять контрольную сумму, если есть файл с контрольной суммой, или делать файл с контрольной суммой, если его нет RunShell('/C c:\Windows\System32\TaskList.exe /V /FO CSV > TaskList.csv',,.F.,.T.) // .F. - чтобы программа не продожалась дальше, пока не закончится перевод aTaskList := {} // Все программы, запущенные на компьютере nHandle := DC_txtOpen( 'TaskList.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(aTaskList, mModName) = 0 // Каждая программа запоминается только один раз AADD (aTaskList, mModName) * ENDIF ENDIF DC_TxtSkip( nHandle, 1 ) ENDDO DC_TxtClose( nHandle ) * LB_Warning(aTaskList, '(C°) Система "Эйдос-Х++"') mFlagprocexp64 = .F. // Программа procexp64.exe не запущена IF ASCAN(aTaskList, 'procexp64.exe') > 0 // Каждая программа запоминается только один раз mFlagprocexp64 = .T. // Программа procexp64.exe запущена ENDIF cFile = 'procexp.exe' IF FILE(cFile) IF .NOT. FILE('_CheckSumProcExp.txt') // Если файла с контрольной суммой нет, то создать его StrFile(ALLTRIM(STR(FILECHECK(cFile))), '_CheckSumProcExp.txt') ELSE // Если файл с контрольной суммой есть, то проверить его совпадение и выдать сообщение, если он отличается mCheckSum = VAL(FileStr('_CheckSumProcExp.txt')) IF FILECHECK(cFile) = mCheckSum * IF .NOT. DC_IsAppRunning('XbpDialog', '(C) Система "Эйдос"', 'procexp64.exe',.T.) // Запускать procexp.exe только один раз IF .NOT. mFlagprocexp64 // Если программа procexp64.exe не запущена, то запустить ее RunShell("/t", "procexp.exe", .T.) // Спасибо Вольфгангу Цирику ENDIF ELSE aMess := {} AADD(aMess, L('EXE-модуль утилиты MS Process Explorer несанкционированно изменен,')) AADD(aMess, L('Поэтому ее работоспособность не гарантируется и она не запущена !!')) LB_Warning(aMess,'(С°) "Эйдос-Х++"') ENDIF ENDIF ENDIF * WTF ****************************************************************************************************************************** *************************************************************************************************************** ***** Если система Эйдос уже запущена в данной папке выдать сообщение об этом и выйти PUBLIC M_ApplsPath := UPPER(ALLTRIM(Disk_dir))+"\AID_DATA" IF .NOT. FILE("PathGrAp.dbf") // запуск системы Эйдос <<<===################################################ GenDbfPaths() ELSE 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 aMess := {} AADD(aMess, L('Это окно появилось потому, что система "Эйдос" уже запущена в папке: "'+ConvToOemCP(ALLTRIM(Disk_dir))+'\", а вы' )) AADD(aMess, L('попытались запустить систему повторно, наверное не дождавшись появления стартового окна.' )) AADD(aMess, L('')) AADD(aMess, L('НЕЛЬЗЯ запускать исполнимый модуль системы: "_aidos-x.exe" в одной папке несколько раз, т.к. система будет пытаться' )) AADD(aMess, L('одновременно обращаться к одним и тем же базам данных, что вызывает конфликт. Но в других папках это вполне возможно.')) AADD(aMess, L('')) AADD(aMess, L('По этой же причине в системе "Эйдос" НЕЛЬЗЯ запускать и несколько режимов из главного меню одновременно, т.е. сначала')) AADD(aMess, L('надо завершить работу (закрыть) ранее запущенный из главного меню режим и только уже после этого запускать новый.' )) AADD(aMess, L('')) AADD(aMess, L('Процесс запуска системы "Эйдос" довольно ДЛИТЕЛЬНЫЙ, т.к. при этом выполняется много разных проверок корректности ' )) AADD(aMess, L('места запуска системы:' )) AADD(aMess, L('- запущена ли система в папке загрузки;' )) AADD(aMess, L('- запущена ли система в папке на рабочем столе;' )) AADD(aMess, L('- запущена ли система в скачанном архиве, в котором она находится;' )) AADD(aMess, L('- есть ли в полном пути на исполнимый модуль системы "__aidos-x.exe" пробелы и кириллица.' )) AADD(aMess, L('')) AADD(aMess, L('Кроме того при запуске системы "Эйдос" определяются все запущенные на этот момент приложения и после ее запуска' )) AADD(aMess, L('закрывается браузер, открывающийся при обращении системы к своему FTP-серверу, если он до этого не был открыт.' )) AADD(aMess, L('Если же он был открыт, то запускается сайт проф.Е.В.Луценко: http://lc.kubagro.ru/.' )) AADD(aMess, L('')) AADD(aMess, L('При запуске системы "Эйдос" запускается также "procexp.exe" (Process Explorer v16.43: http://www.sysinternals.com/).' )) AADD(aMess, L('Process Explorer представляет собой программу, функционально полностью эквивалентную диспетчеру задач. Он запускается')) AADD(aMess, L('потому, что на многих компьютерах, на которых используется система "Эйдос", стандартный диспетчер задач заблокирован.')) AADD(aMess, L('Process Explorer также запускается довольно долго. Система "Эйдос" запускает его только если он еще не был запущен.' )) bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок. Если система Эйдос уже запущена в текущей папке, то возникает ошибка открытия БД BEGIN SEQUENCE *** Попытка запуска системы Эйдос ***************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE PathGrAp SHARED NEW // Если система Эйдос уже запущена в текущей папке, то возникает ошибка открытия БД <<<===################################################ IF Neterr() LB_Warning(aMess, L('(C) Система "Эйдос"')) ADS_SERVER_QUIT() 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 ****** При запуске системы проверить, существует ли база приложений 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 RECOVER // Система Эйдос уже запущена в этой папке ********************* * EXIT // код обработки ошибок. Если система Эйдос уже запущена в данной папке выдать сообщение об этом и выйти LB_Warning(aMess, L('(C) Система "Эйдос"')) ADS_SERVER_QUIT() QUIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый 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("BackGround2",16) = CTOD("//") DIRMAKE("BackGround2") // Скачать по 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) *** При запуске программы: подготовка фонов главного окна для отображения ****** aBitmaps1 := Directory(Disk_dir+'\Aid_data\BackGround\*.jpg') aBitmaps2 := Directory(Disk_dir+'\Aid_data\BackGround2\*.jpg') IF LEN(aBitmaps2) > 0 FOR j=1 TO LEN(aBitmaps2) ERASE(Disk_dir+'\Aid_data\BackGround2\'+aBitmaps2[j, F_NAME]) NEXT ENDIF IF LEN(aBitmaps1) > 0 FOR j=1 TO LEN(aBitmaps1) COPY FILE (Disk_dir+'\Aid_data\BackGround\'+aBitmaps1[j, F_NAME]) TO (Disk_dir+'\Aid_data\BackGround2\'+aBitmaps1[j, F_NAME]) NEXT ENDIF ** Если БД пользователей существует, то можно попытаться авторизоваться сразу, до запуска главного меню. ** Если это получится, то можно запустить меню с цветовой схемой данного пользователя, ** а иначе - с цветовой схемой по умолчанию 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. - чтобы программа не продожалась дальше, пока не закончится перевод ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения * DC_SpawnURL( 'http://aidos.byethost5.com/index.php', .T., .T. ) // Решение Роджера. Не работает под Windows-8, а в 7 и 10 работает но не всегда <<<===################## ShellOpenFile( 'http://aidos.byethost5.com/index.php' ) // Решение от Regan Cawkwell * cFile := LoadFromURL('http://aidos.byethost5.com/index.php') // Считывает страницу сайта в текстовую переменную * MsgBox(cFile) * MsgBox('STOP') * DC_SpawnURL( 'http://aidos.byethost5.com/index.php' ) RECOVER // код обработки ошибки aMess := {} AADD(aMess, L('При обращении к Эйдос-облаку возникла ошибка. Это повлияет только на отметку места запуска системы ')) // НАПРИМЕР AADD(aMess, L('"Эйдос" на карте мира. Можно сделать это вручную, выйдя на сайт: http://aidos.byethost5.com/index.php')) LB_Warning(aMess) * EXIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый ****************************************** 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 *********************************************************************** * ****** Обработка ошибки ****************** * bErrorMM := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок * BEGIN SEQUENCE // код нормального исполнения * *** код нормального исполнения * *** * *** * RECOVER // код обработки ошибки * aMess := {} * AADD(aMess, L('При распознавании была попытка превышения максимального допустимого объема БД 2 Гб.')) // НАПРИМЕР * AADD(aMess, L('Необходимо уменьшить количество классов или/и объектов распознаваемой выборки !!! ')) * AADD(aMess, L('Можно также исключить из результатов распознавания наименее достоверные (режим 3.5)')) * LB_Warning(aMess) ** EXIT * ENDSEQUENCE * ErrorBlock( bErrorMM ) // переустановить старый кодовый блок обработки ошибок ****************************************** 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 объектов обучающей выборки до 2035 шкал') 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 шкал и до 2035 объектов обучающей выборки') 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 SEPARATOR PARENT oMenu2_3_2 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 L('2.3.2.10. CSV => DBF конвертер системы "Эйдос" ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), CsvDbfConv(),LB_Warning(sms,cmc))} MESSAGE L('CSV => DBF конвертер системы "Эйдос" преобразует файл: "c:\Aidos-X\AID_DATA\Inp_data\Inp_data.csv" в файл: "c:\Aidos-X\AID_DATA\Inp_data\Inp_data.dbf", который открывается в MS Excel') DCMENUITEM SEPARATOR PARENT oMenu2_3_2 DCMENUITEM L('2.3.2.11. Прогноз событий по астропараметрам по Н.А.Чередниченко ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_11(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf из файлов: "Input1.xls" и "Input2.xls" и создание модели для прогнозирования различных событий по астропараметрам методом Н.А.Чередниченко (г.Владивосток, Россия)') 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" и создание модели для прогнозирования землетрясений методом Натальи Алексеевны Чередниченко (г.Владивосток, Россия)') DCMENUITEM L('2.3.2.13. Чемпионат RAIF-Challenge 2017-API-bank ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_13(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf из файлов: t1.xlsx, t2.xlsx, t3.xlsx, t4.xlsx') DCMENUITEM L('2.3.2.14. Чемпионат RAIF-Challenge 2017-API-retail ') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_14(),LB_Warning(sms,cmc)) } MESSAGE L('Создание БД Inp_data.dbf и файла: Inp_name.txt соответственно из файлов:jet_raif_challenge.csv и description.csv') DCMENUITEM SEPARATOR PARENT oMenu2_3_2 DCMENUITEM L('2.3.2.15. Вставка промежуточных строк в файл исходных данных Inp_data') PARENT oMenu2_3_2 ACTION {|| IF( !Running(), F2_3_2_15(),LB_Warning(sms,cmc)) } MESSAGE L('Вставка промежуточных строк в файл исходных данных с интерполяцией значений соседних строк в числовых шкалах и объединением (через разделитель) значений в текстовых щкалах') 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(),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) с использованием параллельных вычислений (OpenGL)') 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','ALL'),LB_Warning(sms,cmc)) } MESSAGE L('Синтез и верификация всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} на центральном процессоре (CPU) или на графическом процессоре (GPU)') DCMENUITEM SEPARATOR PARENT oMenu3 DCMENUITEM L('3.6. Обнаружение, удаление и типизация артефактов ') PARENT oMenu3 ACTION {|| IF( !Running(), F3_7_6() ,LB_Warning(sms,cmc)) } MESSAGE L('Объекты обучающей выборки сравниваются с теми классами, к которым они относятся, и, если уровень сходства объекта с классом оказывается ниже заданного в диалоге порога, т.е. объект является нетипичным для данного класса или артефактом, то в справочнике классов создается новый класс с тем же наименованием, что у исходного класса, но с префиксом и объект обучающей выборки перекодируется на принадлежность к нему. Для этого создается новое приложение') DCMENUITEM L('3.7. Синтез и верификация заданной группы моделей ') 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 с фиксированными и адаптивными интервалами со сценариями и без и для каждого класса определяется модель, в которой его идентификация осуществляется наиболее достоверно') 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('Кластеризация, путем разделения классов на типичную и нетипичную части пока реализована в упрощенной форме (по сравнению с DOS-версией системы "Эйдос"). Из файла исходных данных "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 L('3.7.9. Корректировка экспертных оценок: объект => класс ') PARENT oMenu3_7 ACTION {|| IF( !Running(), F3_7_9(),LB_Warning(sms,cmc))} MESSAGE L('В данном итерационном режиме обучающая выборка корректируется на основе результатов распознавания: КОРРЕКТИРУЕТСЯ принадлежность объекта к классу с экспертной оценки на полученную с помощью модели. Затем проводится синтез моделей и распознавание. Это повторяется, пока все положительные решения не станут истинными или результат перестает улучшаться') 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",'CPU',2,2),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.3.12.Вывод результатов распознавания в стиле: "Inp_data.xlsx" ') PARENT oMenu4_1_3 ACTION {|| IF( !Running(), F4_1_3_12(),LB_Warning(sms,cmc))} MESSAGE L('Вывод результатов распознавания в формате "Inp_data.xlsx" в файлах: "RecognResults_####_#_####.xls" для разных моделей: {"Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7"}, интегральных критериев: {"i","k"} и в кодах или наименованиях классов и признаков: {"Kod","Name"}') 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 Professional" (Система "Эйдос-Хpro"),')+' ADS-'+mADStxt+L(', beta-version, rel: 08.12.2022.') ; HANDLER MenuHandler REFERENCE @oMessageBox ; OPTIONS GetOptions ; EVAL {|o|oDlg := o}; PARENT @oDlgBmp * DCREAD GUI TITLE L('Смена фона каждую секунду, минуту, час') PARENT @oDlgBmp OPTIONS GetOptions oTimer:destroy() // Закрытие фона главного меню * RECOVER // код обработки ошибки * aMess := {} * AADD(aMess, L('Возникла ошибка исполнения при попытке запуска режима главного меню системы "Эйдос". ')) // НАПРИМЕР * AADD(aMess, L('Скорее всего эта произошло потому, что не завершен предыдущий режим, также запущенный ')) * AADD(aMess, L('из главного меню. Это могло привести к нарушению среды исполнения, например попытке ')) * AADD(aMess, L('повторного открытия уже открытых и занятых баз данных. Необходимо завершить предыдущий')) * AADD(aMess, L('режим в панели задач, закрывая ранее открытые окна справа на лево в порядке, обратном ')) * AADD(aMess, L('их открытию и повторить попытку запуска режима. Возможно потребуется выйти из системы ')) * AADD(aMess, L('"Эйдос" и опять войти в нее, а затем сразу запустить нужный режим из главного меню. ')) * LB_Warning(aMess) ** EXIT * ENDSEQUENCE * ErrorBlock( bErrorMM ) // переустановить старый кодовый * ****************************************** *ENDIF // Внешнее управление ? ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW ADS_SERVER_QUIT() RETURN NIL *********************************************************************************************************** ******** 6.1. Информация о системе, разработчике и средствах разработки *********************************************************************************************************** FUNCTION F6_1() Running(.T.) aHelp := {} AADD(aHelp, L('ИНФОРМАЦИЯ О СИСТЕМЕ И РАЗРАБОТЧИКЕ:')) AADD(aHelp, L('(C) Персональная интеллектуальная онлайн среда "ЭЙДОС-X Professional" (Система "Эйдос-Хpro"),')+' ADS-'+mADStxt+L(', beta-version, rel: 08.12.2022. ')) AADD(aHelp, L('(C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар. ORCID: https://orcid.org/0000-0002-2742-0502, Blog: https://www.researchgate.net/profile/Eugene-Lutsenko, URL: http://lc.kubagro.ru/,')) AADD(aHelp, L('E-mail: prof.lutsenko@gmail.com, Страницы университетов и РАЕ: https://kubsau.ru/education/chairs/comp-system/staff/3965/, https://kubsu.ru/ru/public-portfolio/39926, http://www.famous-scientists.ru/17314/, ')) AADD(aHelp, L('Skype: eugene_lutsenko. ')) AADD(aHelp, L(' ')) AADD(aHelp, L('ТЕОРЕТИЧЕСКИЕ ОСНОВЫ СИСТЕМЫ: ')) AADD(aHelp, L('Система "Эйдос-Хpro" является программным инструментарием Автоматизированного системно-когнитивного анализа (АСК-анализ). АСК-анализ включает: теоретические основы, в частности базовую ')) AADD(aHelp, L('формализуемую когнитивную концепцию; математическую модель, основанную на системном обобщении теории информации (СТИ); методику численных расчетов (структуры баз данных и алгоритмы их обработки); ')) AADD(aHelp, L('программный инструментарий, в качестве которого в настоящее время выступает Система "Эйдос-Хpro". Принципиальным отличием системы "Эйдос-Хpro" от всех предыдущих версий системы "Эйдос" является то, ')) AADD(aHelp, L('что в ней практически сняты ограничения на объем исходных данных, т.е. она обеспечивает обработку больших данных (BigData), преобразование их в большую информации (BigInformation, а ее в большие знания ')) AADD(aHelp, L('(BigKnowledge) и решение на основе этих знаний большого количества задач в различных предметных областях. Это сделано путем применения локального Advantage Database Server (ADS). ')) AADD(aHelp, L('ФУНКЦИИ СИСТЕМЫ: ')) AADD(aHelp, L('Система "Эйдос-Хpro", разработана в универсальной постановке, не зависящей от предметной области, и ОБЕСПЕЧИВАЕТ решение следующих задач и подзадач: Задача-1. Когнитивная структуризация предметной ')) AADD(aHelp, L('области. Задача-2. Автоматизированная формализация предметной области (разработка классификационных и описательных шкал и градаций и кодирование с их помощью исходных данных, в результате чего они ')) AADD(aHelp, L('преобразуются в обучающую выборку. Задача-3. Синтез 3 статистических и 7 системно-когнитивных моделей (многопараметрическая типизация) с различными частными критериями знаний. Задача-4. Верификация ')) AADD(aHelp, L('моделей путем решения задачи идентификации обучающей выборки. Задача-5. Выбор наиболее достоверной модели по F-критерию Ван Ризбергена и его нечеткому мультиклассовому обобщению, инвариантному ')) AADD(aHelp, L('относительно объема обучающей выборки. Задача-6. Решение задачи идентификации и прогнозирования (системная идентификацию). Задача-7. Решение задачи принятия решений (Упрощенный вариант принятия ')) AADD(aHelp, L('решений как обратная задача прогнозирования, позитивный и негативный информационные портреты классов, SWOT-анализ. Развитый алгоритм принятия решений в автоматизированных интеллектуальных ')) AADD(aHelp, L('адаптивных системах управления на основе АСК-анализа и системы "Эйдос"). Задача-8. Решение задачи исследования объекта моделирования путем исследования его модели: Инвертированные SWOT-диаграммы ')) AADD(aHelp, L('значений описательных шкал (семантические потенциалы); Кластерно-конструктивный анализ классов; Кластерно-конструктивный анализ значений описательных шкал; Модель знаний системы "Эйдос" и ')) AADD(aHelp, L('нелокальные нейроны; Нелокальная нейронная сеть; 3D-интегральные когнитивные карты; 2D-интегральные когнитивные карты содержательного сравнения классов (опосредованные нечеткие правдоподобные ')) AADD(aHelp, L('рассуждения); 2D-интегральные когнитивные карты содержательного сравнения значений факторов (опосредованные нечеткие правдоподобные рассуждения); Когнитивные функции; Значимость описательных шкал ')) AADD(aHelp, L('и их градаций; Степень детерминированности классов и классификационных шкал. ')) AADD(aHelp, L('РАЗРАБОТЧИК концепции, математической модели (системной теории информации - СТИ), методики численных расчетов (структур данных и алгоритмов), программной реализации (100% кода на xBase++: ')) AADD(aHelp, L('Аляска+Экспресс++ADS), технологии и методики применения системы "Эйдос-X" (АСК-анализ) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Alaska CID: E098865, http://Lc.lubagro.ru, ')) AADD(aHelp, L('prof.lutsenko@gmail.com. Система "Эйдос-Хpro" разработана по инициативе автора: проф. Е.В.Луценко, без заказа и финансирования со стороны каких-либо физических и юридических лиц и все права на нее ')) AADD(aHelp, L('принадлежат автору (см. Патент РФ: http://lc.kubagro.ru/aidos/2012619610.jpg, http://lc.kubagro.ru/aidos/index.htm и статью: Луценко Е.В. 30 лет системе "Эйдос" - одной из старейших отечественных универсальных ')) AADD(aHelp, L('систем искусственного интеллекта, широко применяемых и развивающихся и в настоящее время / Е.В. Луценко // Политематический сетевой электронный научный журнал Кубанского государственного аграрного ')) AADD(aHelp, L('университета (Научный журнал КубГАУ) [Электронный ресурс]. - Краснодар: КубГАУ, 2009. - №10(54). С. 48 - 77. - Шифр Информрегистра: 0420900012\0110. - Режим доступа: http://ej.kubagro.ru/2009/10/pdf/04.pdf, ')) AADD(aHelp, L('1,875 у.п.л.). ')) AADD(aHelp, L('УЧАСТИЕ В РАЗРАБОТКЕ И СОАВТОРСТВО: ')) AADD(aHelp, L('- Концепция групп приложений и алгоритмы голосования частных моделей в мультимодели разработаны проф.Е.В.Луценко совместно с Ph.D, Cand.Phys.-Math.Sci., prof. Alexander Trunev, Director, A&E Trounev IT ')) AADD(aHelp, L('Consulting, Toronto, Canada: http://chaosandcorrelation.org; ')) AADD(aHelp, L('- Дмитрий Константинович Бандык, разработчик интеллектуальных систем из Белоруссии, разработал по постановке проф.Е.В.Луценко режимы: 1.8. Создание градиентных фонов главного окна, 4.5. Визуализация ')) AADD(aHelp, L('когнитивных функций, 6.7. Визуализация логотипов мультимоделей, 3.1. Ускоренный синтез моделей на графическом процессоре (GPU), 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('- 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, Fax: 715-848-1411, Aqua Finance, Inc, One Corporate Dr, Ste 300, Wausau WI 54401, USA; ')) AADD(aHelp, L('- dipl.ing.Slobodan Stanojevic Coba, Programi za knjigovodstvo CSYSTEMS, Office:19300 NEGOTIN Srbe Jovanovica 1/10, +38119542070 Centrala, 064 2185522 Coba, 060 0562187 Marko, https://www.cobasystems.com, ')) AADD(aHelp, L('помощь в освоении технологии локального Advantage Database Server (ADS) в интерфейсе ISAM. ')) AADD(aHelp, L('ЛИЦЕНЗИОННЫЕ СРЕДСТВА РАЗРАБОТКИ: ')) AADD(aHelp, L('- Alaska Xbase++ (R) Version 1.90.355 SL1 (международный), Сер.№106281-143290, XbToolsIII V1.90 (международный), Сер.№205281-143319, http://alaska-software.com/, eXPress++ (C) Version 1.9 Build 255, ')) AADD(aHelp, L('http://donnay-software.com. ')) AADD(aHelp, L('- Advantage Database Server: ADS DatabaseEngine V1.90 (международный), Сер.№506281-143458; ')) AADD(aHelp, L('- Xb2.NET ver 3.4.00. http://www.xb2.net; ')) AADD(aHelp, L('- Xbase ++ Проф. V2.00 (международный), Professional Edition, Сер.№ 127980. ')) AADD(aHelp, L('БЛАГОДАРНОСТИ: ')) AADD(aHelp, L('За приобретение лицензионных средств в 2012-2015 годах разработки автор благодарен зав.кафедрой компьютерных технологий и систем проф. В.И.Лойко и проректору по научной работе ФГБОУ ВО "Кубанский ')) AADD(aHelp, L('государственный аграрный университет имени И.Т.Трубилина" проф. Ю.П.Федулову. Особая благодарность лично Steffen Pirsig - Члену совета директоров, - главному архитектору, соучредителю Alaska Software Inc ')) AADD(aHelp, L('(https://www.xing.com/profile/Steffen_Pirsig) за истинно царский подарок, который он сделал в конце 2020 года: инструментальную систему: Xbase++ 2.0, Professional Edition, Сер.№ 127980. ')) 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-48, 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 ************************************************************************************************** ************************************************************************************************** *** Функции Слободана для работы c Advantage Database Server (ADS) ************************************************************************************************** *================================== * CONTENTS: ADS SERVER PROGRAMS *================================== * PROCEDURE DBESYS() * FUNCTION ADS_SERVER_START() * FUNCTION ADS_SERVER_QUIT() * FUNCTION ADS_SERVER_TIP(oSession) *************************************************************************** *PROCEDURE DBESYS() // Overload the default DBESYS for your required DBE *************************************************************************** *//----- FOXCDX: DBF-FPT-CDX * IF ! DbeLoad( "FOXDBE", .T.) // load engine for DBF files * msgbox( "Database Engine FOXDBE not loaded" , "STOP" ) * QUIT * ENDIF * IF ! DbeLoad( "CDXDBE", .T.) // load engine for DBF files * msgbox( "Database Engine CDXDBE not loaded" , "STOP" ) * QUIT * ENDIF * DbeBuild( "FOXCDX", "FOXDBE", "CDXDBE" ) // DBE=FOXCDX * *** DbeSetDefault("FOXCDX") // OFF *//----- DBFNTX: DBF-DBT-NTX *// ADS client engine and ALS Local Server engine exist *// Overload the default DBESYS for your required DBE *// system for working with DBF/NTX files on both server and client * IF ! DbeLoad( "DBFDBE") // load engine for DBF files * msgbox( "Database Engine DBFDBE not loaded" , "STOP" ) * QUIT * ENDIF * IF ! DbeLoad( "NTXDBE") // load engine for DBF files * msgbox( "Database Engine NTXDBE not loaded" , "STOP" ) * QUIT * ENDIF * DbeBuild( "DBFNTX", "DBFDBE", "NTXDBE" ) // DBE=DBFNTX * *** DbeSetDefault("DBFNTX") // OFF *//----- ADSDBE: DBF-DBT-NTX *// there must be ACE32.DLL otherwise it breaks here !!! *// mora postojati ACE32.DLL inaиe ovde pukne !!! *//----------------------------------------------------- * IF ! DbeLoad( "ADSDBE", .F.) // load engine for ADS * msgbox( "Database Engine ADSDBE not loaded" , "STOP" ) * QUIT * ENDIF *********************** * DbeSetDefault("ADSDBE") // ON *********************** *RETURN *************************************************************************** FUNCTION ADS_SERVER_START() *************************************************************************** PUBLIC oSession := NIL PUBLIC cServerTip := "" PUBLIC Server_DRIVE := "C:" // connect to the ADS server oSession := dacSession():New( "ADSDBE", Server_DRIVE ) cr:=chr(13) IF ( oSession:isConnected() ) = .T. cServerTip := ADS_SERVER_TIP(oSession) * // test message only * confirmbox(,"Connecting to server "+cServerTip +cr+; * "to location: server drajv "+Server_DRIVE +cr+; * " " +cr+; * "Advantage Database Server is ON" +cr+; * " " ,; * "SERVER: connection OK",; * XBPMB_OK,XBPMB_INFORMATION,XBPMB_SYSMODAL) ELSE // Konekcija nije uspela obavezno izdaj poruku! // Connection failed be sure to issue a message! cServerTip := ADS_SERVER_TIP(oSession) // issue a message error := var2char(oSession:getLastError()) * confirmbox(,"Connecting to server "+cServerTip +cr+; * "to location: server drajv "+Server_DRIVE +cr+; * " " +cr+; * "Advantage Database Server is OFF" +cr+; * " " +cr+; * "Server connection Error: "+error +cr+; * " " ,; * "SERVER: connection Error",; * XBPMB_OK,XBPMB_CRITICAL,XBPMB_SYSMODAL) ****** QUIT ****** ENDIF RETURN NIL *************************************************************************** FUNCTION ADS_SERVER_QUIT() *************************************************************************** // disconnect from the ADS cServerTip := ADS_SERVER_TIP(oSession) ********************** oSession:disconnect() ********************** cr:=chr(13) *confirmbox(,"Disconnecting from server "+cServerTip +cr+; * "to location: server drajv "+Server_DRIVE +cr+; * " " +cr+; * "Advantage Database Server is OFF" +cr+; * " " ,; * "SERVER: diskonnection OK",; * XBPMB_OK,XBPMB_INFORMATION,XBPMB_SYSMODAL ) RETURN NIL *************************************************************************** FUNCTION ADS_SERVER_TIP(oSession) *************************************************************************** nServerType := oSession:setProperty( ADSDBE_SERVER_TYPE ) IF nServerType == ADSDBE_LOCAL .OR. nServerType == 0 RETURN "::LOCAL SERVER" ELSE RETURN "::REMOTE SERVER" ENDIF RETURN "::STOP SERVER" *** Функции Слободана для работы c Advantage Database Server (ADS) *************************************************************************** ******************************************************************** FUNCTION BigData() // Функция для отладки работы с большими данными (DBF-файлы >>> 2 Gb) ******************************************************************************** ******************************************************************************** * FUNCTION Main() LOCAL Getlist := {}, oProgress, oDialog LOCAL aSay[30], Mess97, Mess98, Mess99 // Массив сообщений отображаемых стадий исполнения (до 30 на экране) DC_IconDefault(1000) ADS_SERVER_START() SET DECIMALS TO 15 SET DATE GERMAN SET ESCAPE On ******************************************************************** mNField = 10 // Максимум 2040 mNRecord = 10 // Максимум 1000000000000 @1,1 DCGROUP oGroup1 CAPTION 'Задайте параметры базы данных:' SIZE 40.0, 3.5 @1,2 DCSAY "Количество полей:" PARENT oGroup1 @1,20 DCSAY "" GET mNField PICTURE "##########" PARENT oGroup1 @2,2 DCSAY "Количество записей:" PARENT oGroup1 @2,20 DCSAY "" GET mNRecord PICTURE "##########" PARENT oGroup1 DCREAD GUI; TO lExit ; FIT; ADDBUTTONS; MODAL; TITLE 'Эксперименты с ADS и PGDBU' IF lExit ** Button Ok ELSE QUIT ENDIF ******************************************************************** Wsego = mNRecord // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar d = 0 @0,0 DCGROUP oGroup1 CAPTION 'Стадии исполнения процесса' FONT "6.Helv" SIZE 105+d, 2.5 PARENT oTabPage1 @4,0 DCGROUP oGroup2 CAPTION 'Прогноз времени исполнения' FONT "6.Helv" SIZE 105+d, 5.0 PARENT oTabPage2 s = 1 @s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" s++ @s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s ,1 DCPROGRESS oProgress ; SIZE 95,1.5 ; PERCENT ; EVERY 1; // Кол-во обновлений изображения MAXCOUNT Wsego; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION '&Cancel' ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE 'Создание базы данных "BigData.dbf"' ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:alwaysOnTop = .T. // Окно открывается на переднем плане oDialog:show() ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения aStructure := { { "NumbRecord" , "N", 19, 0} } FOR j=1 TO mNField FieldName = "F"+ALLTRIM(STR(j,19)) AADD(aStructure, { FieldName , "N", 19, 7 }) NEXT DbCreate( "BigData.dbf", aStructure ) RECOVER // код обработки ошибки aMess := {} AADD(aMess, "Возникла ошибка при попытке создания БД с числом полей: "+ALLTRIM(STR(mNField))) LB_Warning(aMess, 'Эксперименты с "BigData.dbf"') MsgBox('') ADS_SERVER_QUIT() QUIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый ****************************************** // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = "Начало:"+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 ********************************************************************************* ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения aSay[ 1]:SetCaption('Идет процесс создания базы данных: "BigData.dbf"') USE BigData EXCLUSIVE NEW FOR r=1 TO mNRecord APPEND BLANK REPLACE NumbRecord WITH r lOk = Time_Progress (++Time_Progress, mNRecord, oProgress, lOk ) NEXT RECOVER // код обработки ошибки CLOSE ALL aMess := {} AADD(aMess, "Возникла ошибка при попытке добавления в БД записи N=й: "+ALLTRIM(STR(r))) LB_Warning(aMess, 'Эксперименты с "BigData.dbf"') MsgBox('') * ADS_SERVER_QUIT() * QUIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый ****************************************** ADS_CopyFile('BigData.dbf', 'BigDdds.dbf', .T., .F.) ***** Удаление старых версий файла START_AIDOS запуска и обновления системы Эйдос, если они есть <<<===####################### CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * aDir := Directory("*START_AIDOS-X*.exe") mNStartAidos = ADIR("*START_AIDOS-X*.exe") PRIVATE aFileName[mNStartAidos], aFileSize[mNStartAidos], aFileDate[mNStartAidos], aFileTime[mNStartAidos] ADIR("*START_AIDOS-X*.exe", aFileName, aFileSize, aFileDate, aFileTime) * LB_Warning(aFileName, 'Эксперименты с "BigData.dbf"') aStructure := { { 'File_Num ', "C", 8, 0 }, ; { 'File_Name', "C", 40, 0 }, ; // ___START_AIDOS-X_2021_10_26.exe { 'File_Size', "N", 10, 0 }, ; { 'File_Date', "D", 8, 0 }, ; { 'File_Time', "C", 8, 0 }, ; { 'Delete ', "C", 1, 0 } } * DbCreate( "StartAidos.dbf", aStructure, "DBFNTX" ) // ALL NB !!! DbCreate( "StartAidos", aStructure ) // ALL NB !!! * USE ("StartAidos.dbf") NEW SHARED ALIAS "START_AIDOS" USE StartAidos EXCLUSIVE NEW IF LEN(aFileName) > 0 * FOR j := 1 TO Len(aDir) * APPEND BLANK * REPLACE File_Num WITH ALLTRIM(STR(j)) * REPLACE File_Name WITH aDir[j,F_NAME] * REPLACE File_Size WITH aDir[j,F_SIZE] * REPLACE File_Date WITH DTOS(aDir[j,F_WRITE_DATE]) * REPLACE File_Time WITH aDir[j,F_WRITE_TIME] * REPLACE Delete WITH 'Y' * NEXT FOR j := 1 TO Len(aFileName) APPEND BLANK REPLACE File_Num WITH ALLTRIM(STR(j)) REPLACE File_Name WITH aFileName[j] REPLACE File_Size WITH aFileSize[j] REPLACE File_Date WITH aFileDate[j] REPLACE File_Time WITH aFileTime[j] REPLACE Delete WITH 'Y' NEXT INDEX ON DTOS(File_Date)+File_Time TO StartAidos DBGOBOTTOM() REPLACE Delete WITH 'N' mFileName = ALLTRIM(File_Name) MsgBox(mFileName) DBGOTOP() DO WHILE .NOT. EOF() IF Delete = 'Y' ERASE(File_Name) ENDIF DBSKIP(1) ENDDO CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF mFileName <> "___START_AIDOS-X.exe" ADS_CopyFile(mFileName, '___START_AIDOS-X.exe', .F., .T.) // Скопировать новый файл запуска со стандартным именем и удалить новый файл ENDIF ENDIF ****************************************** * РАБОТА С БАЗАМИ ДАННЫХ ****************************************** CLOSE ALL oSay97:SetCaption(oSay97:caption) oButton:SetCaption('&Ok') // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) * PostAppEvent(xbeP_Activate,,,DC_GetObject(GetList,'DCGUI_BUTTON_OK')) // Роджер oDialog:Destroy() aMess := {} AADD(aMess, 'База данных: "BigData.dbf" успешно создана') LB_Warning(aMess, 'Эксперименты с "BigData.dbf"') ADS_SERVER_QUIT() RETURN NIL ***************************************************************************************************** FUNCTION ADS_CopyFile(mFileName1, mFileName2, mDialod, mDelete) // Копирование файла при ADSDBE ON ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения IF mDialod oScr := DC_WaitOn('Копирование файла: '+ALLTRIM(mFileName1)+' ===>>> '+ALLTRIM(mFileName2)+'. Немного подождите!!!',,,,,,,,,,,.F.) ENDIF CLOSE ALL DbeSetDefault("DBFNTX") // ADS OFF COPY FILE (mFileName1) TO (mFileName2) // <<<===########################## kill IF mDelete ERASE(mFileName1) ENDIF DbeSetDefault("ADSDBE") // ADS ON IF mDialod DC_Impl(oScr) ENDIF * IF mDialod * aMess := {} * AADD(aMess, L('Копирование файла:')+' '+ALLTRIM(mFileName1)+' ===>>> '+ALLTRIM(mFileName2)+' '+L('завершено нормально !!!')) * AADD(aMess, '') * LB_Warning(aMess, L('(C) Система "Эйдос-Хpro"')) * ENDIF mFlagError = .F. RECOVER // код обработки ошибки IF mDialod DC_Impl(oScr) aMess := {} AADD(aMess, L('При копировании файла:')+' '+ALLTRIM(mFileName1)+' ===>>> '+ALLTRIM(mFileName2)) AADD(aMess, L('возникла ошибка. С причинами этой ошибки надо разбираться отдельно.')) LB_Warning(aMess, L('(C) Система "Эйдос-Хpro"')) ENDIF mFlagError = .T. * EXIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый блок ****************************************** RETURN(mFlagError) ****************************************************************************************** ******** Функция, которая запускает команду, заданную в виде текстового параметра ****************************************************************************************** Function StartFunctTXT(cText) Local bBlock := "{|| "+cText +" )}" Local uResult bBlock := &(bBlock) // <<<===####### Error uResult := eval(bBlock) return uResult ****************************************************************************************** Function StartFunctPar(cFunction,cPara1,cPara2) Local bBlock := "{|cPara1,cPara2| " + cFunction+"(cPara1,cPara2) }" Local bFunction if IsFunction(cFunction) bBlock := &(bBlock) eval(bBlock,cPara1,cPara2) else msgbox("Function not available") endif return nil ****************************************************************************************** *** Regan Cawkwell *Below is a function we use a lot to execute / open a specific webpage in a users internet browser. As an example, you can use it like the below: *ShellOpenFile("https://www.google.com/") *Maybe that would work with the URL that you posted instead of runshell? //--------------------------------------------------------------------- *#include "dll.ch" *#define SW_HIDE 0 *#define SW_NORMAL 1 *#define SW_SHOWMINIMIZED 2 *#define SW_SHOWMAXIMIZED 3 *#define SW_MAXIMIZE 3 *#define SW_SHOWNOACTIVATE 4 *#define SW_SHOW 5 *#define SW_MINIMIZE 6 *#define SW_SHOWMINNOACTIVE 7 *#define SW_SHOWNA 8 *#define SW_RESTORE 9 *#define SW_SHOWDEFAULT 10 *#define SE_ERR_FNF 2 *#define SE_ERR_PNF 3 *#define SE_ERR_ACCESSDENIED 5 *#define SE_ERR_OOM 8 *#define SE_ERR_DLLNOTFOUND 32 *#define SE_ERR_SHARE 6 *#define SE_ERR_ASSOCINCOMPLETE 27 *#define SE_ERR_DDETIMEOUT 28 *#define SE_ERR_DDEFAIL 29 *#define SE_ERR_DDEBUSY 30 *#define SE_ERR_NOASSOC 31 *#define ERROR_BAD_FORMAT 11 PROCEDURE ShellOpenFile( cFile ) LOCAL nReturn, cMsg nReturn:=DllCall( "SHELL32.DLL",DLL_STDCALL,"ShellExecuteA",AppDesktop():GetHWND(),"open",cFile,NIL,CurDir(),SW_NORMAL) If nReturn <= 32 cMsg:="Error trying to launch "+cFile+";;" do case Case nReturn == SE_ERR_FNF cMsg += "File not found" Case nReturn == SE_ERR_PNF cMsg += "Path not found" Case nReturn == SE_ERR_ACCESSDENIED cMsg += "Access denied" Case nReturn == SE_ERR_OOM cMsg += "Out of memory" Case nReturn == SE_ERR_DLLNOTFOUND cMsg += "DLL not found" Case nReturn == SE_ERR_SHARE cMsg += "A sharing violation occurred" Case nReturn == SE_ERR_ASSOCINCOMPLETE cMsg += "Incomplete or invalid file association" Case nReturn == SE_ERR_DDETIMEOUT cMsg += "DDE Time out" Case nReturn == SE_ERR_DDEFAIL cMsg += "DDE transaction failed" Case nReturn == SE_ERR_DDEBUSY cMsg += "DDE busy" Case nReturn == SE_ERR_NOASSOC cMsg += "No association for file extension" Case nReturn == ERROR_BAD_FORMAT cMsg += "Invalid EXE file or error in EXE image" Otherwise cMsg += "Unknown Error Code ("+ntrim(nReturn)+")" EndCase dc_alert(cMsg) EndIf RETURN //--------------------------------------------------------------------- ****************************************************************************************** ******** Скачивание всех статей проф.Е.В.Луценко из Научного журнала КубГАУ ****************************************************************************************** FUNCTION DownloadArticles() LOCAL cFile, oHC LOCAL Getlist := {}, oProgress, oDialog, lCancelled := .F., lStatus := .T. LOCAL aSay[30], Mess97, Mess98, Mess99 // Массив сообщений отображаемых стадий исполнения (до 30 на экране) * DC_IconDefault(1000) * RunShell("","__aidos-x.exe",.T.) SET DECIMALS TO 15 SET DATE GERMAN SET ESCAPE On SET COLLATION TO SYSTEM // Русификация *SET COLLATION TO ASCII // Русификация ****************************************************************************************************************************** IF InternetGetConnectedState( @n, 0 ) == 0 LB_Warning('Система не может скачать публикации, т.к. нет соединения с Internet!', 'C° Пакетное скачивание публикаций') RETURN NIL ENDIF PUBLIC Disk_name := DISKNAME() PUBLIC Cur_dir := CURDIR() PUBLIC Disk_dir := Disk_name+":\"+Cur_dir // Путь на папку с системой mDataSource = 1 * @0,0 DCGROUP oGroup1 CAPTION 'Укажите источник данных с гиперссылками на публикации:' SIZE 63, 9.7 * @1.0, 2 DCRADIO mDataSource VALUE 1 PROMPT 'Страница в Internet' PARENT oGroup1 * @2.0, 2 DCRADIO mDataSource VALUE 2 PROMPT 'Текстовый файл' PARENT oGroup1 mIntAddr = "http://lc.kubagro.ru/aidos/_Aidos-X.htm " * @4, 2 DCGROUP oGroup2 CAPTION 'Задайте адрес страницы в Internet:' SIZE 59, 3.7 PARENT oGroup1 HIDE {|| .NOT.mDataSource=1} * @1, 2 DCGET mIntAddr PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' PARENT oGroup2 * @2.5, 2 DCSAY 'На странице должны быть абсолютные гиперссылки на публикации' PARENT oGroup2 * mFileName = "ListArticles.txt " * @4, 2 DCGROUP oGroup3 CAPTION 'Задайте имя текстового файла:' SIZE 59, 4.7 PARENT oGroup1 HIDE {|| .NOT.mDataSource=2} * @1, 2 DCGET mFileName PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' PARENT oGroup3 * @2.5, 2 DCSAY 'В текстовом файле должны быть абсолютные гиперссылки на публикации' PARENT oGroup3 * @3.5, 2 DCSAY 'Текстовый файл должен быть стандарта DOS TXT' PARENT oGroup3 * DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE * DCREAD GUI ; * TO lExit ; * FIT ; * OPTIONS GetOptions ; * ADDBUTTONS; * MODAL ; * TITLE 'C° Пакетное скачивание публикаций' * ***************************************************************** * IF lExit * ** Button Ok * ELSE * RETURN NIL * ENDIF * ***************************************************************** mIntAddr = STRTRAN(mIntAddr, ' ','') mFileName = STRTRAN(mFileName,' ','') DO CASE CASE mDataSource = 1 mIntAddr = ALLTRIM(mIntAddr) cFile = '' cFile := LoadFromURL(mIntAddr) // Считывает страницу сайта в текстовую переменную. Но с некоторыми сайтами не получается StrFile(cFile, 'ListArticles.txt') IF AT('404 - File or directory not found',cFile) > 0 aMess := {} AADD(aMess, 'Заданного Internet-адреса не существует:') AADD(aMess, mIntAddr) LB_Warning(aMess, 'C° Пакетное скачивание публикаций') RETURN NIL ENDIF CASE mDataSource = 2 mFileName = ALLTRIM(mFileName) IF .NOT. FILE(mFileName) aMess := {} AADD(aMess, 'В папке с программой: "'+Disk_dir+'"') AADD(aMess, 'должен быть DOS-TXT файл: "'+mFileName+'"') AADD(aMess, 'со списком публикаций и абсолютными гиперссылками на них') LB_Warning(aMess, 'C° Пакетное скачивание публикаций') RETURN NIL ENDIF cFile = FileStr(mFileName) StrFile(cFile, 'ListArticles.txt') ENDCASE PRIVATE aPar[2] AFILL(aPar, .T.) @ 1.3, 6 DCSAY 'Скачивать PDF-файлы' FONT "9.Helv" @ 2.3, 6 DCSAY 'Скачивать ZIP-файлы' FONT "9.Helv" @ 1,2 DCCHECKBOX aPar[1] @ 2,2 DCCHECKBOX aPar[2] DCREAD GUI ; TO lExit ; FIT ; MODAL ; ADDBUTTONS; TITLE 'Какие статьи скачивать?'+'°°°°°°°' ******************************************************************** IF lExit ** Button Ok ELSE CLOSE ALL RETURN NIL ENDIF ******************************************************************** IF aPar[1]=.F. .AND. aPar[2]=.F. LB_Warning('Задайте скачивание файлов какого-нибудь типа', 'C° Пакетное скачивание публикаций') CLOSE ALL RETURN NIL ENDIF ****************************************************************************************************************************** * oScr := DC_WaitOn('Формирование базы данных гиперссылок на pdf-файлы',,,,,,,,,,,.F.) aStructure := { { 'Num ' , "N", 15, 0 }, ; { 'HLinkPDF' , "C",250, 0 }, ; { 'HLinkZIP' , "C",250, 0 }, ; { 'DwnLoadPDF', "C", 5, 0 }, ; { 'DwnLoadZIP', "C", 5, 0 } } DbCreate( "HyperLinks.dbf", aStructure, "DBFNTX" ) // ALL NB !!! USE HyperLinks EXCLUSIVE NEW SELECT HyperLinks aHyperLinks := {} // В БД запоминать только уникальные значения гиперссылок (исключить повторы) mNum = 0 mPos1 = AT('http://', SUBSTR(cFile, 1)) DO WHILE AT('http://', SUBSTR(cFile, mPos1)) * AT('.pdf', SUBSTR(cFile, mPos1)) > 0 mPos2 = mPos1+AT('.pdf', SUBSTR(cFile, mPos1))+3 * http:///2004/05/pdf/14.pdf * http:///2004/05/zip/14.zip mPdfHyperLink = STRTRAN(SUBSTR(cFile, mPos1, mPos2-mPos1),' ','') mZipHyperLink = STRTRAN(STRTRAN(mPdfHyperLink, 'pdf', 'zip'),' ','') ** Проверка корректности гиперссылок *************** IF LEN(mPdfHyperLink) > 255 mPdfHyperLink = SUBSTR(mPdfHyperLink,1,255) ENDIF mPosPdf = AT('.pdf', mPdfHyperLink) IF LEN(mZipHyperLink) > 255 mZipHyperLink = SUBSTR(mZipHyperLink,1,255) ENDIF mPosZip = AT('.zip', mZipHyperLink) IF mPosPdf + mPosZip > 0 IF ASCAN(aHyperLinks, mPdfHyperLink) = 0 // В БД запоминать только уникальные значения гиперссылок (исключить повторы) AADD (aHyperLinks, mPdfHyperLink) APPEND BLANK REPLACE Num WITH ++mNum IF mPosPdf > 0 REPLACE HLinkPDF WITH mPdfHyperLink ENDIF IF mPosZip > 0 REPLACE HLinkZIP WITH mZipHyperLink ENDIF ENDIF ENDIF * MsgBox(ALLTRIM(STR(mPos1))+' '+ALLTRIM(STR(mPos2))+' '+SUBSTR(cFile, mPos1, mPos2-mPos1)) mPos1 = mPos2+AT('http://', SUBSTR(cFile, mPos2))-1 ENDDO * DC_Impl(oScr) *** Скачивание pdf и zip файлов по найденным гиперссылкам ************************** USE HyperLinks EXCLUSIVE NEW SELECT HyperLinks ** Выход с сообщением, если в БД HyperLinks нет гиперссылок IF RECCOUNT() = 0 LB_Warning('Нет гиперссылок на файлы публикаций '+IF(mDataSource=1,'на странице: "'+mIntAddr+'"','в файле: "'+mFileName+'"'), 'C° Пакетное скачивание публикаций') RETURN NIL ENDIF mNFiles = RECCOUNT() mLen = LEN(ALLTRIM(STR(mNFiles))) Wsego = mNFiles // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = "Начало:"+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 ********************************************************************************* **** Формирование базы данных гиперссылок на pdf-файлы ************************** // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar @ 0,0 DCGROUP oGroup1 CAPTION 'Стадии исполнения процесса' FONT "6.Helv" SIZE 105, 3.5 PARENT oTabPage1 @ 5,0 DCGROUP oGroup2 CAPTION 'Прогноз времени исполнения' FONT "6.Helv" SIZE 105, 5.0 PARENT oTabPage2 s = 1 @s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" @s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" s++ @s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay97 FONT "10.HelvBold" s++ @0.2+s++,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay98 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @1.5+s ,1 DCSAY " " SAYSIZE 100 SAYOBJECT oSay99 FONT "9.Helv Bold" COLOR GRA_CLR_BLUE @s , 1 DCPROGRESS oProgress SIZE 95,1.5 PERCENT ; EVERY 1 ; // Кол-во обновлений изображения (в функции самой регулируеся обновление изображений через 0,1 секунды) MAXCOUNT Wsego ; COLOR GRA_CLR_CYAN // Цвет полосы @s++,97 DCPUSHBUTTON CAPTION '&Cancel' ; ACTION {||lOk:=.T.} OBJECT oButton ; SIZE 7,1.5 DCREAD GUI ; TITLE 'C° Пакетное скачивание публикаций в папку: "'+Disk_dir+'"'; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:show() ****************************************************************************************************************************** aSay[ 1]:SetCaption('1/2. Поиск гиперссылок на файлы публикаций '+IF(mDataSource=1,'на странице: "'+mIntAddr+'"','в файле: "'+mFileName+'"')) aSay[ 2]:SetCaption('2/2. Скачивание'+' '+IF(aPar[1],'PDF','')+IF(aPar[1] .AND. aPar[2],' и ',' ')+IF(aPar[2],'ZIP','')+' '+'файлов статей в папку:'+' '+STRTRAN(Disk_dir,'\','/')+'/AID_DATA/Articles') IF FILEDATE(Disk_dir+'/AID_DATA/Articles',16) = CTOD("//") DIRMAKE( Disk_dir+'/AID_DATA/Articles') ENDIF DBGOTOP() DO WHILE .NOT. EOF() DC_CompleteEvents();IF lCancelled;EXIT;ENDIF // Выход из цикла загрузки по нажатию клавиши Cancel * oScr := DC_WaitOn('Скачивание pdf-файла: "'+STRTRAN(STR(Num,mLen),' ','0')+'.pdf" / '+ALLTRIM(STR(mNFiles)),,,,,,,,,,,.F.) IF aPar[1] cFile = '' cFile := LoadFromURL(HLinkPDF) // Считывает страницу сайта в текстовую переменную. Но с некоторыми сайтами не получается IF AT('Error 404',cFile) = 0 StrFile(cFile, Disk_dir+'/AID_DATA/Articles'+'/'+STRTRAN(STR(Num,mLen),' ','0')+'.pdf') REPLACE DwnLoadPDF WITH 'Ok' ELSE REPLACE DwnLoadPDF WITH 'Error' ENDIF ENDIF IF aPar[2] cFile = '' cFile := LoadFromURL(HLinkZIP) // Считывает страницу сайта в текстовую переменную. Но с некоторыми сайтами не получается IF AT('Error 404',cFile) = 0 StrFile(cFile, Disk_dir+'/AID_DATA/Articles'+'/'+STRTRAN(STR(Num,mLen),' ','0')+'.zip') REPLACE DwnLoadZIP WITH 'Ok' ELSE REPLACE DwnLoadZIP WITH 'Error' ENDIF ENDIF * DC_Impl(oScr) lOk = Time_Progress (++Time_Progress, mNFiles, oProgress, lOk ) DBSKIP(1) ENDDO CLOSE ALL * LB_Warning('Все pdf-файлы скачаны успешно !!!', 'Скачивание pdf-файлов по гиперссылкам с сайта') oSay97:SetCaption('Все pdf и zip файлы статей скачаны успешно !!!') oSay97:SetCaption(oSay97:caption) oButton:SetCaption('&Ok') // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) * PostAppEvent(xbeP_Activate,,,DC_GetObject(GetList,'DCGUI_BUTTON_OK')) // Роджер oDialog:Destroy() RETURN NIL ****************************************************************************************** FUNCTION Xb2NetKey() PUBLIC Ftp_User := '***' PUBLIC Ftp_Passw := '***' Ftp_User := m1 Ftp_Passw := m2 Return NIL ****************************************************************************************** ******************** #include "adsdbe.ch" // ADSDBE = ADS SERVER ENGINE ******************** #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 "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" #pragma Library( "ASINet10.lib" ) // 2.0 // Для альтернативного и неальтернативного выбора в просмотре таблиц *#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 #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 // Return types of ADSDBE_TBL_MODE *#define ADSDBE_NTX 1 *#define ADSDBE_CDX 2 *#define ADSDBE_ADT 3 // Для опредедения разрешения монитора от Джимми #define DESKTOPVERTRES 117 #define DESKTOPHORZRES 118 // 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 * Для CSV=>DBF конвертера *#include "ot4xb.ch" // => ot4xb.dll => www.xbwin.com #ifndef CRLF #define CRLF chr(13)+chr(10) #endif * Klasse zum sequentiellen Einlesen groбer Dateien *#IF .t. // zum Einbinden in eigenes Projekt, .f. setzen ! MEMVAR dCBROWSE, dCEDIT, dCCOLOR STATIC snHdll // Для быстрой графики Роджера ********************************************************************************* ******************************************************************************** ******** 1.1. Авторизация сисадмина, администратора приложения или пользователя ******************************************************************************** FUNCTION F1_1() LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions, m11txt Running(.T.) ** Выбор сообщения на титульной видеограмме (сейчас 1-го из 4) IF .NOT. FILE("_11.txt") m11txt=1;StrFile(STR(m11txt), '_11.txt') ELSE m11txt = VAL(ALLTRIM(FileStr('_11.txt'))) ENDIF aMess = InstallFonts() // Установка шрифтов, независимых от Windows M_Login = "1 " M_Passw = "1 " ***********XXXXXXXXXXXXXXX @0.0,0 DCGROUP oGroup1 CAPTION L('Задайте имя и пароль:' ) SIZE 80.0, 3.5 @4.0,0 DCGROUP oGroup2 CAPTION L('Особенности работы в системе:') SIZE 80.0, 5.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 d=45 IF mADStxt = 'OFF' @1.5,d DCSAY L("Advantage Database Server (ADS) - OFF") PARENT oGroup1 FONT '9.Arial Bold' COLOR(aColor[11]) SAYSIZE 0 @8,240 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP CAPTION cFile SIZE 59,59 PIXEL PARENT oGroup1 ENDIF IF mADStxt = 'ON' @1.5,d DCSAY L("Advantage Database Server (ADS) - ON") PARENT oGroup1 FONT '9.Arial Bold' COLOR(aColor[190]) SAYSIZE 0 @8,240 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP CAPTION cFile SIZE 59,59 PIXEL PARENT oGroup1 ENDIF 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 DO CASE CASE m11txt = 1 @9.5,0 DCGROUP oGroup3 CAPTION L('Главное, что делает система:') SIZE 80.0, 19.2 @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, 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 @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 CASE m11txt = 2 @9.5,0 DCGROUP oGroup3 CAPTION L('Главное, что делает система:') SIZE 80.0, 19.2 @s, 4 DCSAY L('Персональная интеллектуальная онлайн среда "ЭЙДОС-X Professional" (Система "Эйдос-Хpro"): ') PARENT oGroup3;s=s+d*1.5 @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 @s, 4 DCSAY L('много инструментария - интеллектуальной системы "Эйдос-Хpro". ') PARENT oGroup3;s=s+d*1.5 @s,2 DCSAY L("2.") PARENT oGroup3;@s, 4 DCSAY L('ОБЕСПЕЧИВАЕТ преобразование больших данных (Big Data), в большую информацию (Big Information),') PARENT oGroup3;s=s+d @s, 4 DCSAY L('а ее в большие знания (Big Knowledge) с использованием ADS (Advantage Database Server) и реше-') PARENT oGroup3;s=s+d @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('нением технологий искусственного интеллекта на платформе "Эйдос-Хpro". ') PARENT oGroup3;s=s+d*1.5 @s, 4 DCSAY L('Работы автора системы "Эйдос" проф.Е.В.Луценко & C° по АСК-анализу и системе "Эйдос": ') PARENT oGroup3;s=s+d*1.5 CASE m11txt = 3 @9.5,0 DCGROUP oGroup3 CAPTION L('Объявление о получении магистерского образования по искусственному интеллекту:') SIZE 80.0, 19.2 @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 @s, 4 DCSAY L('магистратуру по приоритетным IT направлениям до 75. Приглашаем получить высококвалифициро- ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('ванную подготовку по актуальным IT специальностям. ') PARENT oGroup3;s=s+d*2.0 @s, 4 DCSAY L('СПИСОК направлений подготовки магистратуры (очная и заочная формы обучения): ') PARENT oGroup3;s=s+d*2.0 @s,2 DCSAY L("2.") PARENT oGroup3;@s, 4 DCSAY L('09.04.02 Информационные системы и технологии (Искусственный интеллект и машинное обучение); ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('09.04.02 Информационные системы и технологии (Искусственный интеллект и машинное обучение); ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('01.04.02 Прикладная математика и информатика (Матем.и инф.обеспечение эконом.деятельности); ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('01.04.02 Прикладная математика и информатика (Матем.модел.в естествознании и технологиях); ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('01.04.02 Прикладная математика и информатика (Технологии програм.и разр.инф.-коммун.систем); ') PARENT oGroup3;s=s+d @s, 4 DCSAY L('02.04.02 Фунд.информатика и информ.технологии (Интеллектуальные системы и технологии). ') PARENT oGroup3;s=s+d*2.0 @s,2 DCSAY L("3.") PARENT oGroup3;@s, 4 DCSAY L('КОНТАКТЫ: +79189800003, savanna-05@mail.ru, докт.техн.наук Анна Владимировна Коваленко ') PARENT oGroup3;s=s+d*2.0 CASE m11txt = 4 @9.5,0 DCGROUP oGroup3 CAPTION 'Announcement of own fonts of the Eidos system:' SIZE 80.0, 19.2 IF LEN(aMess) > 0 FOR j=1 TO LEN(aMess) @s, 13 DCSAY L(aMess[j]) PARENT oGroup3;s=s+d NEXT ENDIF ENDCASE m11txt = IF(m11txt<4,m11txt+1,1) StrFile(STR(m11txt), '_11.txt') l = s a = 41 b = 37 *@l,2 DCPUSHBUTTON CAPTION L('Системное обобщение математики') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Work_on_emergence.htm' , .T., .T. )} PARENT oGroup3;l=l+d*2 *@l,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;l=l+d*2 *@l,2 DCPUSHBUTTON CAPTION L('АСК-анализ как метод познания ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_identification_presentation_and_use_of_knowledge.htm', .T., .T. )} PARENT oGroup3;l=l+d*2 @l,2 DCPUSHBUTTON CAPTION L('Кратко об АСК-анализе ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'https://www.researchgate.net/publication/356084911', .T., .T. )} PARENT oGroup3;l=l+d*2 l = s *@l,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;l=l+d*2 *@l,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;l=l+d*2 *@l,a DCPUSHBUTTON CAPTION L('Когнитивная наукометрия ') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/Works_on_scientometrics.htm' , .T., .T. )} PARENT oGroup3;l=l+d*2 @l,a DCPUSHBUTTON CAPTION L('Подборки публикаций по АСК-анализу') SIZE b, 1.5 ACTION {||DC_SpawnURL( 'http://lc.kubagro.ru/aidos/_Aidos-X.htm' , .T., .T. )} PARENT oGroup3;l=l+d*2 *@l,2 DCPUSHBUTTON CAPTION L('АСК-анализ влияния космической среды на процессы на Земле ') SIZE 76, 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;l=l+d*2 @l,2 DCPUSHBUTTON CAPTION L('Скачать все публикации проф.Е.В.Луценко из Научного журнала КубГАУ (> 2 Гб)') SIZE 76, 1.5 ACTION {||DownloadArticles()} PARENT oGroup3;l=l+d*2 @l,2 DCPUSHBUTTON CAPTION L('СЕРТИФИКАТ об освоении системы "Эйдос" от проф.Е.В.Луценко. ПОДДЕРЖКА') SIZE 76, 1.5 ACTION {||Help11()} FONT '9.Arial Bold' PARENT oGroup3;l=l+d*2 DCREAD GUI; TO lExit ; FIT; ADDBUTTONS; MODAL; TITLE L('(c) Авторизация в системе ЭЙДОС-X++') ******************************************************************** IF lExit ** Button Ok ELSE * ADS_SERVER_QUIT() 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 aMess := {} AADD(aMess, L('Приветствую тебя, о СИСАДМИН! Слушаюсь и повинуюсь!!!')) AADD(aMess, '') AADD(aMess, L('ВНИМАНИЕ! Эта версия системы "Эйдос" откомпилирована на языке Аляска-2.0')) AADD(aMess, L('и предназначена для всех версий MS Windows: 7, 8, а также Windows-10. Файл')) AADD(aMess, L('запуска системы "Эйдос": ___START_AIDOS-X.exe тоже работает под Windows-10')) AADD(aMess, L('и рекомендуется его запускать, т.к. он проверяет обновления системы Эйдос')) AADD(aMess, L('и скачивает их, если они есть. Можно также скачать их самим в режиме 6.2. ')) * LB_Warning(aMess, 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 = 'CheckSum='+ALLTRIM(STR(mCheckSum))+'. '+L('EXE-модуль системы "Эйдос" поврежден и его работоспособность не гарантируется!' * LB_Warning(Mess) * ENDIF * ENDIF * ENDIF * ******************************************************************************************************** Running(.F.) RETURN(M_KodAdmAppls) *********************************************************************************************************** ******** Просьба о помощи *********************************************************************************************************** FUNCTION Help11() * Я могу решать задачи, которые вам интересны (если вы предоставите исходные данные). Если получится что-то разумное * - вы можете публиковать результаты (со мной) в изданиях, входящих в Скопус и WoS. Мы можем размещать описания и * исходные данные задач в Эйдос-облаке (в общем доступе). Я могу выдавать сертификаты об освоении вами или вашими * учениками знаний, умений и навыков автоматизированного системо-когнитивного анализа и системы Эйдос. Я могу * разрабатывать заказные расширения системы Эйдос. Вы можете разрабатывать новые версии системы Эйдос на перспективных * языках программирования. Я могу предоставить всю необходимую для этого информацию. Вы можете платить мне за это. * Вы можете предложить еще что-то. DCSETFONT TO '10.Helv' s=0 @ s++,1 DCSAY L('Проф.Е.В.Луценко - автор и разработчик Автоматизированного системно-когнитивного анализа') SAYSIZE 0 @ s++,1 DCSAY L('(АСК-анализ) и его программного инструментария - интеллектуальной системы "Эйдос" может:') SAYSIZE 0 @ s++,1 DCSAY L('выдать СЕРТИФИКАТ (в электронной форме) об успешном освоении знаний, умений и навыков, ') SAYSIZE 0 @ s++,1 DCSAY L('необходимых для разработки собственного интеллектуального облачного Эйдос-приложения и ') SAYSIZE 0 @ s++,1 DCSAY L('его размещении в Эйдос-облаке, https://researchgate.net/ и в РИНЦ: https://elibrary.ru/.') SAYSIZE 0 @ s++,1 DCSAY L('Возможны также авторское сопровождение и консультации по разработке Эйдос-приложений в ') SAYSIZE 0 @ s++,1 DCSAY L('в различных предметных областях и заказная доработка системы "Эйдос" с учетом пожеланий ') SAYSIZE 0 @ s++,1 DCSAY L('заказчика. Большой объем научной и учебно-методической информации находится по ссылкам ') SAYSIZE 0 @ s++,1 DCSAY L('в режиме 6.2 системы "Эйдос". Краткая инструкция по разработке интеллектуальных облачных') SAYSIZE 0 @ s++,1 DCSAY L('Эйдос-приложений, включающая информацию об источниках данных для машинного обучения (ML),') SAYSIZE 0 @ s++,1 DCSAY L('шаблоны описания Эйдос-приложений и видео-занятия проф.Е.В.Луценко, находится по ссылке:') SAYSIZE 0 @ s++,1 DCSAY L('http://lc.kubagro.ru/aidos/How_to_make_your_own_cloud_Eidos-application.htm') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/aidos/How_to_make_your_own_cloud_Eidos-application.htm', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} @ s++,1 DCSAY L('') SAYSIZE 0 DCSETFONT TO '10.Helv Bold' @ s++,1 DCSAY L('Если у вас возникло желание поблагодарить автора, то это можно сделать очень просто:') SAYSIZE 0 @ s++,1 DCSAY L('перечислив подарок на карту Сбербанка РФ (в рублях), привязанную к телефону автора: ') SAYSIZE 0 @ s++,1 DCSAY L('+7 905 408 5424. Просьба в поле: "назначение платежа" писать только: "ПОДАРОК". ') SAYSIZE 0 @ s++,1 DCSAY L('Звонить можно ТОЛЬКО в рабочие дни в рабочее время по московскому времени (МСК). ') SAYSIZE 0 @ s++,1 DCSAY L('e-mail: prof.lutsenko@gmail.com ') SAYSIZE 0 DCREAD GUI FIT TITLE L('Предложения профессора Е.В.Луценко') RETURN nil **************************************************************************************** ******** 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 * --------------- 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 * --------------- 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 * --------------- 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.2. Ссылки на патенты, монографии и статьи по системе *********************************************************************************************************** FUNCTION F6_2() Running(.T.) DCSETFONT TO '10.Helv Bold' s=0 d=0.8 @ s,1 DCSAY L('1. САЙТ АВТОРА АСК-АНАЛИЗА И ИНТЕЛЛЕКТУАЛЬНОЙ СИСТЕМЫ "ЭЙДОС":') SAYSIZE 0 ;s=s+d @ s,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.)} ;s=s+d*2 @ s,1 DCSAY L('2. ПАТЕНТЫ, НАУЧНЫЕ МОНОГРАФИИ И УЧЕБНЫЕ ПОСОБИЯ:') SAYSIZE 0 ;s=s+d @ s,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.)} ;s=s+d*2 @ s,1 DCSAY L('3. НАУЧНЫЕ СТАТЬИ И ДРУГИЕ ПУБЛИКАЦИИ В НАУЧНОМ ЖУРНАЛЕ И В РИНЦ:') SAYSIZE 0 ;s=s+d @ s,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.)} ;s=s+d @ s,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.)} ;s=s+d*1.5 @ s,1 DCPUSHBUTTON CAPTION L('4. Скачать все публикации проф.Е.В.Луценко из Научного журнала КубГАУ (> 2 Гб)') SIZE 110, 1.8 ACTION {||DownloadArticles()};s=s+d*3 @ s,1 DCSAY L('5. ПОЛНЫЙ АРХИВ СИСТЕМЫ "ЭЙДОС" С ПРИЛОЖЕНИЯМИ (>150 МБ):') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('http://lc.kubagro.ru/Aidos-X.exe') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Aidos-X.exe', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 @ s,1 DCSAY L('6. МИНИМАЛЬНАЯ ИНСТАЛЛЯЦИЯ СИСТЕМЫ "ЭЙДОС" (>60 МБ):') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('http://lc.kubagro.ru/a-min.rar') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/a-min.rar', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 @ s,1 DCSAY L('7. АКТУАЛЬНОЕ ТЕКУЩЕЕ ОБНОВЛЕНИЕ СИСТЕМЫ "ЭЙДОС" (ПАТЧ) (> 20 МБ)') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('http://lc.kubagro.ru/Downloads.exe') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Downloads.exe', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 @ s,1 DCSAY L('8. Если вы хотите, чтобы система <Эйдос> использовала не стандартные шрифты MS Windows, а свои собственные,') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('то надо скачать самораспаковывающийся архив (118 Мб) шрифтов <Эйдос> по прямой ссылке, приведенной ниже, ') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('а затем разархивировать этот файл в папку с исполнимым модулем системы <Эйдос>. Такая потребность может ') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('у вас возникнуть, если вы используете неруссифицированную версию MS Windows. В этом случае из-за отсутствия') 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('http://lc.kubagro.ru/Fonts.exe') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/Fonts.exe', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 @ s,1 DCSAY L('9. СКАЧАТЬ СТАРТОВЫЙ ФАЙЛ СИСТЕМЫ "ЭЙДОС": "___START_AIDOS-X.exe" (400 КБ)') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('http://lc.kubagro.ru/___START_AIDOS-X.exe ') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'http://lc.kubagro.ru/___START_AIDOS-X.exe ', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 @ s,1 DCSAY L('10. ИНФОРМАЦИЯ ОБ ОБНОВЛЕНИЯХ СИСТЕМЫ "ЭЙДОС" ЗА ВСЕ ВРЕМЯ (doc-файл 600 Кб)') SAYSIZE 0 ;s=s+d @ s,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.)} ;s=s+d*2 @ s,1 DCSAY L('11. СТРАНИЧКА И ЛАБОРАТОРИИ В RESEARCHGATE ПО АСК-АНАЛИЗУ И СИСТЕМЕ "ЭЙДОС"') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('https://www.researchgate.net/profile/Eugene_Lutsenko') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://www.researchgate.net/profile/Eugene_Lutsenko', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d @ s,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.)} ;s=s+d*2 @ s,1 DCSAY L('12. ВИДЕО-ЗАНЯТИЯ ПРОФ.Е.В.ЛУЦЕНКО ПО АСК-АНАЛИЗУ И СИСТЕМЕ "ЭЙДОС"') SAYSIZE 0 ;s=s+d @ s,1 DCSAY L('https://yadi.sk/d/knISAD5qzV83Ng?w=1') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://yadi.sk/d/knISAD5qzV83Ng?w=1', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d @ s,1 DCSAY L('https://bigbluebutton.pstu.ru/b/w3y-2ir-ukd-bqn') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://bigbluebutton.pstu.ru/b/w3y-2ir-ukd-bqn', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d @ s,1 DCSAY L('https://bigbluebutton.pstu.ru/b/3kc-n8a-gon-tjz') COLOR GRA_CLR_BLUE SAYSIZE 0 HYPERLINK {|p,c|p := 'url.dll,FileProtocolHandler ' + ; 'https://bigbluebutton.pstu.ru/b/3kc-n8a-gon-tjz', c := 'Rundll32.exe', RunShell(p,c,.t.,.t.)} ;s=s+d*2 *@ s,1 DCSAY L('13. ГРУППА В ФЕЙСБУКЕ ПО АСК-АНАЛИЗУ И СИСТЕМЕ "ЭЙДОС"') SAYSIZE 0 ;s=s+d *@ s,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.)} ;s=s+d*2 DCREAD GUI FIT TITLE L('6.2. Ссылки на патенты, литературу, обновление системы, группа в ResearchGate и т.п.') 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() // Закрытие всех баз данных с ожиданием завершения операций * ADS_SERVER_QUIT() QUIT RETURN NIL ******************************************************************************************************************************* ******** 6.3. Развитый алгоритм принятия решений в интеллектуальных системах управления на основе АСК-анализа и системы "Эйдос" ******************************************************************************************************************************* FUNCTION F6_3() DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы 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) = 26510151 // <<<===############### * DC_PrintPreviewAcrobat( cFile, '6.3. Развитый алгоритм принятия решений АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF RETURN NIL **************************************************************************************************************** ******** 6.4. Порядок преобразования данных в информацию, а ее в знания ******** В режиме раскрывается соотношение содержания понятий: "Данные", "Информация" и "Знания", ******** а также последовательность преобразования данных в информацию, а ее в знания в системе "Эйдос-Х++" ******** с указанием имен баз данных и ссылками на основные публикации по этим вопросам' **************************************************************************************************************** FUNCTION F6_4() DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы cFile = "_DataInfCogn.pdf" IF .NOT. FILE(cFile) Mess = L('В папке с исполнимым модулем системы нет файла: "#"') Mess = STRTRAN(Mess, "#", cFile) LB_Warning(Mess) ELSE // Проверить контрольную сумму файла и если она не совпадает // выдать сообщение о том, что файл поврежден (чтобы было невозможно заменить графический файл). IF FILECHECK(cFile) = 36088784 // <<<===############### * DC_PrintPreviewAcrobat( cFile, '6.4. Последовательность обработки данных, информации и знаний в системе "Эйдос-Х++"' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF ENDIF 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. Свидетельства РосПатента РФ на систему "Эйдос"' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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 LC_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('- только те, которые он сам создал. Как создать собственные приложения описано в инструкции для учащихся в п.2. на сайте автора. ')) 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. Посмотреть достоверность моделей в режиме 3.4. Посмотреть частотные распределения числа истинных и ложных положительных ')) AADD(aHelp, L(' и отрицательных решений при различных уровнях сходства. ')) AADD(aHelp, L(' 8. Сделать текущей наиболее достоверную модель (в режиме 5.6). ')) AADD(aHelp, L(' 9. Решить задачу идентификации в наиболее достоверной модели в режиме 4.1.2. ')) AADD(aHelp, L('10. Посмотреть результаты идентификации в режимах 4.1.3. ')) AADD(aHelp, L('11. Решить задачу поддерки принятия решений в упрощенном варианте (режим 4.4.8) ')) AADD(aHelp, L('12. Провести исследование наиболее достоверной модели в 4-й подсистеме. ')) AADD(aHelp, L('13. Решить задачу поддерки принятия решений в развитом варианте (режим 6.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-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 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 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Classes EXCLUSIVE NEW 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 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW 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 ********** Проверка числа полей в БД Opis_Sc.dbf и приведение к новому числу полей старых БД *** aStructure := { { "KOD_OpSc" , "N", 15, 0 }, ; // 1 { "NAME_OpSc" , "C",250, 0 }, ; // 2 { "INT_INF" , "N", 19, 7 }, ; // 3 { "SUM_II" , "N", 19, 7 }, ; // 4 { "SII_PERC" , "N", 19, 7 }, ; // 5 { "RANG" , "N", 15, 0 }, ; // 6 { "ABS" , "N", 15, 0 }, ; // 7 { "PERC_FIZ" , "N", 19, 7 }, ; // 8 { "Sum_ZnGr" , "N", 19, 7 }, ; // 9 { "N_GrOpSc" , "N", 15, 0 }, ; // 10 { "KodGr_min" , "N", 15, 0 }, ; // 11 Минимальный код градаций описательной шкалы { "KodGr_max" , "N", 15, 0 }, ; // 12 Максимальный код градаций описательной шкалы { "N_combinat", "N", 15, 0 }, ; // 13 Число комбинаций различных сочетаний значений факторов { "Date" , "C", 10, 0 }, ; // 14 { "Time" , "C", 8, 0 } } // 15 CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc EXCLUSIVE NEW SELECT Opis_Sc IF .NOT. DC_IsStru( aStructure ) *IF FCOUNT() = 14 // Если БД Opis_Sc старая (в новой 15 полей) oScr := DC_WaitOn(L('БД Opis_Sc.dbf приводится в соответствие с новой структурой. Немного подождите!!!'),,,,,,,,,,,.F.) DC_StruUpdate( aStructure ) // Обновить структуру БД с сохранением данных DC_Impl(oScr) 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() aHelp22 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) *DC_DataRest( aHelp22 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) *SELECT Opis_sc Opis_sc->(DBGOTOP()) REPLACE Opis_sc->N_COMBINAT WITH Opis_sc->N_GROPSC mNCombinat = Opis_sc->N_COMBINAT mNCombinatOld = mNCombinat mFlagError = .F. Opis_sc->(DBSKIP(1)) DO WHILE .NOT. Opis_sc->(EOF()) bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE REPLACE Opis_sc->N_COMBINAT WITH Opis_sc->N_GROPSC * mNCombinat mNCombinat = Opis_sc->N_COMBINAT mNCombinatOld = mNCombinat RECOVER mFlagError = .T. EXIT // код обработки ошибок ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый блок Opis_sc->(DBSKIP(1)) ENDDO 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('Текущей является шкала или градация, на которой установлен курсор. ')) AADD(aHelp, L(' ')) IF mNCombinatOld > 0 mNCombinat = mNCombinatOld mDay = mNCombinat/(24*60*60) mYear = mDay/365.24219878 IF mFlagError AADD(aHelp, L('Количество сочетаний значений всех факторов >')+' '+ALLTRIM(STR(mNCombinat))+L('. Если при принятии решений')) AADD(aHelp, L('путем многовариантного прогнозирования на один прогноз результатов действия некоторого ')) AADD(aHelp, L('сочетания значений факторов тратить 1 секунду, то на все прогнозирование уйдет >')+' '+ALLTRIM(STR(mYear,19))+' '+L('лет.')) ELSE AADD(aHelp, L('Количество сочетаний значений всех факторов =')+' '+ALLTRIM(STR(mNCombinat))+L('. Если при принятии решений')) AADD(aHelp, L('путем многовариантного прогнозирования на один прогноз результатов действия некоторого ')) IF mDay < 365.24219878 AADD(aHelp, L('сочетания значений факторов тратить 1 секунду, то на все прогнозирование уйдет =')+' '+ALLTRIM(STR(mDay, 19,2))+' '+L('дней.')) ELSE AADD(aHelp, L('сочетания значений факторов тратить 1 секунду, то на все прогнозирование уйдет =')+' '+ALLTRIM(STR(mYear,19,2))+' '+L('лет.')) ENDIF ENDIF ENDIF 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++"') *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 *SELECT Opis_Sc *aHelp22 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) DC_DataRest( aHelp22 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) 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 }, ; // Максимальный код градаций описательной шкалы { "N_combinat", "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 ************************************************************************************************** ******** Перекодирование и переиндексация распознаваемой выборки ************************************************************************************************** FUNCTION RecodingRsp() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW USE Rso_Kcl EXCLUSIVE NEW USE Rso_Kpr EXCLUSIVE NEW * Формирование массивов старых и новых кодов **************************** * Перекодирование БД заголовков объектов распознаваемой выборки ********* M_MaxKodObj = 0 Ar_KodObjOld := {} // Коды объектов исходной выборки Ar_KodObjNew := {} // Коды объектов результирующей выборки SELECT Rso_zag DBGOTOP() DO WHILE .NOT. EOF() AADD(Ar_KodObjOld, Kod_obj) AADD(Ar_KodObjNew, ++M_MaxKodObj) REPLACE Kod_obj WITH M_MaxKodObj DBSKIP(1) ENDDO * Перекодирование БД кодов классов объектов распознаваемой выборки ****** SELECT Rso_Kcl DBGOTOP() DO WHILE .NOT. EOF() Pos = ASCAN(Ar_KodObjOld, Kod_obj) REPLACE Kod_obj WITH Ar_KodObjNew[Pos] DBSKIP(1) ENDDO * Перекодирование БД кодов признаков объектов распознаваемой выборки **** SELECT Rso_Kpr DBGOTOP() DO WHILE .NOT. EOF() Pos = ASCAN(Ar_KodObjOld, Kod_obj) REPLACE Kod_obj WITH Ar_KodObjNew[Pos] DBSKIP(1) ENDDO GenNtxRsoZag();GenNtxRsoKcl();GenNtxRsoKpr() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций 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 (fastest)') 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 IF Dialog;oScr := DC_WaitOn(L('Идет процесс копирования обучающей выборки в распознаваемую. Немного подождите!'),,,,,,,,,,,.F.);ENDIF 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") GenNtxRsoZag();GenNtxRsoKcl();GenNtxRsoKpr() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций IF Dialog;DC_Impl(oScr);ENDIF DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ENDIF ******************************************************** ************************************************************************************* ** Скопировать просто как файлы, переименовать и удалить каждый N-й объект ************************************************************************************* IF nRadio1=3 .AND. nRadio2=1 .AND. nRadio3=1 // Копировать каждый N-й объект <<<===###################### IF Dialog;oScr := DC_WaitOn(L('Идет процесс копирования обучающей выборки в распознаваемую. Немного подождите!'),,,,,,,,,,,.F.);ENDIF 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") USE Rso_Zag EXCLUSIVE NEW DELETE FOR Kod_obj <> N_CopyObj*INT(Kod_obj/N_CopyObj);PACK USE Rso_Kcl EXCLUSIVE NEW DELETE FOR Kod_obj <> N_CopyObj*INT(Kod_obj/N_CopyObj);PACK USE Rso_Kpr EXCLUSIVE NEW DELETE FOR Kod_obj <> N_CopyObj*INT(Kod_obj/N_CopyObj);PACK RecodingRsp() IF Dialog;DC_Impl(oScr);ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveCopOR ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ENDIF ************************************************************************************ ** Скопировать просто как файлы, переименовать и удалить все записи до N1 и после N2 ************************************************************************************ IF nRadio1=5 .AND. nRadio2=1 .AND. nRadio3=1 // Копировать все объекты от N1 до N2 IF Dialog;oScr := DC_WaitOn(L('Идет процесс копирования обучающей выборки в распознаваемую. Немного подождите!'),,,,,,,,,,,.F.);ENDIF 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") USE Rso_Zag EXCLUSIVE NEW DELETE FOR Kod_obj < mN1 .OR. Kod_obj > mN2;PACK USE Rso_Kcl EXCLUSIVE NEW DELETE FOR Kod_obj < mN1 .OR. Kod_obj > mN2;PACK USE Rso_Kpr EXCLUSIVE NEW DELETE FOR Kod_obj < mN1 .OR. Kod_obj > mN2;PACK IF mN1 = 1 GenNtxRsoZag();GenNtxRsoKcl();GenNtxRsoKpr() ELSE RecodingRsp() ENDIF IF Dialog;DC_Impl(oScr);ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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 ) // С включенным ADS DC_DataRest() не работает!!! 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 // Конвертирование БД классификационных шкал и градаций 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 // Конвертирование БД классификационных шкал и градаций 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) *********************************************************************************************************** FUNCTION Time_Progress(Time_Progress, Wsego, oProgress, lOk ) LOCAL nMaxCount := Wsego xtime = Time_Progress ** Отображение занимает очень много времени, поэтому показывать прогресс не чаще чем через 0.1 секунды (как в PercTimeVisio()) T2tp = (DOY(DATE())-1)*86400+SECONDS() // Текущее время IF T2tp - T1tp > 0.1 .OR. xtime = Wsego // Время в секундах или 100% * aSay[mPTVnumb]:SetCaption(mPTVmess+' '+ALLTRIM(STR(mNumPP/Wsego*100,15,7))+'%') *** Индикация времени исполнения ***** Процесс может идти больше суток, поэтому для определения ***** во всех случаях вычисляется время, прошедшее с начала года * T_Mess1 = "Начало:"+" "+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 = "Прошло:"+" "+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+" всего: "+ALLTRIM(STR(Sec_2,17))+" сек." 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+" всего: "+ALLTRIM(STR(Sec_3,17))+" сек." 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 = "Окончание:"+" "+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+" всего: "+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+" всего: "+ALLTRIM(STR(Sec_5,17))+" сек." 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 = "Осталось:"+" "+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+" всего: "+ALLTRIM(STR(Sec_6,17))+" сек." 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 ) T1tp = T2tp ENDIF RETURN lOk ****************************************************************************************************************************************** ******** Ускоренный синтез всех статистических и системно-когнитивных моделей: {Abs, Prc1, Prc2, Inf1, Inf2, Inf3, Inf4, Inf5, Inf6, Inf7} ****************************************************************************************************************************************** FUNCTION F3_1() Running(.T.) F3_5('GPU','Sint','3.1','ALL') ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** 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_2() Running(.T.) F3_5('GPU','Rec','3.2','ALL') ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** 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() Running(.T.) F3_5('GPU','SintRec','3.3','ALL') ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 SET ORDER TO 1 DBGOTOP() Mess = L(' ') ******* Запись фона в ABS ************************** mFonAbs = 0 IF FILE('_FonAbs.txt') * StrFile(ALLTRIM(STR(mFonAbs,19,1)),'_FonAbs.txt') mFonAbs = VAL(FileStr('_FonAbs.txt')) ENDIF IF mFonAbs <> 0 FOR i=1 TO N_Gos For j=1 TO N_Cls String = STR(mFonAbs, 19, 1 ) // Ячейка [i,j]++ Flag_err = LC_FieldPut( Ar_Model[1]+".txt", nHandle[1], i, 2+j, String ) // Запись поля в БД (корректная) ############ Ar_Summ_j[j] = Ar_Summ_j[j] + mFonAbs // Строка "Сумма абс.частот" по столбцам Ar_Summ_i[i] = Ar_Summ_i[i] + mFonAbs // Столбец "Сумма абс.частот" по строкам Summa_Nij = Summa_Nij + mFonAbs // Сумма Nij по всей БД Abs.txt aColEmpty[j] = .T. // .T., если колонка не пустая и .F. - если пустая aStrEmpty[i] = .T. // .T., если строка не пустая и .F. - если пустая NEXT NEXT ENDIF **************************************************** 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 > 2035 Mess = L('БД абсолютных частот не может быть создана, т.к. в модели # классов, что более 2035 !') 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 пустых записей ################ для ABS с фоновым значением *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 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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 > 2035 Mess = L('Базы процентных распределений, т.к. в модели # классов, что более 2035 !') 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 > 2035 Mess = L('Базы знаний не могут быть созданы, т.к. в модели # классов, что более 2035 !') 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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) = 93032445 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Help3.3: Смысл частных критериев знаний системы "Эйдос-Х++"' ) * MsgBox(Disk_dir+'\'+cFile) * DC_SpawnUrl(Disk_dir+'\'+cFile) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) ELSE Mess = L('Файл: "#" поврежден (CRC=$) и не может быть отображен!') Mess = STRTRAN(Mess, "#", cFile) Mess = STRTRAN(Mess, "$", ALLTRIM(STR(FILECHECK(cFile),19))) // Отображение контрольной суммы файла LB_Warning(Mess) ENDIF DIRCHANGE(Disk_dir) DC_DataRest( aSaveH3_3 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 // Отображение стадии исполнения. Будет написано прямо в окне 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() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 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() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rasp EXCLUSIVE NEW mRSRsp = RECSIZE() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DC_DataRest( aSaveGenDbf ) RETURN(mRSRsp) // Вернуть размер записи в байтах *********************************************************************************************************** ******** Создание баз результатов распознавания для визуализации *********************************************************************************************************** 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, 2035) 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, 2035) 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, 2035) 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 LC_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 LC_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 LC_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() 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW Running(.F.) RETURN NIL ENDIF IF .NOT. FILE("Rsp2k.dbf") LB_Warning(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 IF .NOT. FILE("Rsp2i.dbf") LB_Warning(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 dbeSetDefault('DBFNTX') CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX ON Kod_cls TO Classes CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rsp2k NEW INDEX ON Kod_cls TO Rsp2k CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rsp2i NEW INDEX ON Kod_cls TO Rsp2i CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Classes EXCLUSIVE *SET FILTER TO Int_inf+Abs > 0 DBGOTOP();DBGOBOTTOM();DBGOTOP() USE Rsp2k INDEX Rsp2k EXCLUSIVE NEW USE Rsp2i INDEX Rsp2i EXCLUSIVE NEW /* ----- Create ToolBar ----- */ @ 27.7, 0 DCTOOLBAR oToolBar SIZE 131, 1.5 DCADDBUTTON CAPTION L('Помощь') ; SIZE LEN(L("Помощь"))+2 ; ACTION {||Help4132a(), DC_GetRefresh(GetList)} ; PARENT oToolBar DCADDBUTTON CAPTION L('Поиск объекта') ; SIZE LEN(L("Поиск объекта"))+2 ; ACTION {||Search4_1_3_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar DCADDBUTTON CAPTION L('В начало БД') ; SIZE LEN(L("В начало БД"))+2 ; ACTION {||dbGoTop(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar DCADDBUTTON CAPTION L('В конец БД') ; SIZE LEN(L("В конец БД"))+2 ; ACTION {||dbGoBottom(), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar DCADDBUTTON CAPTION L('Предыдущая') ; SIZE LEN(L("Предыдущая"))+2 ; ACTION {||dbSkip(-1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestBof()} ; PARENT oToolBar DCADDBUTTON CAPTION L('Следующая') ; SIZE LEN(L("Следующая"))+2 ; ACTION {||dbSkip(1), DC_GetRefresh(GetList)} ; WHEN {||!DC_TestEof()} ; PARENT oToolBar DCADDBUTTON CAPTION L('9 записей') ; SIZE LEN(L("9 записей"))+2 ; ACTION {||FltrOn4_1_3_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar DCADDBUTTON CAPTION L('Все записи') ; SIZE LEN(L("Все записи"))+2 ; ACTION {||FltrOff4_1_3_2(), DC_GetRefresh(GetList)} ; PARENT oToolBar DCADDBUTTON CAPTION L('Печать XLS') ; SIZE LEN(L("Печать XLS"))+2 ; ACTION {||PrintXLS4_1_3_2(), DC_GetRefresh(GetList)}; PARENT oToolBar DCADDBUTTON CAPTION L('Печать TXT') ; SIZE LEN(L("Печать TXT"))+2 ; ACTION {||PrintTXT4_1_3_2(), DC_GetRefresh(GetList)}; PARENT oToolBar DCADDBUTTON CAPTION L('Печать ALL') ; SIZE LEN(L("Печать ALL"))+2 ; ACTION {||PrintALL4_1_3_2(), DC_GetRefresh(GetList)}; PARENT oToolBar **************************************************************** @1.0, 0 DCPUSHBUTTON ; CAPTION L('Классы') ; SIZE 45.8, 1 ; ACTION {||Help4132b()} @1.0,49 DCPUSHBUTTON ; CAPTION L('Интегральный критерий сходства: "Семантический резонанс знаний"'); SIZE 88.7, 1 ; ACTION {||Help4132c()} @14.2,49 DCPUSHBUTTON ; CAPTION L('Интегральный критерий сходства: "Сумма знаний"') ; SIZE 88.7, 1 ; ACTION {||Help4_1_3_2d()} **************************************************************** PRIVATE bColorBlockKor:={|| iif(Rsp2k->Korr>0 ,{GRA_CLR_RED,nil},iif(Rsp2k->Korr=0 ,{GRA_CLR_WHITE,nil},{GRA_CLR_BLUE,nil})) } // Клиффорд PRIVATE bColorBlockInf:={|| iif(Rsp2i->Sum_inf>0,{GRA_CLR_RED,nil},iif(Rsp2i->Sum_inf=0,{GRA_CLR_WHITE,nil},{GRA_CLR_BLUE,nil})) } // Клиффорд /* ----- Create browse-1: Главная БД Classes.dbf ----- */ bZag := {|| Rsp2i->(DC_SetScope(0,Classes->Kod_cls)), ; Rsp2i->(DC_SetScope(1,Classes->Kod_cls)), ; Rsp2i->(DC_DbGoTop()) , ; oBrowInf:refreshAll() , ; Rsp2k->(DC_SetScope(0,Classes->Kod_cls)), ; Rsp2k->(DC_SetScope(1,Classes->Kod_cls)), ; Rsp2k->(DC_DbGoTop()) , ; oBrowKor:refreshAll() } @ 2, 0 DCBROWSE oBrowZag ALIAS 'Classes' SIZE 45.8,25.2 ; PRESENTATION LC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED {|| Eval(bZag), ; DC_GetRefresh(GetList,, ; DCGETREFRESH_TYPE_EXCLUDE,{GETLIST_BROWSE}) } DCSETPARENT oBrowZag DCBROWSECOL FIELD Classes->Kod_cls HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Classes->Name_cls HEADER L('Наим. класса') WIDTH 21.0 DCBROWSECOL FIELD Classes->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Classes->Time HEADER L('Время' ) WIDTH 9 /* Create browse-2: БД Rsp2k.dbf, связанная отношением "Один ко многим" с БД Classes.dbf*/ DCSETPARENT TO @2, 49 DCBROWSE oBrowKor ALIAS 'Rsp2k' SIZE 88.7,12.0 ; PRESENTATION LC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowKor DCBROWSECOL FIELD Rsp2k->Kod_obj HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Rsp2k->Name_obj HEADER L('Наименование объекта') WIDTH 19.0 DCBROWSECOL FIELD Rsp2k->Korr HEADER L('Сходство' ) WIDTH 6 DCBROWSECOL FIELD Rsp2k->Fakt HEADER L('Факт' ) WIDTH 1 DCBROWSECOL FIELD Rsp2k->Histogram HEADER L('Сходство' ) WIDTH 19 COLOR bColorBlockKor DCBROWSECOL FIELD Rsp2k->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Rsp2k->Time HEADER L('Время' ) WIDTH 9 /* Create browse-3: БД Rsp2i.dbf, связанная отношением "Один ко многим" с БД Classes.dbf*/ DCSETPARENT TO @15.2,49 DCBROWSE oBrowInf ALIAS 'Rsp2i' SIZE 88.7,12.0; PRESENTATION LC_BrowPres() ; // Только просмотр БД NOSOFTTRACK ; SCOPE ; ITEMMARKED bItems DCSETPARENT oBrowInf DCBROWSECOL FIELD Rsp2i->Kod_obj HEADER L('Код' ) WIDTH 5 DCBROWSECOL FIELD Rsp2i->Name_obj HEADER L('Наименование объекта') WIDTH 19.0 DCBROWSECOL FIELD Rsp2i->Sum_inf HEADER L('Сходство' ) WIDTH 6 DCBROWSECOL FIELD Rsp2i->Fakt HEADER L('Факт' ) WIDTH 1 DCBROWSECOL FIELD Rsp2i->Histogram HEADER L('Сходство' ) WIDTH 19 COLOR bColorBlockInf DCBROWSECOL FIELD Rsp2i->Date HEADER L('Дата' ) WIDTH 10 DCBROWSECOL FIELD Rsp2i->Time HEADER L('Время' ) WIDTH 9 SELECT Classes DCGETOPTIONS SAYFONT '10.Helv Bold' TABSTOP AUTORESIZE cTitle = L('4.1.3.2. Визуализация результатов распознавания в отношении: "Класс-объекты". Текущая модель: "')+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 Help4132a() aHelp := {} AADD(aHelp, L('Режим: 4.1.3.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('распознавания). ')) 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.2. (C) Система "ЭЙДОС-X++"') RETURN NIL ************************************************************************************************** **************************************************************************************** FUNCTION Help4132b() 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.2. Смысл термина: "Распознаваемая выборка" (C) Система "ЭЙДОС-X++"') RETURN NIL ***************************************************************************************** ******** Помощь по режиму 4.1.3.2: смысл интегрального критерия "Семантический ******** резонанс знаний" сходства распознаваемых объектов с классами системы "Эйдос-Х++" ***************************************************************************************** FUNCTION Help4132c() 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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 DC_DataRest( aSaveH4131 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ****************************************************************************** ******** Помощь по режиму 4.1.3.2: смысл интегрального критерия "Сумма знаний" ******** сходства распознаваемых объектов с классами системы "Эйдос-Х++" ****************************************************************************** FUNCTION Help4_1_3_2d() 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) = 59487304 // <<<===############### * DC_PrintPreviewAcrobat( cFile, 'Сценарный метод АСК-анализа' ) RunShell(cFile,"SumatraPDF-3.4.5-32.exe",.T.) 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 DC_DataRest( aSaveH4131 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) RETURN NIL ****************************************************************************** FUNCTION Search4_1_3_2() Razrab() RETURN NIL FUNCTION FltrOn4_1_3_2() Razrab() RETURN NIL FUNCTION FltrOff4_1_3_2() Razrab() RETURN NIL FUNCTION PrintXLS4_1_3_2() Razrab() RETURN NIL FUNCTION PrintTXT4_1_3_2() Razrab() RETURN NIL ******************************************************************************************************************************************** ******** Печать выходных форм : класс (код и наименование) - коды, наименования и содержимое всех объектов с уровнем сходства выше заданного ******** Печать выходной формы: коды, наименования и содержимое всех объектов с уровнем сходства ниже заданного ******************************************************************************************************************************************** FUNCTION PrintALL4_1_3_2() mPorog = 30 @0,0 DCGROUP oGroup1 CAPTION L('Задайте порог сходства объектов с классами:') SIZE 40.0, 2.5 @1,2 DCSAY L(" ") GET mPorog PARENT oGroup1 DCREAD GUI; TO lExit ; FIT; ADDBUTTONS; MODAL; TITLE L('(c) Система "ЭЙДОС-X++"') IF lExit ** Button Ok ELSE RETURN NIL ENDIF ******************************************************************** oScrn := DC_WaitOn(L('Печать выходных форм'),,,,,,,,,,,.F.) *************************************************** ***** Печать кратких выходных форм **************** *************************************************** DIRCHANGE(Disk_dir+"\AID_DATA\Inp_rasp\") // Перейти в папку Inp_rasp mCountObjTxt = ADIR("*.TXT") // Кол-во TXT-файлов IF mCountObjTxt = 0 LB_Warning(L('В папке: '+Disk_dir+'\AID_DATA\Inp_rasp\ нет TXT-файлов', '(c) Система "ЭЙДОС-X++"')) ELSE PRIVATE aFileNameObj [mCountObjTxt] ADIR("*.txt", aFileNameObj) DIRCHANGE(M_PathAppl) // База данных неидентифицированных объектов распознаваемой выборки, // не вошедших в выходные формы (непривязанных ссылок), потом напечатать ********** Создать БД для выходной формы ************** aStructure := { { "Kod" , "N", 15, 0 }, ; // 1 { "File_name", "C", 255, 0 }, ; // 2 { "Text" , "C", 255, 0 }, ; // 3 { "Type" , "C", 13, 0 }, ; // 5 IdentObject / UnidentObject { "TextALL" , "M", 10, 0 } } // 6 MEMO-FIELD DbCreate( 'UnidentObj', aStructure ) ******************************************************* CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW USE UnidentObj EXCLUSIVE NEW SELECT Rso_Zag DBGOTOP() DO WHILE .NOT. EOF() SELECT Rso_Zag mKodObj = Kod_obj mNameObj = ALLTRIM(Name_obj) mTextObj = ALLTRIM(FILESTR(Disk_dir+'\AID_DATA\Inp_rasp\'+aFileNameObj[mKodObj])) // Загрузка файла объектов распознаваемой выборки SELECT UnidentObj APPEND BLANK REPLACE Kod WITH mKodObj REPLACE File_name WITH mNameObj REPLACE Text WITH SUBSTR(mTextObj,1,255) REPLACE TextALL WITH mTextObj REPLACE Type WITH 'UnidentObject' SELECT Rso_Zag DBSKIP(1) ENDDO ENDIF ********** Создать БД для выходной формы ************** aStructure := { { "Kod_cls" , "N", 15, 0 }, ; // 1 { "Name_cls" , "C", 255, 0 }, ; // 2 { "Kod_objs" , "C", 255, 0 }, ; // 3 { "Urov_sxods", "C", 255, 0 }, ; // 4 { "Kobj_UrSx" , "M", 10, 0 } } // 5 MEMO-FIELD для печати текстовой формы с полной информацией DbCreate( 'Rsp2km', aStructure ) DbCreate( 'Rsp2im', aStructure ) ******************************************************* CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rsp2k EXCLUSIVE NEW USE Rsp2i EXCLUSIVE NEW USE Rsp2km EXCLUSIVE NEW USE Rsp2im EXCLUSIVE NEW USE UnidentObj EXCLUSIVE NEW SELECT Rsp2k DBGOTOP() mNameCls = '' mKodObj = Kod_obj mKodCls = Kod_cls DO WHILE .NOT. EOF() IF Korr >= mPorog mKodObj = Kod_obj mKodCls = Kod_cls mUrovSxod= ROUND(Korr,1) ****** Отметить, что объект идентифицирован SELECT UnidentObj DBGOTO(mKodObj) REPLACE Type WITH 'IdentObject' SELECT Rsp2k IF ALLTRIM(mNameCls) <> ALLTRIM(Name_cls) mNameCls = ALLTRIM(Name_cls) SELECT Rsp2km APPEND BLANK REPLACE Kod_cls WITH mKodCls REPLACE Name_cls WITH mNameCls ENDIF SELECT Rsp2km mKodObjs = ALLTRIM(Kod_objs)+' '+ALLTRIM(STR(mKodObj)) IF LEN(mKodObjs) <= 255 REPLACE Kod_objs WITH mKodObjs ENDIF mUrovSxods = ALLTRIM(Urov_sxods)+' '+ALLTRIM(STR(mUrovSxod)) IF LEN(mUrovSxods) <= 255 REPLACE Urov_sxods WITH mUrovSxods ENDIF mKobjUrSx = ALLTRIM(Kobj_UrSx)+' '+ALLTRIM(STR(mKodObj))+'('+ALLTRIM(STR(mUrovSxod,5,1))+')' // Мемо-поле REPLACE Kobj_UrSx WITH mKobjUrSx ENDIF SELECT Rsp2k DBSKIP(1) ENDDO ****** ПЕЧАТЬ ТЕКСТОВОГО ФАЙЛА ******* set device to printer set printer on set printer to ("Rsp2km.txt") set console off ?"РЕЗУЛЬТАТЫ ИДЕНТИФИКАЦИИ ОБЪЕКТОВ С КЛАССАМИ (ИНТ.КРИТ. - РЕЗОНАНС ЗНАНИЙ):" ?"НАИМЕНОВАНИЯ ФАЙЛОВ, КОДЫ КЛАССОВ И РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА):" ?'показаны объекты распознаваемой выборки с уровнями сходства с классом => '+ALLTRIM(STR(mPorog)) ?'' ?REPLICATE('=',80) SELECT Rsp2km DBGOTOP() DO WHILE .NOT. EOF() ?REPLICATE('=',80) ?'КОД КЛАССА: '+ALLTRIM(STR(Kod_cls))+' НАИМЕНОВАНИЕ КЛАССА: '+ALLTRIM(Name_cls) ?REPLICATE('~',80) ?'КОДЫ РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ С КЛАССОМ):' ?Kobj_UrSx ?REPLICATE('=',80) ?'' DBSKIP(1) ENDDO ?REPLICATE('=',80) Set device to screen Set printer off Set printer to Set console on ************************************** SELECT Rsp2i DBGOTOP() mNameCls = '' mKodObj = Kod_obj mKodCls = Kod_cls DO WHILE .NOT. EOF() IF Sum_inf >= mPorog mKodObj = Kod_obj mKodCls = Kod_cls mUrovSxod= ROUND(Sum_inf,1) ****** Отметить, что объект идентифицирован SELECT UnidentObj DBGOTO(mKodObj) REPLACE Type WITH 'IdentObject' SELECT Rsp2i IF ALLTRIM(mNameCls) <> ALLTRIM(Name_cls) mNameCls = ALLTRIM(Name_cls) SELECT Rsp2im APPEND BLANK REPLACE Kod_cls WITH mKodCls REPLACE Name_cls WITH mNameCls ENDIF SELECT Rsp2im mKodObjs = ALLTRIM(Kod_objs)+' '+ALLTRIM(STR(mKodObj)) IF LEN(mKodObjs) <= 255 REPLACE Kod_objs WITH mKodObjs ENDIF mUrovSxods = ALLTRIM(Urov_sxods)+' '+ALLTRIM(STR(mUrovSxod,5,1)) IF LEN(mUrovSxods) <= 255 REPLACE Urov_sxods WITH mUrovSxods ENDIF mKobjUrSx = ALLTRIM(Kobj_UrSx)+' '+ALLTRIM(STR(mKodObj))+'('+ALLTRIM(STR(mUrovSxod,5,1))+')' // Мемо-поле REPLACE Kobj_UrSx WITH mKobjUrSx ENDIF SELECT Rsp2i DBSKIP(1) ENDDO ****** ПЕЧАТЬ ТЕКСТОВОГО ФАЙЛА ******* set device to printer set printer on set printer to ("Rsp2im.txt") set console off ?"РЕЗУЛЬТАТЫ ИДЕНТИФИКАЦИИ ОБЪЕКТОВ С КЛАССАМИ (ИНТ.КРИТ. - СУММА ИНФОРМАЦИИ):" ?"НАИМЕНОВАНИЯ ФАЙЛОВ, КОДЫ КЛАССОВ И РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА):" ?'показаны объекты распознаваемой выборки с уровнями сходства с классом => '+ALLTRIM(STR(mPorog)) ?'' ?REPLICATE('=',80) SELECT Rsp2im DBGOTOP() DO WHILE .NOT. EOF() ?REPLICATE('=',80) ?'КОД КЛАССА: '+ALLTRIM(STR(Kod_cls))+' НАИМЕНОВАНИЕ КЛАССА: '+ALLTRIM(Name_cls) ?REPLICATE('~',80) ?'КОДЫ РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ С КЛАССОМ):' ?Kobj_UrSx ?REPLICATE('=',80) ?'' DBSKIP(1) ENDDO ?REPLICATE('=',80) Set device to screen Set printer off Set printer to Set console on ************************************** *************************************************** ***** Печать подробных выходных форм ************** *************************************************** DIRCHANGE(Disk_dir+"\AID_DATA\Inp_data\") // Перейти в папку Inp_data mCountClsTxt = ADIR("*.TXT") // Кол-во TXT-файлов DIRCHANGE(Disk_dir+"\AID_DATA\Inp_rasp\") // Перейти в папку Inp_rasp mCountObjTxt = ADIR("*.TXT") // Кол-во TXT-файлов IF mCountClsTxt = 0 LB_Warning(L('В папке: '+Disk_dir+'\AID_DATA\Inp_data\ нет TXT-файлов'), L('(c) Система "ЭЙДОС-X++"')) ELSE IF mCountObjTxt = 0 LB_Warning(L('В папке: '+Disk_dir+'\AID_DATA\Inp_rasp\ нет TXT-файлов'), L('(c) Система "ЭЙДОС-X++"')) ELSE DIRCHANGE(Disk_dir+"\AID_DATA\Inp_data\") // Перейти в папку Inp_data PRIVATE aFileNameCls [mCountClsTxt] PRIVATE aFileNameClsL[mCountClsTxt] ADIR("*.txt", aFileNameCls) FOR j=1 TO LEN(aFileNameCls) aFileNameClsL[j] = ALLTRIM(ConvToOemCP(aFileNameCls[j])) NEXT DIRCHANGE(Disk_dir+"\AID_DATA\Inp_rasp\") // Перейти в папку Inp_rasp PRIVATE aFileNameObj [mCountObjTxt] PRIVATE aFileNameObjL[mCountObjTxt] ADIR("*.txt", aFileNameObj) FOR j=1 TO LEN(aFileNameObj) aFileNameObjL[j] = ALLTRIM(ConvToOemCP(aFileNameObj[j])) NEXT DIRCHANGE(M_PathAppl) ********** Создать БД для выходной формы ************** aStructure := { { "Kod" , "N", 15, 0 }, ; // 1 { "File_name", "C", 255, 0 }, ; // 2 { "Text" , "C", 255, 0 }, ; // 3 { "Urov_sxod", "N", 5, 1 }, ; // 4 { "Type" , "C", 8, 0 }, ; // 5 Classes / Object / KobjUrSx { "TextALL" , "M", 10, 0 } } // 6 MEMO-FIELD DbCreate( 'Rsp2kT', aStructure ) DbCreate( 'Rsp2iT', aStructure ) ******************************************************* CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW USE Rsp2km EXCLUSIVE NEW USE Rsp2im EXCLUSIVE NEW USE Rsp2kT EXCLUSIVE NEW USE Rsp2iT EXCLUSIVE NEW USE UnidentObj EXCLUSIVE NEW SELECT Rsp2km DBGOTOP() DO WHILE .NOT. EOF() mKodCls = Kod_cls mNameCls = ALLTRIM(aFileNameClsL[mKodCls]) // Сформировать имя файла mTextCls = ALLTRIM(FILESTR(Disk_dir+'\AID_DATA\Inp_data\'+aFileNameCls[mKodCls])) // Загрузка файла объекта обучающей выборки mKodObjs = Kod_objs mUrSxods = Urov_sxods mKobjUrSx= Kobj_UrSx SELECT Rsp2kT APPEND BLANK APPEND BLANK REPLACE Kod WITH mKodCls REPLACE File_name WITH mNameCls REPLACE Text WITH mTextCls REPLACE TextALL WITH mTextCls REPLACE Type WITH 'Classes' APPEND BLANK REPLACE File_name WITH mKobjUrSx REPLACE TextALL WITH mKobjUrSx REPLACE Type WITH 'KobjUrSx' aKodOrv := {} // Коды объектов распознаваемой выборки aUrSxod := {} // Уровни сходства объектов расп.выборки с классом mKodCls FOR j=1 TO NUMTOKEN(mKodObjs, ' ') AADD(aKodOrv, VAL(TOKEN(mKodObjs, ' ', j))) AADD(aUrSxod, VAL(TOKEN(mUrSxods, ' ', j))) NEXT IF LEN(aKodOrv) > 0 FOR j=1 TO LEN(aKodOrv) SELECT Rso_Zag DBGOTO(aKodOrv[j]) mNameObj = ALLTRIM(aFileNameObjL[aKodOrv[j]]) mTextObj = ALLTRIM(FILESTR(Disk_dir+'\AID_DATA\Inp_rasp\'+aFileNameObj[aKodOrv[j]])) // Загрузка файла объектов распознаваемой выборки SELECT Rsp2kT APPEND BLANK REPLACE Kod WITH aKodOrv[j] REPLACE File_name WITH mNameObj REPLACE Text WITH SUBSTR(mTextObj,1,255) REPLACE TextALL WITH mTextObj REPLACE Urov_sxod WITH aUrSxod[j] REPLACE Type WITH 'Object' NEXT ENDIF SELECT Rsp2km DBSKIP(1) ENDDO ****** ПЕЧАТЬ ТЕКСТОВОГО ФАЙЛА ******* set device to printer set printer on set printer to ("Rsp2kT.txt") set console off ?"РЕЗУЛЬТАТЫ ИДЕНТИФИКАЦИИ ОБЪЕКТОВ С КЛАССАМИ (ИНТ.КРИТ. - РЕЗОНАНС ЗНАНИЙ):" ?"КОДЫ И НАИМЕНОВАНИЯ ФАЙЛОВ КЛАССОВ И ИХ СОДЕРЖИМОЕ." ?"КОДЫ И НАИМЕНОВАНИЯ ФАЙЛОВ ОБЪЕКТОВ РАСПОЗНАВАЕМОЙ ВЫБОРКИ И ИХ СОДЕРЖИМОЕ." ?'Показаны объекты распознаваемой выборки с уровнями сходства с классом => '+ALLTRIM(STR(mPorog)) SELECT Rsp2kT DBGOTOP() DO WHILE .NOT. EOF() IF Type = 'Classes' ?'' ?REPLICATE('=',80) ?'КОД КЛАССА: '+ALLTRIM(STR(Kod))+' НАИМЕНОВАНИЕ ФАЙЛА КЛАССА: '+ALLTRIM(File_name) ?'СОДЕРЖИМОЕ ФАЙЛА:' ?ALLTRIM(TextALL) ?REPLICATE('~',80) ENDIF IF Type = 'KobjUrSx' ?'КОДЫ РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ С КЛАССОМ):' ?ALLTRIM(TextALL) ?REPLICATE('=',80) ENDIF IF Type = 'Object' DO WHILE .NOT. EOF() .AND. Type = 'Object' ?'Сходства объекта с классом: '+ALLTRIM(STR(Urov_sxod,5,1))+'. Код объекта: '+ALLTRIM(STR(Kod))+'. Имя файла объекта:'+ALLTRIM(File_name) ?'Содержимое файла:' ?ALLTRIM(TextALL) ?REPLICATE('~',80) DBSKIP(1) ENDDO ENDIF DBSKIP(1) ENDDO ?REPLICATE('=',80) Set device to screen Set printer off Set printer to Set console on ************************************** SELECT Rsp2im DBGOTOP() DO WHILE .NOT. EOF() mKodCls = Kod_cls mNameCls = ALLTRIM(aFileNameClsL[mKodCls]) // Сформировать имя файла mTextCls = ALLTRIM(FILESTR(Disk_dir+'\AID_DATA\Inp_data\'+aFileNameCls[mKodCls])) // Загрузка файла объекта обучающей выборки mKodObjs = Kod_objs mUrSxods = Urov_sxods mKobjUrSx= Kobj_UrSx SELECT Rsp2iT APPEND BLANK APPEND BLANK REPLACE Kod WITH mKodCls REPLACE File_name WITH mNameCls REPLACE Text WITH mTextCls REPLACE TextALL WITH mTextCls REPLACE Type WITH 'Classes' APPEND BLANK REPLACE File_name WITH mKobjUrSx REPLACE TextALL WITH mKobjUrSx REPLACE Type WITH 'KobjUrSx' aKodOrv := {} // Коды объектов распознаваемой выборки aUrSxod := {} // Уровни сходства объектов расп.выборки с классом mKodCls FOR j=1 TO NUMTOKEN(mKodObjs, ' ') AADD(aKodOrv, VAL(TOKEN(mKodObjs, ' ', j))) AADD(aUrSxod, VAL(TOKEN(mUrSxods, ' ', j))) NEXT IF LEN(aKodOrv) > 0 FOR j=1 TO LEN(aKodOrv) SELECT Rso_Zag DBGOTO(aKodOrv[j]) mNameObj = ALLTRIM(aFileNameObjL[aKodOrv[j]]) mTextObj = ALLTRIM(FILESTR(Disk_dir+'\AID_DATA\Inp_rasp\'+aFileNameObj[aKodOrv[j]])) // Загрузка файла объекта распознаваемой выборки SELECT Rsp2iT APPEND BLANK REPLACE Kod WITH aKodOrv[j] REPLACE File_name WITH mNameObj REPLACE Text WITH SUBSTR(mTextObj,1,255) REPLACE TextALL WITH mTextObj REPLACE Urov_sxod WITH aUrSxod[j] REPLACE Type WITH 'Object' NEXT ENDIF SELECT Rsp2im DBSKIP(1) ENDDO ****** ПЕЧАТЬ ТЕКСТОВОГО ФАЙЛА ******* set device to printer set printer on set printer to ("Rsp2iT.txt") set console off ?"РЕЗУЛЬТАТЫ ИДЕНТИФИКАЦИИ ОБЪЕКТОВ С КЛАССАМИ (ИНТ.КРИТ. - СУММА ЗНАНИЙ):" ?"КОДЫ И НАИМЕНОВАНИЯ ФАЙЛОВ КЛАССОВ И ИХ СОДЕРЖИМОЕ." ?"КОДЫ И НАИМЕНОВАНИЯ ФАЙЛОВ ОБЪЕКТОВ РАСПОЗНАВАЕМОЙ ВЫБОРКИ И ИХ СОДЕРЖИМОЕ." ?'Показаны объекты распознаваемой выборки с уровнями сходства с классом => '+ALLTRIM(STR(mPorog)) SELECT Rsp2iT DBGOTOP() DO WHILE .NOT. EOF() IF Type = 'Classes' ?'' ?REPLICATE('=',80) ?'КОД КЛАССА: '+ALLTRIM(STR(Kod))+' НАИМЕНОВАНИЕ ФАЙЛА КЛАССА: '+ALLTRIM(File_name) ?'СОДЕРЖИМОЕ ФАЙЛА:' ?ALLTRIM(TextALL) ?REPLICATE('~',80) ENDIF IF Type = 'KobjUrSx' ?'КОДЫ РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ (УРОВНИ СХОДСТВА РАСПОЗНАВАЕМЫХ ОБЪЕКТОВ С КЛАССОМ):' ?ALLTRIM(TextALL) ?REPLICATE('=',80) ENDIF IF Type = 'Object' DO WHILE .NOT. EOF() .AND. Type = 'Object' ?'Сходства объекта с классом: '+ALLTRIM(STR(Urov_sxod,5,1))+'. Код объекта: '+ALLTRIM(STR(Kod))+'. Имя файла объекта:'+ALLTRIM(File_name) ?'Содержимое файла:' ?ALLTRIM(TextALL) ?REPLICATE('~',80) DBSKIP(1) ENDDO ENDIF DBSKIP(1) ENDDO ?REPLICATE('=',80) Set device to screen Set printer off Set printer to Set console on ENDIF ENDIF ***** Еще вывести такие же формы (только коды и с текстами) по неидентифицрованным ссылкам ***** (нераспознанным объектам, т.е. у которых уровень сходства < mPorog) ################ SELECT UnidentObj DELETE FOR Type = 'IdentObject' PACK ****** ПЕЧАТЬ ТЕКСТОВОГО ФАЙЛА ******* set device to printer set printer on set printer to ("UnidentObj.txt") set console off ?"ОТЧЕТ ПО НЕИДЕНТИФИЦИРОВАННЫМ ОБЪЕКТАМ РАСПОЗНАВАЕМОЙ ВЫБОРКИ, Т.Е.ТЕМ, У КОТОРЫХ" ?"УРОВЕНЬ СХОДСТВА С КЛАССАМИ ОКАЗАЛСЯ НИЖЕ ЗАДАННОГО ПОРОГА: < "+ALLTRIM(STR(mPorog)) ?"ПРИВЕДЕНЫ КОДЫ И НАИМЕНОВАНИЯ ФАЙЛОВ ОБЪЕКТОВ РАСПОЗНАВАЕМОЙ ВЫБОРКИ И ИХ СОДЕРЖИМОЕ." ?'' SELECT UnidentObj DBGOTOP() DO WHILE .NOT. EOF() DO WHILE .NOT. EOF() ?'Код объекта: '+ALLTRIM(STR(Kod))+'. Имя файла объекта:'+ALLTRIM(File_name) ?'Содержимое файла:' ?ALLTRIM(TextALL) ?REPLICATE('~',80) DBSKIP(1) ENDDO DBSKIP(1) ENDDO ?REPLICATE('=',80) Set device to screen Set printer off Set printer to Set console on ************************************************************************** DC_Impl(oScrn) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Classes EXCLUSIVE *SET FILTER TO Int_inf+Abs > 0 DBGOTOP();DBGOBOTTOM();DBGOTOP() USE Rsp2k INDEX Rsp2k EXCLUSIVE NEW USE Rsp2i INDEX Rsp2i EXCLUSIVE NEW aMess := {} AADD(aMess, L('РАСЧЕТ ЗАВЕРШЕН УСПЕШНО! ВЫХОДНЫЕ ФОРМЫ НАХОДЯТСЯ В ФАЙЛАХ:')) AADD(aMess, L(' ')) AADD(aMess, L(' ')) AADD(aMess, M_PathAppl+L('\Rsp2km.dbf - форма с именами файлов и кодами распозн.объектов (инт.крит. - резонанс знаний)') ) AADD(aMess, M_PathAppl+L('\Rsp2im.dbf - форма с именами файлов и кодами распозн.объектов (инт.крит. - сумма знаний)') ) AADD(aMess, M_PathAppl+L('\Rsp2kT.dbf - форма с содержимым файлов и распознаваемых объектов (инт.крит. - резонанс знаний)')) AADD(aMess, M_PathAppl+L('\Rsp2iT.dbf - форма с содержимым файлов и распознаваемых объектов (инт.крит. - сумма знаний)') ) AADD(aMess, M_PathAppl+L('\UnidentObj.dbf - форма с информацией по неидентифицированным объектам распознаваемой выборки') ) AADD(aMess, L(' ')) AADD(aMess, L('Все эти базы данных открываются в MS Excel')) AADD(aMess, L('В них есть ограничение на максимальный размер поля: 255 символов.')) AADD(aMess, L(' ')) AADD(aMess, L(' ')) AADD(aMess, M_PathAppl+L('\Rsp2km.txt - форма с именами файлов и кодами распозн.объектов (инт.крит. - резонанс знаний)') ) AADD(aMess, M_PathAppl+L('\Rsp2im.txt - форма с именами файлов и кодами распозн.объектов (инт.крит. - сумма знаний)') ) AADD(aMess, M_PathAppl+L('\Rsp2kT.txt - форма с содержимым файлов и распознаваемых объектов (инт.крит. - резонанс знаний)')) AADD(aMess, M_PathAppl+L('\Rsp2iT.txt - форма с содержимым файлов и распознаваемых объектов (инт.крит. - сумма знаний)') ) AADD(aMess, M_PathAppl+L('\UnidentObj.txt - форма с информацией по неидентифицированным объектам распознаваемой выборки') ) AADD(aMess, L(' ')) AADD(aMess, L('Все эти базы данных открываются в MS Word')) AADD(aMess, L('В текстовых выходных формах ограничения на размер текста отсутствуют.')) AADD(aMess, L('Текстовые выходные формы в DOS-кодировке.')) LB_Warning(aMess, L('(c) Система "ЭЙДОС-X++"')) RETURN NIL *********************************************************************************************** ******** 3.4. Автоматическое выполнение режимов 1-2-3, "Синтез модели с нуля" ######### ******** По очереди исполняются режимы: 3.1., 3.2. и 3.3. для заданных моделей баз знаний ******** и затем заданная делается текущей' ######### *********************************************************************************************** *FUNCTION F3_4old( Dialog, TP, Ws, oP, lO, Regim ) *Running(.T.) *PUBLIC Time_progress, Wsego, oProgress, lOk := .T., Sec_1 *IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации * LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) * Running(.F.) * RETURN NIL *ENDIF *IF Dialog * IF ApplChange("3.4()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения * ************************************************************** * ***** БД, открытые перед запуском главного меню * ***** Восстанавливать их после выхода из функций главного меню * ************************************************************** * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW * ************************************************************** * Running(.F.) * RETURN NIL * ENDIF *ELSE * IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения * PUBLIC aSaveMainM := DC_ARestore("_SaveMainM.arx") // Восстановление вычислительной среды (открытые и текущие БД и индексы) с диска * DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) * Running(.F.) * RETURN NIL * ENDIF *ENDIF *// Организовать отображение стадии процесса и прогноз времени исполнения ******* Задание на расчет баз знаний *IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее * aCalcInf = DC_ARestore("_CalcInf.arx") *ELSE * AFILL(aCalcInf, .T.) * DC_ASave(aCalcInf, "_CalcInf.arx") *ENDIF *IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей * M_CurrInf = DC_ARestore("_CurrInf.arx") *ELSE * DC_ASave(M_CurrInf, "_CurrInf.arx") *ENDIF ******* Задание моделей знаний для расчета и задание текущей модели *@ 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.4. Задание баз знаний для расчета и работы (текущей)') ******************************************************************** * 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") // Файл с информацией о том, какая модель задана текущей ***** Проверка диалога **FOR j=1 TO LEN(aCalcInf) ** IF aCalcInf[j] ** LB_Warning(L("Задан Расчет модели знаний: ")+ALLTRIM(STR(j,19))) ** ELSE ** LB_Warning(L("Расчет модели знаний: ")+ALLTRIM(STR(j,19))+L(" не задан")) ** ENDIF **NEXT **LB_Warning(L("Текущей задана модель: ")+STR(M_CurrInf,19)) *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 ***************************************************************************************************** *CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() *USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() *USE Obi_Zag EXCLUSIVE NEW;N_Obj = RECCOUNT() ***************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego // Задание максимальной величины параметра Time * Wsego_Abs = N_Obj + 3*N_Cls +2*N_Gos // Задание максимальной величины параметра Time * Wsego_Prc = N_Gos // Задание максимальной величины параметра Time // Задание максимальной величины параметра Time * Wsego_Inf = 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) * Wsego = Wsego_Abs + Wsego_Prc + Wsego_Inf // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar * @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105,14.5 ; * PARENT oTabPage1 * @16,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" // Abs.dbf * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // Prc1.dbf, Prc2.dbf * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // БЗ-1 - Inf1~Prc1 1 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // БЗ-2 - Inf2~Prc2 2 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // БЗ-3 - Inf3-хи-квадрат 3 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" // БЗ-4 - Inf4-roi~Prc1 4 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // БЗ-5 - Inf5-roi~Prc2 5 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // БЗ-6 - Inf6-Dp~Prc1 6 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // БЗ-7 - Inf7-Dp~Prc2 7 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 8 * @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[11] FONT "10.Helv" // 8 * @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" // 8 * 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('3.4. Расчет стат.моделей: Abs.dbf, Prc1.dbf, Prc2.dbf и заданных моделей знаний: Inf1-Inf7') ; * PARENT @oDialog ; * FIT ; * EXIT ; * MODAL * oDialog:show() ***************************************************************************************************** * Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года * T_Mess1 = L("Начало:")+" "+TIME() // Начало * Sec_1 = (DOY(DATE())-1)*86400+SECONDS() * PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения * PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) * PUBLIC T1tp := T1 * PUBLIC T2tp := T2 *aSay[ 2]:SetCaption(L('ШАГ 1-Й ИЗ 3: СИНТЕЗ СТАТ.МОДЕЛИ "ABS" (РАСЧЕТ МАТРИЦЫ АБСОЛЮТНЫХ ЧАСТОТ) - ИСПОЛНЕНИЕ:')) *Time_Progress = F3_1(.F., Time_Progress, Wsego, oProgress, lOk, "3_4" ) // Расчет Abs.dbf *aSay[ 2]:SetCaption(L('Шаг 1-й из 3: Синтез стат.модели "ABS" (расчет матрицы абсолютных частот) - Готово')) *FOR j=3 TO 13;aSay[j]:SetCaption(L(" "));NEXT *aSay[ 3]:SetCaption(L('ШАГ 2-Й ИЗ 3: СИНТЕЗ СТАТ.МОДЕЛЕЙ "PRC1" И "PRC2" (УСЛ.И БЕЗУСЛ.% РАСПР.) - ИСПОЛНЕНИЕ:')) *Time_Progress = F3_2(.F., Time_Progress, Wsego, oProgress, lOk, "3_4" ) // Расчет Prc1.dbf b Prc2.dbf *aSay[ 3]:SetCaption(L('Шаг 2-й из 3: Синтез стат.моделей "PRC1" и "PRC2" (усл.и безусл.% распр.) - Готово')) *Flag_Inf = .F. // Определить, задана хотя бы одна модель знаний для расчета *FOR j=4 TO 10 * IF aCalcInf[j] * Flag_Inf = .T. * EXIT * ENDIF *NEXT *IF Flag_Inf * FOR j=4 TO 13;aSay[j]:SetCaption(L(" "));NEXT * aSay[ 4]:SetCaption(L('ШАГ 3-Й ИЗ 3: СИНТЕЗ МОДЕЛЕЙ ЗНАНИЙ: INF1-INF7 - ИСПОЛНЕНИЕ:')) * Time_Progress = F3_3(.F., Time_Progress, Wsego, oProgress, lOk, "3_4" ) // Расчет баз знаний Inf1.dbf, Inf2.dbf, Inf3.dbf, Inf4.dbf, Inf5.dbf, Inf6.dbf, Inf7.dbf ** Time_Progress = F3_3(.F., Time_Progress, Wsego, oProgress, lOk, "3_5" ) // Расчет баз знаний Inf1.dbf, Inf2.dbf, Inf3.dbf, Inf4.dbf, Inf5.dbf, Inf6.dbf, Inf7.dbf * FOR j=5 TO 13;aSay[j]:SetCaption(L(" "));NEXT * aSay[ 4]:SetCaption(L('Шаг 3-й из 3: Синтез моделей знаний: INF1-INF7 - Готово')) *ENDIF ***************************************************************************************************** *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() * ************************************************************** * ***** БД, открытые перед запуском главного меню * ***** Восстанавливать их после выхода из функций главного меню * ************************************************************** * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW * ************************************************************** *Running(.F.) *RETURN NIL **************************************************************************************************************** ******** 3.5. Синтез и верификация заданных из 3 стат.моделей и 7 моделей знаний ******** Оценивается внутренняя достоверность (адекватность) заданных стат.моделей и моделей знаний. ******** Для этого в каждой заданной модели обучающая выборка копируется в распознаваемую, проводится ******** распознавание и подсчитывается количество верно идентифицированных, верно не идентифицированных, ******** ошибочно идентифицированных и ошибочно не идентифицированных объектов (ошибки 1-го и 2-го рода). ******** Для распознавания могут быть использованы статистические базы: Abs, Prc1, Prc2 и базы знаний: ******** Inf1~Prc1, Inf2~Prc2, Inf3-хи-квадрат, Inf4-roi~Prc1, Inf5-roi~Prc2, Inf6-Dp~Prc1, Inf7-Dp~Prc2. **************************************************************************************************************** FUNCTION F3_5(mProcessor, mSintRec, mRegim, mModel) * F3_5('GPU' ,'SintRec','3.5' ,'ALL') PUBLIC Time_progress:=0, Wsego, oProgress, lOk := .T., Sec_1, Regim := "3_5" Running(.T.) aSaveF35 := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы) * DC_DataRest( aSaveF35 ) // Восстановление вычислительной среды (открытые и текущие БД и индексы) IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации LB_Warning(L("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")) Running(.F.) RETURN NIL ENDIF *IF ApplChange("3.5()") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения * Running(.F.) * RETURN NIL *ENDIF IF ApplChange("") // Если не запущен режим, работающий с БД, то перейти в папку выбранного приложения Running(.F.) RETURN NIL ENDIF ****** Задание на расчет баз знаний * IF FILE("_CalcInf.arx") // Файл с информацией о том, какие модели были рассчитаны ранее * aCalcInf = DC_ARestore("_CalcInf.arx") * ELSE * DC_ASave(aCalcInf, "_CalcInf.arx") * ENDIF * IF ASCAN(aCalcInf, .T.) = 0 * LB_Warning(L("Нет просчитанных моделей. Необходимо выполнить синтез моделей в 3-й подсистеме!") Running(.F.) * RETURN NIL * ENDIF Regim = "3_5" IF FILE("_CurrInf.arx") // Файл с информацией о том, какая модель задана текущей M_CurrInf = DC_ARestore("_CurrInf.arx") ELSE DC_ASave(M_CurrInf, "_CurrInf.arx") ENDIF ****** Задание на верификацию баз знаний IF FILE("_VerifInf.arx") // Файл с информацией о том, какие модели были верифицированы ранее aVerifInf = DC_ARestore("_VerifInf.arx") ELSE AFILL(aVerifInf, .T.) DC_ASave(aVerifInf, "_VerifInf.arx") ENDIF *********************************************************************************************************************** mTitleName = L('3.5. Синтез и верификация моделей') IF EMPTY(mRegim) mProcessor = 'CPU' mSintRec = 'SintRec' mRegim = '3.5' mModel = 'ALL' ELSE DO CASE CASE mRegim = '3.1' mTitleName = L('3.1. Ускоренный синтез всех моделей') CASE mRegim = '3.2' mTitleName = L('3.2. Верификация всех моделей на GPU') CASE mRegim = '3.3' mTitleName = L('3.3. Синтез и верификация всех моделей на GPU') CASE mRegim = '3.5' .OR. LEN(ALLTRIM(mRegim)) = 0 mTitleName = L('3.5. Синтез и верификация моделей') CASE mRegim = '3.6' mTitleName = L('3.6. Обнаружение, удаление и типизация артефактов') CASE mRegim = '3.7.9' mTitleName = L('3.7.9. Корректировка экспертных оценок: объект => класс') CASE mRegim = '3.7.6' mTitleName = L('3.6. Обнаружение, удаление и типизация артефактов') CASE mRegim = '4.2.2.4' mTitleName = L('3.6. Обнаружение, удаление и типизация артефактов') ENDCASE ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций // Почему-то дает ошибку при повторном запуске ################################## USE Obi_Zag EXCLUSIVE NEW mN1 = 1 mN2 = RECCOUNT() nRadio1 = 1 nRadio2 = 1 nRadio3 = 1 nRadioM = 1 nRadioP = 1 N_CopyObj = 0 mPerDel = 10 StrFile(ALLTRIM(STR(mPerDel,17,7)),'_PerDel.txt') *IF nRadio1 = 6 .OR. ( nRadioM = 3 .AND. mRegim <> '3.7.9' ) mAlgorithm = 2 mVisualization = 2 mFonAbs = 0 StrFile(ALLTRIM(STR(mAlgorithm,1)),'_Algorithm.txt') StrFile(ALLTRIM(STR(mVisualization,1)),'_Visualization.txt') IF mRegim = '3.5' .OR. mRegim = '3.6' // Диалог только если распознавание на CPU. Если на GPU - то параметры задаются фиксированные но теже самые, что на CPU // Диалог задания моделей для синтеза и верификации @ 0, 0 DCGROUP oGroup1 CAPTION L('Задайте модели для синтеза и верификации' ) SIZE 87,14.7 @15, 0 DCGROUP oGroup2 CAPTION L('Параметры копирования обучающей выборки в распознаваемую (бутстрепный подход):') SIZE 87,13.7 @15+ 1, 2 DCGROUP oGroup3 CAPTION L('Какие объекты обуч.выборки копировать:' ) SIZE 44, 7.7 @15+ 9, 2 DCGROUP oGroup4 CAPTION L('Удалять из обуч.выборки скопированные объекты:' ) SIZE 44, 3.7 @15+ 1,48 DCGROUP oGroup6 CAPTION L('Пояснение по алгоритму верификации:' ) SIZE 37, 7.7 @15+ 9,48 DCGROUP oGroup7 CAPTION L('Подробнее:' ) SIZE 37, 3.7 @ 0, 89 DCGROUP oGroup8 CAPTION L('Текущая модель' ) SIZE 25,13.7 @15, 89 DCGROUP oGroup9 CAPTION L('' ) SIZE 25, 6.7 * @15+ 7,89 DCGROUP oGroup10 CAPTION L('Задайте процессор' ) SIZE 25, 6.7 @15+14, 0 DCGROUP oGroup11 CAPTION L('Использование только наиболее достоверных результатов распознавания: Rasp.dbf и целесобразность применения бутстрепного подхода') SIZE 114, 4.7 @ 1.0,1 DCSAY L('Статистические базы:') PARENT oGroup1 @ 2.0,3 DCCHECKBOX aVerifInf[ 1] PROMPT L('1. ABS - частный критерий: количество встреч сочетаний: "класс-признак" у объектов обуч.выборки') PARENT oGroup1 @ 3.3,7 DCSAY L("Задайте значение фона в матрице абсолютных частот:") PARENT oGroup1; @ 3.2,50 DCGET mFonAbs PICTURE "###########.#######" PARENT oGroup1 * 1234567890123456789 @ 4,3 DCCHECKBOX aVerifInf[ 2] PROMPT L('2. PRC1 - частный критерий: усл. вероятность i-го признака среди признаков объектов j-го класса' ) PARENT oGroup1 @ 5,3 DCCHECKBOX aVerifInf[ 3] PROMPT L('3. PRC2 - частный критерий: условная вероятность i-го признака у объектов j-го класса' ) PARENT oGroup1 @ 6.2,1 DCSAY L('Системно-когнитивные модели (базы знаний):') PARENT oGroup1 @ 7,3 DCCHECKBOX aVerifInf[ 4] PROMPT L('4. INF1 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC1' ) PARENT oGroup1 @ 8,3 DCCHECKBOX aVerifInf[ 5] PROMPT L('5. INF2 - частный критерий: количество знаний по А.Харкевичу; вероятности из PRC2' ) PARENT oGroup1 @ 9,3 DCCHECKBOX aVerifInf[ 6] PROMPT L('6. INF3 - частный критерий: Xи-квадрат, разности между фактическими и ожидаемыми абс.частотами' ) PARENT oGroup1 @10,3 DCCHECKBOX aVerifInf[ 7] PROMPT L('7. INF4 - частный критерий: ROI (Return On Investment); вероятности из PRC1' ) PARENT oGroup1 @11,3 DCCHECKBOX aVerifInf[ 8] PROMPT L('8. INF5 - частный критерий: ROI (Return On Investment); вероятности из PRC2' ) PARENT oGroup1 @12,3 DCCHECKBOX aVerifInf[ 9] PROMPT L('9. INF6 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC1' ) PARENT oGroup1 @13,3 DCCHECKBOX aVerifInf[10] PROMPT L('10.INF7 - частный критерий: разн.усл.и безусл.вероятностей; вероятности из PRC2' ) PARENT oGroup1 ****** Задание моделей знаний для расчета и задание текущей модели z = 5 @ 2, z DCRADIO M_CurrInf VALUE 1 PROMPT L('1. ABS ') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 1] } HIDE {|| .NOT. aVerifInf[ 1] } @ 3, z DCRADIO M_CurrInf VALUE 2 PROMPT L('2. PRC1') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 2] } HIDE {|| .NOT. aVerifInf[ 2] } @ 4, z DCRADIO M_CurrInf VALUE 3 PROMPT L('3. PRC2') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 3] } HIDE {|| .NOT. aVerifInf[ 3] } @ 6, z DCRADIO M_CurrInf VALUE 4 PROMPT L('4. INF1') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 4] } HIDE {|| .NOT. aVerifInf[ 4] } @ 7, z DCRADIO M_CurrInf VALUE 5 PROMPT L('5. INF2') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 5] } HIDE {|| .NOT. aVerifInf[ 5] } @ 8, z DCRADIO M_CurrInf VALUE 6 PROMPT L('6. INF3') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 6] } HIDE {|| .NOT. aVerifInf[ 6] } @ 9, z DCRADIO M_CurrInf VALUE 7 PROMPT L('7. INF4') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 7] } HIDE {|| .NOT. aVerifInf[ 7] } @10, z DCRADIO M_CurrInf VALUE 8 PROMPT L('8. INF5') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 8] } HIDE {|| .NOT. aVerifInf[ 8] } @11, z DCRADIO M_CurrInf VALUE 9 PROMPT L('9. INF6') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[ 9] } HIDE {|| .NOT. aVerifInf[ 9] } @12, z DCRADIO M_CurrInf VALUE 10 PROMPT L('10.INF7') PARENT oGroup8 EDITPROTECT {|| .NOT. aVerifInf[10] } HIDE {|| .NOT. aVerifInf[10] } // Диалог задания параметров режима копирования обуч.выборки в распознаваемую @ 1, 2 DCRADIO nRadio1 VALUE 1 PROMPT L('Копировать всю обучающую выборку' ) PARENT oGroup3 @ 2, 2 DCRADIO nRadio1 VALUE 2 PROMPT L('Копировать только текущий объект' ) PARENT oGroup3 @ 3, 2 DCRADIO nRadio1 VALUE 3 PROMPT L('Копировать каждый N-й объект' ) PARENT oGroup3 @ 4, 2 DCRADIO nRadio1 VALUE 4 PROMPT L('Копировать N случайных объектов' ) PARENT oGroup3 @ 5, 2 DCRADIO nRadio1 VALUE 5 PROMPT L('Копировать объекты от N1 до N2 (fastest)') PARENT oGroup3 @ 6, 2 DCRADIO nRadio1 VALUE 6 PROMPT L('Вообще не менять распознаваемую выборку' ) PARENT oGroup3 @ 1, 2 DCRADIO nRadio2 VALUE 1 PROMPT L('Не удалять' ) PARENT oGroup4 @ 2, 2 DCRADIO nRadio2 VALUE 2 PROMPT L('Удалять' ) PARENT oGroup4 @ 1, 2.2 DCSAY L("Измеряется внутренняя достоверн. модели") EDITPROTECT {|| .NOT.nRadio2=1 } HIDE {|| .NOT.nRadio2=1 } PARENT oGroup7 @ 2, 2.2 DCSAY L("Измеряется внешняя достоверность модели") EDITPROTECT {|| .NOT.nRadio2=2 } HIDE {|| .NOT.nRadio2=2 } PARENT oGroup7 nRadio3 = 1 mMess = L("Использовать ту расп.выборку, что есть") @ 3 , 2.2 DCSAY L(" ") GET N_CopyObj PARENT oGroup6 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=3 } HIDE {|| .NOT.nRadio1=3 } @ 4 , 2.2 DCSAY L(" ") GET N_CopyObj PARENT oGroup6 PICTURE "###############" EDITPROTECT {|| .NOT.nRadio1=4 } HIDE {|| .NOT.nRadio1=4 } @ 5 , 2.2 DCSAY L(" ") GET mN1 PARENT oGroup6 PICTURE "###########" EDITPROTECT {|| .NOT.nRadio1=5 } HIDE {|| .NOT.nRadio1=5 } @ 5 , 19 DCSAY L(" ") GET mN2 PARENT oGroup6 PICTURE "###########" EDITPROTECT {|| .NOT.nRadio1=5 } HIDE {|| .NOT.nRadio1=5 } @ 6.1,2.2 DCSAY mMess PARENT oGroup6 EDITPROTECT {|| .NOT.nRadio1=6 } HIDE {|| .NOT.nRadio1=6 } @14.9,49 DCPUSHBUTTON ; CAPTION L('Пояснение по алгоритму верификации') ; SIZE LEN(L('Пояснение по алгоритму верификации'))-4, 0.9 ; ACTION {||Help35()} @14+8.9,49 DCPUSHBUTTON ; CAPTION L('Подробнее') ; SIZE LEN(L('Подробнее'))+1, 0.9 ; ACTION {||Help_OiRo()} nRadioM = 1 @1.0, 2 DCSAY L("Для каждой заданной") PARENT oGroup9 @2.0, 2 DCSAY L("модели выполнить:" ) PARENT oGroup9 @3.0, 2 DCRADIO nRadioM VALUE 1 PROMPT L('Синтез и верификацию') PARENT oGroup9 @4.0, 2 DCRADIO nRadioM VALUE 2 PROMPT L('Только верификацию') PARENT oGroup9 @5.0, 2 DCRADIO nRadioM VALUE 3 PROMPT L('Только синтез') PARENT oGroup9 nRadioP = 1 @14+ 7,89 DCGROUP oGroup10 CAPTION L('Задайте процессор') SIZE 25, 6.7 @0.8, 2 DCRADIO nRadioP VALUE 1 PROMPT L('CPU') PARENT oGroup10 @0.8,15 DCRADIO nRadioP VALUE 2 PROMPT L('GPU') PARENT oGroup10 EDITPROTECT {|| .NOT.mFonAbs=0 } HIDE {|| .NOT.mFonAbs=0} // Если mFonAbs <> 0 ВООБЩЕ НЕ СПРАШИВАТЬ ПРО GPU mAlgorithm = 2 @ 2, 2 DCGROUP oGroup12 CAPTION L('Задайте алгоритм:') SIZE 21, 3.7 PARENT oGroup10 HIDE {|| .NOT.nRadioP=1} // <<<===############### @ 1, 2 DCRADIO mAlgorithm VALUE 1 PROMPT L('Классика - дольше') PARENT oGroup12 EDITPROTECT {|| .NOT.nRadioP=1 } HIDE {|| .NOT.nRadioP=1} @ 2, 2 DCRADIO mAlgorithm VALUE 2 PROMPT L('Упрощенно-быстрее ') PARENT oGroup12 EDITPROTECT {|| .NOT.nRadioP=1 } HIDE {|| .NOT.nRadioP=1} mVisualization = 2 @ 2, 2 DCGROUP oGroup12 CAPTION L('Отображать процесс?') SIZE 21, 3.7 PARENT oGroup10 HIDE {|| .NOT.nRadioP=2} // <<<===############### @ 1, 2 DCRADIO mVisualization VALUE 1 PROMPT L('Без визуализации:' ) PARENT oGroup12 EDITPROTECT {|| .NOT.nRadioP=2 } HIDE {|| .NOT.nRadioP=2} @ 2, 2 DCRADIO mVisualization VALUE 2 PROMPT L('Визуализация 3 с.' ) PARENT oGroup12 EDITPROTECT {|| .NOT.nRadioP=2 } HIDE {|| .NOT.nRadioP=2} * StrFile(ALLTRIM(STR(mAlgorithm,1)),'_Algorithm.txt') * StrFile(ALLTRIM(STR(mVisualization,1)),'_Visualization.txt') ********************************************************************************* ********** Сокращение объема БД Rasp.dbf **************************************** // При использовании ADS это ограничение полностью преодолено ********************************************************************************* mRSVMD = GenDbfDostModObj() // Размер записи БД для измерения достоверности моделей mRSRsp = GenDbfRspC() * MsgBox(STR(mRSRsp)) mRSRsp = 50 // Размер записи БД Rasp.dbf CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Obi_Zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Rasp EXCLUSIVE NEW;mHRsp = HEADER() USE VerModObj EXCLUSIVE NEW;mHVMO = HEADER() // Объединить все (M_VerMod) по объектам расп.выборки без итоговых строк * MsgBox(STR(mRSVMD*N_Obj*10*2 + mHVMO)+' '+STR(2*1024^3)) * MsgBox(STR(mRSVMD)+' '+STR(N_Obj)+' '+STR(mHVMO)+' '+STR(2*1024^3)) ** N_Obj - число объектов обучающей выборки ** N_Cls - число классов ** mRSRsp- размер записи БД Rasp.dbf // Измерить длину 1 записи при новой ширине полей <=====########### N_Rec = N_Obj * N_Cls // расчетное число записей в БД Rasp.dbf mFileSizeRasp = N_Rec * mRSRsp + mHRsp // Измерить длину 1 записи при новой ширине полей <=====########### ******************************************************** ** Возможно ли вообще обрабатывать БД Rasp.dbf ********* // При использовании ADS это ограничение полностью преодолено ******************************************************** IF mFileSizeRasp > 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(mFileSizeRasp))) 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 IF mRSVMD*N_Obj*10*2 + mHVMO > 2*1024^3 // ПЕРЕД ОТКРЫТИЕМ ЭТОЙ БАЗЫ ДАННЫХ ПРОВЕРЯТЬ, МЕНЬШЕ ЛИ ОНА 2 ГБ. ЕСЛИ БОЛЬШЕ - ВЫДАВАТЬ СООБЩЕНИЕ О НЕОБХОДИМОСТИ ЗАДАТЬ ПАРАМЕТР, УМЕНЬШАЮЩИЙ ЧИСЛО ЗАПИСЕЙ ТАК, ЧТОБЫ БД БЫЛА < 2ГБ aMess := {} AADD(aMess, L('При использовании всей обучающей выборки из')+' '+ALLTRIM(STR(N_Obj))+' '+L('объектов размер БД "VerModObj.dbf" ')) AADD(aMess, L('для оценки достоверности моделей достигает')+' '+ALLTRIM(STR(mRSVMD*N_Obj*10*2+mHVMO))+' '+L('байт, что больше 2 Гб и недопустимо.')) AADD(aMess, L('Поэтому необходимо использовать БУТСТРЕПНЫЙ подход для оценки достоверности моделей')) AADD(aMess, L('и задать в режиме 3.5 количество объектов распознаваемой выборки, НЕ БОЛЕЕ:')+' '+ALLTRIM(STR(INT((2*1024^3-mHVMO)/(mRSVMD*10*2))))+'.') AADD(aMess, L('Тогда БД оценки достоверности распознавания объектов "VerModObj.dbf" будет меньше 2 Гб!')) AADD(aMess, L('Можно также выбрать режим только синтеза моделей, а их верификацию провести позже')) AADD(aMess, L('на распознаваемой выборке - подмножестве обучающей выборки или созданной другим путем.')) LB_Warning(aMess, L('3.5. Синтез и верификация моделей')) * ************************************************************** * ***** БД, открытые перед запуском главного меню * ***** Восстанавливать их после выхода из функций главного меню * ************************************************************** * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы * USE PathGrAp EXCLUSIVE NEW * USE Appls EXCLUSIVE NEW * USE Users EXCLUSIVE NEW * ************************************************************** * Running(.F.) ** RETURN NIL * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * QUIT ENDIF @1, 2 DCSAY L("Расчетный размер БД результатов распознавания Rasp.dbf равен")+' '+ALLTRIM(STR(mFileSizeRasp))+' '+; L('байт, т.е.:')+' '+ALLTRIM(STR(mFileSizeRasp/(2*1024^3)*100,15,7))+' '+L('% от MAX-возможного, (от 2Гб)') PARENT oGroup11 * @1, 2 DCSAY L("Расчетный размер БД результатов распознавания Rasp.dbf равен")+' '+ALLTRIM(STR(mFileSizeRasp))+' '+L('байт') PARENT oGroup11 // При использовании ADS это ограничение полностью преодолено mPerDel = 100 IF mFileSizeRasp > 1*1024^3 // Экспериментально путем расчетов определить максимальный размер БД Rasp.dbf. При ADS и использовании обработки ошибок при расчетах выходных форм это не играет роли mPerDel = 0.5*1024^3 / mFileSizeRasp * 100 // Оставить 0.5 Гб ИЛИ МЕНЬШЕ, т.е. СТОЛЬКО, СКОЛЬКО надо, чтобы рассчитывались все 11 выходных форм на основе Rasp.dbf ENDIF mPerDelMax = mPerDel mPerDel = 100 @2, 2 DCSAY L("Задайте, сколько % от исходной БД Rasp.dbf ОСТАВИТЬ, удаляя наименее достоверные результаты распознавания:") PARENT oGroup11 @2,87 DCSAY L('') GET mPerDel PICTURE "###.#######" PARENT oGroup11 // Можно только уменьшать этот % IF mRSVMD*N_Obj*10*2 + mHVMO > 2*1024^3 // ПЕРЕД ОТКРЫТИЕМ ЭТОЙ БАЗЫ ДАННЫХ ПРОВЕРЯТЬ, МЕНЬШЕ ЛИ ОНА 2 ГБ. ЕСЛИ БОЛЬШЕ - ВЫДАВАТЬ СООБЩЕНИЕ О НЕОБХОДИМОСТИ ЗАДАТЬ ПАРАМЕТР, УМЕНЬШАЮЩИЙ ЧИСЛО ЗАПИСЕЙ ТАК, ЧТОБЫ БД БЫЛА < 2ГБ mMess = L('Рекомендуется применить бутстрепный подход (объектов обучающей выборки <=')+' '+ALLTRIM(STR(INT((2*1024^3-mHVMO)/(mRSVMD*10*2))))+' '+L(') или выполнить только синтез моделей.') @3, 2 DCSAY mMess PARENT oGroup11 FONT '9.Arial Bold' COLOR BD_CANDYRED SAYSIZE 0 ELSE mMess = L('В примении бутстрепного подхода нет необходимости. Синтез и верификация моделей будут выполнены на основе всей выборки.') @3, 2 DCSAY mMess PARENT oGroup11 SAYSIZE 0 ENDIF * MsgBox(STR(mRSVMD*N_Obj*10*2 + mHVMO)+' '+STR(2*1024^3)) ********************************************************************************* DCGETOPTIONS TABSTOP RESIZE RESIZEDEFAULT DCGUI_RESIZE_AUTORESIZE DCREAD GUI ; TO lExit ; FIT ; OPTIONS GetOptions ; ADDBUTTONS; MODAL ; TITLE mTitleName ***************************************************************** 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 mPerDel > mPerDelMax // Если пользователь увеличил % остающихся результатов распознавания, то не делать этого, т.к. посчитано уже максимальное количество mPerDel = mPerDelMax aMess := {} AADD(aMess, '% остающихся результатов распознавания остается ') AADD(aMess, 'расчетным, т.к. может его можно только уменьшать') LB_Warning(aMess, L('4.1.2. Пакетное распознавание')) ENDIF StrFile(ALLTRIM(STR(mPerDel,17,7)),'_PerDel.txt') ENDIF StrFile(ALLTRIM(STR(mAlgorithm,1)),'_Algorithm.txt') StrFile(ALLTRIM(STR(mVisualization,1)),'_Visualization.txt') StrFile(ALLTRIM(STR(mFonAbs,19,1)),'_FonAbs.txt') *mFonAbs = VAL(FileStr('_FonAbs.txt')) mProcessor = IF(nRadioP=1,'CPU','GPU') // <<<===################### IF mSintRec = 'Sint' nRadioM = 3 ENDIF *IF mProcessor = 'GPU' // Синтез и распознавание на GPU - параметры задаются фиксированные * DO CASE * CASE mSintRec = 'Sint' * nRadioM = 3 * CASE mSintRec = 'Rec' * nRadioM = 2 * CASE mSintRec = 'SintRec' * nRadioM = 1 * ENDCASE * AFILL(aVerifInf, .T.) // Все модели * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * USE Obi_Zag EXCLUSIVE NEW * mN1 = 1 * mN2 = RECCOUNT() * nRadio1 := 1 // Копировать всю обучающую выборку * nRadio2 := 1 // Не удалять скопированные в распознаваемую выборку объекты обучающей выборки * nRadio3 := 1 // Стирать расп.выборку перед копированием * nRadioP := 2 // Расчеты проводить на графическом процессоре (GPU) * N_CopyObj = 0 // Даже на GPU не всегда надо распознавать все объекты *ENDIF IF nRadio1 = 5 // Копировать все объекты от N1 до N2 IF mN2 < mN1 LB_Warning(L("Неверно задан диапазон объектов для верификации модели: N1 должен быть <= N2 !"),L('3.5. Выбор моделей для синтеза и верификации')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF ENDIF DC_ASave(M_CurrInf, "_CurrInf.arx") Pos = ASCAN(aVerifInf, .T.) IF Pos > 0 .AND. M_CurrInf > 0 * M_CurrInf = Pos ELSE LB_Warning(L("Необходимо задать хотя бы одну модель для расчета и верификации!"),L('3.5. Выбор моделей для синтеза и верификации')) ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** Running(.F.) RETURN NIL ENDIF DC_ASave(aVerifInf , "_VerifInf.arx") // Файл с информацией о том, создание каких моделей было задано ***************************************************************************************************** oScr := DC_WaitOn(L('Немного подождите. Идет подготовка к загрузке мастера подготовки запуска мастера исполнения режима синтеза и верификации моделей !!!')) Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } M_Inf = UPPER(Ar_Model[M_CurrInf]) PUBLIC a1 := 0, b1 := 0, c1 := 0 // Процесс синтеза и верификации заданных моделей ***************************************************************************************************** ***************************************************************************************************** // Подготовка данных для отображения графического прогресс-бар // Определить значение Wsego IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF // Переиндексация БД приложения GenNtxClass() // Классификационные шкалы и градации GenNtxOpSc() // Описательные шкалы GenNtxGrOpSc() // Градации описательных шкал GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки IF nRadio1 <> 6 GenNtxRsoZag() // Заголовки объектов распознаваемой выборки GenNtxRsoKcl() // Коды классов объектов распознаваемой выборки GenNtxRsoKpr() // Коды признаков объектов распознаваемой выборки ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Opis_Sc EXCLUSIVE NEW;N_Osc = RECCOUNT() USE Gr_OpSc EXCLUSIVE NEW;N_Gos = RECCOUNT() 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 Flag = .F. 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_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей Running(.F.) 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() DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей 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 DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей 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-й объект обуч.выборки: это значит каждый 2-й, 3-й, ..., N-й, где N<=# !!!") Mess = STRTRAN(Mess,"#", ALLTRIM(STR(N0_ObiZag,19))) LB_Warning(Mess) ENDIF DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей CASE nRadio1 = 4 // Копировать N случайных объектов (по-другому отобр.прогн.времени исп.) // Сформировать массив кодов случайных объектов обучающей выборки без повторов из N элементов DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей oScr := DC_WaitOn(L('Формирование массива случайных кодов объектов обучающей выборки без повторов из')+' '+ALLTRIM(STR(N_CopyObj))+' '+L('элементов'),,,,,,,,,,,.F.) mNumPP = 0 DO WHILE LEN(Ar_RndObj) < N_CopyObj // В массиве еще нет N_CopyObj элементов? <<<===################# по сути зависает при большом числе объектов N_CopyObj mNumPP++ // Случайный номер записи от 1 до N0_ObiZag (N0_ObiZag - кол-во объектов обуч.выборки). ОЧЕНЬ ХОРОШИЙ ГЕНЕРАТОР СЛУЧАЙНЫХ ЧИСЕЛ С ВНЕШНИМ ИСТОЧНИКОМ ЭНТРОПИИ <<<== mTime = ALLTRIM(STR(SECONDS()*100)) // Текущее время в сотых долях секунды от начала суток mTime = SUBSTR(mTime,1,AT('.',mTime)-1) mNormT = VAL(SUBSTR(mTime,LEN(mTime)-2,3)) // Три последних знака текущего времени mNormR = RANDOM()%999 M_KodObj = 1+INT((mNormT*mNormR)/998001*N0_ObiZag) // Нормировка текущего времени от 1 до N0_ObiZag * MsgBox(STR(mNumPP)+', mTime='+mTime+', mNormT='+ALLTRIM(STR(mNormT,9))+', mNormR='+ALLTRIM(STR(mNormR,9))+', M_KodObj='+ALLTRIM(STR(M_KodObj))) IF ASCAN(Ar_RndObj, M_KodObj) = 0 // Номер этого объекта еще не разыгрывался? AADD (Ar_RndObj, M_KodObj) ENDIF ENDDO ASORT(Ar_RndObj) DC_Impl(oScr) * 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 // Копировать все объекты в диапазоне от N1 до N2 <<<===############## 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 DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей CASE nRadio1 = 6 // Не менять распознаваемую выборку SELECT Rso_zag;N_ObiZag = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() SELECT Rso_Kcl;N_ObiKcl = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() SELECT Rso_Kpr;N_ObiKpr = RECCOUNT() SET FILTER TO DBGOTOP();DBGOBOTTOM();DBGOTOP() DC_Impl(oScr) // Немного подождите. Идет подготовка к синтезу и верификации моделей ENDCASE DO CASE CASE nRadio3 = 1 // Стирать расп.выборку перед копированием IF nRadio1 <> 6 SELECT Rso_Zag;ZAP SELECT Rso_Kcl;ZAP SELECT Rso_Kpr;ZAP M_MaxKodObj = 0 ELSE SELECT Rso_zag DBGOBOTTOM() M_MaxKodObj = Kod_Obj ENDIF CASE nRadio3 = 2 // Дополнять расп.выборку SELECT Rso_zag DBGOBOTTOM() M_MaxKodObj = Kod_Obj ENDCASE Ar_KodObjOld := {} // Коды объектов исходной выборки Ar_KodObjNew := {} // Коды объектов результирующей выборки // Перенести информацию о заданных для верификации моделях в файл о моделях для рассчета // и посчитать, сколько моделей задано для расчета и верификации PUBLIC aCalcInf[LEN(aVerifInf)] N_ModAll = 0 FOR j=1 TO LEN(aVerifInf) aCalcInf[j] = aVerifInf[j] M_ModAll = IF(aVerifInf[j],++N_ModAll,N_ModAll) // Inf# NEXT DC_ASave(aCalcInf , "_CalcInf.arx") // Файл с информацией о том, создание каких моделей было задано * LB_Warning(STR(N_ModAll,19)) // Progress_bar сдвигать столько раз, сколько операций выполняется с N_ModAll моделями K=IF(nRadioM = 1, 1, 0) // Расчет "Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" * Wsego = 1 + N_ModAll*K + N_ModAll + N_ModAll + 2*N_ModAll + N_ModAll + 1 + 2*N_ModAll * Copy Расчет Сделать Провести Верификация Объединение Печать Расчет достоверности * Oi->Ro моделей текущей распознав. для 2 инт.кр БД DostRsp# форм по классам DO CASE CASE nRadioM = 1 // Синтез и верификация статистических и системно-когнитивных моделей Wsego = 1 + N_ModAll*K + N_ModAll + N_ModAll + 2*N_ModAll + 1 + 1 + 1 + 2 + 1 * Copy Расчет Сделать Провести Верификация Объединение Печать Расчет достоверности Запись диапазонов Присвоение * Oi->Ro моделей текущей распознав. для 2 инт.кр БД DostRsp# форм по классам кодов градаций заданной модели * кл.и оп.шкал статуса текущей CASE nRadioM = 2 // Верификация заданных статистических и системно-когнитивных моделей Wsego = 0 + 0 + N_ModAll + N_ModAll + 2*N_ModAll + 1 + 1 + 1 + 2 + 1 * Copy Расчет Сделать Провести Верификация Объединение Печать Расчет достоверности Запись диапазонов Присвоение * Oi->Ro моделей текущей распознав. для 2 инт.кр БД DostRsp# форм по классам кодов градаций заданной модели * кл.и оп.шкал статуса текущей IF nRadioM <> 6 // Копировать обучающую выборку в распознаваемую Wsego = Wsego + 1 ENDIF CASE nRadioM = 3 // Синтез заданных статистических и системно-когнитивных моделей Wsego = 0 + N_ModAll*K + N_ModAll + 0 + 0 + 0 + 0 + 0 + 0 + 1 * Copy Расчет Сделать Провести Верификация Объединение Печать Расчет достоверности Запись диапазонов Присвоение * Oi->Ro моделей текущей распознав. для 2 инт.кр БД DostRsp# форм по классам кодов градаций заданной модели * кл.и оп.шкал статуса текущей ENDCASE IF mRegim <> '3.7.9' * MsgBox(mRegim) // Отображение стадии исполнения. Будет написано прямо в окне Progress-bar d = 0 @ 0,0 DCGROUP oGroup1 CAPTION L('Стадии исполнения процесса') FONT "6.Helv" SIZE 105+d,19.5 PARENT oTabPage1 @21,0 DCGROUP oGroup2 CAPTION L('Прогноз времени исполнения') FONT "6.Helv" SIZE 105+d, 5.0 PARENT oTabPage2 s = 1 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 1] FONT "10.Helv" // 1. Копирование всей обучающей выборки в распознаваемую @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 2] FONT "10.Helv" // 2. Расчет стат.модели ABS @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 3] FONT "10.Helv" // 3. Расчет стат.моделей PRC1 и PRC2 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 4] FONT "10.Helv" // 4. Расчет моделей знаний INF-1INF7 @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 5] FONT "10.Helv" // Начало цикла по частным и интегральным критериям---- @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 6] FONT "10.Helv" // 5. Задание модели № M_NumMod в качестве текущей @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 7] FONT "10.Helv" // 6. Пакетное распознавание в модели № M_NumMod @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 8] FONT "10.Helv" // 7. Измерение достоверности модели: № M_NumMod @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[ 9] FONT "10.Helv" // Конец цикла по частным и интегральным критериям---- @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[10] FONT "10.Helv" // 8. Объединение БД DostRsp# в БД DostRasp @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[11] FONT "10.Helv" // 9. Печать сводной формы по результатам верификации моделей @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[12] FONT "10.Helv" // 10.Запись информации о верифицированных моделях @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[13] FONT "10.Helv" // 11.Этапы распознавания @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[14] FONT "10.Helv" // 12.Сделать заданную модель текущей @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[15] FONT "10.Helv" // 13. @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[16] FONT "10.Helv" // 14. @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[17] FONT "10.Helv" // 15. @s++,1 DCSAY L(" ") SAYSIZE 100 SAYOBJECT aSay[18] FONT "10.Helv" // 16. 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 mTitleName ; PARENT @oDialog ; FIT ; EXIT ; MODAL oDialog:alwaysOnTop = .T. // Окно открывается на переднем плане oDialog:show() ENDIF ***************************************************************************************************** Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } M_Inf = UPPER(Ar_Model[M_CurrInf]) // Начало отсчета времени для прогнозирования длительности исполнения Time_progress = 0 // Прошло секунд с начала процесса // Процесс может идти больше суток, поэтому для определения // во всех случаях вычисляется время, прошедшее с начала года T_Mess1 = L("Начало:")+" "+TIME() // Начало Sec_1 = (DOY(DATE())-1)*86400+SECONDS() PUBLIC T1 := (DOY(DATE())-1)*86400+SECONDS() // Время предыдущей индикации процесса исполнения PUBLIC T2 := (DOY(DATE())-1)*86400+SECONDS()+1 // Текущее время (1-й раз оно заметно больше T1 чтобы было отображение) PUBLIC T1tp := T1 PUBLIC T2tp := T2 IF nRadio1 = 6 .OR. nRadioM = 3 **** Копировать не надо IF mRegim <> '3.7.9' aSay[ 1]:SetCaption(L('Шаг 1-й из 11: Копирование обуч.выборки в расп. Этот шаг при заданных опциях пропускается')) ENDIF ELSE IF mRegim <> '3.7.9' aSay[ 1]:SetCaption(L('ШАГ 1-Й ИЗ 11: КОПИРОВАНИЕ ОБУЧАЮЩЕЙ ВЫБОРКИ В РАСПОЗНАВАЕМУЮ - ИСПОЛНЕНИЕ:')) ENDIF GenNtxObiZag() // Заголовки объектов обучающей выборки GenNtxObiKcl() // Коды классов объектов обучающей выборки GenNtxObiKpr() // Коды признаков объектов обучающей выборки // А если расп.выборки вообще не было, а задано ее дополнять? Режим дополнения расп.выборки надо закрыть IF nRadio1 <> 6 .AND. nRadio1 <> 1 GenDbfRsoZag() // Заголовки объектов распознаваемой выборки GenDbfRsoKcl() // Коды классов объектов распознаваемой выборки GenDbfRsoKpr() // Коды признаков объектов распознаваемой выборки ENDIF // Копирование обучающей выборки в распознаваемую в заданном режиме // с предварительным стиранием расп.выборки (без диалога) IF nRadio1 <> 6 CopyOiRo(.F., nRadio1, nRadio2, nRadio3, "3_5", mN1, mN2) // <<<===################## ENDIF * IF nRadio1 = 1 .AND. nRadio2 = 1 .AND. nRadio3 = 1 ** oScr := DC_WaitOn(L('Идет процесс копирования обучающей выборки в распознаваемую. Немного подождите!')) * 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) * ENDIF IF mRegim <> '3.7.9' aSay[ 1]:SetCaption(L("Шаг 1-й из 11: Копирование обучающей выборки в распознаваемую - Готово")) ENDIF ENDIF GenDbfDostModCls() // Создать БД для измерения достоверности моделей GenDbfDostModObj() // Создать БД для измерения достоверности моделей IF mRegim <> '3.7.9' lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDIF *############################################################################################################################### * СИНТЕЗ МОДЕЛЕЙ НА CPU. ЗДЕСЬ СДЕЛАТЬ ВАРИАНТ СИНТЕЗА МОДЕЛЕЙ НА GPU. ВЫБОР ПО ПАРАМЕТРУ, ЗАДАННОМУ ПРИ ОБРАЩЕНИИ К F3_5() *############################################################################################################################### *MsgBox(mProcessor) IF nRadioM <> 2 // Расчет "Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" DO CASE CASE mProcessor = 'CPU' // ********************************************************** IF aVerifInf[1] // Если модель N Num_mod задана для верификации FOR j=2 TO 18;aSay[j]:SetCaption(L(" "));NEXT IF mRegim <> '3.7.9' aSay[ 2]:SetCaption(L('ШАГ 2-Й ИЗ 11: СИНТЕЗ СТАТ.МОДЕЛИ "ABS" (РАСЧЕТ МАТРИЦЫ АБСОЛЮТНЫХ ЧАСТОТ) - ИСПОЛНЕНИЕ:')) Time_Progress = F3_1CPU(.F., Time_Progress, Wsego, oProgress, lOk, "3_5" ) // Расчет Abs.dbf lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[ 2]:SetCaption(L('Шаг 2-й из 11: Синтез стат.модели "ABS" (расчет матрицы абсолютных частот) - Готово')) ENDIF ENDIF IF aVerifInf[2] .OR. aVerifInf[3] // Если модель N Num_mod задана для верификации FOR j=3 TO 18;aSay[j]:SetCaption(L(" "));NEXT IF mRegim <> '3.7.9' aSay[ 3]:SetCaption(L('ШАГ 3-Й ИЗ 11: СИНТЕЗ СТАТ.МОДЕЛЕЙ "PRC1" И "PRC2" (УСЛ.БЕЗУСЛ.% РАСПР.) - ИСПОЛНЕНИЕ:')) Time_Progress = F3_2CPU(.F., Time_Progress, Wsego, oProgress, lOk, "3_5" ) // Расчет Prc1.dbf b Prc2.dbf lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[ 3]:SetCaption(L('Шаг 3-й из 11: Синтез стат.моделей "PRC1" и "PRC2" (усл.безусл.% распр.) - Готово')) ENDIF ENDIF Flag_Inf = .F. // Определить, задана хотя бы одна модель знаний для расчета и верификации FOR j=4 TO 10 IF aVerifInf[j] Flag_Inf = .T. ENDIF NEXT IF Flag_Inf FOR j=4 TO 18;aSay[j]:SetCaption(L(" "));NEXT IF mRegim <> '3.7.9' aSay[ 4]:SetCaption(L('ШАГ 4-Й ИЗ 11: СИНТЕЗ МОДЕЛЕЙ ЗНАНИЙ: INF1-INF7 - ИСПОЛНЕНИЕ:')) Time_Progress = F3_3CPU(.F., Time_Progress, Wsego, oProgress, lOk, "3_5" ) // Расчет баз знаний Inf1.dbf, Inf2.dbf, Inf3.dbf, Inf4.dbf, Inf5.dbf, Inf6.dbf, Inf7.dbf FOR j=4 TO 10 IF aVerifInf[j] lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDIF NEXT aSay[ 4]:SetCaption(L('Шаг 4-й из 11: Синтез моделей знаний: INF1-INF7 - Готово')) ENDIF ENDIF CASE mProcessor = 'GPU' // ********************************************************** ****** Обработка ошибки ****************** bError := ErrorBlock( {|e| Break(e)} ) // установить новый кодовый блок обработки ошибок BEGIN SEQUENCE // код нормального исполнения *** код нормального исполнения ****** Формирование и запись txt-файла параметров модуля синтеза моделей ************************* cFile = "Model_sint_settings.txt" // <===######################################################## aPar := {} * StrFile(ALLTRIM(STR(mVisualization,1)),'_Visualization.txt') mVisualization = VAL(FileStr('_Visualization.txt')) DO CASE CASE mVisualization=1 AADD(aPar,'Show_progress') // Без визуализации стадии процесса исполнения AADD(aPar,'Show_statistics_(milliseconds) 0') CASE mVisualization=2 AADD(aPar,'Show_progress *') // С визуализацией стадии процесса исполнения AADD(aPar,'Show_statistics_(milliseconds) 3000') ENDCASE 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) ************************************************************************************************** * Отразить нужные aSay[ IF mRegim <> '3.7.9' aSay[ 2]:SetCaption(L('ШАГ 2-Й ИЗ 11: СИНТЕЗ СТАТ.МОДЕЛИ "ABS" (РАСЧЕТ МАТРИЦЫ АБСОЛЮТНЫХ ЧАСТОТ) - ИСПОЛНЕНИЕ:')) aSay[ 3]:SetCaption(L('ШАГ 3-Й ИЗ 11: СИНТЕЗ СТАТ.МОДЕЛЕЙ "PRC1" И "PRC2" (УСЛ.БЕЗУСЛ.% РАСПР.) - ИСПОЛНЕНИЕ:')) aSay[ 4]:SetCaption(L('ШАГ 4-Й ИЗ 11: СИНТЕЗ СИСТЕМНО-КОГНИТИВНЫХ МОДЕЛЕЙ: INF1-INF7 - ИСПОЛНЕНИЕ:')) ENDIF LC_RunShell("Model_sint.exe", 89882657) // Модуль синтеза моделей *########################################################################################## *** ИСПРАВИТЬ МОДЕЛЬ PRC2, посчитанную на GPU: КАК В F3_2CPU (НА СТР.14011) *** <<<===##### *########################################################################################## * oScr := DC_WaitOn(L('Дорасчет модели PRC2. Немного подождите'),,,,,,,,,,,.F.) DIRCHANGE(M_PathAppl) // Перейти в папку текущего приложения 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 * ###########################################################################* mLenNameMax = CreateStructAll() // Создание файлов структур баз данных всех моделей // Открытие текстовых баз данных ******************************************** *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 * ########################################################################### * 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 *** Prc2.txt ****************************** *** Запись столбца "Безусловная вероятность" IF NObj > 0 *** Запись столбца "Безусловная вероятность" FOR i=1 TO N_Gos // №9, N_Gos ################################ 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 ENDIF CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций FOR z=1 TO 3 FClose( nHandle[z] ) // Закрытие dbf и txt баз данных ###################################### NEXT * DC_Impl(oScr) *########################################################################################## IF mRegim <> '3.7.9' * Отразить нужные aSay[ и Time_Progress ( <===############################################# lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[ 2]:SetCaption(L('Шаг 2-й из 11: Синтез стат.модели "ABS" (расчет матрицы абсолютных частот) - Готово')) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[ 3]:SetCaption(L('Шаг 3-й из 11: Синтез стат.моделей "PRC1" и "PRC2" (усл.безусл.% распр.) - Готово')) FOR j=4 TO 10 lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT aSay[ 4]:SetCaption(L('Шаг 4-й из 11: Синтез системно-когнитивных моделей: INF1-INF7 - Готово')) ENDIF RECOVER // код обработки ошибки aMess := {} AADD(aMess, L("На данном компьютере установлена видеокарта не на чипсете NVIDIA, не поддерживающая язык")) AADD(aMess, L("OpenGL (Open Graphics Library). Поэтому использование графического процессора (GPU) для ")) AADD(aMess, L("синтеза моделей невозможен и для расчетов надо задать центральный процессор (CPU). ")) LB_Warning(aMess) * EXIT ENDSEQUENCE ErrorBlock( bError ) // переустановить старый кодовый ****************************************** ENDCASE ENDIF *############################################################################################################################### IF nRadioM <> 3 // nRadioM = 1 - и синтез, и верифкация, = 2 - только верификация, = 3 - только синтез ******************************************************************************************************************* ********* ВЕРИФИКАЦИЯ МОДЕЛЕЙ ************************************************************************************* ******************************************************************************************************************* // Полные наименования стат.моделей и моделей знаний aModFullNm := {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 ') } FOR j=5 TO 18;aSay[j]:SetCaption(L(" "));NEXT IF mRegim <> '3.7.9' aSay[ 5]:SetCaption(L('НАЧАЛО ЦИКЛА ПО ЧАСТНЫМ И ИНТЕГРАЛЬНЫМ КРИТЕРИЯМ - ИСПОЛНЕНИЕ:')+REPLICATE("-",80)) ENDIF *############################################################################################################################################################# * ВЕРИФИКАЦИЯ МОДЕЛЕЙ НА CPU. ЗДЕСЬ СДЕЛАТЬ ВАРИАНТ СИНТЕЗА МОДЕЛЕЙ НА GPU. ВЫБОР ПО ПАРАМЕТРУ, ЗАДАННОМУ ПРИ ОБРАЩЕНИИ К F3_5() * СДЕЛАТЬ ВАРИАНТ СИНТЕЗА ВСЕХ МОДЕЛЕЙ НА GPU ДО НАЧАЛА ЦИКЛА ПО МОДЕЛЯМ И ИНТ.КРИТЕРИЯМ. А ПОТОМ ПРОСТО ИСПОЛЬЗОВАТЬ БД, СОЗДАННЫЕ GPU-МОДУЛЕМ РАСПОЗНАВАНИЯ *############################################################################################################################################################# FOR M_NumMod = 1 TO LEN(Ar_Model) // Цикл по всем моделям IF aVerifInf[M_NumMod] // Если модель N Num_mod задана для верификации FOR j=6 TO 18;aSay[j]:SetCaption(L(" "));NEXT Mess = L('ШАГ 5-Й ИЗ 11: ЗАДАНИЕ МОДЕЛИ "#" В КАЧЕСТВЕ ТЕКУЩЕЙ - ИСПОЛНЕНИЕ:') Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_NumMod])) aSay[ 6]:SetCaption(Mess) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций * F5_6(M_NumMod,.F.,"3_5") // Сделать текущей модель M_NumMod (без диалога, но с отображением стадии исполнения) lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) * CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций Mess = L('Шаг 5-й из 11: Задание модели "#" в качестве текущей - Готово') Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_NumMod])) aSay[ 6]:SetCaption(Mess) ****************************************************************************************** ****************************************************************************************** FOR j=7 TO 18;aSay[j]:SetCaption(L(" "));NEXT Mess = L('ШАГ 6-Й ИЗ 11: ПАКЕТНОЕ РАСПОЗНАВАНИЕ В МОДЕЛИ "#" - ИСПОЛНЕНИЕ:') // ############################## Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_NumMod])) aSay[ 7]:SetCaption(Mess) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций F4_1_2(M_NumMod,.F.,"3_5",mProcessor,mAlgorithm,mVisualization) // Провести распознавание в текущей модели (без диалога, но с отображением стадии исполнения) включить Model_rec.exe в состав F4_1_2 <===####### lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) Mess = L('Шаг 6-й из 11: Пакетное распознавание в модели "#" - Готово') Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_NumMod])) aSay[ 7]:SetCaption(Mess) ****************************************************************************************** ****************************************************************************************** FOR M_IntKrit = 1 TO 2 // 1. Корреляция. 2. Сумма DO CASE CASE M_NumMod = 1 M_NameIntKrit = IF(M_IntKrit=1,L("Корреляция абс.частот с обр.объекта"),L("Сумма абс.частот по признакам объекта")) CASE M_NumMod = 2 .OR. M_NumMod = 3 M_NameIntKrit = IF(M_IntKrit=1,L("Корреляция усл.отн.частот с обр.объекта"),L("Сумма усл.отн.частот по признакам объекта")) CASE M_NumMod > 3 M_NameIntKrit = IF(M_IntKrit=1,L("Семантический резонанс знаний"),L("Сумма знаний")) ENDCASE FOR j=8 TO 18;aSay[j]:SetCaption(L(" "));NEXT Mess = L('ШАГ 7-Й ИЗ 11: ИЗМЕРЕНИЕ ДОСТОВЕРНОСТИ МОДЕЛИ: "#" - ИНТ.КРИТЕРИЙ: "$" - ИСПОЛНЕНИЕ:') Mess = STRTRAN(Mess,"#", UPPER(Ar_Model[M_NumMod])) Mess = STRTRAN(Mess,"$", M_NameIntKrit) aSay[ 8]:SetCaption(Mess) ******************************************************** // ИЗМЕРИТЬ ДОСТОВЕРНОСТЬ ИДЕНТИФИКАЦИИ КЛАССОВ В МОДЕЛИ С ИНТ.КРИТ. в моей метрике и F-мере Ван Ризбергена и занести информацию в БД ***************** GenValidModCls(M_NumMod, M_IntKrit) ******************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Dost_modCls EXCLUSIVE NEW USE VerModClsIT EXCLUSIVE NEW SELECT VerModClsIT DBGOBOTTOM() // ModIntKrit Код: ##_####_#, где: // ##-числовой номер модели и инт.критерия {1-20}, // ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, // #-инт.крит.: {k,i} REPLACE ModIntKrit WITH STRTRAN(STR(2*M_NumMod-IF(M_IntKrit=1,1,0),2)," ","0")+"_"+Ar_Model[M_NumMod]+"_"+IF(M_IntKrit=1,"k","i") REPLACE Name_Mod WITH aModFullNm[M_NumMod] REPLACE Int_krit WITH M_NameIntKrit * Структура базы данных N°=22: Dost_modCls.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | TYPE_MODEL | C | 250 | 0 | * | 2 | INT_KRIT | C | 40 | 0 | * | 3 | N_LOGOBJ | N | 15 | 0 | 3. Количество логических объектов расп.выборки, фактически относящихся к классу (TP+FN) * | 4 | N_T_IDENT | N | 15 | 0 | 4. Количество верно идентифицированных объектов расп.выборки (TP) * | 5 | N_F_NIDENT | N | 15 | 0 | 5. Количество ошибочно неидентифицированных объектов расп.выборки (FN) * | 6 | N_F_IDENT | N | 15 | 0 | 6. Количество ошибочно идентифицированных объектов расп.выборки (FP) * | 7 | N_T_NIDENT | N | 15 | 0 | 7. Количество верно неидентифицированных объектов расп.выборки (TN) * | 8 | P_T_IDENT | N | 15 | 7 | 8. Вероятность верной идентификации объекта с классом с использованием модели * | 9 | P_T_NIDENT | N | 15 | 7 | 9. Вероятность верной не идентификации объекта с классом с использованием модели * | 10 | P_F_IDENT | N | 15 | 7 | 10.Вероятность ошибочной идентификации объекта с классом с использованием модели * | 11 | P_F_NIDENT | N | 15 | 7 | 11.Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 12 | P_AVR_T | N | 15 | 7 | 12.Вероятность верной идентификации или неидентификации объекта с классом с использованием модели (моя мера) * | 13 | DVMOD | N | 15 | 7 | 13.M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") * | 14 | PRECISION | N | 15 | 7 | 14.Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15.Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16.F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * | 17 | S_T_IDENT | N | 15 | 7 | 17.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 18 | S_F_NIDENT | N | 15 | 7 | 18.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 19 | S_F_IDENT | N | 15 | 7 | 19.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 20 | S_T_NIDENT | N | 15 | 7 | 20.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 21 | SPRECISION | N | 15 | 7 | 21.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 22 | SRECALL | N | 15 | 7 | 22.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 23 | L1_mera | N | 15 | 7 | 23.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение * | 24 | DATE | C | 10 | 0 | 24. Date Дата формирования записи БД * | 25 | TIME | C | 8 | 0 | 25. Time Время формирования записи БД * ============================================================================ * В С Е Г О длина записи: 624 байтов. | * ============================================================================ * Структура базы данных N°=74: VerModClsIT.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | MODINTKRIT | C | 9 | 0 | 1. ModIntKrit Код: ##_####_#, где: ##-числовой номер модели и инт.критерия {1-20}, ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, #-инт.крит.: {k,i} * | 2 | NAME_MOD | C | 250 | 0 | 2. Код класса * | 3 | INT_KRIT | C | 40 | 0 | 3. Наименование класса * | 4 | DIFVALMOD | N | 15 | 7 | 4. DifValMod Достоверность идентификации класса (с учетом всех верно и ошибочно идентифицированных и неидентифицированных логических объектов)) * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 8 | N_LOGOBJ | N | 15 | 0 | 8. N_LogObj Количество объектов расп.выборки, фактически относящихся к классу * | 9 | N_T_IDENT | N | 15 | 0 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 0 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 0 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 0 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * | 13 | DVMOD | N | 15 | 7 | 13. M_DVMod = (NT-NF)/(NT+NF)*100 Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов"). NT = N_T_id+N_T_nid: Количество ВЕРНО идентифицированных и неидентифицированных объектов, NF = N_F_id+N_F_nid: Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 14 | PRECISION | N | 15 | 7 | 14. Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15. Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * | 17 | P_T_IDENT | N | 15 | 7 | 17. P_T_Ident Вероятность верной идентификации объекта с классом с использованием модели * | 18 | P_T_NIDENT | N | 15 | 7 | 18. P_T_NIdent Вероятность верной не идентификации объекта с классом с использованием модели * | 19 | P_F_IDENT | N | 15 | 7 | 19. P_F_Ident Вероятность ошибочной идентификации объекта с классом с использованием модели * | 20 | P_F_NIDENT | N | 15 | 7 | 20. P_F_NIdent Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 21 | P_SLUG_ID | N | 15 | 7 | 21. P_SlUg_Id Вероятность случайного угадывания принадлежности объектов к классам * | 22 | P_SLUG_NID | N | 15 | 7 | 22. P_SlUg_NId Вероятность случайного угадывания непринадлежности объектов к классам * | 23 | EFFMOD_ID | N | 15 | 7 | 23. EffMod_Id Эффективность модели при идентификации: отношение вероятности верной идентификации при использовании модели к вероятности случайного угадывания принадлежности объекта к классу * | 24 | EFFMOD_NID | N | 15 | 7 | 24. EffMod_NId Эффективность модели при неидентификации: отношение вероятности верной неидентификации при использовании модели к вероятности случайного угадывания непринадлежности объекта к классу * | 25 | AVR_EFFMOD | N | 15 | 7 | 25. Avr_EffMod Средняя эффективность модели: (EffMod_Id+EffMod_NId)/2 * | 26 | S_T_IDENT | N | 15 | 7 | 26. Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27. Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28. Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29. Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 30 | SPRECISION | N | 15 | 7 | 30. SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31. SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32. L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение * | 33 | DATE | C | 10 | 0 | 33. Date Дата формирования записи БД * | 34 | TIME | C | 8 | 0 | 34. Time Время формирования записи БД * В С Е Г О длина записи: 753 байтов. | * ============================================================================ mN_LogObj = N_T_Ident+N_F_NIdent mN_T_Ident = N_T_Ident // Количество верно идентифицированных объектов расп.выборки (TP) mN_F_NIdent = N_F_NIdent // Количество ошибочно неидентифицированных объектов расп.выборки (FN) mN_F_Ident = N_F_Ident // Количество ошибочно идентифицированных объектов расп.выборки (FP) mN_T_NIdent = N_T_NIdent // Количество верно неидентифицированных объектов расп.выборки (TN) mS_T_Ident = S_T_Ident // Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (TP) mS_F_NIdent = S_F_NIdent // Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (FN) mS_F_Ident = S_F_Ident // Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (FP) mS_T_NIdent = S_T_NIdent // Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (TN) mP_T_Ident = P_T_Ident // Вероятность верной идентификации объекта с классом с использованием модели mP_T_NIdent = P_T_NIdent // Вероятность верной не идентификации объекта с классом с использованием модели mP_F_Ident = P_F_Ident // Вероятность ошибочной идентификации объекта с классом с использованием модели mP_F_NIdent = P_F_NIdent // Вероятность ошибочной не идентификации объекта с классом с использованием модели mDVMod = DVMod // M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") mPrecision = Precision // Precision = TP/(TP+FP) - точность mRecall = Recall // Recall = TP/(TP+FN) - полнота mF_mera = F_mera // F-mera = 2*(Precision*Recall)/(Precision+Recall) ( мультиклассовый вариант) mSPrecision = SPrecision // SPrecision = STP/(STP+SFP) - точность mSRecall = SRecall // SRecall = STP/(STP+SFN) - полнота mL1_mera = L1_mera // L1-mera = 2*(SPrecision*SRecall)/(SPrecision+Recall) (нечеткий мультиклассовый вариант) ****** Заполнить базу для отображения качества моделей (классификаторов) в режиме 4.1.3.6 SELECT Dost_modCls APPEND BLANK REPLACE Type_model WITH aModFullNm[M_NumMod] REPLACE Int_krit WITH M_NameIntKrit REPLACE N_LogObj WITH mN_LogObj // Количество объектов расп.выборки, фактически относящихся к классу (TP+FN) REPLACE N_T_Ident WITH mN_T_Ident // Количество верно идентифицированных объектов расп.выборки (TP) REPLACE N_F_NIdent WITH mN_F_NIdent // Количество ошибочно неидентифицированных объектов расп.выборки (FN) REPLACE N_F_Ident WITH mN_F_Ident // Количество ошибочно идентифицированных объектов расп.выборки (FP) REPLACE N_T_NIdent WITH mN_T_NIdent // Количество верно неидентифицированных объектов расп.выборки (TN) REPLACE S_T_Ident WITH mS_T_Ident // Количество верно идентифицированных объектов расп.выборки (STP) REPLACE S_F_NIdent WITH mS_F_NIdent // Количество ошибочно неидентифицированных объектов расп.выборки (SFN) REPLACE S_F_Ident WITH mS_F_Ident // Количество ошибочно идентифицированных объектов расп.выборки (SFP) REPLACE S_T_NIdent WITH mS_T_NIdent // Количество верно неидентифицированных объектов расп.выборки (STN) REPLACE P_T_Ident WITH mP_T_Ident // Вероятность верной идентификации объекта с классом с использованием модели REPLACE P_T_NIdent WITH mP_T_NIdent // Вероятность верной не идентификации объекта с классом с использованием модели REPLACE P_F_Ident WITH mP_F_Ident // Вероятность ошибочной идентификации объекта с классом с использованием модели REPLACE P_F_NIdent WITH mP_F_NIdent // Вероятность ошибочной не идентификации объекта с классом с использованием модели REPLACE DVMod WITH mDVMod // M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") REPLACE Precision WITH mPrecision // Precision = TP/(TP+FP) - точность REPLACE Recall WITH mRecall // Recall = TP/(TP+FN) - полнота REPLACE F_mera WITH mF_mera // F-mera = 2*(Precision*Recall)/(Precision+Recall) ( мультиклассовый вариант) REPLACE SPrecision WITH msPrecision // SPrecision = STP/(STP+SFP) - точность REPLACE SRecall WITH msRecall // SRecall = STP/(STP+SFN) - полнота REPLACE L1_mera WITH mL1_mera // L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (нечеткий мультиклассовый вариант) REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) REPLACE P_Avr_T WITH (P_T_Ident+P_T_NIdent)/2 // Средняя вероятность верной идентификации или неидентификации объекта с классом с использованием модели REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ******************************************************** // ИЗМЕРИТЬ ДОСТОВЕРНОСТЬ ИДЕНТИФИКАЦИИ ОБЪЕКТОВ В МОДЕЛИ С ИНТ.КРИТ. в моей метрике и F-мере Ван Ризбергена и занести информацию в БД ***************** GenValidModObj(M_NumMod, M_IntKrit) ******************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Dost_modObj EXCLUSIVE NEW USE VerModObjIT EXCLUSIVE NEW SELECT VerModObjIT DBGOBOTTOM() // ModIntKrit Код: ##_####_#, где: // ##-числовой номер модели и инт.критерия {1-20}, // ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, // #-инт.крит.: {k,i} REPLACE ModIntKrit WITH STRTRAN(STR(2*M_NumMod-IF(M_IntKrit=1,1,0),2)," ","0")+"_"+Ar_Model[M_NumMod]+"_"+IF(M_IntKrit=1,"k","i") REPLACE Name_Mod WITH aModFullNm[M_NumMod] REPLACE Int_krit WITH M_NameIntKrit *cFileName := "Dost_mod" *aStructure := { { "Type_model", "C",250, 0 }, ; * { "Int_krit" , "C", 40, 0 }, ; * { "N_T_Ident" , "N", 15, 0 }, ; // Количество верно идентифицированных объектов расп.выборки (TP) * { "N_F_NIdent", "N", 15, 0 }, ; // Количество ошибочно неидентифицированных объектов расп.выборки (FN) * { "N_F_Ident" , "N", 15, 0 }, ; // Количество ошибочно идентифицированных объектов расп.выборки (FP) * { "N_T_NIdent", "N", 15, 0 }, ; // Количество верно неидентифицированных объектов расп.выборки (TN) * { "P_T_Ident" , "N", 15, 7 }, ; // Вероятность верной идентификации объекта с классом с использованием модели * { "P_T_NIdent", "N", 15, 7 }, ; // Вероятность верной не идентификации объекта с классом с использованием модели * { "P_F_Ident" , "N", 15, 7 }, ; // Вероятность ошибочной идентификации объекта с классом с использованием модели * { "P_F_NIdent", "N", 15, 7 }, ; // Вероятность ошибочной не идентификации объекта с классом с использованием модели * { "P_Avr_T" , "N", 15, 7 }, ; // Вероятность верной идентификации или неидентификации объекта с классом с использованием модели (моя мера) * { "DVMod" , "N", 15, 7 }, ; // M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") * { "Precision" , "N", 15, 7 }, ; // Precision = TP/(TP+FP) - точность * { "Recall" , "N", 15, 7 }, ; // Recall = TP/(TP+FN) - полнота * { "F_mera" , "N", 15, 7 }, ; // F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * { "Date" , "C", 10, 0 }, ; * { "Time" , "C", 8, 0 } } mN_T_Ident = N_T_Ident // Количество верно идентифицированных объектов расп.выборки (TP) mN_F_NIdent = N_F_NIdent // Количество ошибочно неидентифицированных объектов расп.выборки (FN) mN_F_Ident = N_F_Ident // Количество ошибочно идентифицированных объектов расп.выборки (FP) mN_T_NIdent = N_T_NIdent // Количество верно неидентифицированных объектов расп.выборки (TN) mP_T_Ident = P_T_Ident // Вероятность верной идентификации объекта с классом с использованием модели mP_T_NIdent = P_T_NIdent // Вероятность верной не идентификации объекта с классом с использованием модели mP_F_Ident = P_F_Ident // Вероятность ошибочной идентификации объекта с классом с использованием модели mP_F_NIdent = P_F_NIdent // Вероятность ошибочной не идентификации объекта с классом с использованием модели mDVMod = DVMod // M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") mPrecision = Precision // Precision = TP/(TP+FP) - точность mRecall = Recall // Recall = TP/(TP+FN) - полнота mF_mera = F_mera // F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) ****** Заполнить базу для отображения качества моделей (классификаторов) в режиме 4.1.3.6 SELECT Dost_modObj APPEND BLANK REPLACE Type_model WITH aModFullNm[M_NumMod] REPLACE Int_krit WITH M_NameIntKrit REPLACE N_T_Ident WITH mN_T_Ident // Количество верно идентифицированных объектов расп.выборки (TP) REPLACE N_F_NIdent WITH mN_F_NIdent // Количество ошибочно неидентифицированных объектов расп.выборки (FN) REPLACE N_F_Ident WITH mN_F_Ident // Количество ошибочно идентифицированных объектов расп.выборки (FP) REPLACE N_T_NIdent WITH mN_T_NIdent // Количество верно неидентифицированных объектов расп.выборки (TN) REPLACE P_T_Ident WITH mP_T_Ident // Вероятность верной идентификации объекта с классом с использованием модели REPLACE P_T_NIdent WITH mP_T_NIdent // Вероятность верной не идентификации объекта с классом с использованием модели REPLACE P_F_Ident WITH mP_F_Ident // Вероятность ошибочной идентификации объекта с классом с использованием модели REPLACE P_F_NIdent WITH mP_F_NIdent // Вероятность ошибочной не идентификации объекта с классом с использованием модели REPLACE DVMod WITH mDVMod // M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") REPLACE Precision WITH mPrecision // Precision = TP/(TP+FP) - точность REPLACE Recall WITH mRecall // Recall = TP/(TP+FN) - полнота REPLACE F_mera WITH mF_mera // F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) REPLACE P_Avr_T WITH (P_T_Ident+P_T_NIdent)/2 // Средняя вероятность верной идентификации или неидентификации объекта с классом с использованием модели REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) Mess = L('Шаг 7-й из 11: Измерение достоверности модели: "#" - Интегральный критерий: "$" - Готово') Mess = STRTRAN(Mess,"#", Ar_Model[M_NumMod]) Mess = STRTRAN(Mess,"$", M_NameIntKrit) aSay[ 8]:SetCaption(Mess) NEXT ****************************************************************************************** ENDIF NEXT FOR j=9 TO 18;aSay[j]:SetCaption(L(" "));NEXT aSay[9]:SetCaption(L('КОНЕЦ ЦИКЛА ПО ЧАСТНЫМ И ИНТЕГРАЛЬНЫМ КРИТЕРИЯМ - ГОТОВО:')+REPLICATE("-",80)) // Объединить БД DostRsp# в БД DostRasp CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE DostRasp EXCLUSIVE NEW;ZAP aSay[10]:SetCaption(L("ШАГ 8-Й ИЗ 11: ОБЪЕДИНЕНИЕ БД DostRsp# В БД DostRasp")) FOR M_NumMod = 1 TO LEN(Ar_Model) // Цикл по всем моделям IF aVerifInf[M_NumMod] // Если модель N Num_mod задана для верификации M_DostRsp := "DostRsp"+ALLTRIM(STR(M_NumMod,3)) // Имя текущей БД достоверности распознавания в текущей модели * LB_Warning(M_DostRsp) * Mess = L("Шаг 8-й ИЗ 11: Объединение БД # из $ в БД DostRasp." * Mess = STRTRAN(Mess,"#", M_DostRsp) * Mess = STRTRAN(Mess,"$", ALLTRIM(STR(M_NumMod,19))) * aSay[10]:SetCaption(Mess) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE (M_DostRsp) EXCLUSIVE NEW USE DostRasp EXCLUSIVE NEW SELECT (M_DostRsp) DBGOTOP() DO WHILE .NOT. EOF() Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) * DC_DebugQout( { Alias(), FCOUNT(), j, Ar[j] } ) NEXT SELECT DostRasp APPEND BLANK FOR j=1 TO FCOUNT() * DC_DebugQout( { Alias(), FCOUNT(), j, Ar[j] } ) FIELDPUT(j, Ar[j]) NEXT SELECT (M_DostRsp) DBSKIP(1) ENDDO * lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) ENDIF NEXT lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[10]:SetCaption(L("Шаг 8-й из 11: Объединение БД DostRsp# в БД DostRasp - Готово ")) *aSay[ 1]:SetCaption(L("Шаг 1-й из 11: Копирование обучающей выборки в распознаваемую - Готово")) aSay[11]:SetCaption(L("ШАГ 9-Й ИЗ 11: ПЕЧАТЬ СВОДНОЙ ФОРМЫ ПО РЕЗУЛЬТАТАМ ВЕРИФИКАЦИИ МОДЕЛЕЙ")) // ########################################################################## // Сделать экспорт БД по достоверности моделей: DostRasp, Dost_mod, VerModClsIT // в Excel и сообщить пользователю об этом с именами файлов и путями на них *** Загрузить полный путь на текущее приложение, *** т.к. DC_WorkArea2Excel работает только с полным конкретным указанием путей * DC_ASave(M_PathAppl, "_PathAppl.arx") // Записывается в ApplChange("") * M_PathAppl = DC_ARestore("_PathAppl.arx") *DC_LoadRdds() *CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций *USE Dost_modCls EXCLUSIVE NEW VIA 'DBFNTX' *SELECT Dost_modCls *aFields := { 'Наименование модели' ,; * 'Интегральный критерий' ,; * 'Вероятность верной идентификации' ,; * 'Вероятность верной неидентификации',; * 'Средняя вер-ть верного результата' ,; * 'Дата' ,; * 'Время' } aFields := { "Type_model", ; "Int_krit" , ; "P_T_Ident" , ; "P_T_NIdent", ; "P_Avr_T" , ; "Date" , ; "Time" } *cExcelFile := M_PathAppl + '\Dost_mod.xls' *DC_WorkArea2Excel( DC_CurPath() + '\Dost_mod.xls' ) *DC_WorkArea2Excel(cExcelFile,,,,aFields) *DC_SpawnUrl(Disk_dir+'Dost_mod.XLS') *** Эти файлы тоже преобразовать в Excel *** Как сделать русские наименования столбцов? *USE VerModClsIT EXCLUSIVE NEW *USE DostRasp EXCLUSIVE NEW lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[11]:SetCaption(L("Шаг 9-й из 11: Печать сводной формы по результатам верификации моделей - Готово ")) *aSay[ 1]:SetCaption(L("Шаг 1-й из 11: Копирование обучающей выборки в распознаваемую - Готово")) // Подготовка формы для режима: 4.1.3.8. Достоверность идент.классов в различных моделях aSay[12]:SetCaption(L('ШАГ 10-Й ИЗ 11: СОЗДАНИЕ ФОРМЫ: "ДОСТОВЕРНОСТЬ ИДЕНТ.КЛАССОВ В РАЗЛИЧНЫХ МОДЕЛЯХ"')) // Определение максимальной длины наименования класса CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW SELECT Classes DBGOTOP() MN = 15 DO WHILE .NOT. EOF() MN = MAX(MN, LEN(ALLTRIM(Name_cls))) DBSKIP(1) ENDDO // Создание БД Dost_cls.dbf Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } ********** Dost_cls.dbf - достоверность распознавания класса в модели с инт.критерием aStructure := { { "Kod_cls" , "N", 15, 0},; // 1 { "Name_cls" , "C", MN, 0},; // 2 { "Max_Dost" , "N", 15, 7},; // 3 { "Mod_MaxD", "C", 15, 0},; // 4 { "IKr_MaxD", "C", 8, 7} } // 5 FOR M_IntKrit = 1 TO 2 FOR j=1 TO LEN(Ar_Model) FieldName = Ar_Model[j]+IF(M_IntKrit=1,"k","i") AADD(aStructure, { FieldName , "N", 15, 7 }) NEXT NEXT DbCreate( "Dost_clsL1.dbf", aStructure ) // Качество классификатора L1-мера, нормированная к {-1,+1} DbCreate( "Dost_clsL2.dbf", aStructure ) // Качество классификатора L1-мера, нормированная к { 0 ,1} DbCreate( "Dost_clsF.dbf" , aStructure ) // Качество классификатора F-мера, нормированная к { 0 ,1} CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT() USE Dost_clsL1 EXCLUSIVE NEW USE Dost_clsL2 EXCLUSIVE NEW USE Dost_clsF EXCLUSIVE NEW SELECT Dost_clsL1 FOR M_NMod = 1 TO LEN(Ar_Model) // Начало цикла по моделям и БД VerMod##c Как при объединении IF aVerifInf[M_NMod] // Если модель N Num_mod задана для верификации FOR M_IntKrit = 1 TO 2 // Начало цикла по инт.критериям M_VerMod := "VerModCls"+STRTRAN(STR(M_NMod,2)," ","0")+IF(M_IntKrit=1,"k","i") USE (M_VerMod) EXCLUSIVE NEW NEXT ENDIF NEXT // Заполнение БД информацией о классах из БД Classes SELECT Classes DBGOTOP() DO WHILE .NOT. EOF() Dost_clsL1->(DBAPPEND()) Dost_clsL1->Kod_cls := Classes->Kod_cls Dost_clsL1->Name_cls := Classes->(ALLTRIM(Name_cls)) Dost_clsL2->(DBAPPEND()) Dost_clsL2->Kod_cls := Classes->Kod_cls Dost_clsL2->Name_cls := Classes->(ALLTRIM(Name_cls)) Dost_clsF ->(DBAPPEND()) Dost_clsF ->Kod_cls := Classes->Kod_cls Dost_clsF ->Name_cls := Classes->(ALLTRIM(Name_cls)) Classes->(DBSKIP(1)) ENDDO Dost_clsL1->(DBAPPEND()) Dost_clsL1->Name_cls := "Средневзвешенное:" Dost_clsL2->(DBAPPEND()) Dost_clsL2->Name_cls := "Средневзвешенное:" Dost_clsF ->(DBAPPEND()) Dost_clsF ->Name_cls := "Средневзвешенное:" SELECT Dost_clsL1 PRIVATE Ar[FCOUNT()] FOR j=3 TO FCOUNT();Ar[j] = 0;NEXT FOR M_NMod = 1 TO LEN(Ar_Model) // Начало цикла по моделям и БД VerMod## как при объединении IF aVerifInf[M_NMod] // Если модель N Num_mod задана для верификации FOR M_IntKrit = 1 TO 2 // Начало цикла по инт.критериям // Заполнение БД БД Dost_cls из VerMod## данными по дифф.валидности модели при данном инт.крит.по данному классу M_VerMod := "VerModCls"+STRTRAN(STR(M_NMod,2)," ","0")+IF(M_IntKrit=1,"k","i") SELECT (M_VerMod) DBGOTOP() DO WHILE .NOT. EOF() M_KodCls = Kod_cls M_DifValMod = DifValMod M_DVMod = DVMod M_F_mera = F_mera SELECT Dost_clsL1 IF M_KodCls > 0 DBGOTO(M_KodCls) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_DifValMod) SELECT Dost_clsL2 IF M_KodCls > 0 DBGOTO(M_KodCls) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_DVMod) SELECT Dost_clsF IF M_KodCls > 0 DBGOTO(M_KodCls) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_F_mera) SELECT (M_VerMod) DBSKIP(1) ENDDO * lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT // Конец цикла по инт.критериям c ENDIF NEXT // Конец цикла по моделям VerMod##c // Цикл по БД Dost_cls и заполнение столбцов 3-5 данными о макс.диф.вал. с применением L-меры и F-меры, // модели и инт.крит., при которых она обеспечивается по данному классу SELECT Dost_clsL1 DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_clsL1->Max_dost := M_MaxDost Dost_clsL1->Mod_MaxD := M_ModMaxD Dost_clsL1->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO SELECT Dost_clsL2 DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_clsL2->Max_dost := M_MaxDost Dost_clsL2->Mod_MaxD := M_ModMaxD Dost_clsL2->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO SELECT Dost_clsF DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_clsF->Max_dost := M_MaxDost Dost_clsF->Mod_MaxD := M_ModMaxD Dost_clsF->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO *########################################################################################################## ********************* Достоверность идент.объектов в различных моделях ************************************ *########################################################################################################## // Определение максимальной длины наименования объекта CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW SELECT Rso_Zag DBGOTOP() MN = 15 DO WHILE .NOT. EOF() MN = MAX(MN, LEN(ALLTRIM(Name_obj))) DBSKIP(1) ENDDO // Создание БД Dost_obj.dbf Ar_Model := {"Abs", "Prc1", "Prc2", "Inf1", "Inf2", "Inf3", "Inf4", "Inf5", "Inf6", "Inf7" } ********** Dost_cls.dbf - достоверность распознавания класса в модели с инт.критерием aStructure := { { "Kod_obj" , "N", 15, 0},; // 1 { "Name_obj", "C", MN, 0},; // 2 { "Max_Dost", "N", 15, 7},; // 3 { "Mod_MaxD", "C", 15, 0},; // 4 { "IKr_MaxD", "C", 8, 7} } // 5 FOR M_IntKrit = 1 TO 2 FOR j=1 TO LEN(Ar_Model) FieldName = Ar_Model[j]+IF(M_IntKrit=1,"k","i") AADD(aStructure, { FieldName , "N", 19, 7 }) NEXT NEXT DbCreate( "Dost_objL1", aStructure ) // Качество классификатора L1-мера, нормированная к {-1,+1} DbCreate( "Dost_objL2", aStructure ) // Качество классификатора L1-мера, нормированная к { 0 ,1} DbCreate( "Dost_objF" , aStructure ) // Качество классификатора F-мера, нормированная к { 0 ,1} CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW;N_Obj = RECCOUNT() USE Dost_objL1 EXCLUSIVE NEW USE Dost_objL2 EXCLUSIVE NEW USE Dost_objF EXCLUSIVE NEW SELECT Dost_objL1 FOR M_NMod = 1 TO LEN(Ar_Model) // Начало цикла по моделям и БД VerMod##c Как при объединении IF aVerifInf[M_NMod] // Если модель N Num_mod задана для верификации FOR M_IntKrit = 1 TO 2 // Начало цикла по инт.критериям M_VerMod := "VerModObj"+STRTRAN(STR(M_NMod,2)," ","0")+IF(M_IntKrit=1,"k","i") USE (M_VerMod) EXCLUSIVE NEW NEXT ENDIF NEXT // Заполнение БД информацией оо объектах из БД Rso_Zag SELECT Rso_Zag DBGOTOP() DO WHILE .NOT. EOF() Dost_objL1->(DBAPPEND()) Dost_objL1->Kod_obj := Rso_Zag->Kod_obj Dost_objL1->Name_obj := Rso_Zag->(ALLTRIM(Name_obj)) Dost_objL2->(DBAPPEND()) Dost_objL2->Kod_obj := Rso_Zag->Kod_obj Dost_objL2->Name_obj := Rso_Zag->(ALLTRIM(Name_obj)) Dost_objF ->(DBAPPEND()) Dost_objF ->Kod_obj := Rso_Zag->Kod_obj Dost_objF ->Name_obj := Rso_Zag->(ALLTRIM(Name_obj)) Rso_Zag->(DBSKIP(1)) ENDDO Dost_objL1->(DBAPPEND()) Dost_objL1->Name_obj := "Средневзвешенное:" Dost_objL2->(DBAPPEND()) Dost_objL2->Name_obj := "Средневзвешенное:" Dost_objF ->(DBAPPEND()) Dost_objF ->Name_obj := "Средневзвешенное:" SELECT Dost_objL1 PRIVATE Ar[FCOUNT()] FOR j=3 TO FCOUNT();Ar[j] = 0;NEXT FOR M_NMod = 1 TO LEN(Ar_Model) // Начало цикла по моделям и БД VerMod## как при объединении IF aVerifInf[M_NMod] // Если модель N Num_mod задана для верификации FOR M_IntKrit = 1 TO 2 // Начало цикла по инт.критериям // Заполнение БД БД Dost_obj из VerMod## данными по дифф.валидности модели при данном инт.крит.по данному объекту M_VerMod := "VerModObj"+STRTRAN(STR(M_NMod,2)," ","0")+IF(M_IntKrit=1,"k","i") SELECT (M_VerMod) DBGOTOP() DO WHILE .NOT. EOF() M_Kodobj = Kod_obj M_DifValMod = DifValMod M_DVMod = DVMod M_F_mera = F_mera SELECT Dost_objL1 IF M_Kodobj > 0 DBGOTO(M_Kodobj) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_DifValMod) SELECT Dost_objL2 IF M_Kodobj > 0 DBGOTO(M_Kodobj) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_DVMod) SELECT Dost_objF IF M_Kodobj > 0 DBGOTO(M_Kodobj) // Срока по классу ELSE DBGOBOTTOM() // Итоговая строка ENDIF FIELDPUT(5+M_NMod+IF(M_IntKrit=1,0,10),M_F_mera) SELECT (M_VerMod) DBSKIP(1) ENDDO * lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) NEXT // Конец цикла по инт.критериям c ENDIF NEXT // Конец цикла по моделям VerMod##c // Цикл по БД Dost_obj и заполнение столбцов 3-5 данными о макс.диф.вал. с применением L-меры и F-меры, // модели и инт.крит., при которых она обеспечивается по данному классу SELECT Dost_objL1 DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_objL1->Max_dost := M_MaxDost Dost_objL1->Mod_MaxD := M_ModMaxD Dost_objL1->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO SELECT Dost_objL2 DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_objL2->Max_dost := M_MaxDost Dost_objL2->Mod_MaxD := M_ModMaxD Dost_objL2->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO SELECT Dost_objF DBGOTOP() DO WHILE .NOT. EOF() M_MaxDost = -9999999 M_ModMaxD = "" M_IKrMaxD = "" FOR j=1 TO 2*LEN(Ar_Model) MD = FIELDGET(5+j) IF MD > M_MaxDost M_MaxDost = MD M_FieldName = FIELDNAME(5+j) M_ModMaxD = SUBSTR(M_FieldName,1,LEN(M_FieldName)-1) M_IKrMaxD = IF(SUBSTR(M_FieldName,LEN(M_FieldName),1)="k","Резонанс", "Сумма") ENDIF NEXT // Записать M_MaxDost и др. Dost_objF->Max_dost := M_MaxDost Dost_objF->Mod_MaxD := M_ModMaxD Dost_objF->IKr_MaxD := M_IKrMaxD DBSKIP(1) ENDDO ************************************************ *** Дорасчет в БД L2-меры: *** - VerModCls *** - VerModClsIT *** - DostModCls ************************************************ *aStructure := { { "Type_model" , "C",250, 0 }, ; * { "Int_krit" , "C", 40, 0 }, ; * { "N_LogObj" , "N", 15, 0 }, ; // 3. Количество логических объектов расп.выборки, фактически относящихся к классу (TP+FN) * { "N_T_Ident" , "N", 15, 0 }, ; // 4. Количество верно идентифицированных объектов расп.выборки (TP) * { "N_F_NIdent" , "N", 15, 0 }, ; // 5. Количество ошибочно неидентифицированных объектов расп.выборки (FN) * { "N_F_Ident" , "N", 15, 0 }, ; // 6. Количество ошибочно идентифицированных объектов расп.выборки (FP) * { "N_T_NIdent" , "N", 15, 0 }, ; // 7. Количество верно неидентифицированных объектов расп.выборки (TN) * { "P_T_Ident" , "N", 15, 7 }, ; // 8. Вероятность верной идентификации объекта с классом с использованием модели * { "P_T_NIdent" , "N", 15, 7 }, ; // 9. Вероятность верной не идентификации объекта с классом с использованием модели * { "P_F_Ident" , "N", 15, 7 }, ; // 10.Вероятность ошибочной идентификации объекта с классом с использованием модели * { "P_F_NIdent" , "N", 15, 7 }, ; // 11.Вероятность ошибочной не идентификации объекта с классом с использованием модели * { "P_Avr_T" , "N", 15, 7 }, ; // 12.Вероятность верной идентификации или неидентификации объекта с классом с использованием модели (моя мера) * { "DVMod" , "N", 15, 7 }, ; // 13.M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") * { "Precision" , "N", 15, 7 }, ; // 14.Precision = TP/(TP+FP) - точность * { "Recall" , "N", 15, 7 }, ; // 15.Recall = TP/(TP+FN) - полнота * { "F_mera" , "N", 15, 7 }, ; // 16.F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * { "S_T_Ident" , "N", 15, 7 }, ; // 17.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP) * { "S_F_NIdent" , "N", 15, 7 }, ; // 18.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN) * { "S_F_Ident" , "N", 15, 7 }, ; // 19.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP) * { "S_T_NIdent" , "N", 15, 7 }, ; // 20.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN) * { "SPrecision" , "N", 15, 7 }, ; // 21.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * { "SRecall" , "N", 15, 7 }, ; // 22.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * { "L1_mera" , "N", 15, 7 }, ; // 23.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена) * { "A_T_IDENT" , "N", 15, 7 }, ; // 24.Среднее модулей уровней сходства верно идентифицированных объектов расп.выборки (ATP=STP/TP) * { "A_F_NIDENT" , "N", 15, 7 }, ; // 25.Среднее модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (AFN=SFN/FN) * { "A_F_IDENT " , "N", 15, 7 }, ; // 26.Среднее модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (AFP=SFP/FP) * { "A_T_NIDENT" , "N", 15, 7 }, ; // 27.Среднее модулей уровней сходства верно неидентифицированных объектов расп.выборки (ATN=STN/TN) * { "APRECISION" , "N", 15, 7 }, ; // 28.APrecision = ATP/(ATP+AFP) - точность с учетом уровней сходства * { "ARECALL" , "N", 15, 7 }, ; // 29.ARecall = ATP/(ATP+AFN) - полнота с учетом уровней сходства * { "L2_MERA" , "N", 15, 7 }, ; // 30.L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (L2-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение * { "Date" , "C", 10, 0 }, ; // 31.Дата формирования записи БД * { "Time" , "C", 8, 0 } } // 32.Время формирования записи БД CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE VerModCls EXCLUSIVE NEW USE VerModClsIT EXCLUSIVE NEW *USE DostModCls EXCLUSIVE NEW SELECT VerModCls DBGOTOP() DO WHILE .NOT. EOF() REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) DBSKIP(1) ENDDO SELECT VerModClsIT DBGOTOP() DO WHILE .NOT. EOF() REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) DBSKIP(1) ENDDO *SELECT DostModCls *DBGOTOP() *DO WHILE .NOT. EOF() * * REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT * REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT * REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT * REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT * REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) * REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) * REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) * * DBSKIP(1) *ENDDO lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[12]:SetCaption(L('Шаг 10-й из 11: Создание формы: "Достоверность идент.классов в различных моделях" - Готово ')) *aSay[ 1]:SetCaption(L("Шаг 1-й из 11: Копирование обучающей выборки в распознаваемую - Готово")) *LB_Warning(STR(Wsego,19)+STR(Time_Progress,19)) M_CurrInf = DC_ARestore("_CurrInf.arx") aSay[13]:SetCaption(L('ШАГ 11-Й ИЗ 11: "ПРИСВОЕНИЕ ЗАДАННОЙ МОДЕЛИ:')+' '+Ar_Model[M_CurrInf]+' '+L('СТАТУСА ТЕКУЩЕЙ"')) ***** Восстановление БД Classes и Attributes *********** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Class_Sc EXCLUSIVE NEW USE Gr_ClSc EXCLUSIVE NEW USE Classes EXCLUSIVE NEW MinMaxGrClSc() lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Opis_Sc EXCLUSIVE NEW USE Gr_OpSc EXCLUSIVE NEW USE Attributes EXCLUSIVE NEW MinMaxGrOpSc() lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) M_CurrInf = DC_ARestore("_CurrInf.arx") F5_6(M_CurrInf,.F.,"3_5") // Сделать заданную модель текущей lOk = Time_Progress (++Time_Progress, Wsego, oProgress, lOk ) aSay[13]:SetCaption(L('Шаг 11-й из 11: "Присвоение заданной модели:')+' '+Ar_Model[M_CurrInf]+' '+L('статуса текущей" - Готово ')) *aSay[ 1]:SetCaption(L("Шаг 1-й из 11: Копирование обучающей выборки в распознаваемую - Готово")) DC_ASave(aVerifInf, "_VerifInf.arx") // Запись информации о верифицированных моделях ENDIF // Если есть распознавание DO CASE CASE nRadioM = 1 oSay97:SetCaption(L("Синтез и верификация статистических и системно-когнитивных моделей упешно завершены !!!")) CASE nRadioM = 2 oSay97:SetCaption(L("Верификация заданных статистических и системно-когнитивных моделей упешно завершена !!!")) CASE nRadioM = 3 IF mRegim <> '3.7.9' oSay97:SetCaption(L("Синтез заданных статистических и системно-когнитивных моделей упешно завершен !!!")) ENDIF ENDCASE Running(.T.) // Чтобы не могли запустить какой-нибудь режим пока висит окно окончания работы IF mRegim <> '3.7.9' oSay97:SetCaption(oSay97:caption) oButton:SetCaption(L('&Ok')) // Деструктурирование окна отображения графического Progress-bar oButton:activate := {||PostAppEvent(xbeP_Close,,,oDialog)} //<<<<<< Add This DC_AppEvent( @lOk ) * PostAppEvent(xbeP_Activate,,,DC_GetObject(GetList,'DCGUI_BUTTON_OK')) // Роджер oDialog:Destroy() ENDIF *InfKritRnd() // Расчет информационного критерия качества шума IF mProcessor = 'CPU' CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций FOR z=1 TO LEN(nHandle) FClose( nHandle[z] ) // Закрытие dbf и txt баз данных ###################################### NEXT ENDIF IF nRadioM <> 3 ********* Прописывает для числовых шкал в БД Classes и Attributes минимальное, максимальное и среднее значение всех градаций MinMaxAvr() * MsgBox(IF(FlagRsp,'.T.','.F.')) 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 StrFile("35", "Rasp.txt") // Запись текстового файла с информацией о том, что был выполнен режим 3.5 IF mRegim <> '3.7.9' ************************************************************** ***** БД, открытые перед запуском главного меню ***** Восстанавливать их после выхода из функций главного меню ************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы USE PathGrAp EXCLUSIVE NEW USE Appls EXCLUSIVE NEW USE Users EXCLUSIVE NEW ************************************************************** ENDIF Running(.F.) RETURN NIL ******************************************************************************************************* FUNCTION Help35() aHelp := {} AADD(aHelp, L('Оценивается достоверность заданных стат.моделей и моделей знаний. Для этого обучающая')) AADD(aHelp, L('выборка копируется в распознаваемую в заданном режиме, осуществляется синтез заданных')) AADD(aHelp, L('моделей, а затем в каждой из них проводится распознавание и подсчитывается количество')) AADD(aHelp, L('верно идентифицированных, верно не идентифицированных, ошибочно идентифицированных и ')) AADD(aHelp, L('ошибочно не идентифицированных объектов (ошибки 1-го и 2-го рода). Для верификации ')) AADD(aHelp, L('могут быть заданы стат.модели: Abs, Prc1, Prc2 и модели знаний: Inf1~Prc1, Inf2~Prc2,')) AADD(aHelp, L('Inf3-хи-квадрат, Inf4-roi~Prc1, Inf5-roi~Prc2, Inf6-Dp~Prc1, Inf7-Dp~Prc2. ')) 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('3.5. Пояснение по алгоритму верификации моделей') RETURN NIL ************************************************************************************************** ****************************************************************************** ******** Расчет отчета по дифференциальной и интегральной достоверности модели ****************************************************************************** FUNCTION GenValidModCls(M_NumMod, M_IntKrit) IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF GenDbfVerModCls(M_NumMod, M_IntKrit) // Создать БД для измерения достоверности моделей // Имя БД, созданной GenDbfValSys, с результами оценки достоверности модели по инт.критерию M_VerMod := "VerModCls"+STRTRAN(STR(M_NumMod,2)," ","0")+IF(M_IntKrit=1,"k","i") // Формирование имен файлов с результатами распознавания // <===################## при GPU - сформировать эти БД из Rasp.dbf M_Rsp1 = "Rsp1"+IF(M_IntKrit=1,"k","i") M_Rsp2 = "Rsp2"+IF(M_IntKrit=1,"k","i") M_Rsp_it1 = "Rsp" +IF(M_IntKrit=1,"k","i")+"1" M_Rsp_it2 = "Rsp" +IF(M_IntKrit=1,"k","i")+"2" ** Генерация БД ValidSys.dbf IF .NOT. FILE(M_Rsp2+".dbf") Mess = L("СФОРМИРУЙТЕ РАСПОЗНАВАЕМУЮ ВЫБОРКУ И ВЫПОЛНИТЕ РАСПОЗНАВАНИЕ!!!") // <===################## LB_Warning(Mess) RETURN NIL ENDIF ***** АЛГОРИТМ СДЕЛАН НА ОСНОВЕ АЛГОРИТМА ФОРМИРОВАНИЯ RASP_IT2 ***** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Cls_kod EXCLUSIVE NEW USE (M_VerMod) EXCLUSIVE NEW;ZAP SELECT Classes SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod_cls M_Name = Name_cls SELECT (M_VerMod) APPEND BLANK REPLACE KOD_CLS WITH M_Kod REPLACE NAME_CLS WITH M_Name SELECT Classes DBSKIP(1) ENDDO ***** Заполняем базу итогов данными из (M_Rsp2).dbf **** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE (M_Rsp2) EXCLUSIVE NEW INDEX ON STR(Kod_cls,19) TO Rsp2_cls CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE (M_VerMod) EXCLUSIVE NEW INDEX ON STR(Kod_cls,19) TO Ver_cls ***** Начало цикла по БД результатов распознавания CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Cls_kod EXCLUSIVE NEW;N_Cls = RECCOUNT() // Количество классов 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 (M_Rsp2) INDEX Rsp2_cls EXCLUSIVE NEW USE (M_VerMod) INDEX Ver_cls EXCLUSIVE NEW USE VerModCls EXCLUSIVE NEW // Объединить все (M_VerMod) по классам без итоговых строк USE VerModClsIT EXCLUSIVE NEW // Объединить все (M_VerMod) итоговые строки без классов ****** Расчет интегрального качества распознавания класса N°Cls *************** * Структура базы данных N°=53: VerModCls.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | MODINTKRIT | C | 9 | 0 | 1. ModIntKrit Код: ##_####_#, где: ##-числовой номер модели и инт.критерия {1-20}, ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, #-инт.крит.: {k,i} * | 2 | KOD_CLS | N | 15 | 0 | 2. Код класса * | 3 | NAME_CLS | C | 35 | 0 | 3. Наименование класса * | 4 | DIFVALMOD | N | 15 | 7 | 4. DifValMod Достоверность идентификации класса (с учетом всех верно и ошибочно идентифицированных и неидентифицированных логических объектов)) * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 8 | N_LOGOBJ | N | 15 | 7 | 8. N_LogObj Количество объектов расп.выборки, фактически относящихся к классу * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * | 13 | DVMOD | N | 15 | 7 | 13. M_DVMod = (NT-NF)/(NT+NF)*100 Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов"). NT = N_T_id+N_T_nid: Количество ВЕРНО идентифицированных и неидентифицированных объектов, NF = N_F_id+N_F_nid: Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 14 | PRECISION | N | 15 | 7 | 14. Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15. Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * | 17 | P_T_IDENT | N | 15 | 7 | 17. P_T_Ident Вероятность верной идентификации объекта с классом с использованием модели * | 18 | P_T_NIDENT | N | 15 | 7 | 18. P_T_NIdent Вероятность верной не идентификации объекта с классом с использованием модели * | 19 | P_F_IDENT | N | 15 | 7 | 19. P_F_Ident Вероятность ошибочной идентификации объекта с классом с использованием модели * | 20 | P_F_NIDENT | N | 15 | 7 | 20. P_F_NIdent Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 21 | P_SLUG_ID | N | 15 | 7 | 21. P_SlUg_Id Вероятность случайного угадывания принадлежности объектов к классам * | 22 | P_SLUG_NID | N | 15 | 7 | 22. P_SlUg_NId Вероятность случайного угадывания непринадлежности объектов к классам * | 23 | EFFMOD_ID | N | 15 | 7 | 23. EffMod_Id Эффективность модели при идентификации: отношение вероятности верной идентификации при использовании модели к вероятности случайного угадывания принадлежности объекта к классу * | 24 | EFFMOD_NID | N | 15 | 7 | 24. EffMod_NId Эффективность модели при неидентификации: отношение вероятности верной неидентификации при использовании модели к вероятности случайного угадывания непринадлежности объекта к классу * | 25 | AVR_EFFMOD | N | 15 | 7 | 25. Avr_EffMod Средняя эффективность модели: (EffMod_Id+EffMod_NId)/2 * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 30 | SPRECISION | N | 15 | 7 | 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение * | 33 | DATE | C | 10 | 0 | 33. Date Дата формирования записи БД * | 34 | TIME | C | 8 | 0 | 34. Time Время формирования записи БД * ============================================================================ * В С Е Г О длина записи: 513 байтов. | * ============================================================================ PRIVATE A_Rec[34] // Массив для текущей записи по классу PRIVATE A_Wsg[34] // Массив для итоговой записи по всем классам AFILL(A_Rec,0) // Массив для текущей записи по классу AFILL(A_Wsg,0) // Массив для итоговой записи по всем классам SELECT (M_VerMod) SET ORDER TO 1 DBGOTOP() N_LogObjALL = 0 // Суммарное количество логических объектов по всей выборке DO WHILE .NOT. EOF() M_KodCls = Kod_cls ******** Расчет дифференциальной достоверности модели по классу (качество распознавания класса) AFILL(A_Rec,0) // Массив для текущей записи по классу N_LogObjCLS = 0 // Суммарное количество логических объектов по классу SELECT (M_Rsp2);SET ORDER TO 1;T=DBSEEK(STR(M_KodCls,19)) IF T * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) DO WHILE Kod_cls=M_KodCls .AND. .NOT. EOF() DO CASE CASE M_IntKrit = 1 // Подсчет по инт.критерию "Корреляция" DO CASE CASE Korr > 0 * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) IF LEN(ALLTRIM(Fakt)) > 0 A_Rec[ 9] = A_Rec[ 9] + 1 // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * A_Rec[26] = A_Rec[26] + 1 // 26. S_T_IDENT Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Korr)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[26] = A_Rec[26] + ABS(Korr)/100 // 26. S_T_IDENT Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[11] = A_Rec[11] + 1 // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * A_Rec[28] = A_Rec[28] + 1 // 28. S_F_IDENT Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Korr)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[28] = A_Rec[28] + ABS(Korr)/100 // 28. S_F_IDENT Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) ENDIF CASE Korr <= 0 IF LEN(ALLTRIM(Fakt)) > 0 * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[10] = A_Rec[10] + 1 // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * A_Rec[27] = A_Rec[27] + 1 // 27. S_F_NIDENT Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Korr)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[27] = A_Rec[27] + ABS(Korr)/100 // 27. S_F_NIDENT Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[12] = A_Rec[12] + 1 // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * A_Rec[29] = A_Rec[29] + 1 // 29. S_T_NIDENT Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Korr)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[29] = A_Rec[29] + ABS(Korr)/100 // 29. S_T_NIDENT Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) ENDIF ENDCASE CASE M_IntKrit = 2 // Подсчет по инт.критерию "Сумма" DO CASE CASE Sum_inf > 0 IF LEN(ALLTRIM(Fakt)) > 0 * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[ 9] = A_Rec[ 9] + 1 // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * A_Rec[26] = A_Rec[26] + 1 // 26. Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Sum_inf)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[26] = A_Rec[26] + ABS(Sum_inf)/100 // 26. Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[11] = A_Rec[11] + 1 // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * A_Rec[28] = A_Rec[28] + 1 // 28. Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Sum_inf)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[28] = A_Rec[28] + ABS(Sum_inf)/100 // 28. Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) ENDIF CASE Sum_inf <= 0 IF LEN(ALLTRIM(Fakt)) > 0 * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[10] = A_Rec[10] + 1 // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * A_Rec[27] = A_Rec[27] + 1 // 27. Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Sum_inf)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[27] = A_Rec[27] + ABS(Sum_inf)/100 // 27. Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) A_Rec[12] = A_Rec[12] + 1 // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * A_Rec[29] = A_Rec[29] + 1 // 29. Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Sum_inf)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[29] = A_Rec[29] + ABS(Sum_inf)/100 // 29. Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) ENDIF ENDCASE ENDCASE DBSKIP(1) ENDDO *********************************************************************************************************************************** ** Мой вариант метрики (старый) *************************************************************************************************** ** Сумма верно идентифицированных и неидентифицированных объектов ** минус ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество объектов (среднее на объект) в процентах * NT = N_T_id+N_T_nid // Количество ВЕРНО идентифицированных и неидентифицированных объектов * NF = N_F_id+N_F_nid // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов NT = A_Rec[ 9] + A_Rec[12] // Количество ВЕРНО идентифицированных и неидентифицированных объектов NF = A_Rec[11] + A_Rec[10] // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов *********************************************************************************************************************************** * M_DVMod = (NT-NF)/(NT+NF)*100 // Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов") *********************************************************************************************************************************** ****** Занесение информации в БД ValidSys SELECT (M_VerMod) ** Мой вариант метрики ************************************************************************************************************ * REPLACE DifValMod WITH M_DVMod // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {-1,+1} * REPLACE DVMod WITH (1+M_DVMod)/2 // Дифференциальная валидность (достоверность) модели (по классу), нормированная к { 0, 1} * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов REPLACE AvrUrSx_T WITH IF(NT>0,A_Rec[ 5]/NT,0) // Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов REPLACE AvrUrSx_F WITH IF(NF>0,A_Rec[ 6]/NF,0) // Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов REPLACE DifAvrUrSx WITH AvrUrSx_T-AvrUrSx_F // Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов REPLACE N_LogObj WITH N_LogObjCLS // Количество логических объектов, фактически относящихся к классу: те, что к нему верно отнесены + те, которые к нему ошибочно не отнесены * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) REPLACE N_T_IDENT WITH A_Rec[ 9] // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) REPLACE N_F_NIDENT WITH A_Rec[10] // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) REPLACE N_F_IDENT WITH A_Rec[11] // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) REPLACE N_T_NIDENT WITH A_Rec[12] // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) REPLACE P_T_Ident WITH N_T_Ident /N_LogObj * 100 // Вероятность верной идентификации объекта с классом ###### в % REPLACE P_F_NIdent WITH N_F_NIdent/N_LogObj * 100 // Вероятность ошибочной не идентификации объекта с классом ###### REPLACE P_F_Ident WITH N_F_Ident /(N_Obj-N_LogObj) * 100 // Вероятность ошибочной идентификации объекта с классом ###### REPLACE P_T_NIdent WITH N_T_NIdent/(N_Obj-N_LogObj) * 100 // Вероятность верной не идентификации объекта с классом ###### *********************************************************************************************************************************** ** F-мера Ван Ризбергена ********************************************************************************************************** *********************************************************************************************************************************** TP = N_T_Ident // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) FN = N_F_NIdent // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) FP = N_F_Ident // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) TN = N_T_NIdent // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) REPLACE Precision WITH TP/(TP+FP) // 14. Precision = TP/(TP+FP) - точность REPLACE Recall WITH TP/(TP+FN) // 15. Recall = TP/(TP+FN) - полнота REPLACE F_mera WITH 2*(Precision*Recall)/(Precision+Recall) // 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) *********************************************************************************************************************************** ** Мой вариант метрики (старый) в терминах F-меры ********************************************************************************* ** Сумма числа верно идентифицированных и неидентифицированных объектов ** минус число ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество объектов (среднее на объект). Есть две нормировки: {-1, +1} и {0, 1} M_DVMod = ( TP + TN - FP - FN ) / ( TP + TN + FP + FN ) // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REPLACE DifValMod WITH M_DVMod // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {-1, +1} REPLACE DVMod WITH (1+M_DVMod)/2 // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {0, 1} *********************************************************************************************************************************** SlUg_T_id = N_LogObj /N_Obj * 100 // Вероятность случайного угадывания принадлежности объектов к классам ######### в % SlUg_T_nid = (100-SlUg_T_id) // Вероятность случайного угадывания непринадлежности объектов к классам REPLACE P_SlUg_Id WITH SlUg_T_id // Вероятность случайного угадывания принадлежности объектов к классам REPLACE P_SlUg_NId WITH SlUg_T_nid // Вероятность случайного угадывания непринадлежности объектов к классам REPLACE EffMod_Id WITH P_T_Ident / SlUg_T_id // Эффективность модели при идентификации: // отношение вероятности верной идентификации с использованием модели // к вероятности случайного угадывания принадлежности объекта к классу REPLACE EffMod_NId WITH P_T_NIdent / SlUg_T_nid // Эффективность модели при неидентификации: // отношение вероятности верной неидентификации с использованием модели // к вероятности случайного угадывания непринадлежности объекта к классу REPLACE Avr_EffMod WITH (EffMod_Id+EffMod_NId)/2 * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) REPLACE S_T_IDENT WITH A_Rec[26] // 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) REPLACE S_F_NIDENT WITH A_Rec[27] // 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) REPLACE S_F_IDENT WITH A_Rec[28] // 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) REPLACE S_T_NIDENT WITH A_Rec[29] // 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 30 | SPRECISION | N | 15 | 7 | 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение *********************************************************************************************************************************** ** L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена ********************************************* *********************************************************************************************************************************** STP = S_T_Ident // 26. S_T_Ident Сумма модулей уровней сходства верно идентифицированных объектов расп.выборк (TP - истино-положительное решение) SFN = S_F_NIdent // 27. S_F_NIdent Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборк (FN - ложно-отрицательное решение) SFP = S_F_Ident // 28. S_F_Ident Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборк (FP - ложно-положительное решение) STN = S_T_NIdent // 29. S_T_NIdent Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборк (TN - истино-отрицательное решение) REPLACE SPrecision WITH STP/(STP+SFP) // 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства REPLACE SRecall WITH STP/(STP+SFN) // 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства REPLACE L1_mera WITH 2*(SPrecision*SRecall)/(SPrecision+SRecall) // 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена) REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) *********************************************************************************************************************************** REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ENDIF ******************************************************************** ****** Переписать информацию по классу из (M_VerMod) в VerModCls.dbf ******************************************************************** SELECT (M_VerMod) Ar := {} FOR j=1 TO FCOUNT()-2 AADD(Ar, FIELDGET(j)) NEXT SELECT VerModCls APPEND BLANK FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT // ModIntKrit Код: ##_####_#, где: // ##-числовой номер модели и инт.критерия {1-20}, // ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, // #-инт.крит.: {k,i} REPLACE ModIntKrit WITH STRTRAN(STR(2*M_NumMod-IF(M_IntKrit=1,1,0),2)," ","0")+"_"+Ar_Model[M_NumMod]+"_"+IF(M_IntKrit=1,"k","i") SELECT (M_VerMod) DBSKIP(1) ENDDO ******* Определение количества логических объетов по классам другим способом *SELECT Rso_Zag *SET ORDER TO 1 *DBGOTOP() *DO WHILE .NOT. EOF() * M_KodObj = Kod_obj * // Формирование массива кодов классов текущего объекта обучающей выборки * SELECT Rso_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 * IF ASCAN(Ar_Kcl, M_Kcl) = 0 * AADD (Ar_Kcl, M_Kcl) * ENDIF * ENDIF * ENDIF * NEXT * DBSKIP(1) * ENDDO * ENDIF * SELECT (M_VerMod);SET ORDER TO 1 * FOR j=1 TO LEN(Ar_Kcl) * T=DBSEEK(STR(Ar_Kcl[j],19)) * IF T * M_NLogObj = N_LogObj * REPLACE N_LogObj WITH M_NLogObj + 1 * ENDIF * NEXT * SELECT Rso_Zag * DBSKIP(1) *ENDDO * Структура базы данных N°=53: VerModCls.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | MODINTKRIT | C | 9 | 0 | 1. ModIntKrit Код: ##_####_#, где: ##-числовой номер модели и инт.критерия {1-20}, ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, #-инт.крит.: {k,i} * | 2 | KOD_CLS | N | 15 | 0 | 2. Код класса * | 3 | NAME_CLS | C | 35 | 0 | 3. Наименование класса * | 4 | DIFVALMOD | N | 15 | 7 | 4. DifValMod Достоверность идентификации класса (с учетом всех верно и ошибочно идентифицированных и неидентифицированных логических объектов)) * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 8 | N_LOGOBJ | N | 15 | 7 | 8. N_LogObj Количество объектов расп.выборки, фактически относящихся к классу * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * | 13 | DVMOD | N | 15 | 7 | 13. M_DVMod = (NT-NF)/(NT+NF)*100 Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов"). NT = N_T_id+N_T_nid: Количество ВЕРНО идентифицированных и неидентифицированных объектов, NF = N_F_id+N_F_nid: Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 14 | PRECISION | N | 15 | 7 | 14. Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15. Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * | 17 | P_T_IDENT | N | 15 | 7 | 17. P_T_Ident Вероятность верной идентификации объекта с классом с использованием модели * | 18 | P_T_NIDENT | N | 15 | 7 | 18. P_T_NIdent Вероятность верной не идентификации объекта с классом с использованием модели * | 19 | P_F_IDENT | N | 15 | 7 | 19. P_F_Ident Вероятность ошибочной идентификации объекта с классом с использованием модели * | 20 | P_F_NIDENT | N | 15 | 7 | 20. P_F_NIdent Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 21 | P_SLUG_ID | N | 15 | 7 | 21. P_SlUg_Id Вероятность случайного угадывания принадлежности объектов к классам * | 22 | P_SLUG_NID | N | 15 | 7 | 22. P_SlUg_NId Вероятность случайного угадывания непринадлежности объектов к классам * | 23 | EFFMOD_ID | N | 15 | 7 | 23. EffMod_Id Эффективность модели при идентификации: отношение вероятности верной идентификации при использовании модели к вероятности случайного угадывания принадлежности объекта к классу * | 24 | EFFMOD_NID | N | 15 | 7 | 24. EffMod_NId Эффективность модели при неидентификации: отношение вероятности верной неидентификации при использовании модели к вероятности случайного угадывания непринадлежности объекта к классу * | 25 | AVR_EFFMOD | N | 15 | 7 | 25. Avr_EffMod Средняя эффективность модели: (EffMod_Id+EffMod_NId)/2 * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 30 | SPRECISION | N | 15 | 7 | 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение * | 33 | DATE | C | 10 | 0 | 33. Date Дата формирования записи БД * | 34 | TIME | C | 8 | 0 | 34. Time Время формирования записи БД * ============================================================================ * В С Е Г О длина записи: 513 байтов. | * ============================================================================ ***** Дорасчет сводных по всем классам показателей по форме валидности для данной модели и инт.критерия ***** Итоговую строку считать как средневзвешенную: ***** каждый показатель: суммировать призведение значения показателя на число лог.объектов по всем классам ***** а потом делить их на суммарное количество логических объектов и занести в БД * N_LogObjALL // Суммарное количество логических объектов по всей выборке AFILL(A_Wsg,0) // Массив для итоговой записи по всем классам ****** Расчет ************************************* SELECT (M_VerMod) DBGOTOP() DO WHILE .NOT. EOF() * | 4 | DIFVALMOD | N | 15 | 7 | 4. DifValMod Достоверность идентификации класса (с учетом всех верно и ошибочно идентифицированных и неидентифицированных логических объектов)) * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов FOR j=4 TO 7 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) * N_LogObj NEXT * | 8 | N_LOGOBJ | N | 15 | 7 | 8. N_LogObj Количество объектов расп.выборки, фактически относящихся к классу * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) FOR j=8 TO 12 // F-мера A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки FOR j=26 TO 29 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT * | 30 | SPRECISION | N | 15 | 7 | 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение FOR j=30 TO 32 // L1-мера A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT * | 13 | DVMOD | N | 15 | 7 | 13. M_DVMod = (NT-NF)/(NT+NF)*100 Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов"). NT = N_T_id+N_T_nid: Количество ВЕРНО идентифицированных и неидентифицированных объектов, NF = N_F_id+N_F_nid: Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 14 | PRECISION | N | 15 | 7 | 14. Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15. Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) * | 17 | P_T_IDENT | N | 15 | 7 | 17. P_T_Ident Вероятность верной идентификации объекта с классом с использованием модели * | 18 | P_T_NIDENT | N | 15 | 7 | 18. P_T_NIdent Вероятность верной не идентификации объекта с классом с использованием модели * | 19 | P_F_IDENT | N | 15 | 7 | 19. P_F_Ident Вероятность ошибочной идентификации объекта с классом с использованием модели * | 20 | P_F_NIDENT | N | 15 | 7 | 20. P_F_NIdent Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 21 | P_SLUG_ID | N | 15 | 7 | 21. P_SlUg_Id Вероятность случайного угадывания принадлежности объектов к классам * | 22 | P_SLUG_NID | N | 15 | 7 | 22. P_SlUg_NId Вероятность случайного угадывания непринадлежности объектов к классам * | 23 | EFFMOD_ID | N | 15 | 7 | 23. EffMod_Id Эффективность модели при идентификации: отношение вероятности верной идентификации при использовании модели к вероятности случайного угадывания принадлежности объекта к классу * | 24 | EFFMOD_NID | N | 15 | 7 | 24. EffMod_NId Эффективность модели при неидентификации: отношение вероятности верной неидентификации при использовании модели к вероятности случайного угадывания непринадлежности объекта к классу * | 25 | AVR_EFFMOD | N | 15 | 7 | 25. Avr_EffMod Средняя эффективность модели: (EffMod_Id+EffMod_NId)/2 FOR j=13 TO 25 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) * N_LogObj NEXT DBSKIP(1) ENDDO ****** Занесение информации в БД SELECT(M_VerMod) * // Сумму сделать только по колонкам, нужным для расчета F-критерия и L-криетрия, а для остальных, как раньше. Посчитать его для строки "Сумма" APPEND BLANK REPLACE Name_cls WITH "Ср.взв.сумма:" * | 4 | DIFVALMOD | N | 15 | 7 | 4. DifValMod Достоверность идентификации класса (с учетом всех верно и ошибочно идентифицированных и неидентифицированных логических объектов)) * | 5 | AVRURSX_T | N | 15 | 7 | 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов * | 6 | AVRURSX_F | N | 15 | 7 | 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов * | 7 | DIFAVRURSX | N | 15 | 7 | 7. DifAvrUrSx Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов FOR j=4 TO 7 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки FOR j=26 TO 29 * A_Wsg[j] = A_Wsg[j] * FIELDPUT(j,A_Wsg[j]) NEXT * ** F-мера Ван Ризбергена ********************************************************************************************************** * | 8 | N_LOGOBJ | N | 15 | 7 | 8. N_LogObj Количество объектов расп.выборки, фактически относящихся к классу * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) FOR j=8 TO 12 * A_Wsg[j] = A_Wsg[j] // Всего логических объектов и TP, FN, FP, TN * FIELDPUT(j,A_Wsg[j]) NEXT * | 13 | DVMOD | N | 15 | 7 | 13. M_DVMod = (NT-NF)/(NT+NF)*100 Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов"). NT = N_T_id+N_T_nid: Количество ВЕРНО идентифицированных и неидентифицированных объектов, NF = N_F_id+N_F_nid: Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов FOR j=13 TO 13 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT ********* Расчет и запись F-меры *************************** * | 9 | N_T_IDENT | N | 15 | 7 | 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * | 10 | N_F_NIDENT | N | 15 | 7 | 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * | 11 | N_F_IDENT | N | 15 | 7 | 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * | 12 | N_T_NIDENT | N | 15 | 7 | 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * | 14 | PRECISION | N | 15 | 7 | 14. Precision = TP/(TP+FP) - точность * | 15 | RECALL | N | 15 | 7 | 15. Recall = TP/(TP+FN) - полнота * | 16 | F_MERA | N | 15 | 7 | 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) A_Wsg[14] = A_Wsg[9]/(A_Wsg[9]+A_Wsg[11]) ;FIELDPUT(14,A_Wsg[14]) // Precision A_Wsg[15] = A_Wsg[9]/(A_Wsg[9]+A_Wsg[10]) ;FIELDPUT(15,A_Wsg[15]) // Recall A_Wsg[16] = 2*A_Wsg[14]*A_Wsg[15]/(A_Wsg[14]+A_Wsg[15]);FIELDPUT(16,A_Wsg[16]) // F-мера ********* Расчет и запись L-меры *************************** * | 26 | S_T_IDENT | N | 15 | 7 | 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) * | 27 | S_F_NIDENT | N | 15 | 7 | 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) * | 28 | S_F_IDENT | N | 15 | 7 | 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) * | 29 | S_T_NIDENT | N | 15 | 7 | 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) * | 30 | SPRECISION | N | 15 | 7 | 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства * | 31 | SRECALL | N | 15 | 7 | 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства * | 32 | L1_mera | N | 15 | 7 | 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение A_Wsg[30] = A_Wsg[26]/(A_Wsg[26]+A_Wsg[28]) ;FIELDPUT(30,A_Wsg[30]) // SPrecision A_Wsg[31] = A_Wsg[26]/(A_Wsg[26]+A_Wsg[27]) ;FIELDPUT(31,A_Wsg[31]) // SRecall A_Wsg[32] = 2*A_Wsg[30]*A_Wsg[31]/(A_Wsg[30]+A_Wsg[31]);FIELDPUT(32,A_Wsg[32]) // L1-мера * | 17 | P_T_IDENT | N | 15 | 7 | 17. P_T_Ident Вероятность верной идентификации объекта с классом с использованием модели * | 18 | P_T_NIDENT | N | 15 | 7 | 18. P_T_NIdent Вероятность верной не идентификации объекта с классом с использованием модели * | 19 | P_F_IDENT | N | 15 | 7 | 19. P_F_Ident Вероятность ошибочной идентификации объекта с классом с использованием модели * | 20 | P_F_NIDENT | N | 15 | 7 | 20. P_F_NIdent Вероятность ошибочной не идентификации объекта с классом с использованием модели * | 21 | P_SLUG_ID | N | 15 | 7 | 21. P_SlUg_Id Вероятность случайного угадывания принадлежности объектов к классам * | 22 | P_SLUG_NID | N | 15 | 7 | 22. P_SlUg_NId Вероятность случайного угадывания непринадлежности объектов к классам * | 23 | EFFMOD_ID | N | 15 | 7 | 23. EffMod_Id Эффективность модели при идентификации: отношение вероятности верной идентификации при использовании модели к вероятности случайного угадывания принадлежности объекта к классу * | 24 | EFFMOD_NID | N | 15 | 7 | 24. EffMod_NId Эффективность модели при неидентификации: отношение вероятности верной неидентификации при использовании модели к вероятности случайного угадывания непринадлежности объекта к классу * | 25 | AVR_EFFMOD | N | 15 | 7 | 25. Avr_EffMod Средняя эффективность модели: (EffMod_Id+EffMod_NId)/2 FOR j=17 TO 25 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT ****** Занесение информации в БД SELECT(M_VerMod) * FOR j=4 TO 32 FIELDPUT(j,A_Wsg[j]) NEXT * | 33 | DATE | C | 10 | 0 | 33. Date Дата формирования записи БД * | 34 | TIME | C | 8 | 0 | 34. Time Время формирования записи БД REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ****** Переписать все итоговые строки из БД по моделям и критериям в одну БД VerModClsIT.dbf SELECT VerModClsIT APPEND BLANK FOR j=4 TO 32 FIELDPUT(j,A_Wsg[j]) NEXT REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL ****************************************************************************** ******** Расчет отчета по дифференциальной и интегральной достоверности модели ****************************************************************************** FUNCTION GenValidModObj(M_NumMod, M_IntKrit) IF ApplChange("") // Перейти в папку выбранного приложения или выйти из системы LB_Warning(L("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")) Running(.F.) RETURN NIL ENDIF mRecSize = GenDbfVerModObj(M_NumMod, M_IntKrit) // Создать БД для измерения достоверности моделей // Имя БД, созданной GenDbfValSys, с результами оценки достоверности модели по инт.критерию M_VerMod := "VerModObj"+STRTRAN(STR(M_NumMod,2)," ","0")+IF(M_IntKrit=1,"k","i") // Формирование имен файлов с результатами распознавания M_Rsp1 = "Rsp1"+IF(M_IntKrit=1,"k","i") M_Rsp2 = "Rsp2"+IF(M_IntKrit=1,"k","i") M_Rsp_it1 = "Rsp" +IF(M_IntKrit=1,"k","i")+"1" M_Rsp_it2 = "Rsp" +IF(M_IntKrit=1,"k","i")+"2" ** Генерация БД ValidSys.dbf IF .NOT. FILE(M_Rsp1+".dbf") Mess = L("СФОРМИРУЙТЕ РАСПОЗНАВАЕМУЮ ВЫБОРКУ И ВЫПОЛНИТЕ РАСПОЗНАВАНИЕ!!!") LB_Warning(Mess) RETURN NIL ENDIF ***** АЛГОРИТМ СДЕЛАН НА ОСНОВЕ АЛГОРИТМА ФОРМИРОВАНИЯ RASP_IT1 ***** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Rso_Zag EXCLUSIVE NEW // ############################################ USE (M_VerMod) EXCLUSIVE NEW;ZAP SELECT Rso_Zag SET ORDER TO 1 DBGOTOP() DO WHILE .NOT. EOF() M_Kod = Kod_obj M_Name = Name_obj SELECT (M_VerMod) APPEND BLANK // Слишком большая база данных, больше 2 Гб, вылетает. Измерять размер в цикле - будет очень медленно работать <<<===########## REPLACE KOD_OBJ WITH M_Kod REPLACE NAME_OBJ WITH M_Name SELECT Rso_Zag DBSKIP(1) ENDDO ***** Заполняем базу итогов данными из (M_Rsp1).dbf **** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE (M_Rsp1) EXCLUSIVE NEW INDEX ON STR(Kod_obj,19) TO Rsp1_obj CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE (M_VerMod) EXCLUSIVE NEW INDEX ON STR(Kod_obj,19) TO Ver_obj ***** Начало цикла по БД результатов распознавания CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE Classes INDEX Cls_kod EXCLUSIVE NEW;N_Cls = RECCOUNT() // Количество классов 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 (M_Rsp1) INDEX Rsp1_obj EXCLUSIVE NEW USE (M_VerMod) INDEX Ver_obj EXCLUSIVE NEW USE VerModObj EXCLUSIVE NEW;mHeader = HEADER() // Объединить все (M_VerMod) по классам без итоговых строк USE VerModObjIT EXCLUSIVE NEW // Объединить все (M_VerMod) итоговые строки без классов ****** Расчет интегрального качества распознавания объекта N°Obj *************** * Структура базы данных N°=100: VerModObj.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | MODINTKRIT | C | 9 | 0 | * | 2 | KOD_OBJ | N | 15 | 0 | * | 3 | NAME_OBJ | C | 15 | 0 | * | 4 | DIFVALMOD | N | 15 | 7 | * | 5 | AVRURSX_T | N | 15 | 7 | * | 6 | AVRURSX_F | N | 15 | 7 | * | 7 | DIFAVRURSX | N | 15 | 7 | * | 8 | N_LOGOBJ | N | 15 | 7 | * | 9 | N_T_IDENT | N | 15 | 7 | * | 10 | N_F_NIDENT | N | 15 | 7 | * | 11 | N_F_IDENT | N | 15 | 7 | * | 12 | N_T_NIDENT | N | 15 | 7 | * | 13 | DVMOD | N | 15 | 7 | * | 14 | PRECISION | N | 15 | 7 | * | 15 | RECALL | N | 15 | 7 | * | 16 | F_MERA | N | 15 | 7 | * | 17 | P_T_IDENT | N | 15 | 7 | * | 18 | P_T_NIDENT | N | 15 | 7 | * | 19 | P_F_IDENT | N | 15 | 7 | * | 20 | P_F_NIDENT | N | 15 | 7 | * | 21 | P_SLUG_ID | N | 15 | 7 | * | 22 | P_SLUG_NID | N | 15 | 7 | * | 23 | EFFMOD_ID | N | 15 | 7 | * | 24 | EFFMOD_NID | N | 15 | 7 | * | 25 | AVR_EFFMOD | N | 15 | 7 | * | 26 | S_T_IDENT | N | 15 | 7 | * | 27 | S_F_NIDENT | N | 15 | 7 | * | 28 | S_F_IDENT | N | 15 | 7 | * | 29 | S_T_NIDENT | N | 15 | 7 | * | 30 | SPRECISION | N | 15 | 7 | * | 31 | SRECALL | N | 15 | 7 | * | 32 | L1_mera | N | 15 | 7 | * | 33 | DATE | C | 10 | 0 | * | 34 | TIME | C | 8 | 0 | * ============================================================================ * В С Е Г О длина записи: 493 байтов. | * ============================================================================ PRIVATE A_Rec[34] // Массив для текущей записи по классу PRIVATE A_Wsg[34] // Массив для итоговой записи по всем классам AFILL(A_Rec,0) // Массив для текущей записи по классу AFILL(A_Wsg,0) // Массив для итоговой записи по всем классам SELECT (M_VerMod) SET ORDER TO 1 DBGOTOP() N_LogObjALL = 0 // Суммарное количество логических объектов по всей выборке mRecno = 0 mFlag = .T. DO WHILE .NOT. EOF() M_KodObj = Kod_obj ******** Расчет дифференциальной достоверности модели по классу (качество распознавания класса) AFILL(A_Rec,0) // Массив для текущей записи по классу N_LogObjCLS = 0 // Суммарное количество логических объектов по классу SELECT (M_Rsp1);SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T DO WHILE Kod_obj=M_KodObj .AND. .NOT. EOF() DO CASE CASE M_IntKrit = 1 // Подсчет по инт.критерию "Корреляция" DO CASE CASE Korr > 0 IF LEN(ALLTRIM(Fakt)) > 0 A_Rec[ 9] = A_Rec[ 9] + 1 // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * A_Rec[26] = A_Rec[26] + 1 // 26. S_T_IDENT Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Korr)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[26] = A_Rec[26] + ABS(Korr)/100 // 26. S_T_IDENT Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE A_Rec[11] = A_Rec[11] + 1 // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * A_Rec[28] = A_Rec[28] + 1 // 28. S_F_IDENT Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Korr)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[28] = A_Rec[28] + ABS(Korr)/100 // 28. S_F_IDENT Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) ENDIF CASE Korr <= 0 IF LEN(ALLTRIM(Fakt)) > 0 A_Rec[10] = A_Rec[10] + 1 // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * A_Rec[27] = A_Rec[27] + 1 // 27. S_F_NIDENT Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Korr)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[27] = A_Rec[27] + ABS(Korr)/100 // 27. S_F_NIDENT Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE A_Rec[12] = A_Rec[12] + 1 // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * A_Rec[29] = A_Rec[29] + 1 // 29. S_T_NIDENT Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Korr)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[29] = A_Rec[29] + ABS(Korr)/100 // 29. S_T_NIDENT Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) ENDIF ENDCASE CASE M_IntKrit = 2 // Подсчет по инт.критерию "Сумма" DO CASE CASE Sum_inf > 0 IF LEN(ALLTRIM(Fakt)) > 0 A_Rec[ 9] = A_Rec[ 9] + 1 // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) * A_Rec[26] = A_Rec[26] + 1 // 26. Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Sum_inf)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[26] = A_Rec[26] + ABS(Sum_inf)/100 // 26. Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE A_Rec[11] = A_Rec[11] + 1 // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) * A_Rec[28] = A_Rec[28] + 1 // 28. Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Sum_inf)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[28] = A_Rec[28] + ABS(Sum_inf)/100 // 28. Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) ENDIF CASE Sum_inf <= 0 IF LEN(ALLTRIM(Fakt)) > 0 A_Rec[10] = A_Rec[10] + 1 // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) * A_Rec[27] = A_Rec[27] + 1 // 27. Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) A_Rec[ 6] = A_Rec[ 6] + ABS(Sum_inf)/100 // 6. AvrUrSx_F Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов A_Rec[27] = A_Rec[27] + ABS(Sum_inf)/100 // 27. Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) ++N_LogObjCLS // Суммарное количество логических объектов по классу ++N_LogObjALL // Суммарное количество логических объектов по всей выборке ELSE A_Rec[12] = A_Rec[12] + 1 // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) * A_Rec[29] = A_Rec[29] + 1 // 29. Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) A_Rec[ 5] = A_Rec[ 5] + ABS(Sum_inf)/100 // 5. AvrUrSx_T Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов A_Rec[29] = A_Rec[29] + ABS(Sum_inf)/100 // 29. Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) ENDIF ENDCASE ENDCASE DBSKIP(1) ENDDO ** Мой вариант метрики ************************************************************************************************************ ** Сумма верно идентифицированных и неидентифицированных объектов ** минус ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество объектов (среднее на объект) в процентах * NT = N_T_id+N_T_nid // Количество ВЕРНО идентифицированных и неидентифицированных объектов * NF = N_F_id+N_F_nid // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов NT = A_Rec[ 9] + A_Rec[12] // Количество ВЕРНО идентифицированных и неидентифицированных объектов NF = A_Rec[11] + A_Rec[10] // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов *********************************************************************************************************************************** * M_DVMod = (NT-NF)/(NT+NF)*100 // Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов") *********************************************************************************************************************************** ****** Занесение информации в БД ValidSys SELECT (M_VerMod) ** Мой вариант метрики ************************************************************************************************************ * REPLACE DifValMod WITH M_DVMod // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {-1,+1} * REPLACE DVMod WITH (1+M_DVMod)/2 // Дифференциальная валидность (достоверность) модели (по классу), нормированная к { 0, 1} REPLACE AvrUrSx_T WITH IF(NT>0,A_Rec[ 5]/NT,0) // Средний модуль уровней сходства ВЕРНО идентифицированных и неидентифицированных объектов REPLACE AvrUrSx_F WITH IF(NF>0,A_Rec[ 6]/NF,0) // Средний модуль уровней сходства ОШИБОЧНО идентифицированных и неидентифицированных объектов REPLACE DifAvrUrSx WITH AvrUrSx_T-AvrUrSx_F // Разность средних модулей уровней сходства ВЕРНО и ОШИБОЧНО идентифицированных и неидентифицированных объектов REPLACE N_LogObj WITH N_LogObjCLS // Количество объектов, фактически относящихся к классу: те, что к нему верно отнесены + те, которые к нему ошибочно не отнесены REPLACE N_T_IDENT WITH A_Rec[ 9] // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) REPLACE N_F_NIDENT WITH A_Rec[10] // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) REPLACE N_F_IDENT WITH A_Rec[11] // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) REPLACE N_T_NIDENT WITH A_Rec[12] // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) REPLACE P_T_Ident WITH N_T_Ident /N_LogObj * 100 // Вероятность верной идентификации объекта с классом ###### в % REPLACE P_F_NIdent WITH N_F_NIdent/N_LogObj * 100 // Вероятность ошибочной не идентификации объекта с классом ###### REPLACE P_F_Ident WITH N_F_Ident /(N_Obj-N_LogObj) * 100 // Вероятность ошибочной идентификации объекта с классом ###### REPLACE P_T_NIdent WITH N_T_NIdent/(N_Obj-N_LogObj) * 100 // Вероятность верной не идентификации объекта с классом ###### *********************************************************************************************************************************** ** F-мера Ван Ризбергена ********************************************************************************************************** *********************************************************************************************************************************** TP = N_T_Ident // 9. N_T_Ident Количество верно идентифицированных объектов расп.выборки (TP - истино-положительное решение) FN = N_F_NIdent // 10. N_F_NIdent Количество ошибочно неидентифицированных объектов расп.выборки (FN - ложно-отрицательное решение) FP = N_F_Ident // 11. N_F_Ident Количество ошибочно идентифицированных объектов расп.выборки (FP - ложно-положительное решение) TN = N_T_NIdent // 12. N_T_NIdent Количество верно неидентифицированных объектов расп.выборки (TN - истино-отрицательное решение) REPLACE Precision WITH TP/(TP+FP) // 14. Precision = TP/(TP+FP) - точность REPLACE Recall WITH TP/(TP+FN) // 15. Recall = TP/(TP+FN) - полнота REPLACE F_mera WITH 2*(Precision*Recall)/(Precision+Recall) // 16. F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) *********************************************************************************************************************************** ** Мой вариант метрики в терминах F-меры ****************************************************************************************** ** Сумма числа верно идентифицированных и неидентифицированных объектов ** минус число ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество объектов (среднее на объект). Есть две нормировки: {-1, +1} и {0, 1} M_DVMod = ( TP + TN - FP - FN ) / ( TP + TN + FP + FN ) // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! REPLACE DifValMod WITH M_DVMod // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {-1, +1} REPLACE DVMod WITH (1+M_DVMod)/2 // Дифференциальная валидность (достоверность) модели (по классу), нормированная к {0, 1} *********************************************************************************************************************************** SlUg_T_id = N_LogObj /N_Obj * 100 // Вероятность случайного угадывания принадлежности объектов к классам в % SlUg_T_nid = (100-SlUg_T_id) // Вероятность случайного угадывания непринадлежности объектов к классам REPLACE P_SlUg_Id WITH SlUg_T_id // Вероятность случайного угадывания принадлежности объектов к классам REPLACE P_SlUg_NId WITH SlUg_T_nid // Вероятность случайного угадывания непринадлежности объектов к классам REPLACE EffMod_Id WITH P_T_Ident / SlUg_T_id // Эффективность модели при идентификации: // отношение вероятности верной идентификации с использованием модели // к вероятности случайного угадывания принадлежности объекта к классу REPLACE EffMod_NId WITH P_T_NIdent / SlUg_T_nid // Эффективность модели при неидентификации: // отношение вероятности верной неидентификации с использованием модели // к вероятности случайного угадывания непринадлежности объекта к классу REPLACE Avr_EffMod WITH (EffMod_Id+EffMod_NId)/2 REPLACE S_T_IDENT WITH A_Rec[26] // 26.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки (STP - истино-положительное решение) REPLACE S_F_NIDENT WITH A_Rec[27] // 27.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (SFN - ложно-отрицательное решение) REPLACE S_F_IDENT WITH A_Rec[28] // 28.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (SFP - ложно-положительное решение) REPLACE S_T_NIDENT WITH A_Rec[29] // 29.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки (STN - истино-отрицательное решение) *********************************************************************************************************************************** ** L1, L2-меры проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена **************************************** *********************************************************************************************************************************** STP = S_T_Ident // 26. S_T_Ident Сумма модулей уровней сходства верно идентифицированных объектов расп.выборк (TP - истино-положительное решение) SFN = S_F_NIdent // 27. S_F_NIdent Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборк (FN - ложно-отрицательное решение) SFP = S_F_Ident // 28. S_F_Ident Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборк (FP - ложно-положительное решение) STN = S_T_NIdent // 29. S_T_NIdent Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборк (TN - истино-отрицательное решение) REPLACE SPrecision WITH STP/(STP+SFP) // 30.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства REPLACE SRecall WITH STP/(STP+SFN) // 31.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства REPLACE L1_mera WITH 2*(SPrecision*SRecall)/(SPrecision+SRecall) // 32.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена) REPLACE A_T_IDENT WITH S_T_IDENT /N_T_IDENT REPLACE A_F_NIDENT WITH S_F_NIDENT/N_F_NIDENT REPLACE A_F_IDENT WITH S_F_IDENT /N_F_IDENT REPLACE A_T_NIDENT WITH S_T_NIDENT/N_T_NIDENT REPLACE APRECISION WITH A_T_IDENT/(A_T_IDENT+A_F_IDENT) REPLACE ARECALL WITH A_T_IDENT/(A_T_IDENT+A_F_NIDENT) REPLACE L2_mera WITH 2*(APRECISION*ARECALL)/(APRECISION+ARECALL) // L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (нечеткий мультиклассовый вариант) *********************************************************************************************************************************** REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ENDIF ********************************************************************* ****** Переписать информацию по объекту из (M_VerMod) в VerModObj.dbf ********************************************************************* SELECT (M_VerMod) Ar := {} FOR j=1 TO FCOUNT() AADD(Ar, FIELDGET(j)) NEXT SELECT VerModObj IF mFlag .AND. RECSIZE()*(RECCOUNT()+1)+HEADER() > 2*1024^3 // ПЕРЕД ОТКРЫТИЕМ ЭТОЙ БАЗЫ ДАННЫХ ПРОВЕРЯТЬ, МЕНЬШЕ ЛИ ОНА 2 ГБ. ЕСЛИ БОЛЬШЕ - ВЫДАВАТЬ СООБЩЕНИЕ О НЕОБХОДИМОСТИ ЗАДАТЬ ПАРАМЕТР, УМЕНЬШАЮЩИЙ ЧИСЛО ЗАПИСЕЙ ТАК, ЧТОБЫ БД БЫЛА < 2ГБ mFlag =.F. // Это сообщение выводить только один раз в цикле aMess := {} AADD(aMess, L('Размер БД достоверности моделей VerModObj.dbf достиг максимального размера')+' '+ALLTRIM(STR(INT(RECSIZE()*RECCOUNT()+HEADER())))+' '+L('байт.' )) AADD(aMess, L('Необходимо применить бутстрепный подход и для оценки достоверности моделей и выбрать')) AADD(aMess, L('в режиме 3.5 не более 179555 объектов обучающей выборки или только синтез моделей.' )) LB_Warning(aMess, L('3.5. Синтез и верификация моделей')) EXIT // Выход из цикла ELSE APPEND BLANK // <<<===############ Здесь возникает ошибка, когда очень много объектов выборки mRecno++ FOR j=1 TO LEN(Ar) FIELDPUT(j,Ar[j]) NEXT // ModIntKrit Код: ##_####_#, где: // ##-числовой номер модели и инт.критерия {1-20}, // ####-модель {Abs,Prc1,Prc2,Inf1,Inf2,Inf3,Inf4,Inf5,Inf6,Inf7}, // #-инт.крит.: {k,i} REPLACE ModIntKrit WITH STRTRAN(STR(2*M_NumMod-IF(M_IntKrit=1,1,0),2)," ","0")+"_"+Ar_Model[M_NumMod]+"_"+IF(M_IntKrit=1,"k","i") ENDIF SELECT (M_VerMod) DBSKIP(1) ENDDO ******* Определение количества логических объетов по классам другим способом *SELECT Rso_Zag *SET ORDER TO 1 *DBGOTOP() *DO WHILE .NOT. EOF() * M_KodObj = Kod_obj * // Формирование массива кодов классов текущего объекта обучающей выборки * SELECT Rso_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 * IF ASCAN(Ar_Kcl, M_Kcl) = 0 * AADD (Ar_Kcl, M_Kcl) * ENDIF * ENDIF * ENDIF * NEXT * DBSKIP(1) * ENDDO * ENDIF * SELECT (M_VerMod);SET ORDER TO 1 * FOR j=1 TO LEN(Ar_Kcl) * T=DBSEEK(STR(Ar_Kcl[j],19)) * IF T * M_NLogObj = N_LogObj * REPLACE N_LogObj WITH M_NLogObj + 1 * ENDIF * NEXT * SELECT Rso_Zag * DBSKIP(1) *ENDDO * Структура базы данных N°=100: VerModObj.dbf * ============================================================================ * | N | Имя поля | Тип | Ширина | Дес. | Примечание | * ============================================================================ * | 1 | MODINTKRIT | C | 9 | 0 | * | 2 | KOD_OBJ | N | 15 | 0 | * | 3 | NAME_OBJ | C | 15 | 0 | * | 4 | DIFVALMOD | N | 15 | 7 | * | 5 | AVRURSX_T | N | 15 | 7 | * | 6 | AVRURSX_F | N | 15 | 7 | * | 7 | DIFAVRURSX | N | 15 | 7 | * | 8 | N_LOGOBJ | N | 15 | 7 | * | 9 | N_T_IDENT | N | 15 | 7 | * | 10 | N_F_NIDENT | N | 15 | 7 | * | 11 | N_F_IDENT | N | 15 | 7 | * | 12 | N_T_NIDENT | N | 15 | 7 | * | 13 | DVMOD | N | 15 | 7 | * | 14 | PRECISION | N | 15 | 7 | * | 15 | RECALL | N | 15 | 7 | * | 16 | F_MERA | N | 15 | 7 | * | 17 | P_T_IDENT | N | 15 | 7 | * | 18 | P_T_NIDENT | N | 15 | 7 | * | 19 | P_F_IDENT | N | 15 | 7 | * | 20 | P_F_NIDENT | N | 15 | 7 | * | 21 | P_SLUG_ID | N | 15 | 7 | * | 22 | P_SLUG_NID | N | 15 | 7 | * | 23 | EFFMOD_ID | N | 15 | 7 | * | 24 | EFFMOD_NID | N | 15 | 7 | * | 25 | AVR_EFFMOD | N | 15 | 7 | * | 26 | S_T_IDENT | N | 15 | 7 | * | 27 | S_F_NIDENT | N | 15 | 7 | * | 28 | S_F_IDENT | N | 15 | 7 | * | 29 | S_T_NIDENT | N | 15 | 7 | * | 30 | SPRECISION | N | 15 | 7 | * | 31 | SRECALL | N | 15 | 7 | * | 32 | L1_mera | N | 15 | 7 | * | 33 | DATE | C | 10 | 0 | * | 34 | TIME | C | 8 | 0 | * ============================================================================ * В С Е Г О длина записи: 493 байтов. | * ============================================================================ ***** Дорасчет сводных по всем классам показателей по форме валидности для данной модели и инт.критерия ***** Итоговую строку считать как средневзвешенную: ***** каждый показатель: суммировать призведение значения показателя на число лог.объектов по всем классам ***** а потом делить их на суммарное количество логических объектов и занести в БД * N_LogObjALL // Суммарное количество логических объектов по всей выборке AFILL(A_Wsg,0) // Массив для итоговой записи по всем классам ****** Расчет ************************************* SELECT (M_VerMod) DBGOTOP() DO WHILE .NOT. EOF() FOR j=4 TO 7 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) * N_LogObj NEXT FOR j=8 TO 12 // F-мера A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT FOR j=26 TO 29 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT FOR j=30 TO 32 // L1-мера A_Wsg[j] = A_Wsg[j] + FIELDGET(j) NEXT FOR j=13 TO 25 A_Wsg[j] = A_Wsg[j] + FIELDGET(j) * N_LogObj NEXT DBSKIP(1) ENDDO ****** Занесение информации в БД SELECT(M_VerMod) * APPEND BLANK REPLACE Name_obj WITH "Ср.взв.сумма:" FOR j=4 TO 7 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT FOR j=26 TO 29 * A_Wsg[j] = A_Wsg[j] * FIELDPUT(j,A_Wsg[j]) NEXT FOR j=8 TO 12 * A_Wsg[j] = A_Wsg[j] // Всего логических объектов и TP, FN, FP, TN * FIELDPUT(j,A_Wsg[j]) NEXT FOR j=13 TO 13 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT A_Wsg[14] = A_Wsg[9]/(A_Wsg[9]+A_Wsg[11]) ;FIELDPUT(14,A_Wsg[14]) // Precision A_Wsg[15] = A_Wsg[9]/(A_Wsg[9]+A_Wsg[10]) ;FIELDPUT(15,A_Wsg[15]) // Recall A_Wsg[16] = 2*A_Wsg[14]*A_Wsg[15]/(A_Wsg[14]+A_Wsg[15]);FIELDPUT(16,A_Wsg[16]) // F-мера A_Wsg[30] = A_Wsg[26]/(A_Wsg[26]+A_Wsg[28]) ;FIELDPUT(30,A_Wsg[30]) // SPrecision A_Wsg[31] = A_Wsg[26]/(A_Wsg[26]+A_Wsg[27]) ;FIELDPUT(31,A_Wsg[31]) // SRecall A_Wsg[32] = 2*A_Wsg[30]*A_Wsg[31]/(A_Wsg[30]+A_Wsg[31]);FIELDPUT(32,A_Wsg[32]) // L1-мера FOR j=17 TO 25 A_Wsg[j] = A_Wsg[j] / N_LogObjALL * FIELDPUT(j,A_Wsg[j]) NEXT ****** Занесение информации в БД SELECT(M_VerMod) * FOR j=4 TO 32 FIELDPUT(j,A_Wsg[j]) NEXT REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() ****** Переписать все итоговые строки из БД по моделям и критериям в одну БД VerModClsIT.dbf SELECT VerModObjIT APPEND BLANK FOR j=4 TO 32 FIELDPUT(j,A_Wsg[j]) NEXT REPLACE Date WITH DTOC(DATE()) REPLACE Time WITH TIME() CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций RETURN NIL ******** Расчет интегрального качества распознавания объектов N°Ist *************** ******** Модифицированный вариант для "Эйдос-астра" FUNCTION DOSTOVER1(M_KodObj) S_T_id = 0 // Сумма уровней сходства верно идентифицированных классов S_T_nid = 0 // Сумма уровней сходства верно неидентифицированных классов S_F_id = 0 // Сумма уровней сходства ошибочно идентифицированных классов S_F_nid = 0 // Сумма уровней сходства ошибочно неидентифицированных классов N_T_id = 0 // Количество верно идентифицированных классов N_T_nid = 0 // Количество верно неидентифицированных классов N_F_id = 0 // Количество ошибочно идентифицированных классов N_F_nid = 0 // Количество ошибочно неидентифицированных классов M_DostS = 0 // Достоверность с учетом уровня сходства объектов с классами M_DostN = 0 // Достоверность с учетом количества логических объектов M_NObj = 0 // Количество классов в карточке идентификации респондента M_Alias = SELECT() M_Recno = RECNO() IF R_Dost = "Y" SELECT Rasp1;SET ORDER TO 1;T=DBSEEK(STR(M_KodObj,19)) IF T SET ORDER TO DO WHILE .NOT. EOF() .AND. Kod_obj=M_KodObj DO CASE CASE Korr > 0 IF ASCAN(Ar_Kcl, Kod_cls) > 0 S_T_id = S_T_id + Korr ++N_T_id ELSE S_F_id = S_F_id + Korr ++N_F_id ENDIF CASE Korr < 0 IF ASCAN(Ar_Kcl, Kod_cls) > 0 S_F_nid = S_F_nid + ABS(Korr) ++N_F_nid ELSE S_T_nid = S_T_nid + ABS(Korr) ++N_T_nid ENDIF ENDCASE ++M_NObj DBSKIP(1) ENDDO ** Сумма верно идентифицированных и неидентифицированных классов ** минус ошибочно идентифицированных и неидентифицированных классов ** деленная на количество классов (среднее на класс) M_DostS = (S_T_id+S_T_nid-S_F_id-S_F_nid)/M_NObj // Моя метрика, сходная с F-мерой M_DostN = (N_T_id+N_T_nid-N_F_id-N_F_nid)/M_NObj ** M_NObj = N_T_id+N_T_nid+N_F_id+N_F_nid // Должно быть так, если все верно ENDIF ENDIF SELECT(M_Alias) DBGOTO(M_Recno) RETURN(M_DostS) ******** Расчет интегрального качества распознавания класса N°Obj ******** Модифицированный вариант для "Эйдос-астра" FUNCTION DOSTOVER2(M_KodCls) S_T_id = 0 // Сумма уровней сходства верно идентифицированных объектов S_T_nid = 0 // Сумма уровней сходства верно неидентифицированных объектов S_F_id = 0 // Сумма уровней сходства ошибочно идентифицированных объектов S_F_nid = 0 // Сумма уровней сходства ошибочно неидентифицированных объектов N_T_id = 0 // Количество верно идентифицированных объектов N_T_nid = 0 // Количество верно неидентифицированных объектов N_F_id = 0 // Количество ошибочно идентифицированных объектов N_F_nid = 0 // Количество ошибочно неидентифицированных объектов M_DostS = 0 // Достоверность с учетом уровня сходства объектов с классами M_DostN = 0 // Достоверность с учетом количества логических объектов M_NResp = 0 // Кол-во объектов в карточке идентификации класса M_Alias = SELECT() M_Recno = RECNO() R_Dost = "Y" IF R_Dost = "Y" SELECT (M_Rsp2);SET ORDER TO 1;T=DBSEEK(STR(M_KodCls,4)) IF T SET ORDER TO DO WHILE .NOT. EOF() .AND. Kod_cls=M_KodCls M_KodObj = Kod_obj SELECT Rso_zag;SET ORDER TO 1;T = DBSEEK(STR(M_KodObj,19)) PUBLIC Ar_Kcl := {} IF T ***** Массив кодов классов, к которым действительно относится данный источник FOR j=3 TO FCOUNT()-4 M_kkl = FIELDGET(j) IF M_kkl > 0 IF ASCAN(Ar_Kcl, M_kkl) = 0 AADD(Ar_Kcl, M_kkl) ENDIF ENDIF NEXT ENDIF SELECT (M_Rsp2) DO CASE CASE Korr > 0 IF ASCAN(Ar_Kcl, Kod_cls) > 0 S_T_id = S_T_id + Korr ++N_T_id ELSE S_F_id = S_F_id + Korr ++N_F_id ENDIF CASE Korr < 0 IF ASCAN(Ar_Kcl, Kod_cls) > 0 S_F_nid = S_F_nid + ABS(Korr) ++N_F_nid ELSE S_T_nid = S_T_nid + ABS(Korr) ++N_T_nid ENDIF ENDCASE ++M_NResp DBSKIP(1) ENDDO ** Сумма верно идентифицированных и неидентифицированных объектов ** минус ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество логических объектов (среднее на респондента) M_DostS = (S_T_id+S_T_nid-S_F_id-S_F_nid)/M_NResp M_DostN = (N_T_id+N_T_nid-N_F_id-N_F_nid)/M_NResp ** M_NResp = N_T_id+N_T_nid+N_F_id+N_F_nid // Должно быть так, если все верно ENDIF ENDIF SELECT(M_Alias) DBGOTO(M_Recno) RETURN(M_DostS) ******** Генерация индексных массивов БД валидности FUNCTION GenNTXVal() aSaveGN13 := DC_DataSave() IF FILE("ValidSys.dbf") CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций USE ValidSys EXCLUSIVE NEW Fm="F1КодF2НаименованиеF3Верн.идентификацияF4Ошиб.неидентификацияF5Общ.достоверность" * USE ValidSys INDEX VAL_kod,VAL_name,VAL_totn,VAL_fnot,VAL_dost EXCLUSIVE NEW INDEX ON STR(Kod_cls,19) TO VAL_kod INDEX ON Name_cls TO VAL_name INDEX ON STR(99999999.9999999-SLAPrOtn,19,7) TO VAL_totn * 123456789012345678 INDEX ON STR(99999999.9999999-SLAOSHNOTN,19,7) TO VAL_fnot INDEX ON STR(99999999.9999999-S_DOST_ID,19,7) TO VAL_dost CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций ENDIF DC_DataRest( aSaveGN13 ) RETURN NIL *********************************************************************************************************** ******** Генерация БД Dost_modCls.dbf ************* *********************************************************************************************************** FUNCTION GenDbfDostModCls() aSaveGenDbf := DC_DataSave() ***** Precision = TP/(TP+FP) - точность ***** Recall = TP/(TP+FN) - полнота ***** F-mera = 2*(Precision*Recall)/(Precision+Recall) ** Мой вариант метрики ************************************************************************************************************ ** Сумма верно идентифицированных и неидентифицированных объектов ** минус ошибочно идентифицированных и неидентифицированных объектов ** деленная на количество объектов (среднее на объект) в процентах * NT = N_T_id+N_T_nid // Количество ВЕРНО идентифицированных и неидентифицированных объектов * NF = N_F_id+N_F_nid // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * NT = A_Rec[ 9] + A_Rec[12] // Количество ВЕРНО идентифицированных и неидентифицированных объектов * NF = A_Rec[11] + A_Rec[10] // Количество ОШИБОЧНО идентифицированных и неидентифицированных объектов * *********************************************************************************************************************************** * M_DVMod = (NT-NF)/(NT+NF)*100 // Дифференциальная валидность (достоверность) модели (по классу) (в знаменателе: "всего объектов") * *********************************************************************************************************************************** CLoseAll() // Закрытие всех баз данных с ожиданием завершения операций aStructure := { { "Type_model" , "C",250, 0 }, ; { "Int_krit" , "C", 40, 0 }, ; { "N_LogObj" , "N", 15, 0 }, ; // 3. Количество логических объектов расп.выборки, фактически относящихся к классу (TP+FN) { "N_T_Ident" , "N", 15, 0 }, ; // 4. Количество верно идентифицированных объектов расп.выборки (TP) { "N_F_NIdent" , "N", 15, 0 }, ; // 5. Количество ошибочно неидентифицированных объектов расп.выборки (FN) { "N_F_Ident" , "N", 15, 0 }, ; // 6. Количество ошибочно идентифицированных объектов расп.выборки (FP) { "N_T_NIdent" , "N", 15, 0 }, ; // 7. Количество верно неидентифицированных объектов расп.выборки (TN) { "P_T_Ident" , "N", 15, 7 }, ; // 8. Вероятность верной идентификации объекта с классом с использованием модели { "P_T_NIdent" , "N", 15, 7 }, ; // 9. Вероятность верной не идентификации объекта с классом с использованием модели { "P_F_Ident" , "N", 15, 7 }, ; // 10.Вероятность ошибочной идентификации объекта с классом с использованием модели { "P_F_NIdent" , "N", 15, 7 }, ; // 11.Вероятность ошибочной не идентификации объекта с классом с использованием модели { "P_Avr_T" , "N", 15, 7 }, ; // 12.Вероятность верной идентификации или неидентификации объекта с классом с использованием модели (моя мера) { "DVMod" , "N", 15, 7 }, ; // 13.M_DVMod = (NT-NF)/(NT+NF)*100 Моя мера качества модели-классификатора (в знаменателе: "всего объектов") { "Precision" , "N", 15, 7 }, ; // 14.Precision = TP/(TP+FP) - точность { "Recall" , "N", 15, 7 }, ; // 15.Recall = TP/(TP+FN) - полнота { "F_mera" , "N", 15, 7 }, ; // 16.F-mera = 2*(Precision*Recall)/(Precision+Recall) (мультиклассовый вариант) { "S_T_Ident" , "N", 15, 7 }, ; // 17.Сумма модулей уровней сходства верно идентифицированных объектов расп.выборки { "S_F_NIdent" , "N", 15, 7 }, ; // 18.Сумма модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки { "S_F_Ident" , "N", 15, 7 }, ; // 19.Сумма модулей уровней сходства ошибочно идентифицированных объектов расп.выборки { "S_T_NIdent" , "N", 15, 7 }, ; // 20.Сумма модулей уровней сходства верно неидентифицированных объектов расп.выборки { "SPrecision" , "N", 15, 7 }, ; // 21.SPrecision = STP/(STP+SFP) - точность с учетом уровней сходства { "SRecall" , "N", 15, 7 }, ; // 22.SRecall = STP/(STP+SFN) - полнота с учетом уровней сходства { "L1_mera" , "N", 15, 7 }, ; // 23.L1-mera = 2*(SPrecision*SRecall)/(SPrecision+SRecall) (L1-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение F-меры Ван Ризбергена) { "A_T_IDENT" , "N", 15, 7 }, ; // 24.Среднее модулей уровней сходства верно идентифицированных объектов расп.выборки (ATP=STP/TP) { "A_F_NIDENT" , "N", 15, 7 }, ; // 25.Среднее модулей уровней сходства ошибочно неидентифицированных объектов расп.выборки (AFN=SFN/FN) { "A_F_IDENT " , "N", 15, 7 }, ; // 26.Среднее модулей уровней сходства ошибочно идентифицированных объектов расп.выборки (AFP=SFP/FP) { "A_T_NIDENT" , "N", 15, 7 }, ; // 27.Среднее модулей уровней сходства верно неидентифицированных объектов расп.выборки (ATN=STN/TN) { "APRECISION" , "N", 15, 7 }, ; // 28.APrecision = ATP/(ATP+AFP) - точность с учетом уровней сходства { "ARECALL" , "N", 15, 7 }, ; // 29.ARecall = ATP/(ATP+AFN) - полнота с учетом уровней сходства { "L2_MERA" , "N", 15, 7 }, ; // 30.L2-mera = 2*(APrecision*ARecall)/(APrecision+ARecall) (L2-мера проф.Е.В.Луценко - нечеткое мультиклассовое обобщение { "Date" , "C", 10, 0 }, ; // 31.Дата формирования записи БД { "Time" , "C", 8, 0 } } // 32.Время формирования записи БД DbCreate( "Dost_modCls.dbf", aStructur