purebasic.info

PureBasic forum
Текущее время: Ср апр 24, 2019 3:52 am

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 6 ] 
Автор Сообщение
 Заголовок сообщения: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Вт фев 12, 2019 10:00 pm 
Не в сети
профессор

Зарегистрирован: Чт фев 09, 2017 10:37 am
Сообщений: 456
Благодарил (а): 33 раз.
Поблагодарили: 50 раз.
Пункты репутации: 0
Попробовал за счёт Map, надо ещё потестировать на длину строки, есть ли у Map ограничение на длину ключа. В AutoIt3 я делал используя объект "Scripting.Dictionary" смысл похожий, но были доп. фичи поддерживался ключ без учёта регистра. Здесь можно сделать, но надо заполнять 2 карты, в одной приводить к одному регистру для поиска, а из второй извлекать с оригинальным регистром.
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Global extended = 0 ; дополнительное значение после функции
 
Procedure StrToArr(Array Arr.s(1), String$, Sep$ = " ")
        CountSep = CountString(String$ , Sep$)
        If CountSep = 0
                ReDim Arr(1)
                Arr(1) = String$
        Else
                ReDim Arr(CountSep+1)
                For n = 1 To CountSep+1
                        Arr(n) = StringField(String$, n, Sep$)
                Next
        EndIf
EndProcedure
 
; Возвращает одинаковые строки в 2-х файлах. С учётом регистра.
Procedure.s Alike_Lines(sText1$, sText2$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, Dim Arr.s(1)
       
        StrToArr(Arr(), sText1$, sep$) ; Создаём ключи 1-го файла
        Protected NewMap StrMap()
        For i=1 To ArraySize(Arr()) ; все элементы массива суём в карту со значением -2
                StrMap(Arr(i)) = -2
        Next
        StrMap("") = 2 ; против пустых строк
       
        ReDim Arr(0) ; очищаем массив, чтобы заполнить элементами из 2-го файла
        StrToArr(Arr(), sText2$, sep$) ; Создаём ключи 2-го файла
       
        k = 0
        sText1$ = ""
        For i=1 To ArraySize(Arr()) ; перебираем второй массив
                StrMap(Arr(i)) = (StrMap(Arr(i)) + 1) ; если у нас попадается первое совпадение, то -2+1 = -1, второй раз уже будет 0, а ни разу будет -2 или 1
                If StrMap(Arr(i)) = -1
                        sText1$ + Arr(i) + sep2$
                        k + 1
                EndIf
        Next
        extended = k
        ProcedureReturn sText1$
EndProcedure
 
s1$ = "привет" + #CRLF$+ "11111" + #CRLF$+ "22222" + #CRLF$+ "ура" + #CRLF$+ "33333" + #CRLF$+ "555"
s2$ = "ура" + #CRLF$+ "000" + #CRLF$+ "привет" + #CRLF$+ "22222" + #CRLF$+ "444" + #CRLF$+ "555"
Debug Alike_Lines(s1$, s2$)
Debug extended
 



Тоже самое но не массив а список
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Global extended = 0 ; дополнительное значение после функции
 
Procedure StrToArr(List StrList.s(), String$, Sep$ = " ")
        CountSep = CountString(String$ , Sep$)
        If CountSep = 0
                AddElement(StrList())
                StrList() = String$
        Else
                For n = 1 To CountSep+1
                        AddElement(StrList())
                        StrList() = StringField(String$, n, Sep$)
                Next
        EndIf
EndProcedure
 
; Возвращает одинаковые строки в 2-х файлах. С учётом регистра.
Procedure.s Alike_Lines(sText1$, sText2$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, NewList StrList.s()
       
        StrToArr(StrList(), sText1$, sep$) ; Создаём ключи 1-го файла
        Protected NewMap StrMap()
        ForEach StrList() ; все элементы списка суём в карту со значением -2
                StrMap(StrList()) = -2
        Next
        StrMap("") = 2 ; против пустых строк
       
        ClearList(StrList())  ; очищаем список, чтобы заполнить элементами из 2-го файла
        StrToArr(StrList(), sText2$, sep$) ; Создаём ключи 2-го файла
       
        k = 0
        sText1$ = ""
        ForEach StrList() ; перебираем второй список
                StrMap(StrList()) = (StrMap(StrList()) + 1) ; если у нас попадается первое совпадение, то -2+1 = -1, второй раз уже будет 0, а ни разу будет -2 или 1
                If StrMap(StrList()) = -1
                        sText1$ + StrList() + sep2$
                        k + 1
                EndIf
        Next
        extended = k
        ProcedureReturn sText1$
EndProcedure
 
s1$ = "привет" + #CRLF$+ "11111" + #CRLF$+ "22222" + #CRLF$+ "ура" + #CRLF$+ "33333" + #CRLF$+ "555"
s2$ = "ура" + #CRLF$+ "000" + #CRLF$+ "привет" + #CRLF$+ "22222" + #CRLF$+ "444" + #CRLF$+ "555"
Debug Alike_Lines(s1$, s2$)
Debug extended
 



Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Вт фев 12, 2019 10:44 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11439
Благодарил (а): 4 раз.
Поблагодарили: 461 раз.
Можно использовать список структур где хранить ключ и другие данные.
Код:
1
2
3
4
5
6
7
Structure ll
  Key.s
  ; Другие данные.
EndStructure
 
NewList Lists.ll()
 

Поиск ключа путем перебора списка циклом ForEach.

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Вт фев 12, 2019 11:17 pm 
Не в сети
профессор

Зарегистрирован: Чт фев 09, 2017 10:37 am
Сообщений: 456
Благодарил (а): 33 раз.
Поблагодарили: 50 раз.
Пункты репутации: 0
Пётр писал(а):
Можно использовать список структур где хранить ключ и другие данные.
Вроде структура ни чем не помогает. У меня один список заполненный строками, всё остальное решается через Map, благодаря тому что она проверяет существует ли ключ перед добавлением. И этот способ быстро работает в отличии от проверки путём поиска, по крайней мере так было в "Scripting.Dictionary". Тут возможно лучше убрать заполнение в список потом в карту, а сделать сразу заполнение в карту.

Вот сделал только на карте Map... без List (указать ваши файлы в примере)
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Global extended = 0 ; дополнительное значение после функции
 
; Возвращает одинаковые строки в 2-х файлах. С учётом регистра.
Procedure.s Alike_Lines(sText1$, sText2$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, NewMap StrMap()
       
        ; Создаём ключи 1-го файла
        CountSep = CountString(sText1$ , sep$)
        If CountSep = 0
                StrMap(sText1$) = -2
        Else
                For n = 1 To CountSep+1
                        StrMap(StringField(sText1$, n, sep$)) = -2
                Next
        EndIf
       
        StrMap("") = 2 ; против пустых строк
;       Debug MapSize(StrMap())
        k = 0
        sText1$ = ""
        CountSep = CountString(sText2$ , sep$)
        If CountSep = 0
                StrMap(sText2$) = (StrMap(sText2$) + 1) ; если у нас попадается первое совпадение, то -2+1 = -1, второй раз уже будет 0, а ни разу будет -2 или 1
                If StrMap(sText2$) = -1
                        sText1$ + sText2$ + sep2$
                        k + 1
                EndIf
        Else
                For n = 1 To CountSep+1
                        tmp$ = StringField(sText2$, n, sep$)
                        StrMap(tmp$) = (StrMap(tmp$) + 1) ; если у нас попадается первое совпадение, то -2+1 = -1, второй раз уже будет 0, а ни разу будет -2 или 1
                        If StrMap(tmp$) = -1
                                sText1$ + tmp$ + sep2$
                                k + 1
                        EndIf
                Next
        EndIf
       
;       Debug MapSize(StrMap())
        extended = k
        ProcedureReturn sText1$
EndProcedure
 
Procedure.s ReadFileR1(Path$) ; свой вариант заменил вариантом из справки, см ниже
        Protected sizefile, Text$
        sizefile = FileSize(Path$) ; определяем размер данных в байтах
        If sizefile => 0 ; файл существует
                ReadFile(0 , Path$, #PB_UTF8)
                Text$ = ReadString(0, #PB_UTF8 | #PB_File_IgnoreEOL)
                CloseFile(0)                                             ; закрытие файла
        EndIf
        ProcedureReturn Text$
EndProcedure
 
s1$ = ReadFileR1("C:\file.pb")
; Debug Len(s1$)
s2$ = ReadFileR1("C:\file2.pb")
Debug Alike_Lines(s1$, s2$)
; Debug Alike_Lines(s2$, s1$)
Debug "уникальных = " + extended
 



проверил длину строки 5000, без проблем.


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Ср фев 13, 2019 9:15 am 
Не в сети
профессор

Зарегистрирован: Вт май 13, 2014 4:12 am
Сообщений: 793
Благодарил (а): 76 раз.
Поблагодарили: 23 раз.
Пункты репутации: 5
так и не понял что надо
AZJIO писал(а):
всё остальное решается через Map, благодаря тому что она проверяет существует ли ключ перед добавлением

похоже тут Федя сделал не прямой перебор всех ключей подряд, а использовал таблицу, вобщем один из фокусов позволяющий быстро находить
словари для проверки орфо, они летают
недавно нечто подобное тоже "изобрёл", быстрый поиск слова в "словаре"
сам незнаю зачем я это сделал, сделал ради интереса, и куда то засунул

кстати, карта позволяет такой фокус, можно создавать пустой элемент, просто создать ключ без данных, получем резкое ускорение


Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Ср фев 13, 2019 11:32 am 
Не в сети
профессор
Аватар пользователя

Зарегистрирован: Вт апр 14, 2009 7:22 pm
Сообщений: 380
Благодарил (а): 1 раз.
Поблагодарили: 16 раз.
Пункты репутации: 0
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
UseSQLiteDatabase()
OpenDatabase(0, ":memory:", "", "") ; :memory: - база создаётся в памяти
DatabaseUpdate(0, "CREATE TABLE T1 (sss VARCHAR(255));")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('привет');")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('11111');")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('22222');")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('ура');")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('33333');")
DatabaseUpdate(0, "INSERT INTO  T1 (sss) VALUES ('555');")
DatabaseUpdate(0, "CREATE INDEX T1I ON T1(sss);")
Debug "=== Сортированная выборка из Т1 ==="
DatabaseQuery(0, "SELECT sss FROM T1 ORDER BY sss;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
Debug "=== Выборка из Т1 в порядке создания ==="
Debug DatabaseQuery(0, "SELECT sss FROM T1;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
DatabaseUpdate(0, "CREATE TABLE T2 (sss VARCHAR(255));")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('ура');")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('000');")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('привет');")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('22222');")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('444');")
DatabaseUpdate(0, "INSERT INTO  T2 (sss) VALUES ('555');")
DatabaseUpdate(0, "CREATE INDEX T2I ON T2(sss);")
Debug "=== Сортированная выборка из Т2 ==="
DatabaseQuery(0, "SELECT sss FROM T2 ORDER BY sss;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
FinishDatabaseQuery(0)
Debug "=== Выборка из Т2 в порядке создания ==="
DatabaseQuery(0, "SELECT sss FROM T2;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
FinishDatabaseQuery(0)
Debug "=== Сортированный результат сравнения ==="
DatabaseQuery(0, "SELECT T1.sss FROM T1, T2 WHERE T1.sss = T2.sss ORDER BY T1.sss;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
FinishDatabaseQuery(0)
Debug "=== Не сортированный результат сравнения ==="
DatabaseQuery(0, "SELECT T1.sss FROM T1, T2 WHERE T1.sss = T2.sss;")
While NextDatabaseRow(0)
  Debug GetDatabaseString(0, 0)
Wend
FinishDatabaseQuery(0)
CloseDatabase(0)


p.s. https://www.sql.ru/forum/1304163/litera ... kom-yazyke


Последний раз редактировалось jobless Ср фев 13, 2019 2:25 pm, всего редактировалось 1 раз.

Вернуться наверх
 Профиль  
 
 Заголовок сообщения: Re: Одинаковые строки в 2-х файлах
СообщениеДобавлено: Ср фев 13, 2019 12:15 pm 
Не в сети
профессор

Зарегистрирован: Чт фев 09, 2017 10:37 am
Сообщений: 456
Благодарил (а): 33 раз.
Поблагодарили: 50 раз.
Пункты репутации: 0
Пока интернета не было наклепал ещё

StringUnique - уникальные строки
StringUnique
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Global extended = 0 ; дополнительное значение после функции
 
; Возвращает одинаковые строки одного файла. С учётом регистра.
Procedure.s StringUnique(sText1$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, CountSep, tmp$, NewMap StrMap()
       
        AddMapElement(StrMap() , "") ; против пустых строк
                                                                 ; Создаём ключи файла
        k = 0
        Res$ = ""
        CountSep = CountString(sText1$ , sep$)
        If CountSep = 0
                ProcedureReturn sText1$
        Else
                For i = 1 To CountSep+1
                        tmp$ = StringField(sText1$, i, sep$)
                        If Not FindMapElement(StrMap() , tmp$) ; если не существует ключ, то
                                AddMapElement(StrMap() , tmp$, #PB_Map_NoElementCheck) ; Добавляем без проверки
                                Res$ + tmp$ + sep2$
                                k + 1
                        EndIf
                Next
        EndIf
       
        extended = k
        ProcedureReturn Res$
EndProcedure
 
Procedure.s ReadFileR1(Path$) ; свой вариант заменил вариантом из справки, см ниже
        Protected sizefile, Text$
        sizefile = FileSize(Path$) ; определяем размер данных в байтах
        If sizefile => 0                   ; файл существует
                ReadFile(0 , Path$, #PB_UTF8)
                Text$ = ReadString(0, #PB_UTF8 | #PB_File_IgnoreEOL)
                CloseFile(0)                                             ; закрытие файла
        EndIf
        ProcedureReturn Text$
EndProcedure
 
s1$ = "привет" + #CRLF$+ "привет" + #CRLF$+ "22" + #CRLF$+ "" + #CRLF$+ "привет" + #CRLF$+ "22" + #CRLF$+ "22"
; s1$ = ReadFileR1("C:\file.pb")
; Debug Len(s1$)
Debug StringUnique(s1$)
Debug "уникальных = " + extended
 



Unique_Lines_Text2 - уникальные 2-го, которых нет в первом
Unique_Lines_Text2
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Global extended = 0 ; дополнительное значение после функции
 
; Возвращает уникальные строки 2-го файла, которых нет в первом. С учётом регистра.
Procedure.s Unique_Lines_Text2(sText1$, sText2$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, CountSep, tmp$, NewMap StrMap()
       
        StrMap("") = 2 ; против пустых строк
         ; Создаём ключи файла
        CountSep = CountString(sText1$ , sep$)
        If CountSep = 0
                StrMap(sText1$) = 2
        Else
                For i = 1 To CountSep+1
                        tmp$ = StringField(sText1$, i, sep$)
                        StrMap(tmp$) = 2
                Next
        EndIf
 
        k = 0
        sText1$ = ""
        CountSep = CountString(sText2$ , sep$)
        If CountSep = 0
                StrMap(sText2$) + 1 ; если попадается первое совпадение, то 1, иначе 2 и более
                If StrMap(sText2$) = 1
                        sText1$ + sText2$ + sep2$
                        k + 1
                EndIf
        Else
                For n = 1 To CountSep+1
                        tmp$ = StringField(sText2$, n, sep$)
                        StrMap(tmp$) + 1 ; если попадается первое совпадение, то 1, иначе 2 и более
                        If StrMap(tmp$) = 1
                                sText1$ + tmp$ + sep2$
                                k + 1
                        EndIf
                Next
        EndIf
        extended = k
        ProcedureReturn sText1$
EndProcedure
 
Procedure.s ReadFileR1(Path$) ; свой вариант заменил вариантом из справки, см ниже
        Protected sizefile, Text$
        sizefile = FileSize(Path$) ; определяем размер данных в байтах
        If sizefile => 0                   ; файл существует
                ReadFile(0 , Path$, #PB_UTF8)
                Text$ = ReadString(0, #PB_UTF8 | #PB_File_IgnoreEOL)
                CloseFile(0)                                             ; закрытие файла
        EndIf
        ProcedureReturn Text$
EndProcedure
 
s1$ = "привет" + #CRLF$ + "привет" + #CRLF$ + "привет" + #CRLF$ + "22" + #CRLF$ + "" + #CRLF$ + "привет" + #CRLF$ + "22" + #CRLF$ + "22"
s2$ = "ура" + #CRLF$+ "000" + #CRLF$+ "привет" + #CRLF$+ "22222" + #CRLF$+ "444" + #CRLF$+ "555"
; s1$ = ReadFileR1("C:\file.pb")
; s2$ = ReadFileR1("C:\file2.pb")
; Debug Len(s1$)
; Debug Unique_Lines_Text2(s1$, s2$)
Debug Unique_Lines_Text2(s2$, s1$)
Debug "уникальных = " + extended
 



CountingStringUnique - уникальные с подсчётом количества
CountingStringUnique
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Global extended = 0 ; дополнительное значение после функции
 
; Возвращает одинаковые строки одного файла с подсчётом количества. С учётом регистра.
Procedure.s CountingStringUnique(sText1$, sep$ = #CRLF$, sep2$ = #CRLF$)
        Protected i, k, CountSep, tmp$, NewMap StrMap()
       
         ; Создаём ключи файла
        CountSep = CountString(sText1$ , sep$)
        If CountSep = 0
                ProcedureReturn sText1$ + #TAB$ + "1"
        Else
                For i = 1 To CountSep+1
                        tmp$ = StringField(sText1$, i, sep$)
                        StrMap(tmp$) + 1
                Next
        EndIf
 
        k = 0
        Res$ = ""
        ForEach StrMap()
                Res$ + Str(StrMap()) +  #TAB$ + MapKey(StrMap()) +sep2$
                k + 1
        Next
        extended = k
        ProcedureReturn Res$
EndProcedure
 
Procedure.s ReadFileR1(Path$) ; свой вариант заменил вариантом из справки, см ниже
        Protected sizefile, Text$
        sizefile = FileSize(Path$) ; определяем размер данных в байтах
        If sizefile => 0                   ; файл существует
                ReadFile(0 , Path$, #PB_UTF8)
                Text$ = ReadString(0, #PB_UTF8 | #PB_File_IgnoreEOL)
                CloseFile(0)                                             ; закрытие файла
        EndIf
        ProcedureReturn Text$
EndProcedure
 
s1$ = "привет" + #CRLF$ + "привет" + #CRLF$ + "привет" + #CRLF$ + "22" + #CRLF$ + "" + #CRLF$ + "привет" + #CRLF$ + "22" + #CRLF$ + "22"
; s1$ = ReadFileR1("C:\file.pb")
; Debug Len(s1$)
Debug CountingStringUnique(s1$)
Debug "уникальных = " + extended



Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 6 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

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


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB