Программа СОРТКЛАСССПЕКТР
Добавлено: Пн ноя 01, 2010 11:32 pm
Спасибо ГИГОМУ. I know HOW!!!! Хочу ВАМ рассказать.
но все впереди. Тороплюсь!
Главное решение найдено, я ничего не делал двадцать лет – и наконец я вижу структуру геохимии почв г.Екатеринбурга (не ТОЛЬКО картинку, а и идя курсором по СВОЕЙ таблице и вижу все, что я не видел по факторному анализу). Ничего не надо (для сверхскоростной оценки какого-то поля геогеохимгеоэко и дррр полей) кроме НОРМИРОВКИ (НОРМАЛИЗАЦИЯ в ЭКСЕЛЕ) и СОРТИРОВКИ как ЯДРА МАНИПУЛИРОВАНИЯ ДАННЫМИ. Я вижу свинец Берзовского золотого, медь – Пышминского медно-кобальтого и ртуть центра города Екатеринбурга, хромитовые ядра гипербазитов, никелевые оторочи, титановые поля , полные спектры. Не поленитесь почитайте по фактанализу – это я только ВАС заманивал – я только чувствовал, что получится. «ГИГОМ» МЕНЯ ОЗАДАЧИЛ И «КАЛИЙ» на таких картах РАБОТАЕТ. Я знаю почему. В КНИЖКАЖ ЭТОГО НЕТ – Я ЧИТАЛ МНОГО!!! Небольшая доработка и программа и алгоритм нужны любому специалисту в науках о Земле – потом поспорим, сейчас некогда. Я заменил слово СОРТИР на СОРТ и факанализ на фактанализ – я меняюсь. Смотрите картинку – думайте! До свидания.
Программка сделана с детской простотой, но и ИИСУС говорил – будьте как дети.
*Недоделанная для детерминированной классификации ('это старое выражение сейчас доделанное не до конца)
*В.Д.Брусницын 2010
PROCEDURE СОРТКЛАСССПЕКТР
SET TALK OFF
CLEAR
IF ALLTRIM(DBF(1))==""
DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF;
MESSAGE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА ПОКАЗАТЕЛЕЙ";
TITLE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА ПОКАЗАТЕЛЕЙ"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
SELECT 1
USE PROMPT() NOUPDATE
ENDIF
SELECT 1
*Use ?
vorname = DBF(1)
vorname = SUBSTR(vorname,1,LEN(vorname)-4)
imia = "S"
viv_file =vorname+ALLTRIM(imia)+'.dbf'
COPY TO &viv_file AS 1251
USE &viv_file
namen = DBF(1)
summel = ""
beg = f_fiel()
ende = FCOUNT()
FOR i= beg TO ende
one = "f"+ ALLTRIM(STR(i-beg + 1))
ALTER TABLE &namen ADD COLUMN &one N(i-beg + 1)
ENDFOR
ALTER TABLE &namen ADD COLUMN summas N(8,2)
ALTER TABLE DBF(1) ADD COLUMN "Spectr" C(200)
GO TOP
DIMENSION A(ende - beg + 1,3)
DO WHILE !EOF()
FOR J = 1 TO ende - beg + 1
A(J,1)=EVAL(FIELD(beg+J-1))
A(J,2)=FIELD(beg+J-1)
A(J,3)=beg+J-1
ENDFOR
=ASORT(A,1,-1,1)
TXT=""
TXT1=""
TXT2=""
FOR ii = 1 TO ende - beg + 1
TXT=TXT+A[ii,2]
TXT1=TXT1+ALLTRIM(STR(A[ii,3]))
one = "f"+ ALLTRIM(STR(ii))
REPL &one WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,ii)))
TXT2=TXT2+A[ii,2]+" " + STR(A[ii,1],4,1)+" "
ENDFOR
REPL spectr WITH TXT2
SKIP
ENDDO
CALC MAX(LEN(ALLTRIM(spectr))) TO dlsp
ALTER TABLE DBF(1) ALTER COLUMN "Spectr" C(dlsp)
BROWSE
*Подпрограмма f_fiel. Цель - выбор первого элемента для расчета.
*возврвщает номер выбранного поля
*Автор алгоритмов и программы В.Д.Брусницын
PROCEDURE f_fiel
DEFINE POPUP obj_fil PROMPT STRUCTURE;
MESSAGE "ВЫБРАТЬ ПЕРВЫЙ ЭЛЕМЕНТ ДЛЯ РАСЧЕТА";
TITLE "ВЫБРАТЬ ПЕРВЫЙ ЭЛЕМЕНТ ДЛЯ РАСЧЕТА"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
beginn = 1
DO WHILE beginn < FCOUNT()
IF ALLTRIM(UPPER(FIELD(beginn)))==ALLTRIM(UPPER(PROMPT()))
EXIT
ELSE
beginn = beginn + 1
ENDIF
ENDDO
RETURN beginn
Главное, что выворачивается изнутри (так говорил В.В.Маяковский)
Красное – серебро
Светло-зеленое – ртуть
Синее – никель
Сиреневое – хром
Желтое – ванадий
Светло-синее – титан
Коричневое – медь
Темно-зеленое – свинец
http://cs10512.vkontakte.ru/u98750176/1 ... 4ab48f.jpg
но все впереди. Тороплюсь!
Главное решение найдено, я ничего не делал двадцать лет – и наконец я вижу структуру геохимии почв г.Екатеринбурга (не ТОЛЬКО картинку, а и идя курсором по СВОЕЙ таблице и вижу все, что я не видел по факторному анализу). Ничего не надо (для сверхскоростной оценки какого-то поля геогеохимгеоэко и дррр полей) кроме НОРМИРОВКИ (НОРМАЛИЗАЦИЯ в ЭКСЕЛЕ) и СОРТИРОВКИ как ЯДРА МАНИПУЛИРОВАНИЯ ДАННЫМИ. Я вижу свинец Берзовского золотого, медь – Пышминского медно-кобальтого и ртуть центра города Екатеринбурга, хромитовые ядра гипербазитов, никелевые оторочи, титановые поля , полные спектры. Не поленитесь почитайте по фактанализу – это я только ВАС заманивал – я только чувствовал, что получится. «ГИГОМ» МЕНЯ ОЗАДАЧИЛ И «КАЛИЙ» на таких картах РАБОТАЕТ. Я знаю почему. В КНИЖКАЖ ЭТОГО НЕТ – Я ЧИТАЛ МНОГО!!! Небольшая доработка и программа и алгоритм нужны любому специалисту в науках о Земле – потом поспорим, сейчас некогда. Я заменил слово СОРТИР на СОРТ и факанализ на фактанализ – я меняюсь. Смотрите картинку – думайте! До свидания.
Программка сделана с детской простотой, но и ИИСУС говорил – будьте как дети.
*Недоделанная для детерминированной классификации ('это старое выражение сейчас доделанное не до конца)
*В.Д.Брусницын 2010
PROCEDURE СОРТКЛАСССПЕКТР
SET TALK OFF
CLEAR
IF ALLTRIM(DBF(1))==""
DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF;
MESSAGE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА ПОКАЗАТЕЛЕЙ";
TITLE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА ПОКАЗАТЕЛЕЙ"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
SELECT 1
USE PROMPT() NOUPDATE
ENDIF
SELECT 1
*Use ?
vorname = DBF(1)
vorname = SUBSTR(vorname,1,LEN(vorname)-4)
imia = "S"
viv_file =vorname+ALLTRIM(imia)+'.dbf'
COPY TO &viv_file AS 1251
USE &viv_file
namen = DBF(1)
summel = ""
beg = f_fiel()
ende = FCOUNT()
FOR i= beg TO ende
one = "f"+ ALLTRIM(STR(i-beg + 1))
ALTER TABLE &namen ADD COLUMN &one N(i-beg + 1)
ENDFOR
ALTER TABLE &namen ADD COLUMN summas N(8,2)
ALTER TABLE DBF(1) ADD COLUMN "Spectr" C(200)
GO TOP
DIMENSION A(ende - beg + 1,3)
DO WHILE !EOF()
FOR J = 1 TO ende - beg + 1
A(J,1)=EVAL(FIELD(beg+J-1))
A(J,2)=FIELD(beg+J-1)
A(J,3)=beg+J-1
ENDFOR
=ASORT(A,1,-1,1)
TXT=""
TXT1=""
TXT2=""
FOR ii = 1 TO ende - beg + 1
TXT=TXT+A[ii,2]
TXT1=TXT1+ALLTRIM(STR(A[ii,3]))
one = "f"+ ALLTRIM(STR(ii))
REPL &one WITH VAL(ALLTRIM(SUBSTR(TXT1, 1,ii)))
TXT2=TXT2+A[ii,2]+" " + STR(A[ii,1],4,1)+" "
ENDFOR
REPL spectr WITH TXT2
SKIP
ENDDO
CALC MAX(LEN(ALLTRIM(spectr))) TO dlsp
ALTER TABLE DBF(1) ALTER COLUMN "Spectr" C(dlsp)
BROWSE
*Подпрограмма f_fiel. Цель - выбор первого элемента для расчета.
*возврвщает номер выбранного поля
*Автор алгоритмов и программы В.Д.Брусницын
PROCEDURE f_fiel
DEFINE POPUP obj_fil PROMPT STRUCTURE;
MESSAGE "ВЫБРАТЬ ПЕРВЫЙ ЭЛЕМЕНТ ДЛЯ РАСЧЕТА";
TITLE "ВЫБРАТЬ ПЕРВЫЙ ЭЛЕМЕНТ ДЛЯ РАСЧЕТА"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
beginn = 1
DO WHILE beginn < FCOUNT()
IF ALLTRIM(UPPER(FIELD(beginn)))==ALLTRIM(UPPER(PROMPT()))
EXIT
ELSE
beginn = beginn + 1
ENDIF
ENDDO
RETURN beginn
Главное, что выворачивается изнутри (так говорил В.В.Маяковский)
Красное – серебро
Светло-зеленое – ртуть
Синее – никель
Сиреневое – хром
Желтое – ванадий
Светло-синее – титан
Коричневое – медь
Темно-зеленое – свинец
http://cs10512.vkontakte.ru/u98750176/1 ... 4ab48f.jpg