Line with repeated numbers

[carloscordeiro]

Hi Bplus
I come again to ask for your help.
The subject is basically the same as always, but the purpose is different.
This time, I want to count in the numbers.txt file how many lines have the same repeated numbers.
I made a very poor code, if you don't understand I can design my purpose this time.
Here is the file and the faulty code that I tried to make.
Carlos

Code: QB64: [Select]

1. DIM repetitions(1 TO 25) AS STRING
2. DIM repetitions2(1 TO 25)
3. DIM total AS LONG
4.  
5. OPEN "numbers.txt" FOR INPUT AS #1
6. FOR i = 1 TO 25
7.     LINE INPUT #1, repetitions(i)
8. NEXT
9. CLOSE #1
10.  
11. total = 1
12. FOR e = 1 TO 25 'Imperfect code
13.     a$ = repetitions$(e)
14.     FOR i = e + 1 TO 25
15.         IF VAL(repetitions$(i)) = VAL((a$)) THEN
16.             total = total + 1
17.             repetitions2(e) = total
18.         END IF
19.     NEXT
20.     total = 1
21. NEXT
22.  
23. FOR e = 1 TO 25
24.     IF repetitions2(e) <> 0 THEN
25.         PRINT repetitions2(e); "  -  "; repetitions$(e) 'Imperfect code
26.     END IF
27. NEXT
28.  

[bplus]

Hi @carloscordeiro

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 440, 32)
2. REDIM fileLines(1 TO 25) AS STRING, repeats(1 TO 25), repeatLines$(1 TO 25)
3. OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
4. FOR i = 1 TO 25
5.     LINE INPUT #1, fileLines(i)
6.     PRINT i, fileLines(i) 'check the lines
7. NEXT
8. CLOSE #1
9. FOR f = 1 TO 25
10.     FOR i = 1 TO 4 ' 4 number for each file line
11.         n = VAL(MID$(fileLines(f), i * 3 - 2, 2))
12.         repeats(n) = repeats(n) + 1 ' count number of occurances of this number
13.         repeatLines$(n) = repeatLines$(n) + STR$(f) + ","
14.     NEXT
15. NEXT
16. 'report repeats
17. FOR i = 1 TO 25
18.     LOCATE i, 30: PRINT i; " repeats:"; repeats(i); " at:"; repeatLines$(i)
19. NEXT
20.  
21.  

[carloscordeiro]

Hello, bplus
Once again I am unable to express the purpose of the code.
I want him to count the entire line.
In the file number.txt, there are 2 lines with the same numbers.
Ex1: 04 05 06 07 there are two (02) repeated lines.
Ex2. 03 04 05 06 there are three (03) repeated lines.
Regardless of the position of the line, I want only the numbers of the entire line and the number of times.

I attach an image marking the lines of my code with errors, as it counts the lines in excess or duplicates those that it has already counted.

Thanking you in advance for your quick response.
Carlos

[bplus]

This?

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 440, 32)
2. REDIM fileLines(1 TO 25) AS STRING
3. OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
4. FOR i = 1 TO 25
5.     LINE INPUT #1, fileLines(i)
6. NEXT
7. CLOSE #1
8. FOR i = 1 TO 24
9.     t = 1
10.     FOR j = i + 1 TO 25
11.         IF _TRIM$(fileLines(i)) = _TRIM$(fileLines(j)) AND _TRIM$(fileLines(i)) <> "" THEN
12.             t = t + 1
13.             fileLines(j) = ""
14.         END IF
15.     NEXT
16.     IF t > 1 THEN PRINT t; " "; fileLines(i)
17. NEXT
18.  
19.  

[carloscordeiro]

That's right, Bplus.
I think the ease you have in finding quick solutions to my questions is agile.

Great!!!

The only return, and to thank

Thank you one more time
Carlos

[carloscordeiro]

Good night, Bplus

Before I come to ask for your help, I try very hard to resolve it on my own.

This code of yours, to separate lines with repeated numbers, served me a lot at the time you created it.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(800, 440, 32)
2. REDIM fileLines(1 TO 25) AS STRING
3. OPEN "numbers.txt" FOR INPUT AS #1 ' get data from file
4. FOR i = 1 TO 25
5.     LINE INPUT #1, fileLines(i)
6. NEXT
7. CLOSE #1
8. FOR i = 1 TO 24
9.     t = 1
10.     FOR j = i + 1 TO 25
11.         IF _TRIM$(fileLines(i)) = _TRIM$(fileLines(j)) AND _TRIM$(fileLines(i)) <> "" THEN
12.             t = t + 1
13.             fileLines(j) = ""
14.         END IF
15.     NEXT
16.     IF t > 1 THEN PRINT t; " "; fileLines(i)
17. NEXT
18.  
19.  

used it to count repeated numbers from the attached code.

Bplus, could you modify or have another idea to count numbers that come out only once?

When I insert it in the attached code, it doesn't count the number 37 as the attached image.

Code: QB64: [Select]

1.           For i = 1 To qu - 1 'Line with repeated numbers Bplus
2.                t = 1
3.                For j = i + 1 To qu
4.                     If _Trim$(soma1(i)) = _Trim$(soma1(j)) And _Trim$(soma1(i)) <> "" Then
5.                          t = t + 1
6.                          soma1(j) = ""
7.                     End If
8.                Next
9.  
10.                If t > 1 Then
11.                     Color 30
12.                     Locate i + 10, 5
13.                     Print "Dezena = ";
14.                     Color 10
15.                     Locate i + 10, 8
16.                     Print " "; soma1(i);
17.                     Color 30
18.                     Locate i + 10, 12
19.                     Print "="; t
20.                End If
21.           Next
22.      Else

Put this string when running the code
083033374548

Carlos

[bplus]

@carloscordeiro

Sorry not interested in immersing into this again, since last time I built an Interpreter, fixed String Math and made nice Pool game. My head and heart is a million miles away from this.

[carloscordeiro]

Sorry not interested in immersing into this again, since last time I built an Interpreter, fixed String Math and made nice Pool game. My head and heart is a million miles away from this.

All right, Bplus
I didn't know you were too busy.
A hug.
Carlos.

[bplus]

@carloscordeiro

This tells if lines are repeated and how many times, so all the lines are accounted for from the file, numbers.txt:

Code: QB64: [Select]

1. Screen _NewImage(800, 440, 32)
2. ReDim fileLines(1 To 25) As String
3. Open "numbers.txt" For Input As #1 ' get data from file
4. For i = 1 To 25
5.     Line Input #1, fl$: fileLines(i) = _Trim$(fl$)
6. Next
7. Close #1
8. For i = 1 To 25
9.     t = 0
10.     For j = i + 1 To 25
11.         If _Trim$(fileLines(i)) = fileLines(j) And Left$(fileLines(i), 7) <> "Repeat " Then
12.             t = t + 1
13.             fileLines(j) = "Repeat " + fileLines(i)
14.         End If
15.     Next
16.     If Left$(fileLines(i), 7) <> "Repeat " Then Print fileLines(i); " repeated"; t; "times." Else Print fileLines(i)
17. Next
18.  

[carloscordeiro]

Good night, Bplus.

That's what I wasn't seeing.

A small change on line 8 from 24 to 25.
FOR i = 1 TO 24

FOR i = 1 TO 24
    t = 1
    FOR j = i + 1 TO 25

For

FOR i = 1 TO 25
    t = 0
    FOR j = i + 1 TO 25

That's what you did and I didn't see it.

Bplus, around here, things are very complicated.

So I created this code with your help, I mean, almost every line of code was with your help and willingness to respond.

I'm trying to find a pattern in the numbers.

More already realized that there is not.

I was trying to help luck when I sometimes make a bet.

[carloscordeiro]

Before thanking,

I would like to ask if there is color in Qbasic 64 as in the example below.

Code: QB64: [Select]

1. [Color 30
2. Print "qbasic"
3. Print
4. Print "Bplus"]

The names keep flashing.

I searched the wiki and I didn't find anything

I always use:

_Title "Qbasic 64"
Screen _NewImage(700, 740, 256)
_Delay .25
_ScreenMove 20, 30

The _Newlmage screen seems to disable this old qbsic effect.

As always, thank you in advance.

Carlos

[carloscordeiro]

 line 8 from 24 to 25.
FOR i = 1 TO 24

FOR i = 1 TO 24
    t = 1
    FOR j = i + 1 TO 25

For

FOR i = 1 TO 25
    t = 0
    FOR j = i + 1 TO 25

The t=0 I left as the previous one
t=1

[bplus]

Before thanking,

I would like to ask if there is color in Qbasic 64 as in the example below.

Code: QB64: [Select]

1. [Color 30
2. Print "qbasic"
3. Print
4. Print "Bplus"]

The names keep flashing.

I searched the wiki and I didn't find anything

I always use:

_Title "Qbasic 64"
Screen _NewImage(700, 740, 256)
_Delay .25
_ScreenMove 20, 30

The _Newlmage screen seems to disable this old qbsic effect.

As always, thank you in advance.

Carlos

Blinking colors and other weird stuff with _NEWIMAGE  0 color setting (or default screen 0):

Code: QB64: [Select]

1. Screen _NewImage(80, 30, 0) ' oh! using 0 means char cells not pixels in _newimage command!
2. For i = 0 To 15
3.     Color i, 0
4.     Locate i + 1, 1: Print "This is color"; i; "for line"; i + 1; "."
5.     Color i + 16
6.     Locate i + 1, 40: Print "This is color"; i + 16; "for line"; i + 1; "."
7. Next
8.  
9.  

 

[carloscordeiro]

Okay, Bplus

I thought that with the settings I use, I could do the same

I wanted for a kind of alert.

Thanks again.

Carlos

[bplus]

Wouldn't be hard to setup blinking text label for graphics screen.

Here's an old one:

Code: QB64: [Select]

1. _Title "Blinking and more with text string" 'b+ 2020-02-15
2.  
3. '===================================================================================
4. ' Lets blink between colors white and blue, expanding and shrinking text for 10 secs
5. '===================================================================================
6.  
7. s$ = "Blink colors white and blue, expanding and shrinking centered text for 10 secs"
8. Screen _NewImage(800, 600, 32)
9. th = 16 'Text Height - start normal
10. dh = 1 'change height
11. flashTimes = 100 'with limit 10 this will take 10 times a second and be done in 100/10 secs
12. start$ = Time$
13. While _KeyDown(27) = 0
14.     Cls
15.     Print start$; ", ";
16.     If flashTimes Then
17.         If toggle = 1 Then C~& = &HFFFFFFFF Else C~& = &HFF0000FF
18.         cText _Width / 2, _Height / 2, th, C~&, s$
19.         toggle = 1 - toggle
20.         th = th + dh
21.         If th > 64 Then th = 64: dh = -dh
22.         If th < 6 Then th = 6: dh = -dh
23.         flashTimes = flashTimes - 1
24.         lastFlash$ = Time$
25.     Else
26.         cText _Width / 2, _Height / 2, 16, &HFFFFFF00, s$
27.     End If
28.     Print lastFlash$; " <<<< notice these numbers are not flashing even though we CLS every frame"
29.     _Display '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> eliminates blinking screens when use CLS
30.     _Limit 10 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  allows maximum number of loops of 10 per sec
31. Wend
32.  
33. 'center the text at x, y with given height and color
34. Sub cText (x, y, textHeight, K As _Unsigned Long, txt$)
35.     Dim fg As _Unsigned Long, cur&, I&, mult, xlen
36.     fg = _DefaultColor
37.     'screen snapshot
38.     cur& = _Dest
39.     I& = _NewImage(8 * Len(txt$), 16, 32)
40.     _Dest I&
41.     Color K, _RGBA32(0, 0, 0, 0)
42.     _PrintString (0, 0), txt$
43.     mult = textHeight / 16
44.     xlen = Len(txt$) * 8 * mult
45.     _PutImage (x - .5 * xlen, y - .5 * textHeight)-Step(xlen, textHeight), I&, cur&
46.     Color fg
47.     _FreeImage I&
48. End Sub
49.  

Another one:

Code: QB64: [Select]

1. Randomize Timer
2. Screen _NewImage(220, 50, 32)
3. _Title ""
4. Const H$ = "Hello World"
5. Dim Shared r&, g&, b&, old&, new&
6. update
7. While _KeyDown(27) = 0
8.     If Rnd < 1 / 20 And m = 10 Then update
9.     Cls
10.     m = (m + 1) Mod 11
11.     If m = 0 Then Swap old&, new&
12.     x = 65 + m * 8
13.     Color old&
14.     _PrintString (65, 15), Mid$(H$, 1, m)
15.     Color new&
16.     _PrintString (x, 15), Mid$(H$, m + 1)
17.     _Display
18.     _Limit 30
19. Wend
20.  
21. Sub update
22.     r& = Rnd * 255: g& = Rnd * 255: b& = Rnd * 255
23.     old& = _RGB32(r&, g&, b&)
24.     new& = _RGB32((r& + 128) Mod 255, (g& + 128) Mod 255, (b& + 128) Mod 255)
25. End Sub
26.  
27.