Calc: Unikalne wystąpienia (po raz trzeci)

Gotowe szablony, skrypty, makropolecenia i rozszerzenia. Tutaj możesz pochwalić i podzielić się swoją twórczością z innymi użytkownikami
Awatar użytkownika
Rafkus
Posty: 416
Rejestracja: czw kwie 12, 2018 10:26 pm

Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Z cztery miesiące, temu na potrzeby forum stworzyłem funkcję UNIKALNE, która to z pewnego tekstu usuwała pewne powtarzające się frazy. Niedawno stworzyłem sobie nową funkcję UNIKALNE2 - wyszukującą i zwracającą tylko niepowtarzalne wyniki z pewnego zakresu. Przyjrzałem się obu tym funkcjom i doszedłem do wniosku, że główny algorytm wyszukiwania działa na tej samej zasadzie. Dlatego połączyłem te dwie funkcje w jedną, oraz dodałem możliwość sortowania wyniku (@Jermor - to akurat był twój pomysł). Oto jej kod:
UWAGA: W poście poniżej jest nowsza - efektywniejsza wersja.

Kod: Zaznacz cały

Function UNIKALNE(dane as variant, optional sort as integer, optional zmienna as string) as variant
REM: Funkcja UNIKALNE: zwraca z pewnego tekstu, komórki lub zakresu danych tylko niepowtarzalne wartości.
REM: Ponadto wynik może zostać automatycznie posortowany
REM: Więcej o funkcji jest tu: https://forum.openoffice.org/pl/forum/viewtopic.php?f=28&p=24335#p24323
dim wynik(0), podziel() as variant
dim i,j,ile_w,ile_d as integer
dim element as variant

REM: dane początkowe
'On Local Error GoTo blad
 ile_w = -1			'ilość wyników, narazie ich brak
 If IsMissing(sort) or not (sort =1 or sort =2) then sort = 0	'czy sortować dane: 0-nie, 1-rosnąco, 2-malejąco
 if IsArray(dane) then			'czy dane są tablicą
   If IsMissing(zmienna) then zmienna = "" 		'zmienna to wartość do pominięcia
   ile_d =  UBound(dane,1)*UBound(dane,2) - 1	'ilość danych
   podziel = dane
 else
   If IsMissing(zmienna) then zmienna = " "		'zmienna to separator
   ile_d = -1									'wyniki połącz w jeden tekst
   dane = replace(dane, "  ", " ")				'pozbycie sie podwójnych spacji
   podziel = split(dane, zmienna)  
   if zmienna <> " " then zmienna = zmienna + " "
 endif 
 
REM: poszukiwanie wartości unikalnych
  for each element in podziel()			'wędrówka po kolejnych danych wejściowych
    if IsEmpty(element) then		'określenie typu elementu
     'Element jest pusty, nie trzeba określać typu
     'UWAGA: W przypadku zakresu danych wejściowych w AOO zaimportowana komórka nigdy nie jest pusta
     'pusta komórka dostaje wartość 0      
    elseif IsNumeric(element) then		
      element = CDBL(element)		'element jest liczbą
    else 
      element = trim(element)		'element jest tekstem, pozbycie się początkowych i końcowych spacji
    endif

    i = 0 'sprawdzaj czy element jest już w tabeli wyników
    do until element = wynik(i) or IsEmpty(element) or element = "" or element = zmienna      	
      'pomijaj puste komórki oraz gdy element jest taki sam jak zmienna
      if ile_w > -1 then i=i+1	'gdy jest już jakiś wynik przejdź do kolejego wyniku
      if i = ile_w+1 then		'popraw pierwszy wynik lub dopisz nowy
        ile_w = i
        ReDim Preserve wynik(ile_w)
        wynik(ile_w) = element
      endif      
    loop 
  next

REM: A może tak posortować dane?
dim zamien as boolean
  j = (ile_w > 0)*(sort>0)
  Do until j=0
    j=0
    for i=0 to ile_w-1
      if not IsNumeric(wynik(i)) and not IsNumeric(wynik(i+1)) then
        'gdy oba wyniki są tekstem to porównaj te teksty ale pisanymi dużymi literami; 
        'niestety teksy zaczynające się polskimi znakami (ł,ć,ż itd.) wylądują na końcu...
        '... gdyż porównuje teksty nie alfabetycznie tylko według kodu ASCII
        zamien = (sort=1 and UCase(wynik(i))>UCase(wynik(i+1)))or(sort=2 and UCase(wynik(i))<UCase(wynik(i+1)))
      else		'porównanie liczb bądź liczby i tekstu
        zamien = (sort=1 and wynik(i)>wynik(i+1))or(sort=2 and wynik(i)<wynik(i+1))
      endif
REM:      if wynik(i)>wynik(i+1) then	'orginalny warunek
      if zamien then
        element=wynik(i) : wynik(i)=wynik(i+1) : wynik(i+1)=element : j=1
      end if
    next
  Loop

REM: Wyniki:
  if ile_d = -1 then		'w formie połączonego tekstu
    UNIKALNE = wynik(0) 
    for i=1 to ile_w 
      UNIKALNE = unikalne + zmienna + wynik(i)
    next i
  elseif UBound(dane,1) > UBound(dane,2) then	' pionowa kolumna bo liczba wierszy w danych jest większa od ilości kolumn
   dim wynik2(ile_d,0)as variant
    for i=0 to ile_w			'wyniki od ile_w do ile_d są puste więc można tutaj zakończyć transpozycję wyników
      wynik2(i,0) = wynik(i)
    next i
    UNIKALNE = wynik2
  else
    ReDim Preserve wynik(ile_d)	'poziomy wiersz wyników ma zająć tyle samo komórek co dane wejściowe
    UNIKALNE = wynik
  endif
    
' exit Function 
'blad:
'  unikalne = "Error"
end Function
Jak działa ta funkcja:
Funkcja ta z pewnego tekstu (przedzielonego jakimiś separatorami) lub zakresu komórek wypisuje tylko unikalne wartości. Składnia tej funkcji :
=UNIKALNE(dane; sort; zmienna)
  • dane - może być tekstem, komórką lub pewnym zakresem danych wejściowych na którym będzie przeprowadzana operacja wyszukiwania.
    UWAGA: W przypadku podania pewnego zakresu danych należy tą formułę zatwierdzić przez jednoczesne wciśnięcie klawiszy CTRL+SHIFT+ENTER, jest to sposób zatwierdzania funkcji macierzowych zwracających pewien obszar danych. Ten obszar będzie tutaj zawsze jedno-wierszowy lub jedno-kolumnowy (zależy to od zakresu wejściowego czy ma więcej wierszy czy kolumn).
  • sort - parametr opcjonalny decydujący czy i jak dane mają być posortowane. Można wprowadzić: 1 - sortuj rosnąco, 2 - sortuj malejąco, 0 - brak lub każda inna wartość - oznacza aby nie sortować;
  • zmienna - parametr opcjonalny w zależności od danych oznacza:
    • - znak separatora dla jednej danej,
    • - wartość do wykluczenia w tabeli danych.
Przykłady zastosowania:
  • =UNIKALNE("na, ma, na, da") - brak podanych parametrów opcjonalnych więc jako separator zostanie uznana spacja, zwrócony zostanie nieposortowany tekst: na, ma, da
  • =UNIKALNE("na, ma, na, da"; 1) - podana dodatkowo 1 oznacza że zwrócony tekst ma zostać posortowany rosnąco, brak podanego ostatniego parametru więc jako separator zostanie uznana spacja: da ma, na,
  • =UNIKALNE(A1; 2; ",") - w komórce A1 znajduje się tekst: "na, ma, na, da"; 2- oznacza że dane mają być posortowane malejąco, separatorem jest przecinek (","); otrzymany tekst: na, ma, da
  • =UNIKALNE(A1:A10) - dane wejściowe mieszczą się w pewnym zakresie. Aby otrzymać wszystkie wyniki PAMIĘTAJ, że taką formułę należy zatwierdzić wciskając jednocześnie CTRL+SHIFT+ENTER.
    W kolumnie A znajdują się przykładowo pozycje:
    • telewizor
      lodówka
      komputer
      komputer
      telewizor
    Wynikiem będzie dziesięcio-komórkowy obszar (bo tyle elementów zawierają dane wejściowe) zawierający nieposortowane = 3 wartości unikalne (telewizor, lodówka, komputer) + reszta komórek pustych.
    • UWAGA: Jeśli jesteś użytkownikiem OpenOffice do dodatkowo po wartościach unikalnych dostaniesz w wyniku również jedną wartość zerową. Otóż OpenOffie w Basic ?ma problem? z interpretacją pustej komórki. Dla basica polecenie w kodzie funlcji : IsEmpty(element) zawsze przyjmie wartość fałsz, a pusta komórka dostaje wartość 0 (LibreOffice tego problemu nie ma). Aby temu zapobiec wymyśliłem na to pewne sposoby:
    • Opcjonalnie można podawać jakąś wartość do pominięcia. Zatem w tym przykładzie można wpisać: =UNIKALNE2(A1:A10;; 0) Teraz w wyniku na pewno dostaniesz tylko 3 wartości unikalne + 7 komórek pustych.
    • drugi sposób to połączyć wszystkie komórki z zakresu z jakimś tekstem, najlepiej pusty tekst "": =UNIKALNE2(A1:A10 & "") w ten sposób pusta komórka przestała być pusta - (znajduje się tam tekst o długości 0 znaków, fajnie to brzmi :lol: )
  • =UNIKALNE(A1:B10 & ""; 1; "komputer" ) - powiedzmy, że kolumna B jest pusta: wówczas wynikiem będzie pionowy obszar(bo liczba wierszy danych=10 jest większa od liczby kolumn=2) 20 komórek z dwoma posortowanymi rosnąco unikalnymi danymi: lodówka, telewizor (komputer został wykluczony).
EDIT:
Poprawiłem nieco kod;
Uwaga 1: Funkcja ta rozróżnia wielkość liter, wynikiem formuły =UNIKALNE("na NA na da") (separatorem jest spacja) będzie tekst "na NA da"
UWAGA 2: Sortowanie jest niezupełnie alfabetyczne. Tak naprawdę to porównuje znaki według kodu ASCII i w przypadku sortowania rosnącego tekst zaczynający się literą "Ć" (numer kodowy to 198) pojawi się po literze np: "W" (kod 87).
Tabela kodów ASCII
LibreOffice 7.1.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
Jan_J
Posty: 4368
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Jan_J »

Cenna inicjatywa; obyśmy mieli długą pamięć, by powoływać się na własne usprawnienia w trakcie przyszłych dyskusji...

Widzę jeden problem:
jak odróżnić użycie dla przeanalizowania zawartości pojedynczej komórki od użycia do jednoelementowej tabeli?
To drugie niby głupie, ale jest przypadkiem granicznym i nie ma powodu, by zmieniać w nim zachowanie przypadku ogólnego.

Mam też odpowiedź:
=unikalne(a1) analizuje tekst z komórki,
=unikalne(a1:a1) analizuje jednoelementowy zakres.
JJ
LO (6.2|7.2) ∙ AOO (4.1) ∙ Python (3.10) ∙ Unicode 14 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
Awatar użytkownika
Rafkus
Posty: 416
Rejestracja: czw kwie 12, 2018 10:26 pm

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Czy dobrze zrozumiałem: chodzi o to aby formułę zapisaną w ten sposób: =unikalne(a1:a1) potraktowało jak formułę =unikalne(a1) ?
np: A1 = "na, ma, na, da"
=unikalne(a1) -----> "na, ma, da"
obecnie: =unikalne(a1:a1) -----> "na, ma, na, da", a sądzisz że powinno dać: -----> "na, ma, da" ?
LibreOffice 7.1.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
Jan_J
Posty: 4368
Rejestracja: pt maja 22, 2009 1:20 pm
Lokalizacja: Wrocław

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Jan_J »

Miałem wątpliwości dot. przypadku granicznego: gdyby ktoś chciał wyjąć unikaty z 1-komórkowego zakresu, to co? Może to głupi przypadek, ale byłoby jeszcze głupiej, gdyby się nie dało tego zrobić.
I zaraz sprawdziłem, że podane wyżej rozróżnienie między a1 i a1:a1 to umożliwia. Tak jak jest, jest OK.
JJ
LO (6.2|7.2) ∙ AOO (4.1) ∙ Python (3.10) ∙ Unicode 14 ∙ LᴬTEX 2ε ∙ XML ∙ Unix tools ∙ Linux (Rocky|CentOS)
Awatar użytkownika
Rafkus
Posty: 416
Rejestracja: czw kwie 12, 2018 10:26 pm

Re: Calc: Unikalne wystąpienia (po raz trzeci)

Post autor: Rafkus »

Przedstawiam nową wersję mojej funkcji. Zmieniłem w niej:
  1. Zrezygnowałem z sortowania metodą bąbelkową - okazała się nieefektywna w przypadku większej ilości danych. Przetwarzając 1230 danych, otrzymałem 410 nieposortowanych wyników po około 5 sek. Chcąc otrzymać dane posortowane czas oczekiwania zwiększył się o jakieś 20 sek.
  2. Wyniki są obecnie układane na bieżąco (w kolejności rosnącej), dzięki temu nie musi być sprawdzany każdy wynik. Wybierając jakąś wartość do sprawdzenia ze środka wyników można stwierdzić czy jest ona większa czy też mniejsza od danego elementu i tym samym wykluczyć z dalszego porównywania połowę wyników.
    Obecnie przetwarzając 1230 danych otrzymuję 410 posortowanych wyników po około 3 sek.
  3. Dodałem możliwość sortowania według zadanego klucza - można do niego dodać jeszcze jakieś inne znaki.

Kod: Zaznacz cały

Function UNIKALNE(dane as variant, optional sort as integer, optional zmienna as string) as variant
REM: Funkcja UNIKALNE: zwraca z pewnego tekstu, komórki lub zakresu danych tylko niepowtarzalne wartości.
REM: Ponadto wynik może zostać automatycznie posortowany
REM: Więcej o funkcji jest tu: https://forum.openoffice.org/pl/forum/viewtopic.php?f=28&p=24335#p24323
Const klucz as string = "AĄBCĆDEĘFGHIJKLŁMNŃOÓPQRSŚTUVWXYZŹŻ"	'klucz do sortowania
dim podziel(),niesort(0), wynik(0) as variant
dim i,ile_w,ile_d, wynik_od, wynik_do, nrlitery, warunek as integer
dim litera1, litera2 as string
dim element as variant

REM: dane początkowe
'On Local Error GoTo blad
 ile_w = -1			'ilość wyników, narazie ich brak
 If IsMissing(sort) or not (sort =1 or sort =2) then sort = 0	'czy sortować dane: 0-nie, 1-rosnąco, 2-malejąco
 if IsArray(dane) then			'czy dane są tablicą
   If IsMissing(zmienna) then zmienna = "" 		'zmienna to wartość do pominięcia
   ile_d =  UBound(dane,1)*UBound(dane,2) - 1	'ilość danych
   podziel = dane
 else
   If IsMissing(zmienna) then zmienna = " "		'zmienna to separator
   ile_d = -1									'wyniki połącz w jeden tekst
   dane = replace(dane, "  ", " ")				'pozbycie sie podwójnych spacji
   podziel = split(dane, zmienna)
   if zmienna <> " " then zmienna = zmienna + " "
 endif 

REM: poszukiwanie wartości unikalnych
  for each element in podziel()			'wędrówka po kolejnych danych wejściowych      
    if not(IsEmpty(element) or element = "" or element = zmienna) then    
     'sprawdzaj tylko jeśli element nie jest pusty oraz jest inny od zmiennej 
     'UWAGA: W przypadku zakresu danych wejściowych w AOO zaimportowana komórka nigdy nie jest pusta
     'pusta komórka dostaje wartość 0      
      if IsNumeric(element) then	'określenie typu elementu
        element = CDBL(element)		'element jest liczbą
      else 
        element = trim(element)		'element jest tekstem, pozbycie się początkowych i końcowych spacji
      endif
      wynik_od = 0 : wynik_do = ile_w	'zmienne określające przedział wyników do sprawdzenia
      do while wynik_od <= wynik_do	'warunek porównywania
        i =(wynik_od + wynik_do)\2		'środkowy indeks wyniku, który zostanie porównany z danym elementem
        if  wynik(i) = element then wynik_od = -1 : EXIT DO	'element jest już w tabeli wyników
        if IsNumeric(wynik(i)) or IsNumeric(element) then	'porównanie liczb bądź liczby i tekstu
          warunek = (wynik(i) < element)
        else
          nrlitery = 1	:	warunek = 3		'obie porównywane wartości są tekstem
        endif
        
        do while warunek = 3 		'gdy obie porównywane wartości są tekstem
          litera1 = UCase(Mid(wynik(i), nrlitery, 1))	'porównaj kolejne litery (DUŻE LITERY dzięki UCase)
          litera2 = UCase(Mid(element, nrlitery, 1))
          if litera1 = "" or litera2 = "" then	'gdy skończyły się litery, sortuj według długości
            warunek = (len(wynik(i)) < len(element)) 
          elseif  litera1 = litera2 then	'litery są takie same - przejdź do następnej litery
            nrlitery = nrlitery + 1       
          elseif InStr(klucz,litera1) = 0 or InStr(klucz,litera2) = 0 then	'litery nie ma w kluczu - sortuj wedug ASCII
            warunek = (litera1 < litera2)
          else 		'porównaj litery według położenia w kluczu
            warunek = (InStr(klucz,litera1) < InStr(klucz,litera2))          
          endif 
        loop

        if warunek then		'zmniejsz zakres
          wynik_od = i+1 	'środek zakresu staje się początkiem
        else
          wynik_do = i-1	'środek zakresu staje się końcem
        endif      
      loop      
      
      if wynik_od > -1 then		'wynik_od to także numer indeksu, na który ma trafić nowy wynik 
        ile_w = ile_w+1			'ilość wyników się zwiększyła
        ReDim Preserve wynik(ile_w), niesort(ile_w)
        for i = ile_w to wynik_od+1 step -1	'przesuń wyniki od ostatniego do wyznaczonego
          wynik(i) = wynik(i-1)				'na dane miejsce wstaw wcześniejszy wynik
        next i        
        wynik(wynik_od) = element : niesort(ile_w) = element	'zapisz nowy element
      endif     
    endif
  next

REM: Jaka ma być kolejność wyników?
  select case sort
    Case 0: 	'dane mają być nieposortowane
      wynik = niesort    
    'Case 1:    'domyślnie wyniki są sortowane rosnąco
    Case 2:		'sortuj malejąco
      for i=0 to ile_w\2		'odwróć kolejność posortowanych wyników
        element=wynik(i) : wynik(i)=wynik(ile_w-i) : wynik(ile_w-i)=element
      next i
  end Select
 
REM: Wypisz wyniki:
  if ile_d = -1 then		'w formie połączonego tekstu
    UNIKALNE = wynik(0) 
    for i=1 to ile_w 
      UNIKALNE = UNIKALNE + zmienna + wynik(i)
    next i
  elseif UBound(dane,1) > UBound(dane,2) then	' pionowa kolumna bo liczba wierszy w danych jest większa od ilości kolumn
   dim wynik2(ile_d,0)as variant
    for i=0 to ile_w			'wyniki od ile_w do ile_d są puste więc można tutaj zakończyć transpozycję wyników
      wynik2(i,0) = wynik(i)
    next i
    UNIKALNE = wynik2
  else
    ReDim Preserve wynik(ile_d)	'poziomy wiersz wyników ma zająć tyle samo komórek co dane wejściowe
    UNIKALNE = wynik
  endif
    
' exit Function 
'blad:
'  UNIKALNE = "Error"
end Function
LibreOffice 7.1.6 (preferowany) oraz OpenOffice 4.1.6. Widows 10
OpenOffice 4.1.3. oraz Libre 4.2.5.2 Windows XP
ODPOWIEDZ