AltME groups: search

I should have said: the values can be of any type,.integers or anything 
else.

You don't need to find a tricky way to swap values. The purpose is 
not to find how to swap values.

The purpose is to find an algorithm with a minimal amount of single 
swaps .
>> swap-sub [a b 1 d  z 3   X 3 Y ]  7 
== [ X 3 Y   a b 1 d z 3]

in R3, you can swap values like this:
swap [a] [b]
in R2
a: also b a: b

Or use a tmp variable, as you want.

what does that 7 in swap-sub [a b 1 d  z 3   X 3 Y ]  7 mean?

I try to swap [[a b 1 d  z 3]   [X 3 Y ]]
minus the sub blocks

Not optimal, but a start:


bubble-to-front: funct [series index] [for i index 2 -1 [swap b: 
at series i back b] series]

swap-sub: funct [series position] [loop (n: length? series) - position 
+ 1 [bubble-to-front series n] series]

I've written some very clunky code that I'd be ashamed to post as 
a solution.

But I can offer you an algorithm that acheives the effect in N-1 
swaps at most where 
N is the sum of the lengths of the two sequences.
It's the more-or-less same algorithm used by Andreas.

Here's how it works. Given these two sequences:
       a b c    1 2 3 4 5 6 7

Step1: cyclically rotate the longer sequence M times, where M is 
the difference in length of the sequences. So in this case, we rotate 
3 (7 - 4) times:
       a b c    4 5 6 7    1 2 3


Step2: swap the elements of the shorter sequence with the tail of 
the longer one:
       1 2 3    4 5 6 7    a b c
And it's done.


The cycling in place is the tricky part. It can be done, but my code 
is just too ugly to share :(

Andreas's bubble-to-front is an elegant approach to doing the cycling, 
but is not optimed to reduce the number of steps.

It's a managable sub-problem that is a challenge to solve, so I am 
sure someone can do better than me :)

; helper function:
swap-first: func [
	{swap the first elements of A and B}
	a [series!]
	b [series!]
	/local t
][
	set/any 't first a
	change/only a first b
	change/only b get/any 't
]

; implementation:
swap-sub: func [
	{swap the subseries using the SWAP-FIRST function}
	a [series!]
	b [integer!]
	/local la lb pa pb
][
	pa: a
	la: b - 1
	pb: skip a la
	lb: (length? a) - la
	while [all [la > 0 lb > 0]][
		either la <= lb [
			loop la [
				swap-first pa pb
				pa: next pa
				pb: next pb
			]
			pb: skip pa la
			lb: lb - la
		][
			pa: skip pa la - lb
			loop lb [
				swap-first pa pb
				pa: next pa
				pb: next pb
			]
			pa: skip pa negate la
			la: la - lb
			pb: skip pa la
		]
	]
	a
]

but, I do not have a proof at hand, that it is optimal

I had a similar volume of code, but not nearly as neat, Ladislav.


The problem somehow feels that it ought to have a one-liner solution; 
but the constaints on what can be used in the code make that hard 
to find :)

this may look more readable:

; implementation:
swap-n: func [
	{swap n elements}
	a [series!]
	b [series!]
	n [integer!]
][
	loop n [swap-first a b a: next a b: next b]
]

swap-sub: func [
	{swap the subseries using the SWAP-FIRST function}
	a [series!]
	b [integer!]
	/local la lb pa pb
][
	pa: a
	la: b - 1
	pb: skip a la
	lb: (length? a) - la
	while [all [la > 0 lb > 0]][
		either la <= lb [
			swap-n pa pb la
			pb: skip pa la
			lb: lb - la
		][
			pa: skip pa la - lb
			swap-n pa pb lb
			pa: skip pa negate la
			la: la - lb
			pb: skip pa la
		]
	]
	a
]

swap-sub: func [
	{swap the subseries using the SWAP-FIRST function}
	a [series!]
	b [integer!]
	/local la lb pa pb
][
	pa: a
	la: b - 1
	pb: skip a la
	lb: (length? a) - la
	while [all [la > 0 lb > 0]][
		either la <= lb [
			swap-n pa pb la
			pa: pb
			pb: skip pa la
			lb: lb - la
		][
			swap-n skip pa la - lb pb lb
			la: la - lb
			pb: skip pa la
		]
	]
	a
]

swap-first: func [
	{swap the first elements of A and B}
	a [series!]
	b [series!]
	/local t
][
	k: k + 1
	set/any 't first a
	change/only a first b
	change/only b get/any 't
]

k: 0
swap-sub [1 2 3 4 5 6 7 8 9] 7
k ; == 6

If the two series lengths are L1 and L2, I get L1+L2-1 swaps -- at 
most. But there are exceptions, eg:
    [a b c d   1 2]

Needs only 4 swaps....An any [{L1 // L2) = 0 (L2 // L1) = 0] test 
triggers a shortcut.


However .....I also have some edge-case bugs in my code -- so you 
win!!

That looks good steeve -- short, neat code, looks optimal on the 
swap numbers.
And a completely different algorithm to mine.

Steeve, good fun. I came to a swap-sub using modulo as well, but 
it only worked for some series lengths, and I had to sleep before 
figuring out which lengths they were, but they surely included prime 
numbers.

(I used only a single loop). I thought maybe I could detect which 
series lengths could be processed using only a single loop, and other 
cases could be processed using another algorithm.

Steeve, 

What might be interesting (and possibly even ... useful) is to generalise 
to be able to swap (rotate) any number of sub-series, eg.
for three sub-series in a series [... AAA ... BBBB ... CC ...]
AAA moves to where BBBB is currently,
BBBB moves to where CC is currently, and finally
CC moves to where AAA is currently.

Should not be that hard with a recursive approach

add a port to communicate with the java app?

>> blk: copy [1]
== [1]
>> blk/1: #[unset!]
** Script error: blk/1: needs a value
>> poke blk 1 #[unset!]
** Script error: poke does not allow unset! for its data argument
>> head insert blk #[unset!]
== [unset! 1]

What other series funcs are you think of Brian?

If any-type! is allowed, should the behavior be like INSERT?

I'm not saying it's a useless requirement, but what is purpose to 
have #[unset!] in a serie, instead of anything else working, for 
instance, #[none!].
Just asking...

what is purpose to have #[unset!] in a serie

 - well, it was not me who 'introduced' #[unset!] to Rebol series.

In my opinion, there are certain simple and useful states, that we 
can choose from. One of the states might be, that #[unset!] is not 
a Rebol value at all. That approach was chosen for the #[end!] value 
as far as I can tell. Moreover, that approach was chosen even for 
#[unset!] for R1, but, for some reason, Carl declined from it, choosing 
a different approach.

That is why allowing it for POKE is a good idea.

This came up in a CC ticket for another series function once, and 
the reasons for the choice made there apply here as well. There are 
two main reasons that you would want series functions to be able 
to handle unset!:

- This gives the error context, so when it is triggered you can get 
an idea of what the conditions were that caused it.

- Your code might be structured to handle errors on output from the 
series instead of input to it.

As a rule, R2/Forward hasn't had any changes to native functions 
in R2, mostly for performance and compatibility reasons. It is intended 
to have an extended version later that attempts to backport as many 
native changes as possible, but that won't be the default because 
it would break a lot of the same R2 code that R3 breaks.

yay... the fact that we couldn't support writing out UNC paths easily 
has bitten me at a high-profile client in the past :-)

nice to have that fixed.

I'm able to consistently produce this in 2.7.7:

---------------------------
REBOL Error
---------------------------
REBOL Internal Error: Invalid series width 1 was 16 (type 39)

Program terminated abnormally.
This should never happen.
Contact www.REBOL.com with details.
---------------------------
OK   
---------------------------


Will need to dig a little. Not sure if it's an encryption part, debase 
part or what it is yet, but it occurs, when loading enbased, encrypted 
data.

You can go through the steps with the data manually, and with different 
R2 versions. Anything unexpected will be a clue.

It shouldn't be to hard to use 2.7.8 in our setup and switch back 
and forth between both. We can take a look at it tomorrow.

Rebol []

make-obj: func [
	"Créé un objet en sauvant son nom dedans."
	'name "Nom de l'objet à créer."
	obj "Objet de base à instancier."
	spec "extension de l'objet de base."
] [

 set name make obj append reduce [to-set-word 'obj-name to-string 
 name] spec
]


save-obj: func [
	"Sauvegarde un objet selon son propre nom."
	'obj "Objet à sauvegarder."
	/local name
] [

 name: any [all [word? obj  object? get obj  get in get obj 'obj-name] 
 join "objet" random 10000]
	save/all to-file join name ".r" get obj
]

load-obj: func [

 "Recharge un objet et l'intancie selon son propre nom s'il en a un."
	file "Nom du fichier à charger."
	/local obj
] [
	if exists? file [
		obj: load file
		probe bind next first obj obj
		probe get in obj 'list
		all [in obj 'obj-name  set to-word get in obj 'obj-name obj]
	]
	obj
]

task: make object! [
  list: copy []
  add: funct [t [block!]] [
    append list t
  ]
  save: does [
    save-obj self
  ]
  run: does [
    do list
  ]  
]

make-obj task1 task []
task1/add [a: 0 a: a + 1]
task1/add [print a]
task1/run
task1/save

task1: none

load-obj %task1.r
task1/run

In other words, how to get back a functionnal object from a serialized 
form (save/all) ?

Using SAVE ensures that you have a list of symbols in unevaluated 
form more suitable for object reconstruction and proper binding.

Anyway, binding information is lost during serialization (MOLD or 
MOLD/ALL), so if you want to get back bindings from serialized code, 
you need to manually ensure that the binding will be reconstructed 
as expected. That's achieved easily in your simple example using 
the SAVE / DO combination, but it can get much more complex in other 
cases and could require a lot of additional code.

do load

 does not work with the serialized form (I tried it)?" I'm not sure 
 to understand what you mean there. SAVE/ALL uses MOLD/ALL to serialize 
 values, so binding information is not preserved. If you want to restore 
 correct binding in a object! serialized using /ALL format, you need 
 to write some code to walk through object's functions body blocks 
 and bind object's words explicitely using BIND.

This would be similar to what MAKE does on an object's spec block! 
but a bit smarter as you need to dive into function! values (MAKE 
doesn't do that AFAICT). You need to see the distinction between 
"unevaluated code" (source form) and "evaluated code" (reduced form) 
to get a clear picture on this issue.

Nested bindings are faked using a procedural process in REBOL. Serialized 
syntax is declarative, and there isn't a reference to the bindings 
in that syntax. It would be possible to make a serialized syntax 
that includes binding references, and the proposal to do that is 
called Rebin.

The only one I can think of only works if the entries in _block_ 
are unique:

     sort/compare copy block func [a b][return (index? find block a) < 
     index? find block b]

This may work too:
  sort/compare/skip block func [a b][return true] length? block

sort/compare [t r y t h 1 s] func [a b] [0]

>> sort/compare [t r y t h 1 s] func [a b] [0]
== [r y t h 1 s t]

This does a null sort in R2 and R3.....but it requires the func to 
know the name of the block being sorted:

    sort/compare block func [a b /local c] [c: [] if 0 = length? c [append 
    c block]  block: copy c 0]

OK. Find a solution.

to-integer #{00ff0000} give me an integer, so I will make some "constant" 
values from the binary I need and will make the AND between integers.

should I just simply replace the first occurence of a 0 on the left 
with a * ?

ok, so where there isn't a 255 in the mask, then replace the same 
point in the ip address with a *

going to be a big file!

Does anyone know why modifeid? and info? return a date without the 
time when accessing a file through ftp lon a windows ftp server? 
 Is this a limitation of windows, the ftp scheme, the ftp server, 
or the version of Rebol (I'm using the latest 2.7 - activated ODBC 
connection all dll access)?  Are there any known fixes to this - 
a quick google didn't find anything?

ecall there is a ftp update out there, does anyone know if that fixes 
this limiation?

it should return the time, I've got ftp synching routines which use 
info? and use date/time.   so I'd bet its a limitation on the server, 
or its using a non-standard date string in its LIST command.

You might also try connecting with the FTP server with a command 
line client like NcFTP and looking at the listings directly.

or just modify the existing ftp client ... the formatting is a parse 
rule

according to the above example I would like to store the binary via 
a tcp.

any other possibility to transform the binary? while  using enbase 
I have 
also todo a dehex after retrieving. would like to avoid this.

the best would be if I could store just 3A189256 and then reform 
ist back to a binary.
is this in general possible brian?

tombon, the binary is not spanning mulitiple lines .. that's just 
 a display issue?

unforunatly not. when I compose the value pairs to transmit there 
occur a crlf within. so the key/value just store #{

to lines separated by a tab for the key/value

is there any other compression which returns a string instead a binary?

You can just form a binary ... to get a string

Mind blank ..anyone got a routine to trim a particular character 
from the end of a string?  I want to remove trailing pipe characters

I could reverse the string and then parse it using a charset .. but 
that seems crude ( any reason why the parse direction can not be 
made an option ? )

I didn't know you could use find with a charset

I'll give it a go... ta

So you might need to do a bit of tweaking for the R2 version, but 
it's a start.

FIND/reverse/tail works in R2, but not with charsets. It's a bug.

FIND works with charsets in R2, but the /tail option doesn't. It's 
a newly discovered (just now) bug.

find/reverse tail a b only finds the first |

>> a
== "abcd|as|dsf|||||"

>> index? find/reverse tail a b
== 16

>> map-each a [] [1]
** Throw Error: Return or exit not in function
** Where: map-each
** Near: return any [output make block! 0]

>> system/version
== 2.7.8.4.2

Darn, my bad. It's the [throw] function attribute. Don't worry, there's 
a way to reorganize the code so no RETURN is necessary.

Here's a working version:

map-each: func [

 "Evaluates a block for each value(s) in a series and returns them 
 as a block."
	[throw catch]

 'word [word! block!] "Word or block of words to set each time (local)"
	data [block!] "The series to traverse"
	body [block!] "Block to evaluate each time"
	/into "Collect into a given series, rather than a new block"

 output [any-block! any-string!] "The series to output to" ; Not image!
	/local init len x
][
	; Shortcut return for empty data
	either empty? data [any [output make block! 0]] [
		; BIND/copy word and body
		word: either block? word [
			if empty? word [throw make error! [script invalid-arg []]]

   copy/deep word  ; /deep because word is rebound before errors checked
		] [reduce [word]]
		word: use word reduce [word]
		body: bind/copy body first word
		; Build init code
		init: none
		parse word [any [word! | x: set-word! (
			unless init [init: make block! 4]
			; Add [x: at data index] to init, and remove from word
			insert insert insert tail init first x [at data] index? x
			remove x
		) :x | x: skip (

   throw make error! reduce ['script 'expect-set [word! set-word!] type? 
   first x]
		)]]
		len: length? word ; Can be zero now (for advanced code tricks)
		; Create the output series if not specified
		unless into [output: make block! divide length? data max 1 len]
		; Process the data (which is not empty at this point)

  until [ ; Note: output: insert/only output needed for list! output
			set word data  do init

   unless unset? set/any 'x do body [output: insert/only output :x]
			tail? data: skip data len
		]
		; Return the output and clean up memory references
		also either into [output] [head output] (
			set [word data body output init x] none
		)
	]
]

I'm studying the RIP archive format and am wondering:


Why does LOAD allow binary "junk" at the end of a file, if it has 
a REBOL [] header, while it does not, when the header is omitted?

No.. it doesn't... it's possible to DO a script which has some sort 
of junk, but not LOAD.

>> load {234523$%$%^& rebol [] print 1}
** Syntax Error: Invalid integer -- 234523$%$%&
** Near: (line 1) 234523$%$%& rebol [] print 1
>> do {234523$%$%^& rebol [] print 1}
** Syntax Error: Invalid integer -- 234523$%$%&
** Near: (line 1) 234523$%$%& rebol [] print 1
>> write/binary %x.r {234523$%$%^& rebol [] print 1}
>> do %x.r
** Syntax Error: Script is missing a REBOL header
** Near: do %x.r
>> write/binary %x.r {234523$%$%^& ^/rebol [] print 1}
>> do %x.r
1

rebol with following block.. this does not works:
>> write/binary %x.r {234523$%$%^& ^/rebol none print 1}
>> do %x.r
** Syntax Error: Script is missing a REBOL header
** Near: do %x.r

I guess it's how the load/next is implemented... if the header is 
inside a block, it stops there.

If you want a file requester: request-file, if you just want to spawn 
a new Explorer window for the user, this should work: call "explorer".

Is there a trick / limit to just how deep one can create an object 
which itself has nested objects stored in a block? I have this xml 
string that I converted to a block via parse-xml but at about two 
levels in, it remains a block (make object!...)

Are you missing a reduce?

Yes, I am using xml-parse and then xml-object. My question is something 
that I have dealing with for a long time actually. So is there a 
limit to how far something is reduced in terms of nesting?

I made a mistake in suggesting that.

I think the code makes blocks rather than objects. You could run 
through the structures changing them to objects.

Sorry, about these delays. I was on on an online session.
So When I  use parse-xml+  on my xml string, I get the following:
[document [version none
        encoding none
        standalone none
        doctype none
        pubid none
        sysid none
        subset none

    ] [["TTL_Status" none ["^/^-" ["INPUT_TTLS" none ["^/^-^-" ["TTL_IN" 
    ["value" "0"] [{

^-^-^-} ["status" ["value" "1"] none] "^/^-^-"]] "^/^-^-" ["TTL_IN" 
["value" "1"] [{

^-^-^-} ["status" ["value" "1"] none] "^/^-^-"]] "^/^-"]] "^/^-" 
["OUTPUT_TTLS" none ["^/^-^-" ["TTL_OUT" ["value" "0"] [{

^-^-^-} ["status" ["value" "0"] none] "^/^-^-"]] "^/^-"]] "^/"]]]]

I know it's not that readable...

Then I run xml-to-object on that block and get:

o: xml-to-object  blk
where block is the output of parse-xml+ above.

probe o


[document: make object! [TTL_Status: make object! [INPUT_TTLS: make 
object! [TTL_IN: make block! reduce [

                    make object! [status: make object! [value?: "" value: "1"] value: 
                    "0"] make object! [status: make object! [value?: "" value
: "1"] value: "1"]

                ]] OUTPUT_TTLS: make object! [TTL_OUT: make object! [status: make 
                object! [value?: "" value: "0"] value: "0"]]] version: none
        encoding: none
        standalone: none
        doctype: none
        pubid: none
        sysid: none
        subset: none
    ]]


So this is where my ignorance leaves me. How do I make "o" into a 
an object where all the nested objects become real objects and don't 
remain as blocks?

OK, so I still get an invalid path but looking at the code I can 
see why.
 [TTL_IN: make block! reduce [

                    make object! [status: make object! [value?: "" value: "1"] value: 
                    "0"] make object! [status: make object! [value?: "" value
: "1"] value: "1"]

So it was making a block of objects. I didn't notice that before.

Thanks for your help. I should have looked more carefully before. 
It was always working.

I think this is a Graham question. I've been trying to communicate 
with this video encoder. It uses .xml and .cgi files to talk to it:
tmp: http-tools http://192.168.1.62/user/GetTTLStatus.xml[]
and this works fine.


The problem is with he .cgi files. They aren't POST files but they 
only return 

 a: http-tools http://192.168.1.62/user/StorageMediaFiles.cgi[] probe 
 a
make object! [
    HTTP-Response: "<?xml version='1.0' encoding='ISO-8859-1' ?>"
    Date: none
    Server: none
    Last-Modified: none
    Accept-Ranges: none
    Content-Encoding: none
    Content-Type: none
    Content-Length: none
    Location: none
    Expires: none
    Referer: none
    Connection: none
    Set-Cookie: none
]
When you place the url in a browser it works as expected. 
Any ideas on how to get this to work?

maybe there's a redirect or something else going on

What does a simple 'read do ?

Graham,  I get an error 

Error.  Target url: http://192.168.1.62/user/StorageMediaFiles.cgi
could not be retrieved.  Server response: HTTP/1.1 40.... 
If you know a way to get the full error code, that might help.

And you're right, there is probably something else going on. I am 
at least getting part of the message. A successful .xml call looks 
like this:

a: http-tools http://192.168.1.62/user/StorageEventMode.xml[] probe 
a
make object! [
    HTTP-Response: "HTTP/1.1 200 OK"
    Date: none
    Server: "Mango DSP - HTTP Server (v2.34)"
    Last-Modified: none
    Accept-Ranges: none
    Content-Encoding: none
    Content-Type: "text/xml"
    Content-Length: "270"
    Location: none
    Expires: none
    Referer: none
    Connection: none
    Set-Cookie: none
    Cache-Control: "no-store"
    content: {<?xml version="1.0" encoding="ISO-8859-1" ?>
<?xml-stylesheet type="text/xsl" href="StorageEventMode.xsl"?>
<StorageEventMode>
^-<RecOnNetworkFailure id="RecOnNetworkFailure" checked="true"/>
^-<PreEventBufferTime id="PreEventBufferTime" value="20"/>
</StorageEventMode>
}
]

I'm learning more about what may be happening. According to the docs, 
I may be getting either a 401 or 404 error. More as I figure this 
out.

Problem almost solved. The http-tools'  http-port-private buffer 
is not being read to the end so all along the data was there. Thanks 
Graham and Sunanda...I am learning a lot from you.

So what's happening is that the server is not returning an LF/CR 
to separate the contents from response fields so when it gets to 
 parse-header, that function does not know there is any contents. 
In stead of getthing something like:

HTTP-Response: HTTP/1.1 200 OK
Server: Mango DSP - HTTP Server (v2.34)
Content-Type: 
text/xml
Content-Length: 270
Cache-Control: no-store

<?xml version=
1.0" encoding="ISO-8859-1" ?>"

I am getting:

HTTP-Response: <?xml version='1.0' encoding='ISO-8859-1' ?>
<?xml-stylesheet type='text/xsl' href='StorageMediaFiles.xsl'?>
<StorageMediaFiles>
<MediaFile ..."


Placing a LF between the first and second lines fixes it. I am going 
to kludge it for now since I know what routines work and don't.

Understood. Thanks a lot for the time you spent ;)

as to why you need append/only: a path! is also a series!, with the 
path componenets being the elements. whitness:

>> type? 'a/b
== path!
>> series? 'a/b
== true

>> first 'a/b
== a
>> second 'a/b
== b

Which is why just APPENDing a path! to a block! separately appends 
each component of the path, just as for other series:

>> append t: copy [1 2] [3 4]
== [1 2 3 4]
>> append t: copy [1 2] 'a/b
== [1 2 a b]

If you want to append a series as a whole to another, you use the 
/only refinement:

>> append/only t: copy [1 2] [3 4]
== [1 2 [3 4]]
>> append/only t: copy [1 2] 'a/b  
== [1 2 a/b]

I think that the help for append should be corrected from:


/only -- Only insert a block as a single value (not the contents 
of the block)

to


/only -- Only insert series as a single value (not the contents of 
series)

Not sure on that Bolek. It might then be confusing in the other direction, 
where appending a string without /only could be expected to append 
the individual chars. Since path! is any-block! the existing help 
is OK IMO.

Seems like it's neither block!s alone nor all series! values, seems 
like it's any-block! values which append/only inserts as a single 
value only.

Yes. I guess it could say "Appends any block value as a single value" 
to be a little clearer.

/only -- Appends any block value as a single value only (not the 
contents)


Is that good enough english to probably suggest it for R3 in curecode 
and R2 rambo?