Ctrl+Shift+M for markdown help[text](javascript:blah blah)foreach c [84 104 97 110 107 115] [prin to-char c]![]()J has the most convenient style for [numeric constants](http://www.jsoftware.com/help/dictionary/dcons.htm) _ for negative numbers, which I'm indifferent about)jJ has the most convenient style for [numeric constants](http://www.jsoftware.com/help/dictionary/dcons.htm) _ for negative numbers, which I'm indifferent about)_* stuff?>> _1: charset "cd"
== make bitset! #{00000000000000000000000018}
>> _2: charset "ao"
== make bitset! #{0000000000000000000000004001}
>> _3: charset "tg"
== make bitset! #{000000000000000000000000010008}
>> rule: [_1 _2 _3]
== [_1 _2 _3]
>> parse "cat" rule
== true
>> parse "dog" rule
== truebinary! though, isn't it?>> to binary! "Hello"
== #{48656C6C6F}
>> enbase/base "Hello" 2
== "0100100001100101011011000110110001101111">> 2#{0100100001100101011011000110110001101111}
== #{48656C6C6F}
>> to string! 2#{0100100001100101011011000110110001101111}
== "Hello"parse works on binary data just fine. Maybe Oldes or Bolek will jump in with examples. I have tinkerings somewhere, but don't think any of them are complete.sing: function [input][ input: copy input n: orig-num: first input sing-verse: func [n][ print [ n =phrase "on the wall," n =phrase ".^/" "Take one down and pass it around," n - 1 =phrase "on the wall.^/" ] ] sing-last-verse: does [ print [ "No more" =phrase "on the wall, no more" =phrase ".^/" "Go to the store and buy some more," orig-num =phrase "on the wall." ] ] phrase: [copy =phrase to end] rule: [ set n quote 0 phrase (sing-last-verse) | change set n integer! (n - 1) phrase (sing-verse n) ] while [n > 0][parse input rule] ] sing [99 bottles of beer] sing [7 carafes of wine]
bottles: func [n][
switch/default n [
0 ["no more bottles"]
1 ["1 bottle"]
][form reduce [n "bottles"]]
]
verse: func [n][
either n = 0 [
{No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
][
form reduce [
bottles n "of beer on the wall," bottles n "of beer.^/"
"Take one down and pass it around," bottles (n - 1) "of beer on the wall.^/"
]
]
]
repeat i 100 [print verse 100 - i]decrement-count: does [count: count - 1]
choose-words: does [
case [
count > 1 ["bottles"]
count = 1 ["bottle"]
count < 1 ["no more bottles"] ;how do I use change to wipe out the 0 value ?
]
]
refrain: [count choose-words "of beer on the wall," count choose-words "of beer."
crlf "Take one down and pass it around," decrement-count choose-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 99
while [count > 0][
print refrain
]
print codadecrement: does [count: count - 1]
choose-words: does [case [count > 1 "bottles" count = 1 "bottle" count < 1 "no more bottles"]]
refrain: [count choose-words "of beer on the wall," count choose-words "of beer."
crlf "Take one down and pass it around," decrement choose-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 99
loop count [print refrain]
print codaEither is the common ternary function in Red. You want one more case than that. This isn't as nice as yours. Too tricky.>> word-idx: does [any [attempt [index? find [0 1] count] 3]] == func [][any [attempt [index? find [0 1] count] 3]] >> count: 0 pick ["no more bottles" "bottle" "bottles"] word-idx == "no more bottles" >> count: 1 pick ["no more bottles" "bottle" "bottles"] word-idx == "bottle" >> count: 99 pick ["no more bottles" "bottle" "bottles"] word-idx == "bottles"
next?get-words: does [case [count > 1 "bottles" count = 1 "bottle" count < 1 "no more bottles"]]
dec-count: does [count: count - 1]
refrain: [count get-words "of beer on the wall," count get-words "of beer."
crlf "Take one down and pass it around," dec-count get-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 3
loop count [print refrain]
print codapoke refrain 9 ""dec-count.get-words: does [case [count > 1 "bottles" count = 1 "bottle" count < 1 "no more bottles"]]
dec-count: does [count: count - 1]
refrain: [count get-words "of beer on the wall," count get-words "of beer."
crlf "Take one down and pass it around," either zero? dec-count [""][count] get-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 3
loop count [print refrain]
print codaget-words: does [case [count > 1 "bottles" count = 1 "bottle" count < 1 "no more bottles"]]
dec-count: does [count: count - 1 either zero? count [""][count]]
refrain: [count get-words "of beer on the wall," count get-words "of beer."
crlf "Take one down and pass it around," dec-count get-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 3
loop count [print refrain]
print codaget-words: does [case [count > 1 "bottles" count = 1 "bottle" count < 1 "no more bottles"]]
dec-count: does [either zero? count: count - 1 [""][count]]
refrain: [count get-words "of beer on the wall," count get-words "of beer."
crlf "Take one down and pass it around," dec-count get-words "of beer on the wall."]
coda: {No more bottles of beer on the wall, no more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.}
count: 3
loop count [print refrain]
print codadec-count: does [count: either count > 0 [count - 1] [count: ""]]text-box rich-text objectrefinement in computing/refinements are more flexible than thatexplode!: func [str [series!] /local coll][
coll: copy []
if not string? str [str: form str]
foreach c str [append coll c space]
return coll
]>> x: explode! "The cat came back" == [#"T" #"h" #"e" #" " #"c" #"a" #"t" #" " #"c" #"a" #"m" #"e" #" " ... >> loop (length? x) [prin x/(random length? x)] acct ee aabc emkb
zipteye:~/workspace $ ./red
--== Red 0.6.2 ==--
Type HELP for starting information.
>> do %snippets.red
== func [coll [any-block!] type [datatype!]][parse coll [collect any [keep type | skip]]]
>> explode! "car"
== [#"c" #"a" #"r"]
>> explode! <one two skidoo>
== [#"<" #"o" #"n" #"e" #" " #"t" #"w" #"o" #" " #"s" #"k" #"i" #"d" #"o" #"o" #">"]
>> source explode!
explode!: func [str [series!] /local coll][coll: copy []
if not string? str [str: form str] foreach c str [append coll c] return coll
]
>>>> explode!: function [str [series!]] [collect [foreach c form str [keep c]]] == func [str [series!] /local c][collect [foreach c form str [keep c]]] >> explode! "abracadabra!" == [#"a" #"b" #"r" #"a" #"c" #"a" #"d" #"a" #"b" #"r" #"a" #"!"] >> explode! "I'm a Scatman! Ski-Ba-Bop-Ba-Dop-Bop." == [#"I" #"'" #"m" #" " #"a" #" " #"S" #"c" #"a" #"t" #"m" #"a" #"n" #"!" #" " #"S" #...
split...explode!explode! happened. It's fun.explode! a series, you can use path notation on all series -- that's one thing>> s: @rebolek == @rebolek >> s/1 *** Script Error: cannot access 1 in path [script invalid-path] *** Where: catch >> s: explode! @rebolek == [#"@" #"r" #"e" #"b" #"o" #"l" #"e" #"k"] >> s/1 == #"@" >>
>> a: ab@cd.ef == ab@cd.ef >> a/1 == #"a"
>> series? x: my@mail.com == true >> x/1 *** Script Error: cannot access 1 in path [script invalid-path] *** Where: catch
series! value>> x: %file.foo == %file.foo >> x/1 == %file.foo/1 >> x/2 == %file.foo/2 >> x/3 == %file.foo/3 >> series? x == true
url!explode! now>> extract/into "Explosion" 1 a: [] == [#"E" #"x" #"p" #"l" #"o" #"s" #"i" #"o" #"n"] >> a == [#"E" #"x" #"p" #"l" #"o" #"s" #"i" #"o" #"n"] >>
ws-no-count: [(count?: no) ws (count?: yes)]
cs/8: charset {[](){}"@:;} ;-- not-file-char
cs/23: charset {[](){}";} ;-- not-url-char
url-rule: [
#":" not [not-url-char | ws-no-count | end]
any [#"@" | #":" | ahead [not-file-char | ws-no-count] break | skip] e:
(type: url! store stack do make-file)
]this:is:key directly in Red ;)scheme:[//[user[:password]@]host[:port]][/path][?query][#fragment], then cat:meow is scheme cat and host meow, so it is valid URL.>> strange: cat:meow == cat:meow >> type? strange == url! >> strange: as email! strange == cat:meow >> type? strange == email! >> strange == cat:meow
ldap://[2001:db8::7]/c=GB?objectClass?one is a valid URL. Do we support that?mailto:John.Doe@example.com news:comp.infosystems.www.servers.unix tel:+1-816-555-1212 telnet://192.0.2.16:80/ urn:oasis:names:specification:docbook:dtd:xml:4.1.2
>> to url! "ldap://[2001:db8::7]/c=GB?objectClass?one" == ldap://%5B2001:db8::7%5D/c=GB?objectClass?one
>> b: [a@:a@b] == [a@ :a @b] >> foreach v b [print type? v] email get-word email
cat scheme doesn't mean you don't. Checking a fixed list, and telling users to change the Red lexer to support new ones, seems like a very bad idea to me. Remember, URLs aren't only useful for known schemes and net access.about:aboutchrome://about/opera::// 1 block = 6 bit);16 bytes (actually 4 dwords), roughly divides it into blocks, and re-arranges these blocks according to static lookup table, giving an array of 12 blocks (i.e. bytes with our 6 bits);1st and 2nd functions there is a small intermezzo - 10 bit checksum is computed for an array of 12 blocks; first 4 bits are ORed into 12th block, other 6 bits constitute a new 13th block. 14, 15, 16 blocks are taken from 5th dword which weren't passed through first function. Overall it gives us 16 blocks total.16-block array and has 3 rounds: first and second rounds perform bit swapping (i.e. swap i-th bit in n-th block with j-th bit in m-th block), thirds round perform bit flipping (i.e. flip i-th bit in n-th block). Indexes i, j, m and n are computed from a static vector of numbers (I named it [initialization vector](https://en.wikipedia.org/wiki/Initialization_vector)). Some modular arithmetic is involved.X block is 4 bits at Y1 offset in Z1 dword ORed with 2 bits at Y2 offset in Z2 dword"reverse/skip, then reversing p-box for encoding/decoding is just a matter ofreverse/skip p-box 2
tag! indexes and loose claritylookup-table could be writed down in some specific 2d dialect formatreverse/skip? :worried: reverse is to name the arg for /skip to be size. That way it matches others with a skip refinement.system/words reverse.>> info/arg-num '+ ; `lit-word` with op!-s, otherwise either `word!` or `lit-word!` *** Script Error: length? does not allow logic! for its series argument *** Where: length? *** Stack: info
arity-of func, and help-ctx exports similar functionality via parse-func-spec. The joys of reflection.info/arg-numbi and variants) SYNTAX: ( factors version of macros/ dialecting)make op!, versus::> make op! func [x f [function! action! native!] [f x]
system/words with binding information./rebol gives me:** User Error: Bad face in screen pane! ** Near: size-text self
error while loading shared libraries: libXt.so.6: cannot open shared object file: No such file or directorybad face error is bypassed :Dapply? Haven't seen it with a search, though maybe if I searched on an actual computer..apply for Red only work on homogeneous data? unset?map, but there's a map datatype so that probably rules out a function named map [Buy 100 shares at $20.00 per share][limit buy 0.3 QTUM at 0.037 ETH gtc order]set...: func [ ; Inspired by Erlang's list model.
"Like SET, but words block is dialected."
words [any-block!] "First refinement! gets remainder of series."
series [series!] "Values to assign to words"
/local word= rule= =word
][
word=: [set =word word!]
rule=: [
any [
set =word refinement! (set to word! =word series) to end
| word= (
set =word pick series 1
series: next series
)
]
]
parse words rule=
]
;set... [a /__] [1 2 3 4 5]
;set... [a b /__] [1 2 3 4 5]
;set... [a b c] [5 6]; destructure: func [ ; "Like SET, but words block is dialected." ; series [series!] "Values to assign to words" ; words [any-block!] "Word '... gets remainder of series. Get-words get word in last object found and don't advance." ; /rest '... [word!] ; /local rule= word= =word ;obj-word= =obj-word w o ; ][ ; word=: [set =word word!] ; obj-word=: [set =obj-word get-word!] ; rule=: [ ; ;some [ ; into rule= ; | any [ ; word= ( ; set =word pick series 1 ; series: next series ; ) ; | obj-word= ( ; w: to word! =obj-word ; o: pick series 1 ; either object? o [set w o/:w] [set w o] ; ) ; ] ; ;] ; mark: ; ] ; parse words rule= ; either rest [set ... series] [series] ; ] ; destructure compose/deep [1 2 [3 context [x: 1 y: 2 d: 4 e: 5]]] [a b [c :d :e]]
map to do that.set: func [stuff][
a: copy b: copy stuff
a/2: a/2 - 1
a/4: a/4 - 3
b/3: b/3 + 2
reduce [a b]
]Map, in your example from red/help, doesn't know anything about [a b]. You need a different kind of function to do that, which you can build.map always returning things in some known order. That may not always hold true. At least I don't think it's a hard requirement. Consider parallel maps.vowels: charset ["a" "e" "i" "o" "u" "A" "E" "I" "O" "U"] ; "y" is a special case
punctuation: charset ["." "," ";" "?" "!" ]
has-puctuation?: func [str] [parse str [punctuation]]
starts-with-vowel?: func [str][parse to-string first str [vowels]]
get-match-pos: func [str cset][index? find str cset ]
;move-punctuation: func [str][
; need to grab punctuation and move it to the end of sentence, or end of word if single word
; idx: get-match-pos str punctuation
;]
move-consonants: func [str][
; take consonants before first vowel, move them to the end of str
idx: get-match-pos str vowels
move/part str back tail str idx - 1
]
pigify: func [str][
either starts-with-vowel? str [append str "yay"][move-consonants str append str "ay"]
]
txt: split "Let's test this thing out!" space
foreach i txt [print pigify i]
; forever [print pigify s: input]pigify: function [str][
alphabet: charset [#"a" - #"z" #"A" - #"Z"]
vowels: charset ["aeiou"]
consonants: exclude alphabet vowels
parse str [
(match: copy "")
remove copy match some consonants
]
lowercase rejoin [str match "ay"]
]rotate with /right refinement>> rotate [a b c] 2 == [c a b] >> rotate/right [a b c] 1 == [c a b]
к. hello is hekelloko and how do you do? is hokow doko youkyou doko? (not sure about you though).syllables: func [str][
alphabet: charset [#"a" - #"z" #"A" - #"Z"]
vowels: charset ["aeiou"]
consonants: exclude alphabet vowels
syllable: [
0 1 consonants
1 vowels
0 1 consonants
]
parse str [
collect some keep syllable
]
]
probe syllables "watermelon"parse challenge thoughhas-puctuation?: func [str] [parse str [punctuation]] starts-with-vowel?: func [str][parse to-string first str [vowels]]
Find should be enough. Find/match for the starts-with-... functionality.has-punctuation? doesn't seem to be used, but doesn't look like it works how you expect, unless you're parsing a single char to check for punc.find instead of parse. Parse is overkill, and doesn't add intent here IMO.vowels: charset "aeiouAEIOU"Uppercase mods vowels in place. You also need to use /case.>> union "aeiou" "AEIOU" == "aeiou" >> union/case "aeiou" "AEIOU" == "aeiouAEIOU"
parse lowercase str..? :smiling_imp: parse/case they should be equivalent.parse doesn't care about case by defaultnone, that's good enough for most cases.starts-with-vowel?: func [str][either find to-string first str vowels [true][false]]find to-string first str vowels should dostring! conversion is neededtext
>> v: charset "aeiou"
== make bitset! #{000000000000000000000000444104}
>> find v #"a"
== truefind will return either true or false anyway, you don't need either to dispatch second time>> v: charset "cat"
== make bitset! #{000000000000000000000000500008}
>> find v "cat"
== true>> starts-with-vowel?: func [str][find to-string first str vowels] == func [str][find to-string first str vowels] >> starts-with-vowel? "ack" == "a" >> starts-with-vowel? "cat" == none
none is falseyeither blockpigify: func [str][
either starts-with-vowel? str [append str "yay"][move-consonants str append str "ay"]
]pigify? either will dispatch as expected on string! or any other true-ish valuefind with to logic!>> vowel?: func [c [char!]][find "aeiou" c] == func [c [char!]][find "aeiou" c] >> vowel-1st?: func [str][to logic! vowel? first str] == func [str][to logic! vowel? first str] >> vowel-1st? "cat" == false >> vowel-1st? "apple" == true
i-hay>> b: "!bear" == "!bear" >> move to-string pick b idx tail b == "" >> b == "!bear!"
I-hay,first on your string, you can use find/match. >> v: charset "aeiou"
== make bitset! #{000000000000000000000000444104}
>> find/match "cat" v
== none
>> find/match "alpaca" v
== "lpaca"
>> find/match at "cat" 2 v
== "t"found? yet, and may not, but that's what Rebol used to coerce find results to logic.found?: func [
"Returns TRUE if value is not NONE."
value
][
not none? :value
]to logic! directly.rotate is as simple as this. rotate: func [b [block!]][
move back tail b head b
head b
]>> rotate: func [block offset][head move/part block (length? block) - offset offset] >> rotate [a b c d e f] 2 == [c d e f a b]
- offset offset ?move/part takes three arguments, series, offset and length. So you can read it as move/part (block) ((length? block) - offset) (offset)>> rotate [a b c d e f] 2 *** Script Error: move does not allow integer! for its target argument *** Where: move *** Stack: rotate
Red for Windows version 0.6.3 built 14-Sep-2017/13:15:36-06:00move works different there.rotate: func [
b [block!] "<-- It's a block"
count [integer!] "Number of times to rotate"
/left "go back!"
][
loop count [
either left [head move head b back tail b][head move back tail b head b]
]
] r: func [b count][head move/part back tail b head b count]== func [block count][move/part block tail block count] >> rotate [a b c d e f] 2 == [c d e f a b]
rotate: func [
series
offset
/right
/local
len shift src dst part
][
len: length? series
shift: offset % len
set [src dst part] reduce pick [
[(skip series len - shift) series offset]
[series (tail series) shift]
] right
move/part src dst part
head series
]text
>> rotate #{DEADBEEF} 2
== #{BEEFDEAD}
>> rotate/right [1 2 3 4] 3
== [2 3 4 1]
>> rotate [a b c d e f] 9
== [d e f a b c]shift/rotate funcs, I made them move by 1 as a default, with a /part refinement./right before /local.rotate/right call will be leaked?/local is not different from other refinements/local is nothing special:>> f: func [/local value][reduce [value]] == func [/local value][reduce [value]] >> f == [none] >> f/local 42 == [42]
>> rotate: func [blk /part length /dir d][
d: any [d 'l]
length: any [length 1]
either d = 'r [
insert head blk take/last/part blk length head blk
][
append blk take/part blk length
]
]
== func [blk /part length /dir d][d: any [d 'l] length: any [length 1] either d = 'r [insert head blk take/last/part blk lengt...
>> b: #{DEADBEEF}
== #{DEADBEEF}
>> rotate b
== #{ADBEEFDE}
>> rotate/dir b 'r
== #{DEADBEEF}
>> rotate/dir/part b 'r 2
== #{BEEFDEAD}
>> b2: [1 2 3 4 5 6 7 8 9]
== [1 2 3 4 5 6 7 8 9]
>> rotate b2
== [2 3 4 5 6 7 8 9 1]
>> rotate/part b2 3
== [5 6 7 8 9 1 2 3 4]
>> rotate/part/dir b2 4 'l
== [9 1 2 3 4 5 6 7 8]
>> rotate/part/dir b2 4 'r
== [5 6 7 8 9 1 2 3 4]
>> rotate/part/dir b2 5 'l
== [1 2 3 4 5 6 7 8 9]either right [take/part blah blah blah blah blah][take/part blah blah blah blah blah blah blah]?text
rotate: function [series offset /local src dst part][
?: negative? offset
shift: offset: absolute offset % len: length? series
set [src dst part] reduce pick [
[series (tail series) shift]
[(skip series len - shift) series offset]
] ?
move/part src dst part
head series
]>> rotate [1 2 3 4 5] 1 == [5 1 2 3 4] >> rotate [1 2 3 4 5] -1 == [2 3 4 5 1] >> rotate [1 2 3 4 5] 6 == [5 1 2 3 4] >> rotate [1 2 3 4 5] -6 == [2 3 4 5 1]
rotate: func [
"Rotate values in a series."
series [series!]
/left "Rotate left (the default)"
/right "Rotate right"
/part range [number!] "Rotate this many positions" ; TBD series! support?
][
range: any [all [range range // length? series] 1]
if any [empty? series zero? range] [return series]
either right [
series: skip tail series negate range
head insert head series take/part series range
][
append series take/part series range
]
]rotate: function [series offset][
?: negative? offset
shift: offset: absolute offset % len: length? series
head do compose [
move/part (
pick [
[series (tail series) shift]
[(skip series len - shift) series offset]
] ?
)
series
]
]/left, and do this other places too, so you can make your code more self-documenting.¯\_(ツ)_/¯rotate/right -5 is useful. #local [
#macro [lit-word!] func [s e][]
probe 'dear 'Red 'please reverse [1 2 3] 'thanks 'in 'advance
]#macro `: :commentand
`wordsyntax, but this will work only with
`<some-series>
absolute all offsetsseries/< or series/>>N support for rotating >> would be shifting, wouldn't it?(>>)?change instead/lisp room shortlysort modifiesmax for Red yet?help maximum series!gel: func [list][last sort copy list]contains?: func [
{Searches for a value in block!
Returns true and the index of the value if found.}
block [block!] "Block of values"
value [any-type!] "Value to check for"
/local match
][
match: find block value
either none? match [false][reduce [true index? match]]
]has: make op! func [
{Searches for a value in block!
Returns true and the index of the value if found.}
block [block!] "Block of values"
value [any-type!] "Value to check for"
/local match
][
match: find block value
either none? match [false][reduce [true index? match]]
]>> gregg: [11 9 "s" #"z" 3.45 work] == [11 9 "s" #"z" 3.45 work] >> gregg has 'work == [true 6]
Has is already a standard function. You could use has?, but then it's not as nice as an op. The tricky thing is that you still don't have the ? predicate clue, so gregg has 'work sounds more like a prolog fact statement than a query.does/locals sounds good to me. has - I've only used does and functext
|9214|: [
[dark thoughts]
<cup of tea>
some-work-to-do
"The Haunting Past of Christoph de Babalon vol. III"
]_(:3」∠)_op! doesn't allow to pass unevaluated operators?>> bar: make op! func ['left 'right][] == make op! [['left 'right]] >> foo bar baz *** Script Error: foo has no value *** Where: bar *** Stack:
/bugs shortly thenhas a lot, but it's a holdover from R2 which is useful at times. I don't think adding a refinement to does will work well, because then locals arg will then come after the body arg.has is leftover from R2. If we can find better use for word has (and I believe we can), than I vote for getting rid of it. I won’t miss it.has should be auto-capturing version of does, the same way function is a "smarter" version of func?func [] [] ; declare params and locals function [] [] ; declare params, automatic local capturing has [] [] ; declare locals, no params does [] ; no params, no locals
Has states the intent well, as long as you know it's a function creator. I've never had confusion over this myself. Proc generally means there's no return value, rather than no params, so doesn't seem any better. In order to get both meanings, we probably need a longer name, which then makes us look at what we gain.closure1: does [func ['f][bind/copy f system/words]] closure2: does [func ['f][bind/copy body-of :f]] closure3: does [func ['f][bind/copy (body-of :f) system/words]] closure4: does [func ['f][bind/copy spec-of :f]] closure5: does [func ['f][bind/copy (spec-of :f) system/words]]
closure: func [vars spec body][
; Don't have to reuse 'spec name; just saves a word.
bind (body-of spec: func spec body) (context vars)
:spec
]z: 1 as z is bound before closure is builtz is bound to it's current value (1) in current context (system/words), same for +, c is skipped because it's in spec block ([c])closure! implementation from R3 is brokendo https://tinyurl.com/y9mtqdqz
Reset only deletes history, so you can't navigate any more with + and -, and leaves the current state as new starting-point. To actually start over you have to choose Blank and then either click-in your new start-pattern or choose Random.palindrome?: func [
"Returns true if the value is a palindrome"
value [string!]
/local punctuation
][
punctuation: {-:;.,?!#" "}
equal? trim/with value punctuation reverse copy value
]
comment {
http://www.palindromelist.net/
>> palindrome? "A Santa at Nasa."
== true
>> palindrome? form [A Santa at Nasa.]
== true
>> palindrome? form 'taco-cat!
== true
}>> palindrome? {Are we not pure? “No sir!” Panama’s moody Noriega brags. “It is garbage!” Irony dooms a man; a prisoner up to new era.}
== truetrim/with/lines but this didn't help (why?):>> trim/with/lines {Are we not pure? “No sir!” Panama’s moody Noriega brags. “It is garbage!” ^/Irony dooms a man; a prisoner up to new era.} {-:;.,?!#" "“”’'"}
== {ArewenotpureNosirPanamasmoodyNoriegabragsItisgarbage^/Ironydoomsamanaprisoneruptonewera}punctuation:punctuation: {-:;.,?!#" "“”’'"#"^/"#"^-"}
...
>> palindrome? {Are we not pure? ^- “No sir!” Panama’s moody Noriega brags. “It is garbage!” ^/Irony dooms a man; a prisoner up to new era.}
== true trim/all/linespalindrome?: func [
"Returns true if the value is a palindrome"
value [string! any-word! block!]
/local punctuation
][
punctuation: {-:;.,?!#" "“”’'"#"^/"#"^-"}
if not string? value [value: form value]
equal? trim/with value punctuation reverse copy value
]text >> palindrome? 111 *** Script Error: palindrome? does not allow integer! for its value argument *** Where: palindrome? *** Stack: palindrome?
palindrome?: func [
"Returns true if the value is a palindrome"
value
/local punctuation
][
punctuation: {-:;.,?!#" "“”’'"#"^/"#"^-"}
value: form value
equal? trim/with value punctuation reverse copy value
]series!, but some series are not symmetrical by their naturetrim, and trim works only with strings, everything should be coerced to string!, form is good enough for that, but there will be edge cases; Determine if a string is numeric.
; Create a boolean function which takes in a string and tells whether it is a
; numeric string (floating point and negative numbers included) in the syntax the
; language uses for numeric literals or numbers converted from strings.
numeric?: func [
"Determines if string is numeric"
string [string!]
][
either attempt [number? to-float string][true][false]
]number? load string
load is ok, I'll change it backnumeric?: func [
"Returns true if arg is a numeric string"
arg [string!]
][
number? attempt [load arg]
]()lisp was like that.. Also, https://en.wikipedia.org/wiki/Dylan_(programming_language)[] speaking of - Factor them too have, wording weird some with also, Yoda's language programming choice it is Forth with together.bi](https://docs.factorcode.org/content/word-bi%2Ckernel.html) that even lisp doesn't have (applies to most concatenative languages). Only [j](http://code.jsoftware.com/wiki/NuVoc) is betterjConjunctionsfold in j is / for example. Such classes of functions are called Adverbs, because they act on Verbs, which themselves is the terminology for functions in j (not a bad terminology might I add, with Noun for data)compose. Only few have more useful stuff like *differentiation*, *function inverses*, etc.. built inJ is also on my listforall gives you series' index for freeset bug in it, so I'm leeryattempt it, check if result is the same as expected, if not - congrats you've found a bug(+/%#) to (+/y)%(#y), I mean, are there any rules for that or is it just "hardcoded"?#, then monad % and finally monad + with adverb /", but instead it's "monad #, then monad + with adverb /, then dyad %"(+/%#) *is itself a dyad*! mah boi(f g h) y = (f y) g (h y) monadic fork
x (f g h) y = (x f y) g (x h y) dyadic fork
(f g) y = y f (g y) monadic hook
x (f g) y = x f (g y) dyadic hook(f g h) writes as a monadic verb, but acts as a dyad by "doubling" it's argumentdelta-time: func [
{Delta-time - returns the time it takes to evaluate the block.}
block [block!] /local
start
][
start: now/precise
do block
difference now/precise start
]>> b: append/dup make block! 10000 1 10000 == [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1... >> delta-time [forall b [print first b]]
== 0:00:00.361print.stats is further developed?delta-profile looks really nicer is nice, also an array processing language and has a built-in library for parsing csv, but larger compared to redbol and j)y (f g h) yf and g could apply to the same argument at the same time if J have strict right to left evaluation order()[$5!:j package managerJoin us!reJoin in the future.(*/)~>:i.9 1 2 3 4 5 6 7 8 9 2 4 6 8 10 12 14 16 18 3 6 9 12 15 18 21 24 27 4 8 12 16 20 24 28 32 36 5 10 15 20 25 30 35 40 45 6 12 18 24 30 36 42 48 54 7 14 21 28 35 42 49 56 63 8 16 24 32 40 48 56 64 72 9 18 27 36 45 54 63 72 81
[ ] wasn't implied in redj has package which interfaces to fftwmath/fftw>> do %cryptarithm.red >> solve/heuristics [SEND + MORE = MONEY][[M S] = [1 9]] == [9567 + 1085 = 10652] >> solve/heuristics [CLOCK + TICK + TOCK = PLANET][P = 1 T <> [0 4] C >= 2] == [90593 + 9693 + 9593 = 109879] >> solve/heuristics [YES + LETS + ALL + TRY + A + FUNNY = TEASER][T = 1 [Y L A F] > 0]; may take long == [206 + 5016 + 355 + 142 + 3 + 97882 = 103604]
* and / ops. Can you give me advice how to keep letters from leaking into global context. I tried declaring them in context but they are still leaking. solve?Set, by default, sets words in the global context. You can use self, if you know the words, but that will limit you in this case. A is hidden here, but you have to know what it will be.>> o: object [a: none go: func [val][set in self 'a val]]
== make object! [
a: none
go: func [val][set in self 'a val]
]
>> o/go 1
== 1
>> probe o
make object! [
a: 1
go: func [val][set in self 'a val]
]set on. Maybe something like this:obj-from-words: function [words [block!]][
object append collect [
foreach word words [keep to set-word! word]
] none
]
heur-obj: object [
heur: none
set-heur: func [spec [block!] "keys+vals" /local key val][
heur: obj-from-words extract spec 2
foreach [key val] spec [set in heur key val]
heur
]
]
heur-obj/set-heur [a 1 b 2 c 3]
probe heur-objsolve block. These are transformed into strings and every letter in string is made into word! in block ltrs and transformed into calculable formula (see calculation). Letters in this block are then appended to another block letters, made unique and later random values are attached to them until the calculation returns true.>> cx: context [
a: b: none
letters: [a b]
set 'fun func [vals][set letters vals]
]
== make object! [
a: none
b: none
letters: [a b]
]
>> fun [1 2]
== [1 2]
>> a
*** Script Error: a has no value
*** Where: catch
*** Stack:
>> b
*** Script Error: b has no value
*** Where: catch
*** Stack:
>> cx/a
== 1
>> cx/b
== 2cryptarithm code.letters is defined *inside* the context. Hence, that's where the words are bound.bind (lines [30](https://gist.github.com/toomasv/c63e49e26d2cfb6032db9d0428029e3d#file-cryptarithm-red-L30) and [50](https://gist.github.com/toomasv/c63e49e26d2cfb6032db9d0428029e3d#file-cryptarithm-red-L50)). Thanks for your help!alphametic](http://www.cadaeic.net/alphas.htm) function to [cryptarithm](https://gist.github.com/toomasv/c63e49e26d2cfb6032db9d0428029e3d):>> alphametic/heuristics "Who is this idiot?" [[i t] = [1 9] W >= 2] == [835 + 12 + 9312 = 10159] >> solve/heuristics "Who is this idiot?" [[i t] = [1 9] W >= 2] == [835 + 12 + 9312 = 10159]
>> solve/heuristics "Saturn, Uranus, Neptune, Pluto: planets." [[s u n p] >= 1]
== {Time-out after 30 seconds! Try to improve heuristics.}compose to include string, it would be a good solution for those who want string interpolation. Or have a separate compose-string Red [
Author: "Gregg Irwin"
Purpose: "COMPOSE for strings"
Notes: {
TBD: Security model for eval'ing expressions
}
]
composite-ctx: context [
eval: func [
"Evaluate expr and return the result"
expr [string!] "Valid Red, as a string expression"
err-val "If not none, return this instead of formed error information, if eval fails"
/local res
][
either error? set/any 'res try [do expr][
any [err-val form reduce [" *** Error:" res/id "Where:" expr "*** "]]
][
either unset? get/any 'res [""][:res]
]
]
; Putting the colons on the outside gives you a clean paren expression
; on the inside.
expr-beg=: ":("
expr-end=: "):"
; One of the big questions is what to do if there are mismatched expr
; markers. We can treat them as errors, or just pass through them, so
; they will be visible in the output. We can support both behaviors
; with a refinement, and then just have to choose the default.
set 'composite func [
"Replace :( ... ): sections in a string with their evaluated results."
data [string! file! url!]
/err-val e "Use instead of formed error info from eval error"
/local expr
][
data: either string? data [copy data] [read data] ; Don't modify the input
parse data [
any [
end break
| change [expr-beg= copy expr to expr-end= expr-end=] (eval expr e)
| expr-beg= to end
| to expr-beg=
]
]
data
]
]composeable and what is not?() to be composed?() but not the other?text
parse s: "1 + 2 = (1 + 2)" [
some [
to change copy match ["(" some [not ["(" | ")"] skip] ")"] (do load match)
| end
]
]
probe s>> composite "1 + 2 = :(1 + 2): (<- this is evaluated)" == "1 + 2 = 3 (<- this is evaluated)"
reword. Allows user to specify pattern. source reword in R3 repl but I didn't think "Ah, elegant!", at first readbuild-markup>> composite/escape {Some [probe "interesting"] Red expressions like 3 + 2 = [3 + 2]} ["[" "]"]
"interesting"
== "Some interesting Red expressions like 3 + 2 = 5"
>> composite/escape {Some (probe "curious") Red expressions like 3 + 2 = (3 + 2)} ["(" ")"]
"curious"
== "Some curious Red expressions like 3 + 2 = 5"
>> composite {Some :(probe "curious"): Red expressions like 3 + 2 = :(3 + 2):}
"curious"
== "Some curious Red expressions like 3 + 2 = 5"
>> composite/escape {Some (probe "curious") Red expressions like 3 + 2 = .(3 + 2).} "."
== {Some (probe "curious") Red expressions like 3 + 2 = 5}
>> composite/escape {Some eval(probe "curious")eval Red expressions like (3 + 2 = eval(3 + 2)eval)} "eval"
"curious"
== "Some curious Red expressions like (3 + 2 = 5)"make and to reuse already existing series with /into refinementscomposite-ctx: context [
eval: func [
"Evaluate expr and return the result"
expr [string!] "Valid Red, as a string expression"
err-val "If not none, return this instead of formed error information, if eval fails"
/local res
][
either error? set/any 'res try [do expr][
any [err-val form reduce [" *** Error:" res/id "Where:" expr "*** "]]
][
either unset? get/any 'res [""][:res]
]
]
; One of the big questions is what to do if there are mismatched expr
; markers. We can treat them as errors, or just pass through them, so
; they will be visible in the output. We can support both behaviors
; with a refinement, and then just have to choose the default.
set 'composite func [
"Replace :( ... ): sections in a string with their evaluated results."
data [string! file! url!]
/err-val e "Use instead of formed error info from eval error"
/escape esc
/local expr expr-beg= expr-end=
][
either escape [
expr-beg=: either block? esc [esc/1][rejoin [esc "("]]
expr-end=: either block? esc [esc/2][rejoin [")" esc]]
][
; Putting the colons on the outside gives you a clean paren expression
; on the inside.
expr-beg=: ":("
expr-end=: "):"
]
data: either string? data [copy data] [read data] ; Don't modify the input
parse data [
any [
end break
| change [expr-beg= copy expr to expr-end= expr-end=] (eval expr e)
| expr-beg= to end
| to expr-beg=
]
]
data
]
]composite to allow custom markers. I would probably call the refinement /with as that's a standard name for default overrides.:( :(compose*:*?* is used for names that alias with high-level definitions>> compose-string "(person) had a (size) (animal). It was (3 ** 3) ft. tall at the shoulders."
== {Mary had a Giant Goat . It was 27 ft. tall at the shoulders.}compose*:natives! in Red/System>> st: stats loop 100000 [checksum rejoin ["aagrtuei" 1] 'MD5] stats - st == 20086784
rejoin to append to reuse the output string, but it seemed like there was still an allocation to convert 1 to "1"append works little better:>> key: "aagrtuei" compare-times/count [[checksum rejoin [key 1000000] 'MD5][checksum append copy key 1000000 'MD5]] 100000 Time | Memory | Code 0:00:00.231 | 12963840 | [checksum append copy key 1000000 'MD5] 0:00:00.335 | 20086784 | [checksum rejoin [key 1000000] 'MD5]
>> key: make string! 100 == "" >> append key "aagrtuei" == "aagrtuei" >> compare-times/count [ [ [checksum rejoin [key 1000000] 'MD5] [ [checksum append copy key 1000000 'MD5] [ [clear at key 9 checksum append key 1000000 'MD5] [ ] 100000 Time | Memory | Code 0:00:00.269 | 15065088 | [checksum append copy key 1000000 'MD5] 0:00:00.288 | 7942144 | [clear at key 9 checksum append key 1000000 'MD5] 0:00:00.382 | 17985536 | [checksum rejoin [key 1000000] 'MD5]
void Main()
{
var outputs = new char[8] {'x', 'x', 'x', 'x', 'x', 'x', 'x', 'x'};
var str = "cxdnnyjw";
var pws = Counter()
.Select(i => HashAttempt(str, i))
.Where(hash => hash.StartsWith("00000"))
.Select(hash => hash[5])
.Take(8);
// part 1
//Observable.ToObservable(pws).Dump();
var hashes = Counter()
.Select(i => HashAttempt(str, i))
.Where(hash => hash.StartsWith("00000"))
.GetEnumerator();
// part 2
while (outputs.Any(i => i == 'x'))
{
hashes.MoveNext();
var hash = hashes.Current;
int idx = hash[5] - '0';
if (idx < 8 && outputs[idx] == 'x') outputs[idx] = hash[6];
String.Join("", outputs).Dump(hash);
}
}
MD5 md5 = MD5.Create();
IEnumerable<long> Counter()
{
long i = 0;
while(true) yield return i++;
}
string HashAttempt(string str, long i)
{
var hashbytes = md5.ComputeHash(Encoding.UTF8.GetBytes(str + i));
return String.Join("", hashbytes.Select(b => b.ToString("X2")));
}simple-gc branch?source sqrt for example of calling straight out Red/System13.8 stack/free Frees a storage space on stack (in stack slots unit). This is useful for manually controlling the release of a stack storage space allocated with system/stack/allocate, or from outside a function. Syntax system/stack/free <slots> <slots>: expression returning an integer Manual stack manipulations and exceptions Current exceptions implementation (catch/throw) cannot mix with manual stack manipulations, therefore all allocated spaces on stack must be freed before entering a catch body block, or using a throw keyword. 13.9 pc Retrieve the CPU program counter value.
[1 2 2 2 3] here?poke I would go with change/part and it's too hairy for such simple task at handchange/part as you suggested.poke does. e.g., does it change the length of a series? No. It replaces one single value with another single value. What kind of values does a string series refer to? Hence...text >> do also 's change/part at s: "abc" 2 "bb" 1 == "abbc"
>> do also 's poke s: "abc" 2 "bb"
change and replace have somewhat overlapping scopes? I'm not trying to imply that is bad, but I'm having some trouble figuring out their individual purposes. Is it just that replace implies a search pattern?change, replace, poke should probably make it straightforward.replace has a difference meaning, because you're replacing by content, not position. It also has refinements that support that intent, which wouldn't apply in an index-based function like change.find/lastparse in my examples?ARGUMENTS:
series [series!] "The series to be modified".
pattern "Specific value or parse rule pattern to match".
value "New value, replaces pattern in the series".find/reverse, or does it just not work?find/last. How would *you* do it? Or, how do other langs do it, that is demonstrably better?Find/reverse should work. Do you have an example?text >> x: skip "babccbab" 6 == "ab" >> head x == "babccbab" >> x == "ab" >> find/reverse x "c" == "cbab"
help messages were sometimes confusing when I started:^) btw?help poke in red/helpcompare-times, for improvements.** **** *** * * *** **** *** ** *** *** * * * * * * * * * * * * * * * * * * *** *** * * * * * *** * * * * **** * * * * * *** * * * * *** ** * * * * * * * * * * * * * * * * * * *** ** * **** *** ** * ***
R or L, can't decide whenever it's cheating or not :Dparse? add one and one which means 1 + 1 in plain Red. How to decide if I should evaluate it each time as it is (interpret) or to translate once into "low level" representation (compile), in our case 1 + 1, and process that representation instead?it depends could be an answer to anything ;)do) or interpret each time with parse, I'd go with "preprocess once and do later".my-spec: preprocess [...] instead of just my-spec: [...]preprocess function run only once?parse, not compiled to Red first and then to HTML. It makes sense for such immediate code, I guess.math dialect for example.math interpreted or compiled?op is here if it's never used?math: func [
{Evaluates a block using math precedence rules, returning the last result}
body [block!] "Block to evaluate"
/safe "Returns NONE on error"
/local rule pos op sub end
][
parse body: copy/deep body rule: [
any [
pos: ['* (op: 'multiply) | quote / (op: 'divide)]
[ahead sub: paren! (sub/1: math as block! sub/1) | skip] (
end: skip pos: back pos 3
pos: change/only/part pos as paren! copy/part pos end end
) :pos
| into rule
| skip
]
]
either safe [attempt body] [do body]
]red/sandbox? :dragon: sm: fsm/make-state-machine/with-stubs/trace 'locked [
when locked
coin causes [unlock thank-you] then unlocked
pass causes alarm
when unlocked
coin causes thank-you
pass causes lock then locked
other causes other-event
when testing
coin causes coin-test
pass causes pass-test
when repairing
coin ignore
pass ignore
when error
other causes reset then locked
otherwise
reset then locked
repair then repairing
test then testing
XXX causes exception then error
YYY causes exception then error
other causes cant-handle-it then dead
]
; Test runner
foreach event [coin pass xxx yyy repair test coin pass reset pass coin pass] [
print rejoin [sm/state tab event]
sm/send event
print rejoin [tab sm/state]
]/with-stubs generates placeholder funcs for the actions it finds. enter/leave events for states, which auto-triggered.drawing and viewing FSM diagrams) or the one that compiles down to Verilog code (similar to [this](https://github.com/sam-falvo/SMG) project)... or bothparse rules.builtins block that contains all of Reds predefined words?builtins list seems easiest, and later if it is desirable, it could be broken into categories based on type or something┌ ┐ │ █ █ █ ██ ████████ █ █████ █ ██ ██ │ │█0 ██ ██ ██ █ █ ███ █ █ ██ ██│ │██ █ █ ██ █ ██ █ █ ████ ████ █ │ │ █ █ ██ ███████ █ █ ████ ██ ███ ██ █ │ │███ █ █ █ ██ █ █ █ █ █ █ █│ │███ █ █ █ ██ █ ██ █ ████ █ █ │ │ █ ██ █ ██ ████ ████ ██ █ █ ██ ██ ██│ │ █████ █ ███ █ █ █ █ ██████ │ │ ████ ███ █ ████ ██ ███ █ ██ ███│ │ █ ███ █████ █████ ██ ██ █ ██ █ █ │ │ ██ █ █ ███ ██ █ █ █ █ █ ██ ██│ │ █ █ █ █ █████ █ █ █ █████│ │ ██ ████ ████ █ █████ ██ █ ███ ███ ██│ │ ██ █ ███ ██ █ ██ █ ███ ███ █ █│ │ █ ██ ██ ██ █ █ █ █ █ █ │ │ ███ █ ██████ █████ █ ██ █ █ ███ █ █│ │ ██ ██ █ ██ █ █ ██ ███ ████│ │ █ █ █ ██ █ █ ██ █ ███ █ █ █│ │█ ██ █ █ █████ █ ████████████ ████ │ │███ ██ ███ █ ██ █ █ █ █████ █│ │█ █ ██ █ █ █ ████ █ ██ ██ │ │ ██████ █ ██ █ █ ███████ █████ ██ █ ██│ │ ██ █ █████ ██ █ █ █ ████ ██ █│ │ █ █ ██ █ ██ █ █ ██ █ █ █│ │ ██ █████ █ ██ ███ █ █ █ ██ █ ██ ██ █│ │ █ █ ██ ███ ██ ██ █ ██ ██ █████ █│ │█ █ ██ █ ██ █ ██ ██ █ ██ █ │ │███████ ██ ██ █ ██ █ ███ █ ██ █ █ █│ │█ █ █ █ ██ █ ███ █ █ ███ ████ │ │█ ██ ███ █ █ █ ██ ██ ██ █ █ │ │██████ ██ ██ ██ ██████ █ █ █ █ █ █ │ │ █ █ █ ██████ █ █ ██ ██ ████ ██████X█│ │██ ██ ██ ██ █ ██ ███ █ ██ █ │ │█ █ █ ███ █████ ██ █ ████ │ │█ ██ █ █ █ █ █████████ █████ ███ │ │███ ██ █ █ ██ █ █ ███ ██ █ │ │█ █ ███ █ ██ ██ █████ █ █ ████ █│ │ ████ █ ███ █ ███ █ ████ ███ █│ │ ██ █████ ██ █ █ ██ █ │ │ █ █ ██ ███ ██████ █ ██ ███ ██ ██│ │ █ █ █ ████ █ ████ ██████ █ █████ │ └ ┘
parseparse visualiser.git reflog -hgit reset -hgit reset --hard git resetgit gc or somethingRed [] dragon: func [n /local m k][ m: -1 until [odd? k: n / (2 ** (m: m + 1))] pick [90 -90] 0 = (k - 3 % 4) ] n: 0 view [ image 600x600 draw [pen red translate 350x450 line 0x0 10x0 translate 10x0] rate 60 on-time [ append face/draw compose [rotate (dragon n: n + 1) line 0x0 10x0 translate 10x0] ] ]
Red [] dragon: func [n /local m k][ m: -1 until [odd? k: n / (2 ** (m: m + 1))] pick [90 -90] 0 = (k - 3 % 4) ] n: 0 view [ image 600x600 draw [pen red translate 350x450 line 0x0 10x0 translate 10x0] rate 120 on-time [ append face/draw compose [rotate (dragon n: n + 1) line 0x0 10x0 translate 10x0] if n = 1880 [remove/part at face/draw 10 tail face/draw n: 0] ] ]
draw and styles isn't that straightforwardrange: func [ lower upper /step num ][ unless step [num: either percent? lower [1%][1]] blk: reduce [lower] while [lower < upper][ append blk probe lower: lower + num ] if upper < last blk [remove back tail blk] blk ]
step in the beginning instead in every step and I added check for out of range values, because of range 0% 10%.unless equal? type? lower type? upper [cause-error 'what-is-that-crazy-syntax-omg]bbrange: func [ lower upper /step num ][ unless step [num: either percent? lower [1%][1]] unless 1 = length? unique reduce [type? lower type? upper type? step][ cause-error 'script 'invalid-type ["All values must be of same type"] ] blk: reduce [lower] while [lower < upper][ append blk lower: lower + num ] if upper < last blk [remove back tail blk] blk ]
>> range 0% 100% 1% 2% [...] 38% 39.00000000000002% 40.00000000000002% 41.00000000000002% 42.00000000000002% [...] 100%
>> rangebb 1% 100% *** Script Error: "All values must be of same type" type is not allowed here *** Where: do *** Stack: rangebb cause-error
cause-error righttake/last blk acceptable?remove back tail blk, and I always figure you have a good reason for your choices...type? step][cause-error 'script 'not-same-type []'what-is-that-crazy-syntax-omg as standard, and @rebolek, I also need 'incorrect-cause-error-usage.cause-error, I always struggle to do it right and usually just print the error and break the program in other way to save my sanity.profile race with them? :car:matrix to solve it. Happy chasing!range works great! But this doesn't feel good to me:>> range/step 5 10 2 == [5 7 9 11]
>> range/step 5.1 10.0 4 == [5.1 9.1 13.1]
>> range/step 5% 10% 4 == [5% 6% 7% 8% 9% 10% 11%]
>> range/step #"a" #"g" 4 == [#"a" #"e" #"i"]
>> range/step #"a" #"g" #"b" == [#"a" #"Ã"]
[5 7 9] over [5 7 9 10] in case of range 5 10 2. Here we have lower limit with which we start, upper limit which we can't overstep and step of intervals. What's there to fuss about?step, of cause it's char's int value, but is it desirable (or natural / sane) to let determine steps in char int values? (It might be interesting, though -- for programming geeks like us)>> range 1/10/2017 5/10/2017 *** Script Error: range does not allow date! for its lower argument
Red [] view [ below text "Parse expression:" _parse: field 500x30 [ _res/data: parse _test/data _parse/data ] text "Test block or string:" _test: field 500x30 [ _res/data: parse _test/data _parse/data ] text "Parse result:" _res: field 500x30 ]
enter.>> range/step 5% 10% 1 *** Script Error: out of range or past end [...] >> range/step 5% 10% 1% *** Script Error: out of range or past end
*** Script Error: values must be of the same type *** Where: do *** Stack: range type-check-step cause-error >> range/step 5% 10% 4 *** Script Error: values must be of the same type *** Where: do *** Stack: range type-check-step cause-error >> range 5% 10% == [5% 6% 7% 8% 9% 10%] >> range 1-nov-2017 15-nov-2017 == [1-Nov-2017 2-Nov-2017 3-Nov-2017 4-Nov-2017 5-Nov-2017 6-Nov-2017 7-Nov-2017 8-Nov-2017 9-Nov-2017 10-Nov-2017 11... >> range/step 1-nov-2017 30-nov-2017 7 *** Script Error: values must be of the same type *** Where: do *** Stack: range type-check-step cause-error
/step don't include the last value. Is that what you mean by "fails"?equal? type? lower type? upper, yes? Same-type? could be a good mezz. if percent? lower [num: to-percent .01]>> range/step 5% 10% 4% == [5% 6% 7% 8% 9% 10%]
unless upper >= lower [bounds-err] could be if lower > upper [bounds-err], not to have shorter code, but to eliminate the implicit negation WRT the comparison. I'd have to look it up, but I recall some research into that, and reducing cognitive load in the kind and order of comparisons and branch logic.while [(lower + num) <= upper][increment], because it reads like lower is fixed, but it's not, and increment has a double side effect. This is just at a first read though.set-word!s in /localdate/step throws an error because *you* throw the error by making the step type match the arg type. Maybe not a good design choice.num > upper to compare an int to a date.equal? type? lower type? upper but what about more than two arguments?>> same-type?: func [series][1 = length? unique collect [forall series [keep type? first series]]] == func [series][1 = length? unique collect [forall series [keep type? first series]]] >> same-type? [1 2 3] == true >> same-type? [1 "2" 3.0] == false
range works great! But this doesn't feel good to me:>> range/step 5 10 2 == [5 7 9 11]
>> range/step 5.1 10.0 4 == [5.1 9.1 13.1]
>> range/step 5% 10% 4 == [5% 6% 7% 8% 9% 10% 11%]
>> range/step #"a" #"g" 4 == [#"a" #"e" #"i"]
>> range/step #"a" #"g" #"b" == [#"a" #"Ã"]
range/step 25-Oct-2017 25-Nov-2017 3 problem1 is 100%range: func [
"Returns a range of numbers or chars from lower to upper"
lower [number! char! date!] upper [number! char! date!]
/step "Increment range by step"
num [number! char! date!]
/rev "Returns range reversed"
/local blk increment
][
blk: reduce [lower]
increment: does [append blk lower: lower + num]
check-bounds: func [val1 val2][
if val1 > val2 [cause-error 'script 'past-end []]
]
either step [check-bounds num upper][check-bounds lower upper num: 1]
while [lower < upper][increment]
either rev [reverse blk][blk]
if upper < last blk [remove back tail blk]
blk
]>> 1-Jan-2017 + 2 == 3-Jan-2017 >> range/step 1-Jan-2017 5-Jan-2017 2 *** Script Error: cannot compare 2 with 5-Jan-2017
check-bounds num upper. I think it is better to let num be as big as user chooses. But if incrementing lower with this value oversteps upper the result is not included in range and that's it. Range will consist of only lower in this case. >> range'/step 1/1/1970 31/12/1970 [month + 1] == [1-Jan-1970 1-Feb-1970 1-Mar-1970 1-Apr-1970 1-May-1970 1-Jun-1970 1-Jul-1970 1-Aug-1970 1-Sep-1970 1-Oct-1970 1-Nov-1970 1-Dec-1970]
time, tuple, pair?binary! maybe?binary! might be interesting too/limit refinement and examples](https://gist.github.com/toomasv/0e3244375afbedce89b3719c8be7eac0).chat-item__text .embed {
overflow: auto
}center-facecaptcha: func [digits /local nums acc][ nums: copy [] acc: 0 digits: mold digits forall digits [if (first digits) = (second digits) [append nums load to-string first digits]] if (first digits) = (last digits)[append nums load to-string last digits] foreach n nums [acc: acc + n] acc ]
nexted it, and reset it to head when it hit the tail?checksum: func [digits /local nums acc temp][
nums: copy []
acc: 0
foreach d digits [
temp: copy ""
temp: sort to-string d
append nums (load to-string last temp) - (load to-string first temp)
]
foreach n nums [acc: acc + n]
acc
]sum a nested block part if you'd explain what you mean[2 8 7 7 4 8 8 3 3 8 4 2 6 2 1 4 2 8 3 1 8 2 3 1 2 6 9 3 2 9 3 4 3 4 7 4 5 3 7 2 8 7 3 6 4 3 2 9 8 4 7 7 5 8 1 5 5 1 5 4 1 8 6 6 9 5 8 6 8 3 9 4 6 8 2 4 6 3 3 5 5 9 6 8 2 4 7 4 6 3 9 4 3 6 7 4 5 2 6 8 6 2 8 8 8 7 2 4 1 8 6 2 9 8 1 5 7 8 8 4 7 6 7 1 7 6 8 4 2 7 7 4 7 4 3 3 7 3 3 3 8 8 6 8 4 4 4 5 3 7 2 5 1 6 4 5 4 4 5 5 2 3 3 4 2 1 7 2 1 8 4 4 4 3 7 2 5 6 4 5 7 2 2 3 4 8 7 6 7 1 2 4 6 6 9 2 7 6 8 1 5 3 4 2 4 6 7 4 8 5 6 8 9 6 4 8 7 7 7 3 3 8 6 6 8 7 5 6 3 4 2 6 0 6 1 0 7 1 7 2 4 3 6 6 5 4 8 6 5 6 2 6 7 7 7 4]
acc: 0 forall stuff [acc: acc + stuff/1]text
input: split next {
5 1 9 5
7 5 3
2 4 6 8
} newline
acc: 0
foreach row input [
digits: sort load row
acc: add acc subtract last digits first digits
]
probe accayy=: ((1 ":@:|.@:#~1 j. ])"0@:i.) ayy 10 1 0 1 0 0 1 0 0 0 1 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 1
timespace=: 6!:2, 7!:2@] timespace 'ayy 10' 3.1e_5 6656
Red [] offset: 400x400 side-x: side-y: 25 size: as-pair side-x side-y s: l: 0 col: 'red f: make font! [name: "arial" size: 8] lay: compose/deep [ style box': base (size + 1) font f beige draw [box 0x0 (size)] ] repeat i 1000 [ append lay compose [at (offset) box' (col) (to-string i)] if i = 1 [col: 'beige] l: l + 1 offset: offset + case [ (l = (4 * s)) or (s = 0) [s: s + 2 l: 0 25x0] l < s [0x-25] l < (2 * s) [-25x0] l < (3 * s) [0x25] l < (4 * s) [25x0] ] ] view lay
SPOILER STARTS HERE!END OF SPOILERatat (word)o1: 50x1 o2: 80x1 o3: 80x31 view compose [ style b: base 31x31 draw [box 0x0 30x30] at (o1) b "1" at (o2) b "2" at (o3) b "3"]
x-pos: y-pos: 150 view compose [ size 300x300 backdrop linen at (to-pair x-pos y-pos) text "1" at (to-pair x-pos y-pos + 10) text "2" ]
init-pos: 200x200 run: does [ do reduce [init-pos: init-pos random/only [+ / -] random 60]] view compose [ size 800x600 backdrop 153.0.0 at (init-pos) btn: button 120x40 "Click Me" on-over [btn/offset: (run)] ]
Red [needs: 'view]
v1: view/options/no-wait [
backdrop blue
button "unview blue"[unview v1]
button "unview yellow" [unview v2]
]
[offset: 30x100] ;options
v2: view/options/no-wait [
backdrop yellow
button "unview blue"[unview v1]
button "unview yellow" [unview v2]
]
[offset: 400x100] ;options; day 4 - part 1 total: 0 p: read/lines %pass.txt foreach i p [if (split i space) = (unique split i space) [total: total + 1]]
(sort "abcde") = sort ("ecdab"); day 4 - part 1 total: 0 p: read/lines %pass.txt foreach i p [if (split i space) = (unique split i space) [total: total + 1]] ; day 4 - part 2 total: 0 p: read/lines %pass.txt new-p: copy [] foreach i p [append/only new-p split i space] foreach i new-p [foreach words i [sort words]] foreach i new-p [if i = (unique i) [total: total + 1]]
input: read/lines %D04
day-4: function [input /part-2][
total: 0
probe get also 'total forall input [
passphrase: split first input space
if part-2 [forall passphrase [sort first passphrase]]
if equal? passphrase unique passphrase [total: total + 1]
]
]
day-4 input
day-4/part-2 inputprobe also total ... be the same thing?0), evaluate right argument (yield total update), return left argument (0)'total left argument evaluates to total, then its value is updated, then total is returned and its value is accessed with getforeach i p [ foreach j words: split i space [sort j] if words = (unique words) [total: total + 1] ]
([:([:":[:|.1#~1 j.])"0 i.) 5
1
0 1
0 0 1
0 0 0 1
0 0 0 0 1
([:,.([:([:<[:|.1{.~])"0[:>:i.)) 5
┌─────────┐
│1 │
├─────────┤
│0 1 │
├─────────┤
│0 0 1 │
├─────────┤
│0 0 0 1 │
├─────────┤
│0 0 0 0 1│
└─────────┘
(,.@:((<@:|.@:(1{.~]))"0@:>:@:i.)) 5
┌─────────┐
│1 │
├─────────┤
│0 1 │
├─────────┤
│0 0 1 │
├─────────┤
│0 0 0 1 │
├─────────┤
│0 0 0 0 1│
└─────────┘([:,.([:([:<[:|.1{.~])"0[:>:i.))
┌─ [:
├─ ,.
│ ┌─ [:
│ │ ┌─ [:
──┤ │ ├─ <
│ │ ┌────┤ ┌─ [:
│ │ │ │ ├─ |.
│ │ │ └────┤ ┌─ 1
└────┼─ " ─┤ └────┼─ ~ ─── {.
│ │ └─ ]
│ └─ 0
│
│ ┌─ [:
└─────┼─ >:
└─ i.=/~i.4 1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1
parse [][]?blk: [1 2 3] val: 4 append blk 5 ; in-place add val 1 ; why not in-place?
word: is more like a place marker in code, and not a variable that references a memory location?add val 1 not changing the referred to value is simply a language design choice. If Red did that, how would you *avoid* mutating val? Copy val? But that leads to a lot of other changes under the hood as well. In this case, val is a normal word being evaluated, so add never sees it. It only sees the result. When blk is evaluated append sees the series, which it can modify in place. If you wanted, you could *probably* choose to have the add action also dispatch to the append behavior for blocks.nums: load %reg.txt
count: temp: 0
while [not tail? nums][
temp: nums/1
either nums/1 >= 3 [nums/1: nums/1 - 1][nums/1: nums/1 + 1]
unless tail? nums [nums: skip nums temp]
count: count + 1
]
print counttemp in place of 3 nums/1 calls to see how much effect that has. Ultimately, Red is going to be slower for things like this, because everything is very high level.cycles and where or how I test for a repeat patterninc functions. 15-16 LoC. Good idea about saving solutions somewhere. I would enjoy learning from your tricks, guys.inc, I guess our solutions are quite similar (combination of parse, string transformation, loading and a couple of user-defined functions)ab for the first timeparse is pure funmove usage, that's neat!op! doesn't allow quoted arguments, that's why I asked about implementation laterdec: func ['value step][set value (get value) + negate step] is stupid. dec: func ['value step][set value (get value) - step]load the input and make blocks for processing. Maybe I can do part 2 today., and use tag! to look for garbageparse.excludeparse, but they can be mashed together in a more long, less detailed post of handwaving and conceptual rambling.parse article?keep pick/ collect after / change)range.reddo %unicode.red unicode/chart 'ascii
ft: make font! [name: "Consolas" size: 144] view compose/deep [base 160x160 draw [font ft text 1x1 (to-string to-char 129318)]]
pull-request is a github thing. Gitlab's name for it is merge-request. The name says it all, it is a request for another person to git pull (or more often, git merge)char! digits in some base, which kills performance for actual numerical work.pair! values? i.e., how do you address their parts versus their digits?parts?>> the-deep: make bitset! [#"0" - #"9"]
== make bitset! #{000000000000FFC0}
>> to-integer to-binary the-deep
== 0
>> the-deep/1: true
== true
>> to-integer to-binary the-deep
== 10737418241-Apr-17 so exporting stats to CSV would be easy peasy. The hard question is **what** stats to export? I have sooo much data...mold quirks, omgmake-dir in Red is exactly the same code as make-dir in rebol2, except that Red uses cause-error and rebol has its make error!return make error! reduce ['access 'cannot-open path]cause-error 'access 'cannot-open path