Williams (Все сообщения пользователя)

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

31.05.2016 12:18:56

Цитата
JeyCi написал: сильно является описанием Тренда!

Добрый день!
Вы верно подметили, вышеуказанные формулы имеют прямое отношение к тренду. Однако используется не столько для выявления тренда как такового, сколько для получения некоторой характеристики ряда данных.
В принципе, можно и тренд искать такими методами (если понимать под трендом определение Ч. Доу)... Однако желающих предостерегу о специфике поиска таким методом. ТАК можно найти и описать тренд в данных, где явно предполагается его наличие (поскольку нужно понимать "ОТКУДОВА" и "ДОКУДОВА" искать).
Так, на примере погоды. Если мы применим формулы к ряду температур за год, то, в лучшем случае, найдем тренд, свидетельствующий о глобальном потеплении/ ледниковом периоде и тп. Если же мы пытаемся математически (статистически) определить критерий, например, когда менять резину автомобиля с зимы на лето, то эта формула возможно подскажет, что переобуться нужно тогда, когда минимальная температура за три дня будет выше 0 (цифры от фонаря, естественно).

Цитата
JeyCi написал: экстремумы

Экстремумы плохи тем, что при их анализе приходится мириться с бОльшими допущениями и/или усреднениями (да еще и в двух измерениях, хотя можно и в одном, но тогда в так называемой "неровной плоскости"). И чем больше "шума" в данных, тем гораздо больше шума в экстремумах.
Я всегда считал, ИМХО, что формула считает то, что в нее включишь, не больше и не меньше (к примеру ВВП на душу населения не отражает того, чего от него ждут, просто потому, что это не "показатель всего", а просто относительное, помноженное на относительное, разделенное на примерное с оговорками). Поэтому это просто формула расчета "Каков минимальный период T ("T(искомое)"), для которого минимумы на заданном одномерном массиве размером N за период T непрерывно возрастают?"

Цитата
JeyCi написал: я не совсем в теме (файлы не смотрела)... но вдруг поняла...

Позвольте заметить, у вас очень цепкий ум

! (Не примите за дерзость)

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

20.05.2016 12:03:02

Просьба уважаемым модераторам: Прикрепите, пожалуйста к моему первому сообщению вверху, под спойлерами, в качестве ответа (решения). Не смог разобраться, как сделать. Спасибо!

Максимумы убывают

Код

Function PerDescHi(srcRange As Range) As Variant
 
    ' Функция для пользователя Williams от Артёма Хоменко с форума http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=78037&TITLE_SEO=78037-nayti-minimalnyy-period-dlya-kotorogo-verno-uslovie&MID=652872
    ' В качестве аргумента должен быть передан один столбец
    ' Функция рассчитывает: "Каков минимальный период T ("T(искомое)"), для которого максимумы на заданном одномерном массиве размером N за период T непрерывно убывают? Если нет такого Т, выдать #Н/Д"
    '
      
    ' Если в переданный диапазон попадут нечисловые данные, просто пропускаем их.
    On Error Resume Next
     
    ' Количество элементов
    Dim rowNum As Long, i As Long, j As Long, t As Long
    rowNum = srcRange.Rows.CountLarge
     
    ' Создадим вектор под исходные данные и под максимумы
    Dim arrSrc() As Variant, arrMax() As Double
    ReDim arrMax(1 To rowNum)
      
    ' Скопируем в массив данные для оптимизации, чтобы не обращаться к ячейкам.
    arrSrc = srcRange.Columns(1).Value
 
    ' Начинаем с периода в 1 и до максимального
    For t = 1 To rowNum - 1
         
        ' Перебираем элементы с первого и до конца
        For i = 1 To rowNum - t + 1
             
            ' Начальное значение
            arrMax(i) = arrSrc(i, 1)
 
            ' Перебираем элементы внутри периода - ищем максимум
            For j = 1 To t - 1
                If arrMax(i) < arrSrc(i + j, 1) Then
                    arrMax(i) = arrSrc(i + j, 1)
                End If
            Next j
             
            ' Если очередной максимум больше либо равен предыдущему, продолжать нет смысла.
            If i > 1 Then
                If arrMax(i) >= arrMax(i - 1) Then
                    GoTo next_t
                End If
            End If
             
        Next i
         
        ' Если попали сюда, то значит перебрали все максимумы и все они убывают - бинго
        PerDescHi = t
        Exit Function
         
next_t:
    Next t
     
    ' Ничего не нашли
    PerDescHi = CVErr(xlErrNA)
End Function

Максимумы возрастают

Код

Function PerIncrHi(srcRange As Range) As Variant
 
    ' Функция для пользователя Williams от Артёма Хоменко с форума http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=78037&TITLE_SEO=78037-nayti-minimalnyy-period-dlya-kotorogo-verno-uslovie&MID=652872
    ' В качестве аргумента должен быть передан один столбец
    ' Функция рассчитывает: "Каков минимальный период T ("T(искомое)"), для которого максимумы на заданном одномерном массиве размером N за период T непрерывно возрастают? Если нет такого Т, выдать #Н/Д"
    '
      
    ' Если в переданный диапазон попадут нечисловые данные, просто пропускаем их.
    On Error Resume Next
     
    ' Количество элементов
    Dim rowNum As Long, i As Long, j As Long, t As Long
    rowNum = srcRange.Rows.CountLarge
     
    ' Создадим вектор под исходные данные и под максимумы
    Dim arrSrc() As Variant, arrMax() As Double
    ReDim arrMax(1 To rowNum)
      
    ' Скопируем в массив данные для оптимизации, чтобы не обращаться к ячейкам.
    arrSrc = srcRange.Columns(1).Value
 
    ' Начинаем с периода в 1 и до максимального
    For t = 1 To rowNum - 1
         
        ' Перебираем элементы с первого и до конца
        For i = 1 To rowNum - t + 1
             
            ' Начальное значение
            arrMax(i) = arrSrc(i, 1)
 
            ' Перебираем элементы внутри периода - ищем максимум
            For j = 1 To t - 1
                If arrMax(i) < arrSrc(i + j, 1) Then
                    arrMax(i) = arrSrc(i + j, 1)
                End If
            Next j
             
            ' Если очередной максимум меньше либо равен предыдущему, продолжать нет смысла.
            If i > 1 Then
                If arrMax(i) <= arrMax(i - 1) Then
                    GoTo next_t
                End If
            End If
             
        Next i
         
        ' Если попали сюда, то значит перебрали все максимумы и все они возрастают - бинго
        PerIncrHi = t
        Exit Function
         
next_t:
    Next t
     
    ' Ничего не нашли
    PerIncrHi = CVErr(xlErrNA)
End Function

Минимумы убывают

Код

Function PerDescLo(srcRange As Range) As Variant
 
    ' Функция для пользователя Williams от Артёма Хоменко с форума http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=78037&TITLE_SEO=78037-nayti-minimalnyy-period-dlya-kotorogo-verno-uslovie&MID=652872
    ' В качестве аргумента должен быть передан один столбец
    ' Функция рассчитывает: "Каков минимальный период T ("T(искомое)"), для которого минимумы на заданном одномерном массиве размером N за период T непрерывно убывают? Если нет такого Т, выдать #Н/Д"
    '
      
    ' Если в переданный диапазон попадут нечисловые данные, просто пропускаем их.
    On Error Resume Next
     
    ' Количество элементов
    Dim rowNum As Long, i As Long, j As Long, t As Long
    rowNum = srcRange.Rows.CountLarge
     
    ' Создадим вектор под исходные данные и под минимумы
    Dim arrSrc() As Variant, arrMin() As Double
    ReDim arrMin(1 To rowNum)
      
    ' Скопируем в массив данные для оптимизации, чтобы не обращаться к ячейкам.
    arrSrc = srcRange.Columns(1).Value
 
    ' Начинаем с периода в 1 и до максимального
    For t = 1 To rowNum - 1
         
        ' Перебираем элементы с первого и до конца
        For i = 1 To rowNum - t + 1
             
            ' Начальное значение
            arrMin(i) = arrSrc(i, 1)
 
            ' Перебираем элементы внутри периода - ищем минимум
            For j = 1 To t - 1
                If arrMin(i) > arrSrc(i + j, 1) Then
                    arrMin(i) = arrSrc(i + j, 1)
                End If
            Next j
             
            ' Если очередной минимум больше либо равен предыдущему, продолжать нет смысла.
            If i > 1 Then
                If arrMin(i) >= arrMin(i - 1) Then
                    GoTo next_t
                End If
            End If
             
        Next i
         
        ' Если попали сюда, то значит перебрали все минимумы и все они убывают - бинго
        PerDescLo = t
        Exit Function
         
next_t:
    Next t
     
    ' Ничего не нашли
    PerDescLo = CVErr(xlErrNA)
End Function

Минимумы возрастают

Код

Function PerIncrLo(srcRange As Range) As Variant
 
    ' Функция для пользователя Williams от Артёма Хоменко с форума http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=78037&TITLE_SEO=78037-nayti-minimalnyy-period-dlya-kotorogo-verno-uslovie&MID=652872
    ' В качестве аргумента должен быть передан один столбец
    ' Функция рассчитывает: "Каков минимальный период T ("T(искомое)"), для которого минимумы на заданном одномерном массиве размером N за период T непрерывно возрастают? Если нет такого Т, выдать #Н/Д"
    '
      
    ' Если в переданный диапазон попадут нечисловые данные, просто пропускаем их.
    On Error Resume Next
     
    ' Количество элементов
    Dim rowNum As Long, i As Long, j As Long, t As Long
    rowNum = srcRange.Rows.CountLarge
     
    ' Создадим вектор под исходные данные и под минимумы
    Dim arrSrc() As Variant, arrMin() As Double
    ReDim arrMin(1 To rowNum)
      
    ' Скопируем в массив данные для оптимизации, чтобы не обращаться к ячейкам.
    arrSrc = srcRange.Columns(1).Value
 
    ' Начинаем с периода в 1 и до максимального
    For t = 1 To rowNum - 1
         
        ' Перебираем элементы с первого и до конца
        For i = 1 To rowNum - t + 1
             
            ' Начальное значение
            arrMin(i) = arrSrc(i, 1)
 
            ' Перебираем элементы внутри периода - ищем минимум
            For j = 1 To t - 1
                If arrMin(i) > arrSrc(i + j, 1) Then
                    arrMin(i) = arrSrc(i + j, 1)
                End If
            Next j
             
            ' Если очередной минимум меньше либо равен предыдущему, продолжать нет смысла.
            If i > 1 Then
                If arrMin(i) <= arrMin(i - 1) Then
                    GoTo next_t
                End If
            End If
             
        Next i
         
        ' Если попали сюда, то значит перебрали все минимумы и все они возрастают - бинго
        PerIncrLo = t
        Exit Function
         
next_t:
    Next t
     
    ' Ничего не нашли
    PerIncrLo = CVErr(xlErrNA)
End Function

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

20.05.2016 11:50:10

Код
' Перебираем элементы внутри периода - ищем максимум For j = 1 To t - 1

(поправил период с t на t-1. Заработало)

Код
' Если очередной максимум больше либо равен предыдущему, продолжать нет смысла. If i > 1 Then If arrMax(i) >= arrMax(i - 1) Then

Вставил ограничение на >= вместо > . Теперь считает "убывание" вместо "невозрастания".

Прикреплю код наверху. Допилил аналоги на Максимум/Минимум и Возрастает/Убывает. Аналоги не проверял пока, но, думаю, все заработает.

Еще раз огромное спасибо ArtHome !!!!

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

20.05.2016 10:51:16

Протестировал. Считает хорошо. Но где-то подглючивает: когда нет решений, пишет период на один больше размера массива. Думаю, сам найду, в чем причина. Отпишусь, как что. Еще раз спасибо большое, особенно за комментарии к коду!

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

19.05.2016 12:22:43

Цитата
ArtHome написал: логика расчёта и ответ верный

Да!

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

19.05.2016 11:57:16

Да, такое решение имеет место быть, но лишь как часть решения. Представьте, что мне нужно не только проверить 101, но так же и все от 1 до 101. Сколько столбцов получится? Поэтому я и пришел к выводу о необходимости использования пользовательской функции.

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

19.05.2016 10:51:20

Цитата
Начинаем с T=1 (то есть при T=5 ищем

про Т=5 - это просто пример.

Про период.
Под периодом я рассматриваю число предыдущих значений, включая текущее, для которых ищем максимум.
То есть, допустим, есть массив, из 8 строк. Максимум за период 5 есть максимальное значение из 1ой-5ой строк. Массив максимумов есть поочередно: максимальное значение из 1ой-5ой строк; затем максимальное значение из 2ой-6ой строк; затем максимальное значение из 3ей-7ой строк; затем максимальное значение из 4ой-8ой строк.

Почему я считаю именно максимум, а не локальный экстремум.

Цитата
Андрей VG написал: странная логика, обычно под локальным максимумом понимают (f(i) - (f(i -1)) > 0 И (f(i + 1) - (f(i)) < 0

Потому что, для последнего значения массива есть шанс стать максимумом, а вот экстремумом (ввиду отсутствия дальнейших значений) - нет.
Для меня статистически важны именно максимумы, а не экстремумы, это специфика исследования.
=============================================================================
Попробую изложить иначе. Если для массива данных размером N есть такие T(число предыдущих значений, включая текущее, для которых ищем максимумы), значения которых непрерывно убывают от предыдущего к последующему, то из всех этих T нужно найти меньшее или сказать, что таких нет вообще.

Поэтому я и предлагаю в начале определить, есть ли вообще такие T, а они есть если условие верно для T=N-1 (то есть, последнее значение меньше первого).
А затем двигаться от минимального Т вверх, пока не выполнится условие непрерывности убывания.

Спасибо за ответ!

Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams Пользователь Сообщений: 9 Регистрация: 19.05.2016	# 19.05.2016 10:07:52 Данные. Смотрим столбец Data. Изменено: Williams - 19.05.2016 10:08:24
	Перейти

Найти минимальный период, для которого верно условие, VBA, пользовательская функция

Williams

Пользователь

Сообщений: 9 Регистрация: 19.05.2016

19.05.2016 09:59:17

Добрый день!

С большим уважением выражаю благодарность всему сообществу и автору сайта лично. В течение многих лет все ответы на все вопросы всегда находил здесь.
Нужна помощь в написании пользовательской функции на VBA. Обычными формулами не решить задачу эффективно, а VBA не знаю.
Суть задачи:
"Каков минимальный период T ("T(искомое)"), для которого максимумы за период T непрерывно убывают? Если нет такого Т, выдать #Н/Д"

1.Ищем T(искомое). Его и выдает функция.
2.Есть столбец с данными длиной N.
3.Для данных ищем максимумы за период T. Начинаем с T=1 (то есть при T=5 ищем по логике: если значение больше четырех (5-1) предыдущих, то оно является максимумом и записывается в массив максимумов за период 5)
4.Далее рассматриваем массив максимумов за период T.
Если каждое последующее значение ниже предыдущего, то текущее T=T(искомое).
Если неверно, то выполняем действия c пункта 3. для T=T+1
5. Так до тех пор, пока не найдется T(искомое).
6. В начале проводим проверку, есть ли вообще такое T, для которого выполнится условие.
Для этого в начале проверяем пункт 3 для T=N-1. Если для такого T гипотеза не верна, то T(искомое) должно выдать #Н/Д.
7. Выводим T(искомое).

Заранее благодарен за помощь!

Изменено: Williams - 19.05.2016 11:04:58

Перейти