Remove elements repeted #2

General FreeBASIC programming questions.
lrcvs
Posts: 571
Joined: Mar 06, 2008 19:27
Location: Spain

Remove elements repeted #2

Postby lrcvs » Aug 10, 2018 6:14

Hi:

Note: This version does not detect the orthographic symbols.
Apologies!


'Program to eliminate the repeated words of a text.

Code: Select all

'Program to eliminate the repeated words of a text.
'The most interesting application of this program is the creation of texts / books with unique words.
'lrcvs 10.08.18

DIM AS STRING z,y,x,a
DIM AS INTEGER j,n
z = "En un lugar de la Mancha, de cuyo nombre no quiero acordarme, no ha mucho tiempo que vivía un hidalgo de los de lanza en astillero, adarga antigua, rocín flaco y galgo corredor. Una olla de algo más vaca que carnero, salpicón las más noches, duelos y quebrantos los sábados, lentejas los viernes, algún palomino de añadidura los domingos, consumían las tres partes de su hacienda. El resto della concluían sayo de velarte, calzas de velludo para las fiestas con sus pantuflos de lo mismo, los días de entre semana se honraba con su vellori de lo más fino. Tenía en su casa una ama que pasaba de los cuarenta, y una sobrina que no llegaba a los veinte, y un mozo de campo y plaza, que así ensillaba el rocín como tomaba la podadera. Frisaba la edad de nuestro hidalgo con los cincuenta años, era de complexión recia, seco de carnes, enjuto de rostro; gran madrugador y amigo de la caza. Quieren decir que tenía el sobrenombre de Quijada o Quesada (que en esto hay alguna diferencia en los autores que deste caso escriben)."
z = z + " "
y = ""
x = ""
a = ""
PRINT "Original text:"
PRINT z
FOR j = 1 TO LEN(z)
    IF MID(z,j,1) <> CHR(32) THEN
        a = a + MID(z,j,1)
        ELSE
        a = a + " "
            IF INSTR(y,a) = 0 THEN
                y = y + a
            ELSE
                x = x + a
            END IF
        a = ""
    END IF
NEXT j

PRINT
PRINT "Text with unique words:"
PRINT y
PRINT
PRINT "Repeated words"
PRINT x
PRINT
PRINT "End"
SLEEP
END


Regards
lrcvs
Posts: 571
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Remove elements repeted #2

Postby lrcvs » Aug 11, 2018 11:43

Hi:

In this new version, I wish I solved this error!

Code: Select all

'Program to eliminate the repeated words of a text.
'The most interesting application of this program is the creation of texts / books with unique words.
'lrcvs 10.08.18

DIM AS STRING z,y,x,a,b
DIM AS INTEGER j,l,n,c
z = "En un lugar de la Mancha, de cuyo nombre no quiero acordarme, no ha mucho tiempo que vivía un hidalgo de los de lanza en astillero, adarga antigua, rocín flaco y galgo corredor. Una olla de algo más vaca que carnero, salpicón las más noches, duelos y quebrantos los sábados, lentejas los viernes, algún palomino de añadidura los domingos, consumían las tres partes de su hacienda. El resto della concluían sayo de velarte, calzas de velludo para las fiestas con sus pantuflos de lo mismo, los días de entre semana se honraba con su vellori de lo más fino. Tenía en su casa una ama que pasaba de los cuarenta, y una sobrina que no llegaba a los veinte, y un mozo de campo y plaza, que así ensillaba el rocín como tomaba la podadera. Frisaba la edad de nuestro hidalgo con los cincuenta años, era de complexión recia, seco de carnes, enjuto de rostro; gran madrugador y amigo de la caza. Quieren decir que tenía el sobrenombre de Quijada o Quesada (que en esto hay alguna diferencia en los autores que deste caso escriben)."
z = z + " "
b = ".:,;-_!¡¿?()/\[]{}=$%&*-+'¨^´·|@#~ " +chr(34)'<<< New option!
y = ""
x = ""
a = ""

PRINT "Original text:"
PRINT z

FOR j = 1 TO LEN(z)
    c = 0
   
    'simbols:.:,;-_!¡¿?()/\[]{}=$%&*-+'¨^´·|@#~ "
    for n = 1 to len (b)
        if mid(z,j,1) = mid(b,n,1) then c = 1:exit for
    next n
   
    IF c = 0 THEN
        a = a + MID(z,j,1)
        ELSE
        a = a +" "
            IF INSTR(y,a) = 0 THEN
                y = y + a
            ELSE
                x = x + a
            END IF
        a = ""
    END IF
NEXT j

PRINT
PRINT "Text with unique words:"
PRINT y
PRINT
PRINT "Repeated words:"
PRINT x
PRINT
PRINT "End"
SLEEP
END



Regards

Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests