DCPROGRESS oProgress no increase in line
Posted: Sun Aug 03, 2014 1:45 am
I have been successfully using the structure:
However, for some reason, there is no increase in line progress bar in this case, which I need:
[/size]
Can tell me what to fix?
Checked all the variables are assigned the correct values, including mTime423
Code: Select all
LOCAL Getlist := {}, oProgress, oDialog
SELECT Gr_OpSc
Mess = '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
DC_GetProgress(oProgress, ++nTime, nMax)
NEXT
DC_GetProgress(oProgress,nMax,nMax)
oDialog:Destroy()
Code: Select all
****************************************************************************************
******** 4.2.3. Когнитивные диаграммы классов
****************************************************************************************
FUNCTION F4_2_3()
LOCAL GetList := {}, aPres, oBrowse, oToolBar, aColors, bColor, GetOptions
LOCAL oProgress, oDialog
IF M_KodAdmAppls = 0 // Выйти из системы если нет авторизации
LB_Warning("Вы не авторизовались в системе (режим 1.1) и не можете ей пользоваться!")
RETURN NIL
ENDIF
IF ApplChange() // Перейти в папку выбранного приложения или выйти из системы
LB_Warning("Необходимо задать (выбрать) хотя бы одно текущее приложение !!!")
RETURN NIL
ENDIF
**** Проверить, существуют ли матрицы сходства классов и признаков, необходимые для выполнения режима
Ar_Model := { "Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" }
FOR j=1 TO LEN(Ar_Model)
mName = "SxodCls"+Ar_Model[j]+".dbf"
IF .NOT. FILE(mName)
Mess = "Отсуствует матрица сходства классов: "+mName+". Необходимо выполнить режим 4.2.2.1."
LB_Warning(Mess, '4.2.3. Когнитивные диаграммы классов')
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
ENDIF
NEXT
FOR j=1 TO LEN(Ar_Model)
mName = "SxodAtr"+Ar_Model[j]+".dbf"
IF .NOT. FILE(mName)
Mess = "Отсуствует матрица сходства признаков: "+mName+". Необходимо выполнить режим 4.3.2.1."
LB_Warning(Mess, '4.2.3. Когнитивные диаграммы классов')
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
ENDIF
NEXT
***** Создание БД для задания диапазонов признаков по описательным шкалам
IF .NOT. FILE("Classes.dbf") // БД градаций класс.шкал + градаций класс.шкал: Classes.dbf
LB_Warning('Отсуствует БД классификационных шкал и градаций: "Classes.dbf". Зайдите в режим 2.1', '4.2.3. Когнитивные диаграммы классов')
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
ENDIF
CLOSE ALL
USE Classes EXCLUSIVE NEW
SELECT Classes
mLenMax = -99999
DBGOTOP()
DO WHILE .NOT. EOF()
mLenMax = MAX(mLenMax, LEN(ALLTRIM(NAME_CLS)))
DBSKIP(1)
ENDDO
aStr := { { "KOD_ClS" , "N", 15, 0 }, ;
{ "NAME_ClS", "C",mLenMax, 0 } }
DbCreate( 'ClassesKD.dbf', aStr )
CLOSE ALL
USE Classes EXCLUSIVE NEW
USE ClassesKD EXCLUSIVE NEW;ZAP
SELECT ClassesKD
APPEND BLANK
REPLACE KOD_ClS WITH 0
REPLACE NAME_ClS WITH "ВСЕ КЛАССЫ"
SELECT Classes
DBGOTOP()
DO WHILE .NOT. EOF()
mKodClS = KOD_ClS
mNameClS = NAME_ClS
SELECT ClassesKD
APPEND BLANK
REPLACE KOD_ClS WITH mKodClS
REPLACE NAME_ClS WITH mNameClS
SELECT Classes
DBSKIP(1)
ENDDO
***** Создание БД для задания диапазонов признаков по описательным шкалам
*MinMaxGrOpSc() // Формирование минимального и максимального кодов градаций описательных шкал (включено в ApplChange())
IF .NOT. FILE("Opis_Sc.dbf") // БД градаций описательных шкал
LB_Warning('Отсуствует БД описательных шкал: "Opis_Sc.dbf". Зайдите в режим 2.1', '4.2.3. Когнитивные диаграммы классов')
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
ENDIF
CLOSE ALL
USE Opis_Sc EXCLUSIVE NEW
SELECT Opis_Sc
mLenMax = -99999
DBGOTOP()
DO WHILE .NOT. EOF()
mLenMax = MAX(mLenMax, LEN(ALLTRIM(NAME_OpSc)))
DBSKIP(1)
ENDDO
aStr := { { "KOD_OpSc" , "N", 15, 0 }, ;
{ "NAME_OpSc" , "C",mLenMax, 0 }, ;
{ "KodGr_min" , "N", 15, 0 }, ; // Минимальный код градаций описательной шкалы
{ "KodGr_max" , "N", 15, 0 } } // Максимальный код градаций описательной шкалы
DbCreate( 'Opis_ScKD.dbf', aStr )
CLOSE ALL
USE Opis_Sc EXCLUSIVE NEW
USE Opis_ScKD EXCLUSIVE NEW;ZAP
USE Attributes EXCLUSIVE NEW
SELECT Attributes
DBGOTOP()
mKodGrMin = Kod_atr
DBGOBOTTOM()
mKodGrMax = Kod_atr
SELECT Opis_ScKD
APPEND BLANK
REPLACE KOD_OpSc WITH 0
REPLACE NAME_OpSc WITH "ВСЕ ОПИСАТЕЛЬНЫЕ ШКАЛЫ"
REPLACE KodGr_min WITH mKodGrMin
REPLACE KodGr_max WITH mKodGrMax
SELECT Opis_Sc
DBGOTOP()
DO WHILE .NOT. EOF()
mKodOpSc = KOD_OpSc
mNameOpSc = NAME_OpSc
mKodGrMin = KodGr_min
mKodGrMax = KodGr_max
SELECT Opis_ScKD
APPEND BLANK
REPLACE KOD_OpSc WITH mKodOpSc
REPLACE NAME_OpSc WITH mNameOpSc
REPLACE KodGr_min WITH mKodGrMin
REPLACE KodGr_max WITH mKodGrMax
SELECT Opis_Sc
DBSKIP(1)
ENDDO
***** ДИАЛОГ ЗАДАНИЯ ПАРАМЕТРОВ **************
// Если ранее параметры были заданы - скачать массив, иначе сформировать и записать в папке приложения
IF .NOT. FILE("_4_2_3.arx")
PUBLIC aParKD[14]
aParKD[ 1] = 0 // Код класса левого инф.портрета
aParKD[ 2] = 0 // Код класса правого инф.портрета
aParKD[ 3] = 0 // Код оп.шкалы левого инф.портрета
aParKD[ 4] = 0 // Код оп.шкалы правого инф.портрета
aParKD[ 5] = .T. // Модель Abs задана для расчетов
aParKD[ 6] = .T. // Модель Prc1 задана для расчетов
aParKD[ 7] = .T. // Модель Prc2 задана для расчетов
aParKD[ 8] = .T. // Модель Inf1 задана для расчетов
aParKD[ 9] = .T. // Модель Inf2 задана для расчетов
aParKD[10] = .T. // Модель Inf3 задана для расчетов
aParKD[11] = .T. // Модель Inf4 задана для расчетов
aParKD[12] = .T. // Модель Inf5 задана для расчетов
aParKD[13] = .T. // Модель Inf6 задана для расчетов
aParKD[14] = .T. // Модель Inf7 задана для расчетов
DC_ASave(aParKD , "_4_2_3.arx")
ELSE
aParKD = DC_ARestore("_4_2_3.arx")
ENDIF
CLOSE ALL
USE ClassesKD EXCLUSIVE NEW
USE Opis_ScKD EXCLUSIVE NEW
****** Подготовка для отображения заданных параметров
SELECT ClassesKD
DBGOTO(1+aParKD[ 1]);mNameCls = Name_Cls
PUBLIC mKNClsLeft := 'Класс для левого инф.портрета: ['+ALLTRIM(STR(aParKD[ 1], 15))+'] '+ALLTRIM(mNameCls)
DBGOTO(1+aParKD[ 2]);mNameCls = Name_Cls
PUBLIC mKNClsRight := 'Класс для правого инф.портрета: ['+ALLTRIM(STR(aParKD[ 2], 15))+'] '+ALLTRIM(mNameCls)
DBGOTOP()
SELECT Opis_ScKD
DBGOTO(1+aParKD[ 3]);mNameOpSc = Name_OpSc
PUBLIC mKNOpScLeft := 'Описательная шкала для левого инф.портрета: ['+ALLTRIM(STR(aParKD[ 3], 15))+'] '+ALLTRIM(mNameOpSc)
DBGOTO(1+aParKD[ 4]);mNameOpSc = Name_OpSc
PUBLIC mKNOpScRight := 'Описательная шкала для правого инф.портрета: ['+ALLTRIM(STR(aParKD[ 4], 15))+'] '+ALLTRIM(mNameOpSc)
DBGOTOP()
Ar_Model := { "Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" }
PUBLIC aSay[14]
mModels = 'Модели, заданные для расчета: '
FlagFirst = .T.
FOR j=5 TO 14
IF aParKD[ j]
mModels = mModels+IF(FlagFirst,"",", ")+Ar_Model[j-4]
FlagFirst = .F.
ENDIF
NEXT
/* ----- Create browse ----- */
@ 0,0 DCGROUP oGroup1 CAPTION 'Выбор классов для когнитивной диаграммы' SIZE 135,14.5
@ 1,2 DCSAY 'Задайте коды двух классов, для левого и правого информационных портретов когнитивной диаграммы' PARENT oGroup1 SIZE 0 FONT "10.Helv Bold" COLOR GRA_CLR_DARKBLUE
@ 2,2 DCSAY 'по очереди выбирая их курсором в таблице и кликая на соответствующей кнопке ниже нее' PARENT oGroup1 SIZE 0 FONT "10.Helv Bold" COLOR GRA_CLR_DARKBLUE
@ 3,2 DCBROWSE oBrowse ALIAS 'ClassesKD' SIZE 131,9 HEADLINES 1 PARENT oGroup1 // Кол-во строк в заголовке (перенос строки - ";")
DCBROWSECOL FIELD ClassesKD->Kod_cls HEADER 'Код' PARENT oBrowse WIDTH 5 PROTECT {|| .T. }
DCBROWSECOL FIELD ClassesKD->Name_cls HEADER 'Наименование класса' PARENT oBrowse WIDTH 75 PROTECT {|| .T. }
DCGETOPTIONS TABSTOP
@ 12.5, 15 DCPUSHBUTTON CAPTION 'Выбор кода класса левого инф.портрета' SIZE 2+LEN("Выбор кода класса левого инф.портрета"), 1.1 ACTION {||KodClsLeft() , DC_GetRefresh(GetList)} PARENT oGroup1
@ DCGUI_ROW, DCGUI_COL+150 DCPUSHBUTTON CAPTION 'Выбор кода класса правого инф.портрета' SIZE 2+LEN("Выбор кода класса правого инф.портрета"), 1.1 ACTION {||KodClsRight(), DC_GetRefresh(GetList)} PARENT oGroup1
/* ----- Create browse ----- */
@15,0 DCGROUP oGroup2 CAPTION 'Выбор способа фильтрации признаков в информационных портретах когнитивной диаграммы' SIZE 135,14.5
@ 1,2 DCSAY 'Задайте коды двух описательных шкал, для левого и правого информационных портретов когнитивной' PARENT oGroup2 SIZE 0 FONT "10.Helv Bold" COLOR GRA_CLR_DARKRED
@ 2,2 DCSAY 'диаграммы по очереди выбирая их курсором в таблице и кликая на соответствующей кнопке ниже нее' PARENT oGroup2 SIZE 0 FONT "10.Helv Bold" COLOR GRA_CLR_DARKRED
@ 3,2 DCBROWSE oBrowse ALIAS 'Opis_ScKD' SIZE 131,9 HEADLINES 2 PARENT oGroup2 // Кол-во строк в заголовке (перенос строки - ";")
DCBROWSECOL FIELD Opis_ScKD->KOD_OpSc HEADER 'Код' PARENT oBrowse WIDTH 5 PROTECT {|| .T. }
DCBROWSECOL FIELD Opis_ScKD->NAME_OpSc HEADER 'Наименование;описательной шкалы' PARENT oBrowse WIDTH 58.7 PROTECT {|| .T. }
DCBROWSECOL FIELD Opis_ScKD->KodGr_min HEADER 'Минимальный; код градации' PARENT oBrowse WIDTH 7 PROTECT {|| .T. }
DCBROWSECOL FIELD Opis_ScKD->KodGr_max HEADER 'Максимальный;код градации' PARENT oBrowse WIDTH 8 PROTECT {|| .T. }
DCGETOPTIONS TABSTOP
@ 12.5, 10 DCPUSHBUTTON CAPTION 'Выбор кода описательной шкалы левого инф.портрета' SIZE 2+LEN("Выбор кода описательной шкалы левого инф.портрета"), 1.1 ACTION {||KodOpScLeft() , DC_GetRefresh(GetList)} PARENT oGroup2
@ DCGUI_ROW, DCGUI_COL+70 DCPUSHBUTTON CAPTION 'Выбор кода описательной шкалы правого инф.портрета' SIZE 2+LEN("Выбор кода описательной шкалы правого инф.портрета"), 1.1 ACTION {||KodOpScRight(), DC_GetRefresh(GetList)} PARENT oGroup2
/* ----- Create ToolBar ----- */
@30,0 DCGROUP oGroup3 CAPTION 'Задайте модели, в которых проводить расчеты когнитивных диаграмм' SIZE 135,2.7 // ABS, PRC1, PRC2, INF#
D = 29.5
@ 1, 10 DCCHECKBOX aParKD[ 5] PROMPT 'Abs' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[ 6] PROMPT 'Prc1' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[ 7] PROMPT 'Prc2' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[ 8] PROMPT 'Inf1' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[ 9] PROMPT 'Inf2' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[10] PROMPT 'Inf3' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[11] PROMPT 'Inf4' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[12] PROMPT 'Inf5' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[13] PROMPT 'Inf6' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D DCCHECKBOX aParKD[14] PROMPT 'Inf7' ACTION {||TakeModels(), DC_GetRefresh(GetList)} PARENT oGroup3
@ DCGUI_ROW, DCGUI_COL+D+0.1 DCPUSHBUTTON CAPTION 'Помощь' SIZE 2+LEN("Помощь"), 1.1 ACTION {||Help423(), DC_GetRefresh(GetList)} PARENT oGroup3
/* ----- Create ToolBar ----- */
@33.2,0 DCGROUP oGroup4 CAPTION 'В диалоге заданы следующие параметры расчета когнитивных диаграмм:' SIZE 135,6.5
PUBLIC aSay[14]
@ 1,2 DCSAY {|| mKNClsLeft } OBJECT aSay[1] SAYSIZE 131 PARENT oGroup4 FONT "10.Helv Bold" COLOR GRA_CLR_DARKBLUE // Класс для левого инф.портрета
@ 2,2 DCSAY {|| mKNClsRight } OBJECT aSay[2] SAYSIZE 131 PARENT oGroup4 FONT "10.Helv Bold" COLOR GRA_CLR_DARKBLUE // Класс для левого инф.портрета
@ 3,2 DCSAY {|| mKNOpScLeft } OBJECT aSay[3] SAYSIZE 131 PARENT oGroup4 FONT "10.Helv Bold" COLOR GRA_CLR_DARKRED // Оп.шкала для левого инф.портрета
@ 4,2 DCSAY {|| mKNOpScRight} OBJECT aSay[4] SAYSIZE 131 PARENT oGroup4 FONT "10.Helv Bold" COLOR GRA_CLR_DARKRED // Оп.шкала для левого инф.портрета
FOR j=5 TO 14
@ 5,2 DCSAY {|| mModels } OBJECT aSay[j] SAYSIZE 131 PARENT oGroup4 FONT "10.Helv Bold" COLOR GRA_CLR_BLACK // Модели, заданные для расчета
NEXT
DCREAD GUI ;
TO lExit ;
FIT ;
ADDBUTTONS;
OPTIONS GetOptions ;
MODAL ;
TITLE '4.2.3. Когнитивные диаграммы классов. Задание параметров генерации выходных форм'
********************************************************************
IF lExit
** Button Ok
ELSE
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
RETURN NIL
ENDIF
********************************************************************
DC_ASave(aParKD , "_4_2_3.arx") // Записать параметры для расчетов когнитивных диаграмм, заданнеы в диалоге
***** КОНЕЦ ДИАЛОГА ЗАДАНИЯ ПАРАМЕТРОВ *****************************
***** РАСЧЕТ БАЗ ДАННЫХ ДЛЯ ОТОБРАЖЕНИЯ КОГНИТИВНЫХ ДИАГРАММ *******
* aParKD[ 1] = 0 // Код класса левого инф.портрета
* aParKD[ 2] = 0 // Код класса правого инф.портрета
* aParKD[ 3] = 0 // Код оп.шкалы левого инф.портрета
* aParKD[ 4] = 0 // Код оп.шкалы правого инф.портрета
* aParKD[ 5] = .T. // Модель Abs задана для расчетов
* aParKD[ 6] = .T. // Модель Prc1 задана для расчетов
* aParKD[ 7] = .T. // Модель Prc2 задана для расчетов
* aParKD[ 8] = .T. // Модель Inf1 задана для расчетов
* aParKD[ 9] = .T. // Модель Inf2 задана для расчетов
* aParKD[10] = .T. // Модель Inf3 задана для расчетов
* aParKD[11] = .T. // Модель Inf4 задана для расчетов
* aParKD[12] = .T. // Модель Inf5 задана для расчетов
* aParKD[13] = .T. // Модель Inf6 задана для расчетов
* aParKD[14] = .T. // Модель Inf7 задана для расчетов
** ПОДГОТОВКА ПРЕДЕЛОВ ЦИКЛОВ ПО КЛАССАМ ЛЕВОГО И ПРАВОГО ИНФОРМАЦИОННЫХ ПОРТРЕТОВ
* Если aParKD[ 1] = 0, то цикл по классам от 1-го до последнего, какие есть в БД Classes.dbf
* иначе цикл от класса с кодом aParKD[ 1] до класса с кодом aParKD[ 1]
CLOSE ALL
USE Classes EXCLUSIVE NEW;N_Cls = RECCOUNT()
SELECT Classes
IF aParKD[ 1] = 0
DBGOTOP()
mCls1Left = Kod_cls
DBGOBOTTOM()
mCls2Left = Kod_cls
ELSE
mCls1Left = aParKD[ 1]
mCls2Left = aParKD[ 1]
ENDIF
* Если aParKD[ 2] = 0, то цикл по классам от 1-го до последнего, какие есть в БД Classes.dbf
* иначе цикл от класса с кодом aParKD[ 2] до класса с кодом aParKD[ 2]
IF aParKD[ 2] = 0
DBGOTOP()
mCls1Right = Kod_cls
DBGOBOTTOM()
mCls2Right = Kod_cls
ELSE
mCls1Right = aParKD[ 2]
mCls2Right = aParKD[ 2]
ENDIF
***** Окрыть текстовые базы данных моделей
* ###########################################################################
// Открытие текстовых баз данных ********************************************
*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
PUBLIC Len_LcBuf := LEN(Lc_buf)
****** Открываем стат.базы и базы знаний (7 по частным критериям знаний)
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
**** Рассчет массива начальных позиций полей в строке
PUBLIC aPos[N_Col]
aPos[1] = 1
FOR j=2 TO N_Col
aPos[j] = aPos[j-1] + aInfStruct[j-1,3]
NEXT
* ###########################################################################
***** Определение максимальной длины полного наименования признака: шкала+признак
CLOSE ALL
USE Attributes EXCLUSIVE NEW
mLenMax = -999999
SELECT Attributes
DBGOTOP()
DO WHILE .NOT. EOF()
mLenMax = MAX(mLenMax, LEN(ALLTRIM(Name_atr)))
DBSKIP(1)
ENDDO
// Сформировать пустую БД InfPortCls, как часть БД Attributes
aStr := { { "Kod_atr" , "N", 15, 0 }, ;
{ "Name_atr" , "C", mLenMax, 0 }, ;
{ "Znach" , "N", 19, 7 }, ;
{ "Kod_OpSc" , "N", 15, 0 }, ;
{ "Fltr_Wind", "C", 1, 0 } } // Для фильтра "Вписать в окно"
DbCreate( "InfPortCls", aStr )
Ar_Model := { "Abs","Prc1","Prc2","Inf1","Inf2","Inf3","Inf4","Inf5","Inf6","Inf7" }
mMax423 = (mCls2Left - mCls1Left + 1) * (mCls2Right - mCls1Right + 1)
mTime423 = 0
@ 4,5 DCPROGRESS oProgress SIZE 70,1.1 MAXCOUNT mMax423 COLOR GRA_CLR_CYAN PERCENT EVERY 100
DCREAD GUI TITLE '4.2.3. Когнитивные диаграммы классов. Генерация выходных форм' PARENT @oDialog FIT EXIT
oDialog:show()
DC_GetProgress(oProgress,0,mMax423)
FOR mClsLeft = mCls1Left TO mCls2Left // ЦИКЛ ПО КЛАССАМ ЛЕВОГО ИНФОРМАЦИОННОГО ПОРТРЕТА ***********
FOR mClsRight = mCls1Right TO mCls2Right // ЦИКЛ ПО КЛАССАМ ПРАВОГО ИНФОРМАЦИОННОГО ПОРТРЕТА **********
FOR mNumbMod = 1 TO LEN(Ar_Model) // ЦИКЛ ПО ВСЕМ МОДЕЛЯМ **************************************
IF aParKD[mNumbMod+4] // ПРОВЕРКА НА ТО, ЗАДАНА ЛИ ОЧЕРЕДНАЯ МОДЕЛЬ ****************
***** ГЕНЕРАЦИЯ ИНФОРМАЦИОННЫХ ПОРТРЕТОВ КЛАССОВ mClsLeft и mClsRight
***** Генерация информационного портрета класса в модели: Ar_Model[M_CurrInf] для класса mCls
mPrtClsLeftMod = "PrtClsLeft" +Ar_Model[mNumbMod] // Наименование БД левого инф.портрета в текущей модели
mPrtClsRightMod = "PrtClsRight"+Ar_Model[mNumbMod] // Наименование БД правого инф.портрета в текущей модели
CLOSE ALL
USE Classes EXCLUSIVE NEW
USE Attributes EXCLUSIVE NEW
USE InfPortCls EXCLUSIVE NEW
InfPortCls423(mNumbMod, mClsLeft)
CLOSE ALL
COPY FILE ("InfPortCls.dbf") TO (mPrtClsLeftMod+".dbf")
CLOSE ALL
USE Classes EXCLUSIVE NEW
USE Attributes EXCLUSIVE NEW
USE InfPortCls EXCLUSIVE NEW
InfPortCls423(mNumbMod, mClsRight)
CLOSE ALL
COPY FILE ("InfPortCls.dbf") TO (mPrtClsRightMod+".dbf")
***** Если не заданы все описательные шкалы,
***** то исключение из потрета тех признаков,
***** которые не попадают в заданные шкалы.
***** Сделать это и для левого, и для правого инф.портретов
* aParKD[ 3] = 0 // Код оп.шкалы левого инф.портрета
* aParKD[ 4] = 0 // Код оп.шкалы правого инф.портрета
IF aParKD[ 3] <> 0
CLOSE ALL
USE (mPrtClsLeftMod) EXCLUSIVE NEW
DELETE FOR Kod_OpSc <> aParKD[ 3]
PACK
ENDIF
IF aParKD[ 4] <> 0
CLOSE ALL
USE (mPrtClsRightMod) EXCLUSIVE NEW
DELETE FOR Kod_OpSc <> aParKD[ 4]
PACK
ENDIF
******* Формирование массивов кодов признаков, которые встречаются
******* хотя бы в одном из портретов и, заодно, расчет средних и ср.кв.откл.
CLOSE ALL
USE (mPrtClsLeftMod) EXCLUSIVE NEW
USE (mPrtClsRightMod) EXCLUSIVE NEW
mSr1 = 0
aKodAtr1 := {}
aKodOpSc1 := {}
aNameAtr1 := {}
aInfAtr1 := {}
SELECT (mPrtClsLeftMod)
INDEX ON STR(Kod_atr,15) TO PrtClsLeft
DBGOTOP()
mN1 = RECCOUNT()
DO WHILE .NOT. EOF()
mSr1 = mSr1 + Znach
AADD(aKodAtr1 , Kod_atr )
AADD(aKodOpSc1, Kod_OpSc)
AADD(aNameAtr1, Name_atr)
AADD(aInfAtr1 , Znach )
DBSKIP(1)
ENDDO
mSr1 = mSr1 / mN1
*** Расчет ср.кв.откл. информативностей 1-го (т.е. левого) инф.портрета
mDi1 = 0
FOR j=1 TO LEN(aInfAtr1)
mDi1 = mDi1 + (aInfAtr1[j]-mSr1)^2
NEXT
mDi1 = SQRT(mDi1/(LEN(aInfAtr1)-1))
mSr2 = 0
aKodAtr2 := {}
aKodOpSc2 := {}
aNameAtr2 := {}
aInfAtr2 := {}
SELECT (mPrtClsRightMod)
INDEX ON STR(Kod_atr,15) TO PrtClsRight
DBGOTOP()
mN2 = RECCOUNT()
DO WHILE .NOT. EOF()
mSr2 = mSr2 + Znach
AADD(aKodAtr2 , Kod_atr)
AADD(aKodOpSc2, Kod_OpSc)
AADD(aNameAtr2, Name_atr)
AADD(aInfAtr2 , Znach)
DBSKIP(1)
ENDDO
mSr2 = mSr2 / mN2
*** Расчет ср.кв.откл. информативностей 2-го (т.е. правого) инф.портрета
mDi2 = 0
FOR j=1 TO LEN(aInfAtr2)
mDi2 = mDi2 + (aInfAtr2[j]-mSr2)^2
NEXT
mDi2 = SQRT(mDi2/(LEN(aInfAtr2)-1))
***** СОЗДАТЬ БД СВЯЗЕЙ КЛАССОВ ДЛЯ ТЕКУЩЕЙ МОДЕЛИ *************
CLOSE ALL
aStr := { { "Kod_atr" , "N", 15, 0},;
{ "Kod_OpSc", "N", 15, 0},;
{ "Name_atr", "C", mLenMax, 0} }
FOR j=1 TO LEN(aKodAtr2)
FieldName = "P"+ALLTRIM(STR(aKodAtr2[j],15))
AADD( aStr, { FieldName, "N", 19, 7 } )
NEXT
mRelClsMod = "RelCls"+Ar_Model[mNumbMod]
DbCreate( mRelClsMod, aStr )
*** Заполнить БД связей
CLOSE ALL
USE (mRelClsMod) EXCLUSIVE NEW
USE (mPrtClsLeftMod) INDEX PrtClsLeft EXCLUSIVE NEW
USE (mPrtClsRightMod) INDEX PrtClsRight EXCLUSIVE NEW
mSxodAtrMod = "SxodAtr"+Ar_Model[mNumbMod]
USE (mSxodAtrMod) EXCLUSIVE NEW
SELECT (mRelClsMod)
FOR i=1 TO LEN(aKodAtr1)
APPEND BLANK
REPLACE Kod_atr WITH aKodAtr1 [i]
REPLACE Kod_OpSc WITH aKodOpSc1[i]
REPLACE Name_atr WITH aNameAtr1[i]
SELECT (mSxodAtrMod)
DBGOTO(aKodAtr1[i])
aK12 := {} // Расчет среднего и ср.кв.откл. для коэф.корр. для даипазона признаков 2-го портрета
mSrK12 = 0
FOR j=1 TO LEN(aKodAtr2)
mK12 = FIELDGET(3+aKodAtr2[j])
AADD(aK12, mK12)
mSrK12 = mSrK12 + mK12
NEXT
mSrK12 = mSrK12 / LEN(aK12)
*** Расчет ср.кв.откл. информативностей 2-го (т.е. правого) инф.портрета
mDiK12 = 0
FOR j=1 TO LEN(aK12)
mDiK12 = mDiK12 + (aK12[j]-mSrK12)^2
NEXT
mDiK12 = SQRT(mDiK12/(LEN(aK12)-1))
****** Расчет силы связи в стандартизированных величинах (точно как коэффициент корреляции, только не два, а три массива)
SELECT (mRelClsMod)
FOR j=1 TO LEN(aKodAtr2)
mRelStand = ((aK12[j]-mSrK12)/mDiK12)*((aInfAtr1[i]-mSr1)/mDi1)*((aInfAtr2[j]-mSr2)/mDi2)
FIELDPUT( FIELDNUM("P"+ALLTRIM(STR(aKodAtr2[j],15))), mRelStand )
NEXT
NEXT
****** Дописать в (mRelClsMod) информационные строки о горизонтальной шапке
SELECT (mRelClsMod)
APPEND BLANK
REPLACE Name_atr WITH 'Имена колонок: P'+REPLICATE("#",100)
FOR i=1 TO LEN(aKodAtr2)
APPEND BLANK
REPLACE Kod_atr WITH aKodAtr2 [i]
REPLACE Kod_OpSc WITH aKodOpSc2[i]
REPLACE Name_atr WITH aNameAtr2[i]
NEXT
**** СОЗДАТЬ БАЗУ ДЛЯ ВИЗУАЛИЗАЦИИ ОТНОШЕНИЙ ДВУХ КЛАССОВ (mRelViewClsMod)
aStr := { { "Num_pp" , "N", 15, 0 }, ;
{ "Kod_atr1" , "N", 15, 0 }, ;
{ "Kod_OpSc1" , "N", 15, 0 }, ;
{ "Name_atr1" , "C", mLenMax, 0 }, ;
{ "Inf_Bit1" , "N", 19, 7 }, ;
{ "Inf_PerTM1", "N", 19, 7 }, ;
{ "Inf_Stand1", "N", 19, 7 }, ;
{ "Kod_atr2" , "N", 15, 0 }, ;
{ "Kod_OpSc2" , "N", 15, 0 }, ;
{ "Name_atr2" , "C", mLenMax, 0 }, ;
{ "Inf_Bit2" , "N", 19, 7 }, ;
{ "Inf_PerTM2", "N", 19, 7 }, ;
{ "Inf_Stand2", "N", 19, 7 }, ;
{ "Kor_12" , "N", 19, 7 }, ;
{ "Kor_12st" , "N", 19, 7 }, ;
{ "Rel_bit" , "N", 19, 7 }, ;
{ "Rel_perTM" , "N", 19, 7 }, ;
{ "Rel_stand" , "N", 19, 7 }, ;
{ "Rang1" , "N", 15, 0 }, ;
{ "Rang2" , "N", 15, 0 } }
mRelViewClsMod = "RelViewCls"+Ar_Model[mNumbMod]
DbCreate( mRelViewClsMod, aStr )
***** ЗАПОЛНИТЬ БАЗУ ДЛЯ ВИЗУАЛИЗАЦИИ ОТНОШЕНИЙ ДВУХ КЛАССОВ (mRelVClsMod)
CLOSE ALL
USE (mSxodAtrMod) EXCLUSIVE NEW
USE (mRelViewClsMod) EXCLUSIVE NEW
USE (mPrtClsLeftMod) EXCLUSIVE NEW
USE (mPrtClsRightMod) EXCLUSIVE NEW
mMaxAbsRel = -99999999 // Фактическая максимальная сила связи
FOR i=1 TO LEN(aKodAtr1)
FOR j=1 TO LEN(aKodAtr2)
SELECT (mSxodAtrMod)
DBGOTO(aKodAtr1[i])
mKor12 = FIELDGET(3+aKodAtr2[j]) // Коэфф.корреляции между признаками, посчитанный по всем признакам
IF ABS(mKor12) > 0 // Показывать только не нулевые связи
******** Расчет показателей
mTeorMaxInf = LOG(N_Cls)/LOG(2) // Теоретически максимальная информативность
mInfPerTM1 = aInfAtr1[i]/mTeorMaxInf*100 // Информативность 1-го пр.в % от теор.MAX-возможной
mInfPerTM2 = aInfAtr2[j]/mTeorMaxInf*100 // Информативность 2-го пр.в % от теор.MAX-возможной
mInfStand1 = (aInfAtr1[i]-mSr1)/mDi1 // Информативность 1-го пр.в стандартизированных величинах
mInfStand2 = (aInfAtr2[j]-mSr2)/mDi2 // Информативность 2-го пр.в стандартизированных величинах
mKor12stan = (aK12[j]-mSrK12)/mDiK12 // Коэффициент корреляции в стандартизированных величинах
mRelBit = mKor12 * aInfAtr1[i] * aInfAtr2[j] // Сила связи в битах
mMaxRelBit = 1 * mTeorMaxInf * mTeorMaxInf // MAX-теоретически возможная сила связи в битах
mRelPercTM = mRelBit / mMaxRelBit * 100 // Сила связи в % от теор.MAX-возможной
mRelStand = mKor12stan * mInfStand1 * mInfStand2 // Сила связи в стандартизированных величинах
SELECT (mRelViewClsMod)
APPEND BLANK
REPLACE Kod_atr1 WITH aKodAtr1 [i]
REPLACE Kod_OpSc1 WITH aKodOpSc1[i]
REPLACE Name_atr1 WITH aNameAtr1[i]
REPLACE Inf_Bit1 WITH aInfAtr1 [i]
REPLACE Inf_PerTM1 WITH mInfPerTM1
REPLACE Inf_stand1 WITH mInfStand1
REPLACE Kod_atr2 WITH aKodAtr2 [j]
REPLACE Kod_OpSc2 WITH aKodOpSc2[j]
REPLACE Name_atr2 WITH aNameAtr2[j]
REPLACE Inf_Bit2 WITH aInfAtr2 [j]
REPLACE Inf_PerTM2 WITH mInfPerTM2
REPLACE Inf_stand2 WITH mInfStand2
REPLACE Kor_12 WITH 0.01*mKor12
REPLACE Kor_12st WITH mKor12stan
REPLACE Rel_bit WITH mRelBit // Сила связи в Bit
REPLACE Rel_perTM WITH mRelPercTM // Сила связи в % от теор.макс.возм.
REPLACE Rel_stand WITH mRelStand // Сила связи в стандартизированных величинах
ENDIF
NEXT
NEXT
SELECT (mRelViewClsMod)
INDEX ON STR(999999.9999999-ABS(Rel_stand),19,7) TO RelViewCls // сделать КД для всех трех видов связей: бит, %бит от ТМ, стандарт. ###############
***** Оставить столько записей с наиболее значимыми связями,
***** чтобы в левом и правом портретах было не более N_Atr признаков
N_Atr = 8 // Количество отображаемых признаков
N_Rel = 10 // Количество отображаемых связей
CLOSE ALL
USE (mRelViewClsMod) INDEX RelViewCls EXCLUSIVE NEW
SELECT (mRelViewClsMod)
SET ORDER TO 1
DBGOTOP()
aKodAtr1 := {} // Коды признаков из 1-го портрета
AADD(aKodAtr1, Kod_atr1)
DO WHILE .NOT. EOF()
IF ASCAN(aKodAtr1, Kod_atr1) = 0
IF LEN(aKodAtr1) <= N_Atr
AADD(aKodAtr1, Kod_atr1)
ELSE
DELETE
ENDIF
ENDIF
DBSKIP(1)
ENDDO
DBGOTOP()
aKodAtr2 := {} // Коды признаков из 1-го портрета
AADD(aKodAtr2, Kod_atr2)
DO WHILE .NOT. EOF()
IF ASCAN(aKodAtr2, Kod_atr2) = 0
IF LEN(aKodAtr2) <= N_Atr
AADD(aKodAtr2, Kod_atr2)
ELSE
DELETE
ENDIF
ENDIF
DBSKIP(1)
ENDDO
mNum = 0 // Количество связей и порядковые номера
DBGOTOP()
DO WHILE .NOT. EOF()
IF mNum <= N_Rel
REPLACE Num_pp WITH ++mNum
ELSE
DELETE
ENDIF
DBSKIP(1)
ENDDO
PACK
INDEX ON STR(999999.9999999-ABS(Rel_stand),19,7) TO RelViewCls // сделать КД для всех трех видов связей: бит, %бит от ТМ, стандарт.
****** ЕСЛИ БАЗА СВЯЗЕЙ ПУСТА - СООБЩЕНИЕ И ВЫХОД
SELECT (mRelViewClsMod)
IF RECCOUNT() = 0
LB_Warning('СТРАННО, НО ПРИ ЗАДАННЫХ УСЛОВИЯХ КЛАССЫ НИКАК НЕ СВЯЗАНЫ !!!', '4.2.3. Когнитивные диаграммы классов')
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
ENDIF
***** ОТОБРАЖЕНИЕ КОГНИТИВНЫХ ДИАГРАММ *****************************
ENDIF // ПРОВЕРКА НА ТО, ЗАДАНА ЛИ ОЧЕРЕДНАЯ МОДЕЛЬ ****************
NEXT // ЦИКЛ ПО ВСЕМ МОДЕЛЯМ **************************************
DC_GetProgress(oProgress, ++mTime423, mMax423)
* MsgBox(STR(mTime423)+STR(mClsLeft)+STR(mClsRight))
NEXT // ЦИКЛ ПО КЛАССАМ ПРАВОГО ИНФОРМАЦИОННОГО ПОРТРЕТА **********
NEXT // ЦИКЛ ПО КЛАССАМ ЛЕВОГО ИНФОРМАЦИОННОГО ПОРТРЕТА ***********
DC_GetProgress(oProgress,mMax423,mMax423)
oDialog:Destroy()
*** Закрыть все текстовые БД ******
FOR z=1 TO LEN(Ar_Model)
FClose( nHandle[z] ) // Закрытие текстовой базы данных ######################################
NEXT
CLOSE ALL
DIRCHANGE(Disk_dir) // Перейти в папку с исполнимым модулем системы
* aSaveMainM := DC_DataSave() // Сохранение вычислительной среды (открытые и текущие БД и индексы)
DC_DataRest( aSaveMainM ) // Восстановление вычислительной среды (открытые и текущие БД и индексы)
ReTURN nil
****************************************************************************************
Can tell me what to fix?
Checked all the variables are assigned the correct values, including mTime423