Нейросеть восстановила мне мой архиватор

Страница: 1

Сообщений 1 страница 5 из 5

Поделиться117.01.2025 16:20:48

Автор: PSY
Активный участник
Откуда: Город Пенза
Зарегистрирован: 26.10.2021
Приглашений: 0
Сообщений: 193
Уважение: [+1/-0]
Позитив: [+0/-0]
Пол: Мужской
Возраст: 37 [1988-09-17]
Провел на форуме:
1 день 12 часов
Последний визит:
26.06.2025 02:49:51

Я попробовал восстановить исходники своего недописанного архиватора и нейросеть хоть и накосячила, но можно исправить, ведь логика верна... Так вот нейросеть родила сие чудо, прямо как и я не дописал, только у меня ещё были введены биты длины слов информации в словаре и указатель на длину битов длин и индексов замены... Вообщем, я его не успел дописать - кранты компьютеру пришли, а так - будет время этим заняться, быть может восстановлю. Подключаемый файл не нужен. Заменить указатель можно на динамический список. Я когда-то такое написал и файл размером около килобайта архивировался несколько минут на слабом компьютере, зато смысл прослеживался этой архивации - к ней бы добавить ещё Хаффмана и тогда можно было бы посоревноваться по качеству сжатия и со всеми архиваторами, думаю результат должен был быть не хуже KGB, RAR и 7Z. Зато программа очень прожорлива на оперативную память!!!!!!!

Запрос: помоги написать архиватор на purebasic'е. Реализовать нужно так: 1)Файл для упаковки представить в виде строки состоящей из нулей и единиц то есть битового содержания файла; 2)Выполнить рекурсивный поиск по всей строке всех повторяющихся данных и занесение их в список; 3)Выполнить оптимальную замену повторяющихся данных в строке на индексы элементов списка, содержащего фрагменты данных то есть словаря; 4)Составить результирующий файл, включающий в себя словарь всех данных строки в виде нулей и единиц и последовательности индексов из словаря после замены данных в строке да притом так, - чтобы файл содержал не строку из нулей и единиц а представил её в виде битов информации

Создание архиватора на PureBasic, который будет работать с битовым содержанием файла, требует нескольких шагов. Давайте разберем, как можно реализовать каждый из этих шагов.

Шаг 1: Чтение файла в виде строки из нулей и единиц
Для начала нам нужно прочитать файл и представить его содержимое в виде строки, состоящей из нулей и единиц. Это можно сделать с помощью функции ReadFile и ReadData.

Шаг 2: Рекурсивный поиск повторяющихся данных
После того как мы получили строку, нам нужно найти все повторяющиеся фрагменты. Это можно сделать с помощью простого алгоритма, который будет проверять все подстроки.

Шаг 3: Замена повторяющихся данных на индексы
Затем мы создадим словарь, который будет хранить уникальные фрагменты и их индексы. После этого мы заменим повторяющиеся фрагменты в строке на соответствующие индексы.

Шаг 4: Составление результирующего файла
Наконец, мы создадим результирующий файл, который будет содержать словарь и последовательности индексов.

Вот пример кода, который иллюстрирует эти шаги:
Результат:

Код:

; Подключаем необходимые библиотеки
IncludeFile "Zip.pbi"

; Процедура для чтения файла и преобразования его в строку из нулей и единиц
Procedure.s ReadFileAsBinaryString(fileName$)
  Protected fileSize, binaryString.s
  If ReadFile(0, fileName$)
    fileSize = Lof(0)
    binaryString = Space(fileSize * 8) ; Создаем строку для хранения битов
    For i = 0 To fileSize - 1
      byte = ReadByte(0)
      For j = 0 To 7
        binaryString + Str(Bit(byte, j))
      Next j
    Next i
    CloseFile(0)
    ProcedureReturn binaryString
  Else
    MessageRequester("Ошибка", "Не удалось открыть файл.", 0)
    ProcedureReturn ""
  EndIf
EndProcedure

; Процедура для поиска повторяющихся данных
Procedure FindRepeatingData(binaryString$, *dictionary)
  Protected index, length, fragment, foundIndex
  For length = 1 To Len(binaryString$) / 2 ; Проверяем фрагменты разной длины
    For index = 1 To Len(binaryString$) - length + 1
      fragment = Mid(binaryString$, index, length)
      foundIndex = FindString(*dictionary, fragment, 1)
      If foundIndex = 0 ; Если фрагмент не найден, добавляем его в словарь
        *dictionary + fragment + Chr(0) ; Добавляем фрагмент в словарь
      EndIf
    Next index
  Next length
EndProcedure

; Процедура для замены повторяющихся данных на индексы
Procedure.s ReplaceWithIndices(binaryString$, *dictionary)
  Protected resultString.s, index, fragment
  For index = 1 To CountString(*dictionary, Chr(0))
    fragment = StringField(*dictionary, index, Chr(0))
    binaryString$ = ReplaceString(binaryString$, fragment, Str(index))
  Next index
  ProcedureReturn binaryString$
EndProcedure

; Основная программа
Define fileName$ = "C:\path\to\your\file.bin" ; Укажите путь к вашему файлу
Define binaryString$, dictionary$, resultString$

; Читаем файл в строку из нулей и единиц
binaryString$ = ReadFileAsBinaryString(fileName$)

; Инициализируем словарь
dictionary$ = ""

; Находим повторяющиеся данные
FindRepeatingData(binaryString$, @dictionary$)

; Заменяем повторяющиеся данные на индексы
resultString$ = ReplaceWithIndices(binaryString$, @dictionary$)

; Сохраняем результирующий файл
If CreateFile(0, "C:\path\to\your\result.bin")
  WriteString(0, dictionary$ + Chr(0) + resultString$)
  CloseFile(0)
  MessageRequester("Успех", "Файл успешно сохранен.", 0)
Else
  MessageRequester("Ошибка", "Не удалось создать результирующий файл.", 0)
EndIf

Кому интересно - исправьте, тут всего то ввести список, алгоритм выборки последовательности данных для архивации (я вручную выбирал и ставил приоритеты) и заменитель строки данных на словарь с индексами, оптимизация под минимальную битность длины и преобразователь из строки в двоичный файл. Я ещё не скоро вернусь к этому...

Создание архиватора на PureBasic требует учитывать несколько ключевых аспектов, включая имеющиеся данные, создания словаря, а также замену повторяющихся данных на индексы. Вот простая реализация, которая иллюстрирует предложенные шаги. Обратите внимание, что этот пример не охватывает все возможные случаи и требует доработки для работы с реальными файлами.

Код:

; Инициализация
Global dict.s = ""          ; Словарь повторяющихся данных
Global data.s = ""          ; Исходные данные в виде строки из нулей и единиц
Global output.s = ""        ; Результирующий вывод

; Функция для добавления данных в словарь
Procedure.i AddToDictionary(pData.s)
  If FindString(dict, pData, 1) = 0
    dict + pData + Chr(0)  ; Добавляем новую строку в словарь
    ProcedureReturn CountString(dict, Chr(0))  ; Возвращаем индекс добавленной строки
  EndIf
  ProcedureReturn FindString(dict, pData, 1) / Len(pData)  ; Возвращаем индекс в словаре
EndProcedure

; Процедура для упаковки данных
Procedure PackData()
  Protected i, lenData, index
  lenData = Len(data)

  For i = 1 To lenData
    ; Ищем максимальное совпадение строк начиная с текущей позиции
    Protected match.s = ""
    For j = i To lenData
      Protected substr.s = Mid(data, i, j - i + 1)
      index = AddToDictionary(substr)
      If index > 0
        match = substr
      Else
        Break
      EndIf
    Next j

    ; Если найдено совпадение, заменяем его на индекс из словаря
    If match <> ""
      output + Str(AddToDictionary(match) - 1)  ; Записываем индекс
      i + Len(match) - 1  ; Переходим к следующему месту
    EndIf
  Next i
EndProcedure

; Процедура для инициализации и загрузки данных
Procedure LoadData()
  ; Для теста просто создадим строку данных (например, 1010101011)
  data = "1010101011101010" ; Это ваша исходная строка из 0 и 1
EndProcedure

; Главная программа
LoadData()  ; Загружаем данные
PackData()  ; Упаковываем данные

; Вывод результата
Debug "Словарь: " + dict
Debug "Результат: " + output

Этот код создает поисковую функцию для повторяющихся строк и добавляет их в словарь. Далее происходит замена найденных фрагментов на индексы словаря.
-Как по мне - так лучше ориентироваться на то что удалось отрыть для того чтобы по этому написать архиватор...

Код:

; Процедура для чтения файла и преобразования его в строку из нулей и единиц
Procedure.s ReadFileAsBinaryString(fileName$)
  Protected fileSize, binaryString.s
  If ReadFile(0, fileName$)
    fileSize = Lof(0)
    binaryString = Space(fileSize * 8) ; Создаем строку для хранения битов
    For i = 0 To fileSize - 1
      byte = ReadByte(0)
      For j = 0 To 7
        binaryString + Str(Bit(byte, j))
      Next j
    Next i
    CloseFile(0)
    ProcedureReturn binaryString
  Else
    MessageRequester("Ошибка", "Не удалось открыть файл.", 0)
    ProcedureReturn ""
  EndIf
EndProcedure

; Процедура для поиска повторяющихся данных
Procedure FindRepeatingData(binaryString$, *dictionary)
  Protected index, length, fragment, foundIndex
  For length = 1 To Len(binaryString$) / 2 ; Проверяем фрагменты разной длины
    For index = 1 To Len(binaryString$) - length + 1
      fragment = Mid(binaryString$, index, length)
      foundIndex = FindString(*dictionary, fragment, 1)
      If foundIndex = 0 ; Если фрагмент не найден, добавляем его в словарь
        *dictionary + fragment + Chr(0) ; Добавляем фрагмент в словарь
      EndIf
    Next index
  Next length
EndProcedure

; Процедура для замены повторяющихся данных на индексы
Procedure.s ReplaceWithIndices(binaryString$, *dictionary)
  Protected resultString.s, index, fragment
  For index = 1 To CountString(*dictionary, Chr(0))
    fragment = StringField(*dictionary, index, Chr(0))
    binaryString$ = ReplaceString(binaryString$, fragment, Str(index))
  Next index
  ProcedureReturn binaryString$
EndProcedure

; Основная программа
Define fileName$ = "C:\path\to\your\file.bin" ; Укажите путь к вашему файлу
Define binaryString$, dictionary$, resultString$

; Читаем файл в строку из нулей и единиц
binaryString$ = ReadFileAsBinaryString(fileName$)

; Инициализируем словарь
dictionary$ = ""

; Находим повторяющиеся данные
FindRepeatingData(binaryString$, @dictionary$)

; Заменяем повторяющиеся данные на индексы
resultString$ = ReplaceWithIndices(binaryString$, @dictionary$)

; Сохраняем результирующий файл
If CreateFile(0, "C:\path\to\your\result.bin")
  WriteString(0, dictionary$ + Chr(0) + resultString$)
  CloseFile(0)
  MessageRequester("Успех", "Файл успешно сохранен.", 0)
Else
  MessageRequester("Ошибка", "Не удалось создать результирующий файл.", 0)
EndIf

Отредактировано PSY (17.01.2025 16:57:46)

Поделиться217.01.2025 20:54:54

Автор: PSY
Активный участник
Откуда: Город Пенза
Зарегистрирован: 26.10.2021
Приглашений: 0
Сообщений: 193
Уважение: [+1/-0]
Позитив: [+0/-0]
Пол: Мужской
Возраст: 37 [1988-09-17]
Провел на форуме:
1 день 12 часов
Последний визит:
26.06.2025 02:49:51

Код:

Structure SAMPLE
  Value$
  Len.i
  Count.i
  Priority.i
EndStructure
NewList Sample.SAMPLE()
OpenConsole("Packer And Unpacker (PU)")
If  CountProgramParameters()  <>  3
  PrintN("Usage: PU pack/unpack InputFile OutputFile")
  Input()
  End
EndIf
Action$ = LCase(ProgramParameter(0))
If  Action$ <>  "pack"  And  Action$ <>  "unpack"
  PrintN("Unknown operation.")
  Input()
  End
  EndIf
If  ReadFile(0, ProgramParameter(1))  = 0
  PrintN("Can't open file to read.")
  Input()
  End
EndIf
While Eof(0)=0
  Source$ + RSet(Bin(ReadAsciiCharacter(0)),  8,  "0")
Wend
CloseFile(0)
Len = Len(Source$)
If  Len<1
  PrintN("Input must have a minimum size.")
  Input()
  End
EndIf
If  Action$ = "pack"
  PrintN("Packing start now...")
  Len2  = Len/2
  LenError  = Len % Len2
  PrintN("Find repeated data and create lex.")
  For  i = 1 To  Len2
    For j = i To  Len2+LenError-i-1
      Sample$ = Mid(Source$,  j,  i)
      IsFind  = #False
      ForEach Sample()
        m + 1
        If  Sample()\Value$ = Sample$
          IsFind  = #True
          Sample()\Len    = Len(Sample$)
          Sample()\Count  + 1
          Break
        EndIf
      Next
      If  IsFind  = #False
        AddElement(Sample())
        Sample()\Value$ = Sample$
        Sample()\Len    = Len(Sample$)
        Sample()\Count  = 1
      EndIf
    Next
  Next
  CreateFile(0,"1.txt")
  ForEach Sample()
    WriteStringN(0,Sample()\Value$)
  Next
Else
  
EndIf

Файл в качестве входного размером 81 байт и содержит:

Код:

Добро пожаловать в самую плотную архивацию..

В качестве отладки я использовал запись на диск файла со всеми значениями словаря - 1.txt
Теперь должно работать - словарь вроде бы наполняется. Необходимо собирать и запускать без отладчика
Остальным займусь позже - необходимо теперь заменять самые повторяющиеся элементы не на 0 и 1 а на a и b. Затем сделать рабочий словарь с флагом использования или нет текущего элемента, то есть расширить структуру SAMPLE одним элементом - Is...Used. Подобрать максимальные условия для выборки и выбрать самые повторяющиеся элементы для замены на индексы начиная с нуля и растянутые по длине в оперирующий процессором размер где сделать замену 0 на a, а 1 на b.Затем с помощью выборки определить предельное значение индекса и оптимизировать длину индекса до минимального возможного количества бит. Всё - сердце архиватора был алгоритм ручной выборки данных для сжатия в определённой последовательности путём расстановки приоритетов порядка кодирования данных словарными индексами. Теперь надо автоматический, у кого какие предложения?

Отредактировано PSY (17.01.2025 21:04:10)

Поделиться318.01.2025 01:06:25

Автор: PSY
Активный участник
Откуда: Город Пенза
Зарегистрирован: 26.10.2021
Приглашений: 0
Сообщений: 193
Уважение: [+1/-0]
Позитив: [+0/-0]
Пол: Мужской
Возраст: 37 [1988-09-17]
Провел на форуме:
1 день 12 часов
Последний визит:
26.06.2025 02:49:51

У меня дополнение -

Код:

ForEach Sample()
    If  Sample()\Count  > MaxCount
      MaxCount  = Sample()\Count
    EndIf
    If  Sample()\Len  > MaxLen
      MaxLen  = Sample()\Len
    EndIf
  Next

Честно говоря для автоматизации нужно использовать эти два параметра и присваивать нарастающий Priority замены из словаря. Но я пока не понял - для чего эти два параметра вместе, но ведь чем длинее повторяемый блок данных и с большим повторением - тем больше шанс сжать более качественно. Быть может задавать параметры нейросетью вообще...

Отредактировано PSY (18.01.2025 01:10:53)

Поделиться418.01.2025 01:34:52

Автор: PSY
Активный участник
Откуда: Город Пенза
Зарегистрирован: 26.10.2021
Приглашений: 0
Сообщений: 193
Уважение: [+1/-0]
Позитив: [+0/-0]
Пол: Мужской
Возраст: 37 [1988-09-17]
Провел на форуме:
1 день 12 часов
Последний визит:
26.06.2025 02:49:51

Код:

Structure SAMPLE
  Value$
  Len.i
  Count.i
  Priority.i
  IsUsed.i
EndStructure

Как подсказывает нейронная сеть: Priority вычисляется так

Код:

Priority = Count / Length
NormalizedCount = Count/MaxCount
NormalizedLength = Length/MaxLength
Priority=NormalizedCount*(1-NormalizedLength)

Остаётся только подогнать результаты...Например, предположим, что вы хотите, чтобы меньшее значение Length и большее значение Count давали более высокий приоритет
То есть наверное нужна будет мнимая середина по длине и/или количеству повторов от которой надо будет отталкиваться попеременно то в большую то в меньшую сторону для достижения перебора всех комбинаций закончив на двух последних действиях как MaxCount, 1 или 1 и MaxCount
Значит не зря я ввёл поиск максимальных значений... всё пригодилось

Отредактировано PSY (18.01.2025 02:00:42)

Поделиться518.01.2025 12:36:05

Автор: PSY
Активный участник
Откуда: Город Пенза
Зарегистрирован: 26.10.2021
Приглашений: 0
Сообщений: 193
Уважение: [+1/-0]
Позитив: [+0/-0]
Пол: Мужской
Возраст: 37 [1988-09-17]
Провел на форуме:
1 день 12 часов
Последний визит:
26.06.2025 02:49:51

Пока получилось это:

Код:

Structure SAMPLE
  Value$
  Len.i
  Count.i
  Priority.d
  IsUsed.i
EndStructure
NewList Sample.SAMPLE()
OpenConsole("Packer And Unpacker (PU)")
If  CountProgramParameters()  <>  3
  PrintN("Usage: PU pack/unpack InputFile OutputFile")
  Input()
  End
EndIf
Action$ = LCase(ProgramParameter(0))
If  Action$ <>  "pack"  And  Action$ <>  "unpack"
  PrintN("Unknown operation.")
  Input()
  End
  EndIf
If  ReadFile(0, ProgramParameter(1))  = 0
  PrintN("Can't open file to read.")
  Input()
  End
EndIf
While Eof(0)=0
  Source$ + RSet(Bin(ReadAsciiCharacter(0)),  8,  "0")
Wend
CloseFile(0)
Len = Len(Source$)
If  Len<1
  PrintN("Input must have a minimum size.")
  Input()
  End
EndIf
If  Action$ = "pack"
  PrintN("Packing start now...")
  Len2  = Len/2
  LenError  = Len % Len2
  PrintN("Find repeated data and create lex.")
  For  i = 1 To  Len2
    For j = i To  Len2+LenError-i-1
      Sample$ = Mid(Source$,  j,  i)
      IsFind  = #False
      ForEach Sample()
        m + 1
        If  Sample()\Value$ = Sample$
          IsFind  = #True
          Sample()\Len    = Len(Sample$)
          Sample()\Count  + 1
          Break
        EndIf
      Next
      If  IsFind  = #False
        AddElement(Sample())
        Sample()\Value$ = Sample$
        Sample()\Len    = Len(Sample$)
        Sample()\Count  = 1
      EndIf
    Next
  Next
  ForEach Sample()
    If  Sample()\Count  > MaxCount
      MaxCount  = Sample()\Count
    EndIf
    If  Sample()\Len  > MaxLen
      MaxLen  = Sample()\Len
    EndIf
  Next
  ForEach Sample()
    Sample()\Priority = Sample()\Count  / MaxCount  * (1  - Sample()\Len  / MaxLen)
  Next
  SortStructuredList(Sample(),  #PB_Sort_Ascending, OffsetOf(SAMPLE\Priority),  #PB_Double)
  i = ListSize(Sample())  / 2
  j = 1
  Repeat
    SelectElement(Sample(), i)
    If  FindString(Source$, Sample()\Value$)
      Source$ = ReplaceString(Source$,  Sample()\Value$,  ReplaceString(ReplaceString(RSet(Bin(Count),  64, "0"), "0",  "a"), "1",  "b"))
      Count + 1
      Lex$  + RSet(Bin(Sample()\Len), 64, "0")  + Sample()\Value$
    EndIf
    If  State
      i+j
      State = 0
    Else
      i-j
      State = 1
    EndIf
    j + 1
  Until i = -1 Or  i = ListSize(Sample())
  Source$ = RSet(Bin(Len),  64, "0")  + RSet(Bin(Count),  64, "0")+Lex$  + ReplaceString(ReplaceString(Source$,  "a",  "0"), "b",  "1")
  CreateFile(0, ProgramParameter(2))
  WriteString(0,  Source$)
Else
  
EndIf

Теперь необходимо написать оптимизацию хранения данных по минимальной битности всех индексов (оптимизировать длину с помощью минимального возможного представления битности и сохранить ещё один параметр в архив).
То есть архив будет состоять из:
1)Размер исходных данных в битах
2)Размерность данных представления длины индексов
3)Количество данных в словаре
4)Размерность данных длин фрагментов в словаре
5)Длина каждого фрагмента в словаре
6)Словарь
7)Последовательности индексов заменённых данных

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

Отредактировано PSY (18.01.2025 12:42:39)

Страница: 1

PureBasic - форум

Меню навигации

Пользовательские ссылки

Информация о пользователе

Нейросеть восстановила мне мой архиватор

Сообщений 1 страница 5 из 5

Поделиться117.01.2025 16:20:48

Поделиться217.01.2025 20:54:54

Поделиться318.01.2025 01:06:25

Поделиться418.01.2025 01:34:52

Поделиться518.01.2025 12:36:05