All Digits

[bplus]

Can anyone do this in 10 lines or less:
http://paulbourke.net/fun/digits.html

I am down to 11 lines, including printing the number, it's square and cube.

(Double parking with colons counts as more lines.)

Update: 10

Update: 9

Update: 7

[Richard Frost]

9 lines, including printing the number, square, and cube.

Code: QB64: [Select]

1. woof:
2. n = n + 1
3. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
4. PRINT n; n * n; n * n * n; " "; n$
5. FOR i = 0 TO 9
6.     p = INSTR(n$, CHR$(48 + i))
7.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO woof
8. NEXT i
9. IF n$ <> "xxxxxxxxxx" THEN GOTO woof
10.  

[bplus]

Nice here it is at 9 with less sauce:

Code: QB64: [Select]

1. woof:
2. n = n + 1
3. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
4. IF LEN(n$) > 10 THEN PRINT " no solution": END
5. FOR i = 0 TO 9
6.     p = INSTR(n$, CHR$(48 + i))
7.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO woof
8. NEXT i
9. IF n$ = "xxxxxxxxxx" THEN PRINT n; n * n; n * n * n ELSE GOTO woof
10.  

[bplus]

I would give it 7 without the check for limit and dump the colon

Code: QB64: [Select]

1. 1 n = n + 1
2. n$ = LTRIM$(STR$(n * n)) + LTRIM$(STR$(n * n * n))
3. FOR i = 0 TO 9
4.     p = INSTR(n$, CHR$(48 + i))
5.     IF p THEN MID$(n$, p, 1) = "x" ELSE GOTO 1
6. NEXT i
7. IF n$ = "xxxxxxxxxx" THEN PRINT n; n * n; n * n * n ELSE GOTO 1
8.  
9.  
10.  

[bplus]

My 7 liner made use of fact that all 10 digits from squares and cubes were numbers from 47 to 99 learned in the 9 liner:

Here is how I worked mine down:

Code: QB64: [Select]

1. ' all digits last one under easy
2. _TITLE "A number whose digits from it's square and cube is 1 of all the digits" 'b+ 2020-09-19 from Paul Bourke
3. 'FOR n = 1 TO 1000
4. '    s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))
5. '    IF LEN(s$) = 10 THEN
6. '        REDIM digits(9)
7. '        FOR i = 1 TO 10
8. '            digits(VAL(MID$(s$, i, 1))) = 1
9. '        NEXT
10. '        OK = -1
11. '        FOR i = 0 TO 9
12. '            IF digits(i) <> 1 THEN OK = 0: EXIT FOR
13. '        NEXT
14. '        IF OK THEN PRINT n: EXIT FOR
15. '    END IF
16. 'NEXT
17. 'PRINT n ^ 2, n ^ 3
18.  
19. 'FOR n = 1 TO 1000
20. '    s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))
21. '    IF LEN(s$) = 10 THEN
22. '        test$ = SPACE$(10)
23. '        FOR i = 1 TO 10
24. '            MID$(test$, VAL(MID$(s$, i, 1)) + 1, 1) = "1"
25. '        NEXT
26. '        IF test$ = STRING$(10, "1") THEN EXIT FOR
27. '    END IF
28. 'NEXT
29. 'IF n <> 1001 THEN PRINT n, n ^ 2, n ^ 3 ELSE PRINT "done"
30.  
31. 'FOR n = 1 TO 1000
32. '    IF LEN(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))) = 10 THEN
33. '        test$ = SPACE$(10)
34. '        FOR i = 1 TO 10
35. '            MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
36. '        NEXT
37. '        IF test$ = STRING$(10, "1") THEN EXIT FOR
38. '    END IF
39. 'NEXT
40. 'IF n <> 1001 THEN PRINT n, n ^ 2, n ^ 3 ELSE PRINT "done"
41.  
42. 'FOR n = 47 TO 1000 ' 10 digits for n^2 and n^3
43. '    IF LEN(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n))) = 10 THEN
44. '        'PRINT n  '47 to 99 is the range for 10 digit numbers
45. '        test$ = SPACE$(10)
46. '        FOR i = 1 TO 10
47. '            MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
48. '        NEXT
49. '        IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3
50. '    END IF
51. 'NEXT
52.  
53. FOR n = 47 TO 99 '<< 10 digit range for n^2 and n^3
54.     test$ = SPACE$(10)
55.     FOR i = 1 TO 10
56.         MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
57.     NEXT
58.     IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3
59. NEXT
60.  
61.  

EDIT: Paul Bourke's name corrected:
http://paulbourke.net/fun/

[Richard Frost]

Maybe I shouldn't have posted code so soon, eh?  Give the beginners a good workout.

My first posting wasn't right - said there was no solution.  Duh. 

Puzzles are fun - unless they take months to solve!

[bplus]

Maybe I shouldn't have posted code so soon, eh?  Give the beginners a good workout.

My first posting wasn't right - said there was no solution.  Duh. 

Puzzles are fun - unless they take months to solve!

Ah but you would miss the bonus points for being the first poster.

I like seeing the MID$ SUB being used as opposed to the FUNCTION and work around from using arrays for the letters.

[johnno56]

Way back when, there used to be competitions, to produce workable games/programs in 10 lines or less...

Do I sense a resurgence? lol

[bplus]

Way back when, there used to be competitions, to produce workable games/programs in 10 lines or less...

Do I sense a resurgence? lol

The occasional challenge is nice I think.

If anyone can beat 7 here, it will knock my socks off! Steve has done some clever things.

[bplus]

Wait... 6

Code: QB64: [Select]

1. 1 n = n + 1
2. test$ = SPACE$(10)
3. FOR i = 1 TO 10
4.     MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"
5. NEXT
6. IF test$ = STRING$(10, "1") THEN PRINT "n n^2 n^3:"; n; n ^ 2; n ^ 3 ELSE GOTO 1
7.  

[luke]

I can't beat bplus's 6 lines, so I'm going to cheat and use Haskell instead:

Code: [Select]

head [x | x <- [1..], ['0'..'9'] == sort (show (x^2) ++ show (x^3))]

[Richard Frost]

That 6 line solution is very odd.  You'd probably fall UP if you jumped out of an airplane.

While super short, it's horrible for processing time, which is what I try to optimize for,  esp. lately.

Did you know that 2 nested DO-LOOPs is faster than 2 nested FOR-NEXT loops?  Not that I
understand why.

[bplus]

I can't beat bplus's 6 lines, so I'm going to cheat and use Haskell instead:

Code: [Select]

head [x | x <- [1..], ['0'..'9'] == sort (show (x^2) ++ show (x^3))]

Oh man this brings back memories of BP.org. We'd have a little challenge and see all the master stuff done with different versions of Basic. Then someone comes in with a One-Liner (and as time went several PL's represented) from the real world of computing. ;-) Reality Check

[bplus]

That 6 line solution is very odd.  You'd probably fall UP if you jumped out of an airplane.

While super short, it's horrible for processing time, which is what I try to optimize for,  esp. lately.

Did you know that 2 nested DO-LOOPs is faster than 2 nested FOR-NEXT loops?  Not that I
understand why.

Heh-heh yes as LOC (Lines Of Code) thins out it tends to get pretty desperate either in readability or efficient processing.

Long known by me and some others FOR loops are slowest by far, internally maintaining an index variable and a stepper and end of loop tests... DO LOOP is faster doing your own conditional testing for jumping out. Also (maybe taboo) but a goto like that used at end of 6 liner is fast too. FOR NEXT loops set a variable index and conditional exit in 2 lines which often makes them better for a LOC challenge.

What really sucks in 6 liner is this:

Code: QB64: [Select]

1. MID$(test$, VAL(MID$(_TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)), i, 1)) + 1, 1) = "1"

the

Code: QB64: [Select]

1.  _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)

part. Look at those functions and math called over and over just to save one line of setting a variable

Code: QB64: [Select]

1.  s$ = _TRIM$(STR$(n * n)) + _TRIM$(STR$(n * n * n)

Falling through to GOTO start of code not so unusual specially if you started out in spaghetti code world. :)

[Cobalt]

Think you could pull it off with no GOTO?