Программа СОРТКЛАСССПЕКТР

Обсуждение программ и утилит, полезных для геологов

Модератор: catty

Ответить
Аватара пользователя
Василиус
Сообщения: 87
Зарегистрирован: Вс окт 24, 2010 8:28 pm

Программа СОРТКЛАСССПЕКТР

Сообщение Василиус » Пн ноя 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
Последний раз редактировалось Василиус Ср ноя 03, 2010 8:00 pm, всего редактировалось 2 раза.
Всего доброго! Василиус.

Сергей Филимонов
Участник
Сообщения: 512
Зарегистрирован: Чт сен 28, 2006 3:30 pm
Откуда: Геологический факультет МГУ
Контактная информация:

Re: Не поленитесь загляните, мне некогда!

Сообщение Сергей Филимонов » Вт ноя 02, 2010 12:59 am

Как жалко, думал было почитать интересное про факторный анализ в геологии, но манера письма Василиуса интерес убила напрочь. Читать и понимать невозможно.
Василиус, мой Вам совет, спуститесь на Землю. Не надо так писать - "Не поленитесь загляните, мне некогда!". Т.е. пока вы там занимаетесь своей фигней, я делаю великие открытия. Нате вам кусочек от моих открытий, а мне вами заниматься некогда. Иначе... да нет, просто возникли некие ассоциации с некоторыми участниками этого форума. *отгоняю наваждение*
Если я не так Вас понял, прошу извинить, но такое возникло первое впечатление.

Аватара пользователя
Василиус
Сообщения: 87
Зарегистрирован: Вс окт 24, 2010 8:28 pm

Re: Программа СОРТ

Сообщение Василиус » Вт ноя 02, 2010 8:51 pm

Эта программа законченная с точки зрения простой мощной сортировки-иерархической кластеризации, с выводом спектров в поле для пространственного анализа. Смотри карту кластеров второго эшелона.
Для использования программы нужно, что бы после первого компонента, участвующего в расчете (колонки - поля) не было номинальных шкал – названий пород и все поля нужные для расчета – это сделано для простоты и скорости – решение принято - действуй при расчетах однообразно! Компонентов не должно быть более 15 (хотя можно) – лавина кластеров. Выбрать наиболее значимые!!! Эту программу надо было назвать СОРТКЛАСС!!
http://cs10597.vkontakte.ru/u98750176/1 ... edbc60.jpg
Здесь (в программе) нет суммы! А они в разных случаях разные. Но в нашем случае мы особо посчитали суммы при НОРМАЛИЗАЦИИ. Эта сумма типа аномальности в геохимии и др. Смотри карту. Необычно, но особо важно подчеркнуть, что вынос элементов (минус) идет в плюс! Почему, а вот почему: мы знаем, например, что марганец и ванадий из колчеданов куда-то выдувает на периферию, толи из-за температуры или кислотности растворов, а это усиливает АНОМАЛЬНОСТЬ ПРОЦЕССА. Мы не видим меди (как пример) но нет ванадия – подозрительно.
Слева яркость – видимо ВЫНОС в плюс – мне не хочется строить карты для анализа ситуации, но все в основном можно понять. И последнее это спектральный анализ – плохонький, но кое-что мы видим.
http://cs10597.vkontakte.ru/u98750176/1 ... 26c0bf.jpg
Привожу программу для ознакомления с нормировкой – думал комментировать – казалось легко но есть много подводных камней. Слегка задумался. Наверное, надо еще статистику и корреляцию, так там показатели, которых нет например у ДЭВИСА и др. и она работает просто из БД.
Обратите внимание на суммы – нигде почти нет.

*Процедура НОРМА для программы ГЕОКЛАСС. Предназначена для нормировки
*цифровой информации распределенной по нормальному закону. В связи с этим
*в исходных данных могут присутствовать ноли (0) и отриц числа.
*Создаются два дополнительных файла - нормированных чисел с заменой последних
*двух букв в названии на ng и параметров нормировки на np в случае нормировки
*основного файла vibor = 0,и один на ng в случае нормировки файла эталонов
* по параметрам нормировки по файлу с np vibor # 0.
*Автор алгоритмов и программы В.Д.Брусницын
PROCEDURE НОРМА
PARAMETERS vibor
formglav.release
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
vorname = DBF(1)
vorname = SUBSTR(vorname,1,LEN(vorname)-6)
imia = "ng"
nach_el = f_fiel()
viv_file = vorname + ALLTRIM(imia) + '.dbf'
IF vibor = 0
imia1 = "np"
viv_fil1 = vorname + ALLTRIM(imia1) + '.dbf'
COPY TO &viv_file AS 1251
COPY STRUCTURE TO &viv_fil1
USE &viv_file
contf = FCOUNT()
konec = FCOUNT()
COUNT TO nom
nom1 = 1/nom/(nom - 1)
DIME srst(2, konec-nach_el + 1)
FOR ii2 = nach_el TO konec
pii = FIELD(ii2)
SUM(&pii) TO sumx
srst(1,ii2-nach_el+1) = sumx/nom
kvsumx = sumx^2
SUM(&pii^2) TO sumxkv
nsumxkv = nom* sumxkv
srst(2,ii2-nach_el+1) = SQRT(nom1*(nsumxkv-kvsumx))
ENDFOR
SELECT 2
USE &viv_fil1
APPEND BLANK
APPEND BLANK
FOR ii3 = nach_el TO konec
pii = FIELD(ii3)
GO BOTTOM
REPL &pii WITH srst(2,ii3-nach_el+1)
SKIP -1
REPL &pii WITH srst(1,ii3-nach_el+1)
ENDFOR
p1 = FIELD(1)
ALTER TABLE &viv_fil1 ALTER COLUMN &p1 C(8)
ALTER TABLE &viv_fil1 RENAME COLUMN &p1 TO "Pokaz"
GO TOP
REPL Pokaz WITH "СРЕДНЕЕ"
SKIP
REPL Pokaz WITH "СТАНДАРТ"
ii4 = 2
DO WHILE ii4<nach_el
pii = UPPER(FIELD(2))
ALTER TABLE &viv_fil1 DROP COLUMN &pii
ii4 = ii4 + 1
ENDDO
BROW TITLE ;
"ВНЕСТИ ИЗМЕНЕНИЯ В СРЕДНЕЕ И СТАНДАРТ (Esc - для продолжения счета)"
ELSE
CLEAR
IF ALLTRIM(DBF(2))==""
DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF;
MESSAGE "ВЫБРАТЬ ФАЙЛ ПОКАЗАТЕЛЕЙ ДЛЯ НОРМИРОВКИ";
TITLE "ВЫБРАТЬ ФАЙЛ ПОКАЗАТЕЛЕЙ ДЛЯ НОРМИРОВКИ"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
SELECT 2
USE PROMPT() NOUPDATE
ENDIF
SELECT 2
COPY STRUCTURE TO &viv_file
SELE 3
USE &viv_file
p1 = FIELD(1)
ALTER TABLE &viv_file ALTER COLUMN &p1 N(3)
p2 = "klasse"
ALTER TABLE &viv_file RENAME COLUMN &p1 TO &p2
APPEND FROM DBF(1)
USE
SELE 1
USE &viv_file
SELE 2
nach_el = 2
konec = FCOUNT()
ENDIF
FOR ii5 = 2 TO FCOUNT()
SELECT 2
pii = FIELD(ii5)
GO BOTTOM
standart = &pii
SKIP -1
srednee = &pii
SELECT 1
REPL ALL &pii WITH (EVAL(pii)-(srednee))/standart
ENDFOR
SELECT 1
FOR ii1 = nach_el TO konec
pii = FIELD(ii1)
pii1 = pii+"_k"
ALTER TABLE &viv_file RENAME COLUMN &pii TO &pii1
ENDFOR
ALTER TABLE &viv_file ADD COLUMN "KA_PLU" N(10,2)
ALTER TABLE &viv_file ADD COLUMN "KA_MIN" N(10,2)
ALTER TABLE &viv_file ADD COLUMN "KA_SUM" N(10,2)
beg = fst_el(UPPER('_K'))
elts = n_el(UPPER('_K'))
last_el = beg + elts - 1
DIMENSION a(elts)
GO TOP
DO WHILE ! EOF()
FOR jj=1 TO elts
a(jj)=EVAL(FIELD(beg-1+jj))
ENDFOR
=ASORT(a, 1, elts, 1)
ka = 0
SUM = 0
ii = 1
SUM = a(ii)
ka1 = SUM / SQRT(ii)
DO WHILE ii <=elts
IF ka < ka1
ka = ka1
ii = ii + 1
IF ii = elts+1
EXIT
ENDIF
SUM = SUM + a(ii)
ka1 = SUM / SQRT(ii)
ELSE
ii = elts+1
ENDIF
ENDDO
REPLACE ka_plu WITH ka
ka = 0
SUM = 0
ii = elts
IF a(ii)<0
SUM = a(ii)
ka1 = SUM / SQRT(elts - ii + 1)
ELSE
SUM = 0
ka1 = 0
ENDIF
DO WHILE ii>= beg
IF ka > ka1 AND a(ii)<0
ka = ka1
ii = ii - 1
SUM = SUM + a(ii)
ka1 = SUM / SQRT(elts -ii+1)
IF ii = beg-1 AND ka > ka1
ka = ka1
EXIT
ENDIF
ELSE
ii = beg-1
ENDIF
ENDDO
REPLACE ka_min WITH ka
SKIP
ENDDO
REPLACE ALL ka_sum WITH (ka_plu + ABS(ka_min))/SQRT(2)
DO FORM formglav
CLOSE ALL
Последний раз редактировалось Василиус Чт ноя 04, 2010 2:03 pm, всего редактировалось 1 раз.
Всего доброго! Василиус.

Аватара пользователя
catty
Сообщения: 248
Зарегистрирован: Сб мар 31, 2007 10:37 pm
Откуда: Ухта

Re: Не поленитесь загляните, мне некогда!

Сообщение catty » Ср ноя 03, 2010 3:41 pm

Сергей Филимонов писал(а):Как жалко, думал было почитать интересное про факторный анализ в геологии, но манера письма Василиуса интерес убила напрочь. Читать и понимать невозможно.
Василиус, мой Вам совет, спуститесь на Землю. Не надо так писать - "Не поленитесь загляните, мне некогда!". Т.е. пока вы там занимаетесь своей фигней, я делаю великие открытия. Нате вам кусочек от моих открытий, а мне вами заниматься некогда. Иначе... да нет, просто возникли некие ассоциации с некоторыми участниками этого форума. *отгоняю наваждение*
Если я не так Вас понял, прошу извинить, но такое возникло первое впечатление.



Сергей, я думаю, математик его поймёт. А что Вы хотели бы почитать про факторный анализ в геологии??

Аватара пользователя
Василиус
Сообщения: 87
Зарегистрирован: Вс окт 24, 2010 8:28 pm

Re: Программа СОРТКЛАСССПЕКТР

Сообщение Василиус » Чт ноя 25, 2010 7:39 am

Засек (даже раньше) непонятное явление на западе - северо-западе почв Екатеринбурга. Не обращал внимания.
Но это выделяется другими методами. Потихоньку буду выяснять, сообщу. Ошибки в данных вроде быть не должно.
Это по сумме нормировки.
http://cs10597.vkontakte.ru/u98750176/1 ... 26c0bf.jpg
Всего доброго! Василиус.

Captain
Сообщения: 61
Зарегистрирован: Ср авг 12, 2009 9:52 am

Re: Программа СОРТКЛАСССПЕКТР

Сообщение Captain » Ср дек 15, 2010 10:25 am

Объясните пожалуйста непонятливому студенту...
Как данный здесь код использовать?
У меня есть таблица хим. анализа в exele (см. приложение) и карта скважин в кореле. Могу ли я, используя вашу программу, построить карты геохимии для каждого литолого-стратиграфического комплекса, данные о геохимии которых есть в таблице?

Преподаватели посоветовали мне использовать сёрфер или глобал мэппер. Но там необходимо всё переносить вручную, здесь же, как я понял, всё происходит в полуавтоматическом режиме, с предподготовкой таблицы.
Вложения
.xls
Таблица такого вида.
(198 КБ) 444 скачивания

Аватара пользователя
Василиус
Сообщения: 87
Зарегистрирован: Вс окт 24, 2010 8:28 pm

Re: Программа СОРТКЛАСССПЕКТР

Сообщение Василиус » Вс дек 19, 2010 9:31 pm

Данные в Excel готовить вообще не правильно. Но если так то они должны быть в виде списков - смотрите справку. Только один заголовок - поля - колонки числовые, дата, символьные (текстовые) строго по типу, интервал не в кучу, а отдельно ОТ ДО. Сначала база данных! Это самое главное. Первой базой я пользуюсь уже 20 лет но в учебных целях. Я от автоматического вывода карт по своей программе отказался, так как там нет привязки к другим ГИС - системам - выводить придется в какой-то системой Surfer? MapInfo, ArcView - любой. Главное координаты. Почему схема скважин в Corele? Если нет координат, надо экспортировать в тип фото и по точкам координировать в какой-то системе - щелчек - точка с координатами. Но как привязать подложку - фото? это в разных системах по разному. Если координаты относительные - не нодо выности на Земной шар, в другую ГИС, то можно просто открыть в Сёрфере и пощелкать. Но Вы не умеете соединять файлы координат и анализов! Проблемы для меня легкие, но объяснить на пальцах трудно Немного напрягитесь - вручную мало делается, но Вам может придется сначала немного потренироваться. Преодолейте - если дальше будете работать - пригодится!! Сейчас все в ГИС, я например взял для примера данные в германии, с координатами в градусах - вынес на карту мира - оказалось часть в Южной часть в Северной Америке и некоторые рассеянные, выбрал автоматически сплошной участок 1690 проб и быстро сохранил в файл и начал работать. Вы учитесь немного постарайтесь - в следующий раз будет легче! У меня сложные расчеты, но я не успел рассказать много важного, на сайте буду - на форуме сложно http://abacuscomp.narod.ru/ Но уменя еще начинается новая тема Сера в природе (мире - кислотность, дренаж, вода и т.д.) и ГИС, системный анализ и др.
Всего доброго! Василиус.

Captain
Сообщения: 61
Зарегистрирован: Ср авг 12, 2009 9:52 am

Re: Программа СОРТКЛАСССПЕКТР

Сообщение Captain » Чт дек 23, 2010 8:46 pm

У меня тоже учебные цели. А Corel потому что другой нет...
Карту привязать не проблема, не хочется ручками данные по скважинам расставлять... это ж на одну скважину несколько параметров выводить (скажем 1000 проб по 10 параметров многовато на меня одного получается), вот и думал может автоматом получится:)

Ответить

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 5 гостей