Вариант #51 дает лишние слэши в конце из-за наличия последнего столбца в котором может быть дополнительный текст. Поправил это дело, но производительность упала до 86 сек. Ну, как вариант с применением выражений SQL и возможностью простой выгрузки результата в DBF, Excel и различные форматы текста вполне может сгодиться. файл schema.ini
Код
[file.txt]
ColNameHeader=False
Format=Delimited(/)
CharacterSet=1251
TextDelimiter="none"
Col1=clm1 Text
Col2=clm2 Text
Col3=clm3 Text
Col4=clm4 Text
Col5=clm5 Text
Col6=clm6 Text
Col7=clm7 Text
MaxScanRows=0
[result.txt]
ColNameHeader=False
Format=Delimited(/)
CharacterSet=1251
TextDelimiter="none"
Col1=clm1 Text
MaxScanRows=0
код VBA
Код
Sub TextFileSort()
Dim ft As Single: ft = Timer
Dim objRS: Set objRS = CreateObject("ADODB.Recordset")
objRS.Open "SELECT [clm1]+'//'+[clm3]+'/'+[clm4]+'/'+[clm5]+'/'+[clm6]+IIF([clm7] IS NOT NULL, '/'+[clm7], '') AS [clm1] INTO [result.txt] FROM [file.txt] IN 'D:\temp' 'TEXT;' ORDER BY VAL([clm6])", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\temp;Extended Properties=TEXT"
Debug.Print "Full time: " & Timer - ft
End Sub
Jack Famous, вряд-ли чем-то помогу, все упирается в производительность ADO. у меня ваш пример выполняется за 63 сек
PS еще раз поправил схему и запрос с учетом наличия лидирующих нолей, либо не числового значения... PPS на всякий случай: синтаксис SQL в OLE DB из FoxPro, как-то мне эта инфа не сразу попалась...
Андрей VG, а мой из #45 за сколько у тебя отрабатывает?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
я про СВОЙ вариант (массивный) Если не сможешь, то завтра постараюсь сам оттестировать свой и твой новый
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
то есть ничья Хотя мой вариант мне (субъективно, естественно) кажется проще и очевиднее А, учитывая "готовую" процедуру сортировки, и вообще — "в лоб")))
боюсь, что сколь значимый прирост в скорости маловероятен Была идея регулярками извлекать числа (сразу из всей строки в массив без цикла) - было бы точно быстрее, чем в цикле, НО один хрен нужно в цикле собирать строки, а Split тупит безбожно (когда строка состоит из сцепки 5 млн строк длиной ~50 символов каждая, навскидку) Можно написать свой аналог Split'а для овердлинных строк и тут, даже на VBA он должен выиграть, не говоря уже о C++
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Сделал сортировку под текущую задачу Ищет число после последнего "/", если там текст, то принимает значение за 0 Значения сортируются как числа: 100 > 20 Скачивает текстовый файл по блочно по 10 млн. строк, каждый блок сортируется быстрой сортировкой, затем объединяются путем слияния файлов (сортировкой слияния) Реализовано на FB, версия 64bit работает чуть быстрее 32bit на этапе сортировки, дисковые операции очень медленные Вместо тестового файла "File.txt" подставьте рабочий файл
вот этот момент бы поправить и совсем хорошо будет
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
у меня какой-то треш - то ли из-за работы в облачном диске, то ли от Win10 (на работе) - открывается txt (и руками и макросом) порядка МИНУТЫ При такой ерунде у нас с Андреем по 136 секунд общего выполнения, а у вас 90 — то есть сильно быстрее
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Выводы: если взять чтение и обработку у меня (12 сек), а сортировку (7 сек) и запись (14,5 сек) у Андрея, то получим 33,5 сек - то есть ещё на 25% быстрее
P.S.: тише едешь — дальше будешь. Тестируйте свои решения
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: Проблемы: сортировка некорректная (даже не учитывая текст после последнего слэша)
Это я косячнул, хотел немного ускорить быструю сортировку, добавил сортировку вставками на коротких участках, реализовал криво - исправляюсь Вложение в сообщении #71 обновил С текстом не понятно, как нужно сортировать - после чисел?
Алексей, всмотрелся в ваш код. Вы просто берёте число после последнего /, а я использовал регулярки. Если вернуть InStrRev, то будет такой результат (ну, чуть сортировку поменял). Read time: 4,78125 Sort time: 4,609375 Write time: 7,578125 Full time: 16,96875
bedvit: где именно некорректная? Поясните на примере
а я старался, скрины делал, чтобы вопросов не возникало Сравните свой итог сортировки и наш с Андреем (либо просто посмотрите скрин вашего результата, который я прикрепил к вашим итогам в предыдущем сообщении)
Цитата
Андрей VG: Вы просто берёте число после последнего /, а я использовал регулярки
ну я ещё проверяю, чтобы после последнего слэша было число и, если нет, то беру между 2мя последними слэшами. У тебя как раз опять этой проверки нет Мы "на вы" опять?)) P.S.: регулярки бы дали жару, если бы построчное чтение не было бы быстрее в 2-3 раза, чем FSO.ReadAll — с такой овердлинной строкой можно было бы и Split самодельный слепить для частного случая
Ускорился в 2 раза до 23 сек (рано списали FSO со счетов)
Код
Option Explicit
Option Private Module
'===========================================================================================
Dim arrVal() As Long, arrInd() As Long
'===========================================================================================
Sub SortAsArray()
Dim FSO As New FileSystemObject, TS As TextStream
Dim arrOld() As String, arrNew() As String
Dim x, txt$, ff&, n&, i&, t!, tt!, flag As Boolean
t = Timer: n = 5000000
ReDim arrInd(n)
ReDim arrOld(n)
ReDim arrVal(n)
ff = FreeFile: n = -1
Open inputName For Input As #ff
Do Until EOF(ff)
Line Input #ff, txt
If Len(txt) < 20 Then GoTo nx
flag = False
n = n + 1
arrInd(n) = n
arrOld(n) = txt
rep: i = InStrRev(txt, "/")
x = Mid(txt, i + 1)
If Not IsNumeric(x) Then
If flag Then MsgBox "Строка «" & txt & "» НЕ РАСПОЗНАНА!", vbCritical, Format(Timer - t, "0 сек"): Close #ff: Exit Sub
flag = True: txt = Left(txt, i - 1): GoTo rep
End If
arrVal(n) = x
nx: Loop
Debug.Print "Array.Обработка:", Format(Timer - t, "0.0 сек"): tt = tt + Timer - t
t = Timer
ReDim Preserve arrInd(n)
ReDim Preserve arrOld(n): ReDim Preserve arrNew(n)
ReDim Preserve arrVal(n)
Array1xSortInd 0, n
Debug.Print "Array.Sort1:", , Format(Timer - t, "0.0 сек"): tt = tt + Timer - t
t = Timer
i = 0
For Each x In arrInd
arrNew(i) = arrOld(x): i = i + 1
Next x
Debug.Print "Array.Sort2:", , Format(Timer - t, "0.0 сек"): tt = tt + Timer - t
t = Timer
On Error Resume Next: Kill outputName: On Error GoTo 0
Set TS = FSO.CreateTextFile(outputName)
TS.Write Join(arrNew, vbNewLine): TS.Close
Debug.Print "Array.Запись FSO:", Format(Timer - t, "0.0 сек"): tt = tt + Timer - t
Debug.Print "Array.Итого:", , Format(tt, "0.0 сек")
End Sub
'-------------------------------------------------------------------------------------------
Sub Array1xSortInd(l&, u&)
Dim x, y, n&, i&, j&
i = l: j = u: x = arrVal((l + u) \ 2)
Do
Do While arrVal(i) < x: i = i + 1: Loop
Do While x < arrVal(j): j = j - 1: Loop
If i <= j Then
y = arrVal(i): arrVal(i) = arrVal(j): arrVal(j) = y
n = arrInd(i): arrInd(i) = arrInd(j): arrInd(j) = n
i = i + 1: j = j - 1
End If
Loop Until i > j
If l < j Then Array1xSortInd l, j
If i < u Then Array1xSortInd i, u
End Sub
'===========================================================================================
Андрей VG, запусти у себя - у тебя должно быть секунд 15…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: сортируем только строки с числами и только по числам в этих строках
Это откуда такое условие? Посмотрел вашу сортировку, строки сортируются неправильно (отметил) в моей все ОК. Или у вас какая-то особенная не стандартная сортировка. У меня стандартная по строкам. Посимвольно.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
bedvit, не думаю, что вычленение чисел сильно вас замедлит, к тому же у вас наверняка есть супербыстрые целочисленные сортировщики для нормального распределения - так что, может даже шустрее выйдет
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Добрый день, коллеги! Андрей, в Вашем примере из #80 (и в остальных аналогичных) может ускорить выполнение параметр Len=32767 оператора Open для чтения и записи.
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
запись в новый файл и через FSO - разве есть связь? Отрыв небольшой - можно списать на колебания мощности, но лишним точно не будет. Полагаю, что можно использовать Len=32767 по-умолчанию, при открытии любых файлов. Правильно? Не будет сбоить на маленьких?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄