Aquí tienes una muestra.
________________________________
De: [email protected]
[mailto:[email protected]] En nombre de alberto
Enviado el: lunes, 18 de noviembre de 2013 15:38
Para: forum.help400
Asunto: RE: Ordenar matriz con %subarr
Hombre, pues no me iría mal algún ejemplo, porque aparte de este caso
que he expuesto, tengo previsto trabajar en arrays dinámicas en otro programa,
y la verdad, que en RPG/ILE no sé cómo hacerlo.
Gracias
De: "Javier Mora" <[email protected]>
Para: "forum.help400" <[email protected]>
Fecha: 18/11/2013 13:16
Asunto: RE: Ordenar matriz con %subarr
________________________________
Yo, para clasificar un array con subcampos (o multidimensional) utilizo
la función qsort() de C. Al principio puede ser que sea difícil de entender y
programar, pero una vez la dominas te permite programar criterios de
clasificación muy complejos.
Si te interesa puedo buscar algún ejemplo.
Javier Mora
________________________________
De: [email protected]
[mailto:[email protected]
<mailto:[email protected]> ] En nombre de alberto
Enviado el: lunes, 18 de noviembre de 2013 12:47
Para: forum.help400
Asunto: RE: Ordenar matriz con %subarr
Hola
No compila, pero tampoco me serviría, porque en mi array(la mia, no la
del ejemplo) tengo tres campos posibles para ordenar, y los tengo que ir
alternando.
He probado una manera más 'tradicional' como la siguiente:
D DS
D Registro 40 Dim(10) Ascend
D name 25A Overlay(Registro)
D Inz(*hival)
D salary 8S 0 Overlay(Registro:*next)
/free
// Initialize the data structure
name(1) = 'Maria';
salary(1) = 1100;
name(2) = 'Pablo';
salary(2) = 1200;
name(3) = 'Bill';
salary(3) = 1000;
name(4) = 'Alex';
salary(4) = 1300;
SORTA name;
*inlr=*on;
Y en el ejemplo funciona. La probaré en mi programa a ver.
Saludos y gracias!!
De: "Javier Mora" <[email protected]>
Para: "forum.help400" <[email protected]>
Fecha: 18/11/2013 12:21
Asunto: RE: Ordenar matriz con %subarr
________________________________
Prueba
SORTA %subarr(emp : 1 : numEmp);
en V6R1 tampoco se puede especificar un subcampo en %SUBARR, el primer
parámentro es siembre el nombre del array. Es a partir de V7R1, con la
estructura array(*).subcampo, cuando se puede especificar el campo de
clasificación.
Javier Mora
________________________________
De: [email protected]
[mailto:[email protected]
<mailto:[email protected]> ] En nombre de alberto
Enviado el: lunes, 18 de noviembre de 2013 11:43
Para: forum.help400
Asunto: RE: Ordenar matriz con %subarr
Hola. Esto lo estoy probando en el AS de desarrollo con una V6R1. Ahora
lo probaré en el de producción que tiene una V7R1 a ver qué tal.
Por cierto, en el V6R1 tambien he probado sin el * : SORTA
%subarr(emp.name : 1 : numEmp);
y tampoco me compila. Bueno, creo que de hecho he probado unas 20
combinaciones y no me compila en ninguna :(
De: "Javier Mora" <[email protected]>
Para: "forum.help400" <[email protected]>
Fecha: 18/11/2013 11:20
Asunto: RE: Ordenar matriz con %subarr
________________________________
¿Versión de S.O.? Si no me equivoco, %SUBARR está disponible en V6R1 (o
como mucho V5R4). La característica 'array(*).subcampo' está disponible a parti
de V7R1. Yo estoy en V6R1 y tampoco me compila el programa.
Un saludo,
Javier Mora
________________________________
De: [email protected]
[mailto:[email protected]
<mailto:[email protected]> ] En nombre de alberto
Enviado el: lunes, 18 de noviembre de 2013 9:51
Para: forum.help400
Asunto: Ordenar matriz con %subarr
Hola Foro
Nunca había tenido la necesidad de ordenar un array, básicamente porque
siempre he podido crearlo en un orden determinado, pero ahora me he encontrado
con esta necesidad y estoy intentando llevarlo a cabo. con un SORTA. Como mi
array es del tipo DS y no están llenos todos los elementos, he seguido las
indicaciones de IBM y uso el %subarr para indicar qué elementos quiero ordenar.
He seguido todas las indicaciones, y no me compila, me dice que el
primer parámetro de %subarr NO es una matriz. Pero lo bueno es que me he
copiado tal cual el ejemplo de IBM,
D emp DS QUALIFIED DIM(25)
D name 25A VARYING
D salary 9P 2
D numEmp S 10I 0
// Initialize the data structure
emp(1).name = 'Maria';
emp(1).salary = 1100;
emp(2).name = 'Pablo';
emp(2).salary = 1200;
emp(3).name = 'Bill';
emp(3).salary = 1000;
emp(4).name = 'Alex';
emp(4).salary = 1300;
numEmp = 4;
SORTA %subarr(emp(*).name : 1 : numEmp);
http://pic.dhe.ibm.com/infocenter/iadthelp/v8r0/index.jsp?topic=%2Fcom.ibm.etools.iseries.langref.doc%2Fevfrilsh1006.htm
<http://pic.dhe.ibm.com/infocenter/iadthelp/v8r0/index.jsp?topic=%2Fcom.ibm.etools.iseries.langref.doc%2Fevfrilsh1006.htm>
y me da exactamente el mismo error
Alguno de vosotros cade servir el sorta con %subarr??
Me podéis dar un ejemplo que funcione?
Gracias____________________________________________________
Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd
<http://bit.ly/db68dd> )
Forum.Help400 © Publicaciones Help400, S.L.
____________________________________________________
Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd
<http://bit.ly/db68dd> )
Forum.Help400 © Publicaciones Help400, S.L.
____________________________________________________
Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd
<http://bit.ly/db68dd> )
Forum.Help400 © Publicaciones Help400, S.L.
H DFTACTGRP(*NO) BNDDIR('QC2LE')
D qsort PR ExtProc('qsort')
D base * value
D num 10U 0 value
D width 10U 0 value
D compare * procptr value
D LastName PR 10I 0
D parm1 like(name)
D parm2 like(name)
D name s 50A
D num_names s 10I 0
D test1 s like(name) dim(10)
c eval test1(1) = 'Bush, George W.'
c eval test1(2) = 'Clinton, Bill'
c eval test1(3) = 'Bush, George H.W.'
c eval test1(4) = 'Reagan, Ronald'
c eval test1(5) = 'Carter, Jimmy'
c eval test1(6) = 'Ford, Gerald'
c eval num_names = 6
c callp qsort(%addr(test1): num_names:
c %size(name): %paddr('LASTNAME'))
c eval *inlr = *on
P LastName B
D LastName PI 10I 0
D parm1 like(name)
D parm2 like(name)
c select
c when parm1 < parm2
c return -1
c when parm1 > parm2
c return 1
c other
c return 0
c endsl
P E
H DFTACTGRP(*NO) BNDDIR('QC2LE')
D QSORT PR ExtProc('qsort')
D base likeds(PhoneNo_t) dim(300)
D numToSort 10I 0 value
D sizeElem 10I 0 value
D compare * procptr value
D AscendExt PR 10I 0
D Elem1 likeds(PhoneNo_t)
D Elem2 likeds(PhoneNo_t)
D PhoneNo_t ds qualified
D Ext 4A
D 1A
D Empl 30A
D List ds likeds(PhoneNo_t)
D dim(300)
D x s 10I 0
D total s 10I 0
/free
// **********************************
// Load some values into array
// **********************************
x = 1;
List(x).Ext = '6292';
List(x).Empl = 'Klement, Scott';
x = x + 1;
List(x).Ext = '6291';
List(x).Empl = 'Bizub, James';
x = x + 1;
List(x).Ext = '6280';
List(x).Empl = 'Lewis, Doug';
x = x + 1;
List(x).Ext = '6230';
List(x).Empl = 'Klement, Anna';
x = x + 1;
List(x).Ext = '6209';
List(x).Empl = 'Michuda, Mike';
x = x + 1;
List(x).Ext = '6272';
List(x).Empl = 'Vogl, Jackie';
x = x + 1;
List(x).Ext = '6272';
List(x).Empl = 'Dobs, Marion';
x = x + 1;
List(x).Ext = '6272';
List(x).Empl = 'Mahan, Stacy';
total = x;
// **********************************
// Run QSORT. QSORT calls my
// "Compare" subprocedure to
// compare each element
// **********************************
qsort(List: Total: %size(PhoneNo_t): %paddr(AscendExt));
dsply 'Sorted by Extension - Ascend';
for x = 1 to total;
dsply List(x);
endfor;
*inlr = *on;
/end-free
P AscendExt B
D AscendExt PI 10I 0
D Elem1 likeds(PhoneNo_t)
D Elem2 likeds(PhoneNo_t)
/free
select;
when Elem1.Ext < Elem2.Ext;
return -1;
when Elem1.Ext > Elem2.Ext;
return 1;
other;
return 0;
endsl;
/end-free
P E
/EOF
*
* Otros criterios de clasificación
*
P DescendExt B
D DescendExt PI 10I 0
D Elem1 likeds(PhoneNo_t)
D Elem2 likeds(PhoneNo_t)
/free
select;
when Elem1.Ext < Elem2.Ext;
return 1;
when Elem1.Ext > Elem2.Ext;
return -1;
other;
return 0;
endsl;
/end-free
P E
P DescendName B
D DescendName PI 10I 0
D Elem1 likeds(PhoneNo_t)
D Elem2 likeds(PhoneNo_t)
/free
select;
when Elem1.Empl < Elem2.Empl;
return 1;
when Elem1.Empl > Elem2.Empl;
return -1;
other;
return 0;
endsl;
/end-free
P E
P NameWithinExt B
D NameWithinExt PI 10I 0
D Elem1 likeds(PhoneNo_t)
D Elem2 likeds(PhoneNo_t)
/free
select;
when Elem1.Ext < Elem2.Ext;
return -1;
when Elem1.Ext > Elem2.Ext;
return 1;
when Elem1.Empl < Elem2.Empl;
return 1;
when Elem1.Empl > Elem2.Empl;
return -1;
other;
return 0;
endsl;
/end-free
P E
*
* Demonstration of the QSORT function from the ILE C runtime
* library.
* Scott Klement, Dec 4th, 2003
*
* Compile me with:
* CRTBNDRPG QSORTDEMO SRCFILE(mylib/QRPGLESRC) DBGVIEW(*LIST)
*
H DFTACTGRP(*NO) BNDDIR('QC2LE')
* void qsort(void *base, size_t num, size_t width,
* int(*compare)(const void *key, const void *element));
*
*
D qsort PR ExtProc('qsort')
D base * value
D num 10U 0 value
D width 10U 0 value
D compare * procptr value
*
* These are some sample "compare" functions we will
* use with QSort
*
D LastName PR 10I 0
D parm1 like(name)
D parm2 like(name)
D LastName2 PR 10I 0
D parm1 like(name)
D parm2 like(name)
D LastName3 PR 10I 0
D parm1 like(name)
D parm2 like(name)
D FirstName PR 10I 0
D parm1 like(name)
D parm2 like(name)
D FirstName2 PR 10I 0
D parm1 like(name)
D parm2 like(name)
D Mods_Name PR 10I 0
D parm1 * value
D parm2 * value
D Mods_Year PR 10I 0
D parm1 * value
D parm2 * value
*
* These subprocedures will be used to show the results of
* each sort.
*
D Show PR
D title 47A const
D num_elems 10I 0 value
D array like(name) dim(32767)
D options(*varsize)
D ShowMods PR
D title 47A const
D num_elems 10I 0 value
D mods * value
D name s 50A
D test1 s like(name) dim(10)
D p_test2 s *
D test2 s like(name) dim(32767)
D based(p_test2)
D test3 DS OCCURS(10)
D test3_name like(name)
D test3_year 4P 0
D num_names s 10I 0
*************************************************
* Example 1: This does a very simple sort by
* last name.
*************************************************
c eval test1(1) = 'Bush, George W.'
c eval test1(2) = 'Clinton, Bill'
c eval test1(3) = 'Bush, George H.W.'
c eval test1(4) = 'Reagan, Ronald'
c eval test1(5) = 'Carter, Jimmy'
c eval test1(6) = 'Ford, Gerald'
c eval num_names = 6
c callp qsort(%addr(test1): num_names:
c %size(name): %paddr('LASTNAME'))
c callp Show('Array sorted by Last Name'
c : num_names: test1)
*************************************************
* Example 2: This sorts the same set of names
* into descending sequence.
*************************************************
c callp qsort(%addr(test1): num_names:
c %size(name): %paddr('LASTNAME2'))
c callp Show('Same sort in descending sequence'
c : num_names: test1)
*************************************************
* Example 3: This does the same thing as the
* first example, except that we use a dynamic
* array.
*************************************************
c eval num_names = 6
c eval p_test2 = %alloc(%size(name) * num_names)
c eval test2(1) = 'Klement, Scott'
c eval test2(2) = 'Lundgren, Chuck'
c eval test2(3) = 'Guthrie, Gary'
c eval test2(4) = 'Flensburg, Carsten'
c eval test2(5) = 'Monypenny, Julian'
c eval test2(6) = 'zenith, Zack'
c callp qsort(%addr(test2): num_names:
c %size(name): %paddr('LASTNAME'))
c callp Show('The same sort on a dynamic array'
c : num_names: test2)
*************************************************
* Example 4: The last example showed that lower-
* case letters come bfore uppercase. This
* time we'll use the LastName2 subprocedure
* which sorts them all as if they were
* uppercase.
*************************************************
c callp qsort(%addr(test2): num_names:
c %size(name): %paddr('LASTNAME3'))
c callp Show('Case-Insensitive sort by Last Name'
c : num_names: test2)
*************************************************
* Example 5: This time we'll sort by first
* name. Take a look at the FirstName()
* procedure to see how it works!
*************************************************
c callp qsort(%addr(test2): num_names:
c %size(name): %paddr('FIRSTNAME'))
c callp Show('Array sorted by First Name'
c : num_names: test2)
*************************************************
* Example 6: Using QSORT to sort a MODS.
*************************************************
c 1 occur test3
c eval test3_name = 'Bush, George W.'
c eval test3_year = 2000
c 2 occur test3
c eval test3_name = 'Clinton, Bill'
c eval test3_year = 1992
c 3 occur test3
c eval test3_name = 'Bush, George H.W.'
c eval test3_year = 1988
c 4 occur test3
c eval test3_name = 'Reagan, Ronald'
c eval test3_year = 1980
c 5 occur test3
c eval test3_name = 'Carter, Jimmy'
c eval test3_year = 1976
c 6 occur test3
c eval test3_name = 'Ford, Gerald'
c eval test3_year = 1974
c 1 occur test3
c callp qsort(%addr(test3): num_names:
c %size(test3): %paddr('MODS_NAME'))
c callp ShowMods('MODS sorted by Name'
c : num_names: %addr(test3))
c callp qsort(%addr(test3): num_names:
c %size(test3): %paddr('MODS_YEAR'))
c callp ShowMods('MODS sorted by Year'
c : num_names: %addr(test3))
c dealloc p_test2
c eval *inlr = *on
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This is a "compare" function used by QSORT. It sorts an
* array of names into ascending sequence by last name.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P LastName B
D LastName PI 10I 0
D parm1 like(name)
D parm2 like(name)
c select
c when parm1 < parm2
c return -1
c when parm1 > parm2
c return 1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This is a "compare" function used by QSORT. It sorts an
* array of names into descending sequence by last name.
*
* It's easy to change from ascending to descending sequence,
* all you need to do is reverse the return values.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P LastName2 B
D LastName2 PI 10I 0
D parm1 like(name)
D parm2 like(name)
c select
c when parm1 < parm2
c return 1
c when parm1 > parm2
c return -1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This is a "compare" function used by QSORT. It sorts an
* array of names into ascending sequence by last name.
*
* We convert our names to uppercase before comparing them so
* that upper and lower case names get sorted together.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P LastName3 B
D LastName3 PI 10I 0
D parm1 like(name)
D parm2 like(name)
d lower c 'abcdefghijklmnopqrstuvwxyz'
d upper c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D uc_parm1 s like(name)
D uc_parm2 s like(name)
c lower:upper xlate parm1 uc_parm1
c lower:upper xlate parm2 uc_parm2
c select
c when uc_parm1 < uc_parm2
c return -1
c when uc_parm1 > uc_parm2
c return 1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This is a "compare" function used by QSORT.
*
* We search for the comma in the string, and do the comparison
* by the characters that come after the comma.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P FirstName B
D FirstName PI 10I 0
D parm1 like(name)
D parm2 like(name)
d lower c 'abcdefghijklmnopqrstuvwxyz'
d upper c 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
D uc_parm1 s like(name)
D uc_parm2 s like(name)
D pos s 10I 0
* make uc_parm1 contain only the first name in uppercase
c eval pos = %scan(',': parm1)
c eval uc_parm1 = %triml(%subst(parm1:pos+1))
c lower:upper xlate uc_parm1 uc_parm1
* make uc_parm2 contain only the first name in uppercase
c eval pos = %scan(',': parm2)
c eval uc_parm2 = %triml(%subst(parm2:pos+1))
c lower:upper xlate uc_parm2 uc_parm2
c select
c when uc_parm1 < uc_parm2
c return -1
c when uc_parm1 > uc_parm2
c return 1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This "compare" function shows how to compare names from
* a MODS.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P Mods_Name B
D Mods_Name PI 10I 0
D parm1 * value
D parm2 * value
D ds1 ds based(parm1)
D ds1_name like(name)
D ds1_year 4P 0
D ds2 ds based(parm2)
D ds2_name like(name)
D ds2_year 4P 0
c select
c when ds1_name < ds2_name
c return -1
c when ds1_name > ds2_name
c return 1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This "compare" function shows how to compare years from
* a MODS.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P Mods_Year B
D Mods_Year PI 10I 0
D parm1 * value
D parm2 * value
D ds1 ds based(parm1)
D ds1_name like(name)
D ds1_year 4P 0
D ds2 ds based(parm2)
D ds2_name like(name)
D ds2_year 4P 0
c select
c when ds1_year < ds2_year
c return -1
c when ds1_year > ds2_year
c return 1
c other
c return 0
c endsl
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* Show(): Display the contents of an array of names.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P Show B
D Show PI
D title 47A const
D num_elems 10I 0 value
D array like(name) dim(32767)
D options(*varsize)
D x s 10I 0
D pause s 1A
D msg s 50A
c eval msg = '-- ' + title
c msg dsply
c for x = 1 to num_elems
c array(x) dsply
c endfor
c eval msg = '-- Press ENTER to continue'
c msg dsply pause
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* ShowMods(): Display the contents of the MODS
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P ShowMods B
D ShowMods PI
D title 47A const
D num_elems 10I 0 value
D mods * value
D mymods ds occurs(10) based(mods)
D mymods_name like(name)
D mymods_year 4P 0
D x s 10I 0
D pause s 1A
D msg s 50A
c eval msg = '-- ' + title
c msg dsply
c for x = 1 to num_elems
c x occur mymods
c eval msg = 'Year=' + %editc(mymods_year:'X') +
c ', Name=' + mymods_name
c msg dsply
c endfor
c eval msg = '-- Press ENTER to continue'
c msg dsply pause
P E
____________________________________________________
Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd )
Forum.Help400 © Publicaciones Help400, S.L.
