Список форумов Палеомагнитный форум

Палеомагнитный форум

Добро пожаловать на форум сайта "paleomag.ifz.ru"
 
 FAQFAQ   ПоискПоиск   ПользователиПользователи   ГруппыГруппы   РегистрацияРегистрация 
 ПрофильПрофиль   Войти и проверить личные сообщенияВойти и проверить личные сообщения   ВходВход 

Статистика Фишера (векторов на сфере) для Excel (VBA)

 
Начать новую тему   Ответить на тему    Список форумов Палеомагнитный форум -> Форум
Предыдущая тема :: Следующая тема  
Автор Сообщение
Roman Veselovskiy
Site Admin


Репутация: 0    

Зарегистрирован: 31.07.2007
Сообщения: 25
Откуда: ИФЗ РАН, Москва

СообщениеДобавлено: Пн Янв 16, 2012 1:32 am    Заголовок сообщения: Статистика Фишера (векторов на сфере) для Excel (VBA) Ответить с цитатой

Несколько часов жизни потратил на создание функции для VBA Excel, которая считала бы параметры статистики Фишера для выборки векторов. Прилагаю - может кому пригодится Улыбки
(если будут вопросы - пишите). Все готово: только вставить весь листинг в окно редактирования кода модуля (Alt+F11, создать модуль) и при вставке функции в ячейку выбрать "пользовательские функции", fisher, и, наконец, указать диапазон значений склонений и наклонений для векторов.


Function fisher(declination As Range, inclination As Range) As Variant

' Key words: Fisher statistics, dispersion on a sphere, paleomagnetic data, mean direction, Excel, VBA
' Fisher, 1953

Dim intI As Integer, decl(1000), incl(1000) As Variant

Application.Volatile

pii = Atn(1) * 4
grad = 180 / pii
rad = pii / 180


For intI = 1 To declination.Cells.Count
decl(intI) = declination.Cells(intI)
Next intI

For intI = 1 To inclination.Cells.Count
incl(intI) = inclination.Cells(intI)
Next intI

x = 0: y = 0: Z = 0

For intI = 1 To declination.Cells.Count
DD = decl(intI) * rad: JJ = incl(intI) * rad
x = x + Cos(DD) * Cos(JJ): y = y + Cos(JJ) * Sin(DD): Z = Z + Sin(JJ)

Next intI

nn = declination.Cells.Count

Call xyzdjr(pii, rad, grad, x, y, Z, Dm, Jm, R)

R_norm = R / nn
Km = (nn - 1) / (nn - R)

cosx = 1 - ((nn - R) / R) * ((1 / 0.05) ^ (1 / (nn - 1)) - 1)
Call arccos(pii, cosx, a)
a95m = a * grad

' you can obtain just one parameter of Fisher statistics (at the selected
cell). For that delete ' symbol before the corresponding string:

fisher = a95m
' fisher = Dm
' fisher = Jm
' fisher = R
' fisher = Km

End Function

Sub arccos(pii, x, a)
pi = Atn(1) * 4
If x = 0 Then a = pi / 2
If x >= 1 Then a = 0
If x <= -1 Then a = pi
If x <1> -1 And x <> 0 Then a = Atn(Sqr(1 - x ^ 2) / x)
If a <0>= 1 Then a = pii / 2
If x <= -1 Then a = -pii / 2
If x <1> -1 Then a = Atn(x / Sqr(1 - x ^ 2))

End Sub

Sub xyzdjr(pii, rad, grad, x, y, Z, D, J, R)

p = x ^ 2 + y ^ 2
R = Sqr(p + Z ^ 2)
p = Sqr(p)
xx = x / p
Call arccos(pii, xx, a)
D = a
If y < 0 Then D = -D
D = D * grad
If D < 0 Then D = 360 + D
yy = Z / R
Call arcsin(pii, yy, a)
J = a * grad

End Sub
Вернуться к началу
Посмотреть профиль Отправить личное сообщение Посетить сайт автора
SVShipunov



Репутация: 0    

Зарегистрирован: 06.08.2007
Сообщения: 4
Откуда: мск+спб

СообщениеДобавлено: Пн Янв 16, 2012 2:36 am    Заголовок сообщения: Ответить с цитатой

надо попробовать... Very Happy
Вернуться к началу
Посмотреть профиль Отправить личное сообщение
Показать сообщения:   
Начать новую тему   Ответить на тему    Список форумов Палеомагнитный форум -> Форум Часовой пояс: GMT + 4
Страница 1 из 1

 
Перейти:  
Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете голосовать в опросах


Powered by phpBB © 2001, 2005 phpBB Group
Вы можете бесплатно создать форум на MyBB2.ru, RSS