Newsgroup: it.comp.lang.perl
Titolo: Accoppiare variabili

Vorrei implementare un ciclo che, inserendo manualmente n coppie di 
variabili le abbini
Tento di spiegarmi meglio con un esempio:
 coppie variabili  immesse:     $a1  $ a11  |     $a2  $a22  |   $a3   $a33 
|
$ c1 = $a1+$a2+$a3
$ c2= $a1+$a2+$a33
$ c3 =$a1+$a22+$a3
$c4 = $a1+$a22+$a33
$c5 = $a11+$a2+$a3
$c6= $a11+$a2+$a33
$ c7 =$a11+$a22+$a3
$c8 = $a11+$a22+$a33
spero di essere stato chiaro.
in partenza non posso stabilire quante coppie sara' necessario abbinare 
quindi avevo pensato di stabilire le coppie partendo con un primo pinput 
(del n. di coppie) che con un ciclo crei
le variabili necessarie, ma non so se e' possibile realizzarlo.
Nel caso di impossibilita' nel realizzarlo basterebbe abbinare almeno 6 
coppie.
Grazie in anticipo a chi vorra' dedicarmi attenzione.
Ciao 

Si potrebbe anche salvare in un file tipo .txt la $ ad ogni abbinamento

le variabili necessarie, ma non so se e' possibile realizzarlo.
Difficile che non sia possibile realizzarlo, ma la domanda più appropriata
è probabilmente PERCHE' realizzarlo. Creare VARIABILI in esecuzione è, di
solito, una pessima idea. Per memorizzare un numero a priori indefinito di
valori ci sono altri sistemi (array, hash, database...).
Ciao.

Hai ragione.  la domanda e' posta proprio male e chiedo scusa per la fretta
con la quale l'ho scritta.
Il problema e' questo:
Ho una serie di coppie di valori (da inserire manualmente ) che devono
essere abbinati tra loro secondo il seguente ordine:
1  2    3  4     5  6    7  8      9 10  11  12
a a1 - b b1 - c c1 - d  d1  - e e1 - f    f1
quindi        1 +3+5+7+9+12
                 1 +3+5+7+9+11
                 1+3+5+7+10+12
                 1+3+5+7+10+11
                 1+3+5+8+9+12
                 1+3+5+8+9+11
                 1+3+5+8+10+12
                 1+3+5+8+10+11
e cosi' via fino ad averli abbinati tutti.    Il risultato di ogni 
abbinamento
va salvato in un file  e quindi
    1 +3+5+7+9+12
salva in file
    1 +3+5+7+9+11
salva in file
     1+3+5+7+10+12
salva in file
   ecc.
Mi rendo ancora conto di non essere stato troppo chiaro e se puo' servire,
diro' che il prg dovrebbe calcolare gli alleli per il quadrato di punnett
quindi il sudetto abbinamento serve per calcolare le possibili
caratteristiche trasmesse da un soggetto ad esempio il padre.
ripetendo poi il sudetto abbinamento, si otterranno i caratteri trasmessi
dalla madre.
Grazie in anticipo.

essere abbinati tra loro secondo il seguente ordine:
Usa un array, o un array di array, o un hash di array, o insomma la
struttura dati che ritieni più adeguata (guarda perldsc e perllol) per
memorizzare i dati.
Per fare le somme, combinazioni, permutazioni o quello che siano, farai dei
cicli sugli indici. Ci sono anche dei moduli apposta, ma quello che chiedi
sembra abbastanza semplice da cavarsela con un paio di for.
Ciao.

Allora, dopo un po di tempo ho tirato fuori questo codice
#  crea Array
@pc = ($c1, $c2, $c3, 
$c4,$c5,$c6,$c7,$c8,$c9,$c10,$c11,$c12,$c13,$c14,$c15,$c16,$c17,$c18,$c19,$c20,$c21,$c22,$c23,$c24,$c25,$c26,$c27,$c28,$c29,$c30,$c31,$c32,);
@pd = ($d1, $d2, $d3, 
$d4,$d5,$d6,$d7,$d8,$d9,$d10,$d11,$d12,$d13,$d14,$d15,$d16,$d17,$d18,$d19,$d20,$d21,$d22,$d23,$d24,$d25,$d26,$d27,$d28,$d29,$d30,$d31,$d32,);
$cont =0;
while ($cont <34) {
 $x =$pc[$cont];
 $y =$pd[$cont];
 $xy = "$x$y";
    push (@pp,$xy);         # abbina i valori di C e D
    $cont ++;}
# ---------------------------fin qui tutto OK---(almeno 
credo)-----------------------------------------
$cont = 0;
$cont1 =0;
$cont2 =0;
while ($cont <34) {
 $x1 =$pp[$cont];
 $x2 =$pp[$cont1];
 while ($cont2 <34) {
  if ($x1 ne $x2) {push (@pp1,$x1);} push (@pp2,$x1);
     $cont2 ++;
     $x1 =$pp[$cont2];
     #print "@pp1 \n "; $zz =<stdin>;
     }
 $cont ++;
 $cont2 =0;
}
Il problema e' sommare i valori uguali contenuti in @pp
e quindi scrivere in un nuovo array (una sola volta per ogni valore 
individuato) il valore stesso e il n. di volte trovato
Insomma alla fine dovrebbe venir fuori un array depurato dai doppioni, ma 
che indichi con un contatore quante volte lo stesso valore e' stato 
riscontrato.
Spero di essere stato chiaro :-)
Ciao

#  crea Array
@pc = ($c1, $c2, $c3, 
$c4,$c5,$c6,$c7,$c8,$c9,$c10,$c11,$c12,$c13,$c14,$c15,$c16,$c17,$c18,$c19,$c20,$c21,$c22,$c23,$c24,$c25,$c26,$c27,$c28,$c29,$c30,$c31,$c32,);
@pd = ($d1, $d2, $d3, 
$d4,$d5,$d6,$d7,$d8,$d9,$d10,$d11,$d12,$d13,$d14,$d15,$d16,$d17,$d18,$d19,$d20,$d21,$d22,$d23,$d24,$d25,$d26,$d27,$d28,$d29,$d30,$d31,$d32,);
$cont =0;
while ($cont <34) {
 $x =$pc[$cont];
 $y =$pd[$cont];
 $xy = "$x$y";
    push (@pp,$xy); # inserisce valori in array definitivo
    $cont ++;}
# -----------------------fin qui tutto 
OK------------------------------------------
$cont = 0;
$cont1 =0;
$cont2 =0;
while ($cont <34) {
 $x1 =$pp[$cont];
 $x2 =$pp[$cont1];
 while ($cont2 <34) {
  if ($x1 ne $x2) {push (@pp1,$x1);} push (@pp2,$x1);
     $cont2 ++;
     $x1 =$pp[$cont2];
     #print "@pp1 \n "; $zz =<stdin>;
     }
 $cont ++;
 $cont2 =0;
}
Il problema e' ottenere un nuovo array, depurato da tutti i doppioni, che 
pero' contenga oltre al valore anche il n. delle volte riscontrato

 ha scritto nel messaggio 
news:p3art2hujoit6jpku...@4ax.com...


Chiedo scusa, ma per errore ho inserito piu' volte la stessa domanda

 valori ci sono altri sistemi (array, hash, database...).
Quoto, questi bastano e avanzano.
 Raffaello

pero' contenga oltre al valore anche il n. delle volte riscontrato
Se riuscissi a capire che cosa vuoi fare, forse (e ripeto forse) potrei
anche cercare di aiutarti, allo stato attuale delle cose non posso che
riconoscere la mia inadeguatezza.
Il codice che hai postato mi ha confuso ulteriormente, perché mi pare che
faccia qualcosa di diverso da quello che chiedevi in prima istanza.
In compenso, quello che fa lo fa, mi pare, in modo molto confuso e
aggrovigliato:
non capisco a che cosa servano $c1..$c32 e $d1..$d32, non s'era detto di
usare degli array?
non capisco quale sia la funzione di $cont1, dal momento che lo metti a
zero e non lo modifichi più;
mi viene da pensare che tu non sappia che esiste un ciclo for, che è
flessibile quanto while, e che nel caso specifico aiuterebbe forse a
spiegarsi meglio;
non capisco se sei interessato ad una certa composizione dei valori, o a
tutte le possibili, e nel caso ti interessino solo alcune, perché non
produci solo quelle invece di sparare nel mucchio e poi ripulire i resti?
se vuoi contare le occorrenze di una serie di stringhe, puoi usare un hash
che abbia come chiavi le stringhe e come valori il numero di occorrenze, e
questo è già automaticamente il tuo "array depurato";
se vuoi contare le possibili combinazioni di derminati valori, ci sono
algoritmi per farlo, non è necessario produrre tutte le combinazioni.
Nell'insieme, ho l'impressione che uno studio più approfondito del
linguaggio aiuterebbe, in particolare torno a suggerire perldsc e perllol,
ma prima ancora perlsyn e perldata.
Guarda anche i moduli Algorithm::Combinatorics e Math::Combinatorics.
Ciao.

 Ciao.
Ps. posto il codice per intero cosi' come e' oggi (non funziona)      dopo 
posto altro codice, che fa la stessa cosa, ma con solo 3 doppi caratteri per 
soggetto e salvando di volta in volta in files.
prego solo di essere clementi nei giudizzi :-))
# attuale prg------------------  non funzionante
system (cls);#esegue il cmd dos (non memorizza risultati)
print"\t\t        Quadrato di Punnett               .   .\n";
print " \n\n";
print "\t\t \n";
#  input variabili
print " inserisci i caratteri da combinare  \n\n";
print "devi inserire 5 coppie di caratteri per soggetto ricorda che c'e' 
differenza tra MAIUSCOLO e minuscolo\n\n";
print "caratteri 1 M";
chomp($a1 = <stdin>);
print "caratteri 1 M";
chomp($a11 = <stdin>);
print "caratteri 2 M";
chomp($a2 = <stdin>);
print "caratteri 2 M";
chomp($a22 = <stdin>);
print "caratteri 3 M";
chomp($a3 = <stdin>);
print "caratteri 3 M";
chomp($a33 = <stdin>);
print "caratteri 4 M";
chomp($a4 = <stdin>);
print "caratteri 4 M";
chomp($a44 = <stdin>);
print "caratteri 5 M";
chomp($a5 = <stdin>);
print "caratteri 5 M";
chomp($a55 = <stdin>);
print "caratteri 1 F";
chomp($b1 = <stdin>);
print "caratteri 1 F";
chomp($b11 = <stdin>);
print "caratteri 2 F";
chomp($b2 = <stdin>);
print "caratteri 2 F";
chomp($b22 = <stdin>);
print "caratteri 3 F";
chomp($b3 = <stdin>);
print "caratteri 3 F";
chomp($b33 = <stdin>);
print "caratteri 4 F";
chomp($b4 = <stdin>);
print "caratteri 4 F";
chomp($b44 = <stdin>);
print "caratteri 5 F";
chomp($b5 = <stdin>);
print "caratteri 5 F";
chomp($b55 = <stdin>);
# combina variabili (dei 2 soggetti)
$c1  = "$a1$a2$a3$a4$a5 ";
$c2  = "$a1$a2$a3$a4$a55 ";
$c3  = "$a1$a2$a3$a44$a5 ";
$c4  = "$a1$a2$a3$a44$a55 ";
$c5  = "$a1$a2$a33$a4$a5 ";
$c6  = "$a1$a2$a33$a4$a55 ";
$c7  = "$a1$a2$a33$a44$a5 ";
$c8  = "$a1$a2$a33$a44$a55 ";
$c9  = "$a1$a22$a3$a4$a5 ";
$c10 = "$a1$a22$a3$a4$a55 ";
$c11 = "$a1$a22$a3$a44$a5 ";
$c12 = "$a1$a22$a3$a44$a55 ";
$c13 = "$a1$a22$a33$a4$a5 ";
$c14 = "$a1$a22$a33$a4$a55 ";
$c15 = "$a1$a22$a33$a44$a5 ";
$c16 = "$a1$a22$a33$a44$a55 ";
$c17 = "$a11$a2$a3$a4$a5 ";
$c18 = "$a11$a2$a3$a4$a55 ";
$c19 = "$a11$a2$a3$a44$a5 ";
$c20 = "$a11$a2$a3$a44$a55 ";
$c21 = "$a11$a2$a33$a4$a5 ";
$c22 = "$a11$a2$a33$a4$a55 ";
$c23 = "$a11$a2$a33$a44$a5 ";
$c24 = "$a11$a2$a33$a44$a55 ";
$c25 = "$a11$a22$a3$a4$a5 ";
$c26 = "$a11$a22$a3$a4$a55 ";
$c27 = "$a11$a22$a3$a44$a5 ";
$c28 = "$a11$a22$a3$a44$a55 ";
$c29 = "$a11$a22$a33$a4$a5 ";
$c30 = "$a11$a22$a33$a4$a55 ";
$c31 = "$a11$a22$a33$a44$a5 ";
$c32 = "$a11$a22$a33$a44$a55 ";
$d1 = "$b1$b2$b3$b4$b5 ";
$d2 = "$b1$b2$b3$b4$b55 ";
$d3 = "$b1$b2$b3$b44$b5 ";
$d4 = "$b1$b2$b3$b44$b55 ";
$d5 = "$b1$b2$b33$b4$b5 ";
$d6 = "$b1$b2$b33$b4$b55 ";
$d7 = "$b1$b2$b33$b44$b5 ";
$d8 = "$b1$b2$b33$b44$b55 ";
$d9 = "$b1$b22$b3$b4$b5 ";
$d10 = "$b1$b22$b3$b4$b55 ";
$d11 = "$b1$b22$b3$b44$b5 ";
$d12 = "$b1$b22$b3$b44$b55 ";
$d13 = "$b1$b22$b33$b4$b5 ";
$d14= "$b1$b22$b33$b4$b55 ";
$d15 = "$b1$b22$b33$b44$b5 ";
$d16 = "$b1$b22$b33$b44$b55 ";
$d17 = "$b11$b2$b3$b4$b5 ";
$d18 = "$b11$b2$b3$b4$b55 ";
$d19 = "$b11$b2$b3$b44$b5 ";
$d20 = "$b11$b2$b3$b44$b55 ";
$d21 = "$b11$b2$b33$b4$b5 ";
$d22 = "$b11$b2$b33$b4$b55 ";
$d23 = "$b11$b2$b33$b44$b5 ";
$d24 = "$b11$b2$b33$b44$b55 ";
$d25 = "$b11$b22$b3$b4$b5 ";
$d26 = "$b11$b22$b3$b4$b55 ";
$d27 = "$b11$b22$b3$b44$b5 ";
$d28 = "$b11$b22$b3$b44$b55 ";
$d29 = "$b11$b22$b33$b4$b5 ";
$d30 = "$b11$b22$b33$b4$b55 ";
$d31 = "$b11$b22$b33$b44$b5 ";
$d32 = "$b11$b22$b33$b44$b55 ";
#  crea Array
@pc = ($c1, $c2, $c3, 
$c4,$c5,$c6,$c7,$c8,$c9,$c10,$c11,$c12,$c13,$c14,$c15,$c16,$c17,$c18,$c19,$c20,$c21,$c22,$c23,$c24,$c25,$c26,$c27,$c28,$c29,$c30,$c31,$c32,);
@pd = ($d1, $d2, $d3, 
$d4,$d5,$d6,$d7,$d8,$d9,$d10,$d11,$d12,$d13,$d14,$d15,$d16,$d17,$d18,$d19,$d20,$d21,$d22,$d23,$d24,$d25,$d26,$d27,$d28,$d29,$d30,$d31,$d32,);
$cont =0;
while ($cont <34) {
 $x =$pc[$cont];   # dato primo array maschio
 $y =$pd[$cont];   # dato secondo array femmina
 $xy = "$x$y";       # combina genotipi maschio femmina
    push (@pp,$xy); # inserisce valori in array definitivo
    $cont ++;}         #passa al dato successivo
# ----------------------------------------------------------------------------------------
$cont = 0;
$cont1 =0;
$cont2 =0;
while ($cont <34) {                 # max n. di dati nell'array
 $x1 =$pp[$cont];                  # asssegna valore 1 arrai a variabile
 $x2 =$pp[$cont1];                #                          2 array
 while ($cont2 <34) {
  if ($x1 ne $x2) {push (@pp1,$x1);} push (@pp2,$x1);     # qui mi sono 
perso dovrebbe scrivere in pp1 se diverso  altrimenti contare le volte che 
trova lo stesso valore e poi scriverlo in pp2
     $cont2 ++;
     $x1 =$pp[$cont2];
     #print "@pp1 \n "; $zz =<stdin>;
     }
 $cont ++;
 $cont2 =0;
}
open(in, ">> P1.txt") || die("Errore nell'apertura del file 'dati'.\n\n"); # 
apre file
    print in "@pp|\n\n\n@pp1|\n\n\n@pp2";
# ----------------------------------------------------------------------------------------
#   _---_---_---_---_---_---_   II  prg funzionante 
_---_---_---_---_---_---_
#!/bin/perl
system (cls);#esegue il cmd dos (non memorizza risultati)
print"\t\t        Quadrato di Punnett               .   .\n";
print " \n\n";
print "\t\t                                      By Salbos\n";
print " \n";
#  input variabili
print " inserisci i caratteri da combinare  \n\n";
print "devi inserire 3 coppie di caratteri per soggetto ricorda che c'e' 
differenza tra MAIUSCOLO e minuscolo\n\n";
print "caratteri 1 M";
chomp($a1 = <stdin>);
print "caratteri 1 M";
chomp($a11 = <stdin>);
print "caratteri 2 M";
chomp($a2 = <stdin>);
print "caratteri 2 M";
chomp($a22 = <stdin>);
print "caratteri 3 M";
chomp($a3 = <stdin>);
print "caratteri 3 M";
chomp($a33 = <stdin>);
print "caratteri 1 F";
chomp($b1 = <stdin>);
print "caratteri 1 F";
chomp($b11 = <stdin>);
print "caratteri 2 F";
chomp($b2 = <stdin>);
print "caratteri 2 F";
chomp($b22 = <stdin>);
print "caratteri 3 F";
chomp($b3 = <stdin>);
print "caratteri 3 F";
chomp($b33 = <stdin>);
# combina variabili
$c1 = "$a1$a2$a3";
$c2 = "$a1$a2$a33";
$c3 = "$a1$a22$a3";
$c4 = "$a1$a22$a33";
$c5 = "$a11$a2$a3";
$c6 = "$a11$a2$a33";
$c7 = "$a11$a22$a3";
$c8 = "$a11$a22$a33";
$d1 = "$b1$b2$b3";
$d2 = "$b1$b2$b33";
$d3 = "$b1$b22$b3";
$d4 = "$b1$b22$b33";
$d5 = "$b11$b2$b3";
$d6 = "$b11$b2$b33";
$d7 = "$b11$b22$b3";
$d8 = "$b11$b22$b33";
# crea quadrato punnett
$e1 = "$c1$d1"; $f1 = "$c1$d2"; $g1 = "$c1$d3"; $h1 = "$c1$d4"; $i1 = 
"$c1$d5"; $l1 = "$c1$d6"; $m1 = "$c1$d7"; $n1 = "$c1$d8";
$e2 = "$c2$d1"; $f2 = "$c2$d2"; $g2 = "$c2$d3"; $h2 = "$c2$d4"; $i2 = 
"$c2$d5"; $l2 = "$c2$d6"; $m2 = "$c2$d7"; $n2 = "$c2$d8";
$e3 = "$c3$d1"; $f3 = "$c3$d2"; $g3 = "$c3$d3"; $h3 = "$c3$d4"; $i3 = 
"$c3$d5"; $l3 = "$c3$d6"; $m3 = "$c3$d7"; $n3 = "$c3$d8";
$e4 = "$c4$d1"; $f4 = "$c4$d2"; $g4 = "$c4$d3"; $h4 = "$c4$d4"; $i4 = 
"$c4$d5"; $l4 = "$c4$d6"; $m4 = "$c4$d7"; $n4 = "$c4$d8";
$e5 = "$c5$d1"; $f5 = "$c5$d2"; $g5 = "$c5$d3"; $h5 = "$c5$d4"; $i5 = 
"$c5$d5"; $l5 = "$c5$d6"; $m5 = "$c5$d7"; $n5 = "$c5$d8";
$e6 = "$c6$d1"; $f6 = "$c6$d2"; $g6 = "$c6$d3"; $h6 = "$c6$d4"; $i6 = 
"$c6$d5"; $l6 = "$c6$d6"; $m6 = "$c6$d7"; $n6 = "$c6$d8";
$e7 = "$c7$d1"; $f7 = "$c7$d2"; $g7 = "$c7$d3"; $h7 = "$c7$d4"; $i7 = 
"$c7$d5"; $l7 = "$c7$d6"; $m7 = "$c7$d7"; $n7 = "$c7$d8";
$e8 = "$c8$d1"; $f8 = "$c8$d2"; $g8 = "$c8$d3"; $h8 = "$c8$d4"; $i8 = 
"$c8$d5"; $l8 = "$c8$d6"; $m8 = "$c8$d7"; $n8 = "$c8$d8";
# registra i dati nel file
open(in, ">> P1.txt") || die("Errore nell'apertura del file 'dati'.\n\n"); # 
apre file
open(out, ">> O4.txt") || die("Errore nell'apertura del file 'dati'.\n\n"); 
# apre file
   # scrive nel file
print in 
"$e1|\n$f1|\n$g1|\n$h1|\n$i1|\n$l1|\n$m1|\n$n1|\n$e2|\n$f2|\n$g2|\n$h2|\n$i2|\n$l2|\n$m2|\n$n2|\n$e3|\n$f3|\n$g3|\n$h3|\n$i3|\n$l3|\n$m3|\n$n3|\n$e4|\n$f4|\n$g4|\n$h4|\n$i4|\n$l4|\n$m4|\n$n4|\n$e5|\n$f5|\n$g5|\n$h5|\n$i5|\n$l5|\n$m5|\n$n5|\n$e6|\n$f6|\n$g6|\n$h6|\n$i6|\n$l6|\n$m6|\n$n6|\n$e7|\n$f7|\n$g7|\n$h7|\n$i7|\n$l7|\n$m7|\n$n7|\n$e8|\n$f8|\n$g8|\n$h8|\n$i8|\n$l8|\n$m8|\n$n8";
close(in);
print out 
"$e1|\n$f1|\n$g1|\n$h1|\n$i1|\n$l1|\n$m1|\n$n1|\n$e2|\n$f2|\n$g2|\n$h2|\n$i2|\n$l2|\n$m2|\n$n2|\n$e3|\n$f3|\n$g3|\n$h3|\n$i3|\n$l3|\n$m3|\n$n3|\n$e4|\n$f4|\n$g4|\n$h4|\n$i4|\n$l4|\n$m4|\n$n4|\n$e5|\n$f5|\n$g5|\n$h5|\n$i5|\n$l5|\n$m5|\n$n5|\n$e6|\n$f6|\n$g6|\n$h6|\n$i6|\n$l6|\n$m6|\n$n6|\n$e7|\n$f7|\n$g7|\n$h7|\n$i7|\n$l7|\n$m7|\n$n7|\n$e8|\n$f8|\n$g8|\n$h8|\n$i8|\n$l8|\n$m8|\n$n8";
close(out);
# accorpa dati uguali
open(in, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
open(out, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
open(in2, ">> p2.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
open(in3, ">> p3.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
seek (in,0,0);  # puntatore a inizio file
seek (out,0,0);
$cont = 0;
while ($reco1=<out>) {($z)= split(/\|/,$reco1);
   while ($reco=<in>) {  ($x)= split(/\|/,$reco);
      if ($x ne $z) {print in3 "$x|\n";} else {$cont ++; }
   }print in2 "$cont|$z|\n";
    $cont = 0;
   close(out);close(in);close(in2);close(in3);
   system ("del p1.txt");
   system ("ren p3.txt p1.txt");       # rinomina il nuovo file in vecchio 
file
   open(in, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
   open(out, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
   open(in2, ">> p2.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
   open(in3, ">> p3.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
   seek (in,0,0);  # puntatore a inizio file
   seek (out,0,0);
}
 close(out);close(in);close(in2);close(in3);
 system ("del p1.txt"); system ("del o4.txt");system ("del p3.txt");
 system ("ren p2.txt p1.txt");
#-------------   fine estrazione quadrato punnet e accorpamento dati
open(in, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
open(in2, ">> p2.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
  while ($reco=<in>) { ($x,$z)= split(/\|/,$reco);
   #es. var. w6: estrae da $z una sottostringa di lunghezza 1 a partire dal 
carattere 6°
     $w1=substr($z,0,1);
     $w3=substr($z,1,1);
     $w5=substr($z,2,1);
     $w2=substr($z,3,1);
     $w4=substr($z,4,1);
     $w6=substr($z,5,1);
 #crea variabili con alleli dello stesso tipo
     $q1="$w1$w2";
     $q2="$w3$w4";
     $q3="$w5$w6";
 # ordina gli alleli maiuscoli e minuscoli
     $r1 = join '', sort split //, $q1;
     $r2 = join '', sort split //, $q2;
     $r3 = join '', sort split //, $q3;
     $q ="$r1$r2$r3";
 # riscrive file con nuove variabili calcolate
     print in2 "$q|\n ";
  }
close(in);close(in2);
 system ("del p1.txt");
 system ("ren p2.txt p1.txt");
  # fine ordinamento variabili
 # accorpa dati uguali (ultimo accorpamento per q.punnett definitivo)
open(in, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
open(out, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
open(in2, ">> p2.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
open(in3, ">> p3.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
seek (in,0,0);  # puntatore a inizio file
seek (out,0,0);
$cont = 0;
$cont1 = -1;
while ($reco1=<out>) {($z)= split(/\|/,$reco1);
   while ($reco=<in>) {  ($x)= split(/\|/,$reco);
      if ($x ne $z) {print in3 "$x|\n";} else {$cont ++;$cont1 ++; }
   }print in2 "$cont|$z|\n";
# # #  print "$cont| $z\n";
    $cont = 0;
   close(out);close(in);close(in2);close(in3);
   system ("del p1.txt");
   system ("ren p3.txt p1.txt");       # rinomina il nuovo file in vecchio 
file
   open(in, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
   open(out, "+< P1.txt") || die("Errore nell'apertura del file 'dati'.\n");
   open(in2, ">> p2.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
   open(in3, ">> p3.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
   seek (in,0,0);  # puntatore a inizio file
   seek (out,0,0);
}
 close(out);close(in);close(in2);close(in3);
 system ("del p1.txt"); system ("del p3.txt");
 system ("ren p2.txt p1.txt");
   open(in, ">> p1.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
   seek (in,0,0);  # puntatore a inizio file
   print in "denominatore frazione $cont1 \n|\n";
# # #   print "denominatore frazione $cont1 \n|\n";
#-------------   fine estrazione quadrato punnet e accorpamento dati
# calcolo percentuali
    open(in, "+< P1.txt") || die("Errore nell'apertura del file 
'dati'.\n\n");
    seek (in,0,0);  # puntatore a inizio file
    while ($reco=<in>) { ($x,$z)= split(/\|/,$reco);
    $perc = (($x/$cont1)*100).'%';
    print "$perc | $z \n "; }
 print "invio per terminare, ricorda che i dati oltre che in video vengono 
salvati in un file (p1.txt)";<stdin>; 

perso
Francamente, anch'io, e non sono in grado di andare oltre
nell'analisi.
Se riscrivi tutto in modo più ordinato, utilizzando le strutture dati
più appropriate, dei cicli più espliciti, e dei nomi più significativi
per le variabili, sarà anche più facile capire ed evitare di perdersi.
Ciao.

 E perché non usi un array fin dall'inizio?
devo associare le variabili in modo particolare e non so farlo con cicli 
nidificati
#!/bin/perl
system (cls);#esegue il cmd dos (non memorizza risultati)
print"\t\t        Quadrato di Punnett               .   .\n";
print " \n\n";
print "\t\t                                      By Salbos\n";
print " \n";
#  input variabili
print " inserisci i caratteri da combinare  \n\n";
print "caratteri 1 M";
chomp($a1 = <stdin>);
print "caratteri 1 M";
chomp($a11 = <stdin>);


# combina variabili (dei 2 soggetti)
$c1  = "$a1$a2$a3$a4$a5 ";
$c2  = "$a1$a2$a3$a4$a55 ";     cambia l'ultima
$c3  = "$a1$a2$a3$a44$a5 ";    cambia la penultima e ritorna a5
$c4  = "$a1$a2$a3$a44$a55 ";   cambia la penultima e la precedente


#  crea Array
@padre = ($c1, $c2, $c3, 
$c4,$c5,$c6,$c7,$c8,$c9,$c10,$c11,$c12,$c13,$c14,$c15,$c16,$c17,$c18,$c19,$c20,$c21,$c22,$c23,$c24,$c25,$c26,$c27,$c28,$c29,$c30,$c31,$c32,);
@madre = ($d1, $d2, $d3, 
$d4,$d5,$d6,$d7,$d8,$d9,$d10,$d11,$d12,$d13,$d14,$d15,$d16,$d17,$d18,$d19,$d20,$d21,$d22,$d23,$d24,$d25,$d26,$d27,$d28,$d29,$d30,$d31,$d32,);
$cont =0;
while ($cont <34) {
 $x =$padre[$cont];
 $y =$madre[$cont];
 $xy = "$x$y";
    push (@figli,$xy); # inserisce valori in array definitivo
    push (@figli1,$xy);
    $cont ++;
}
#   fin qui fa bene il suo lavoro   :-))    adesso
#  dovrebbe prendere il primo valore dell'array,verificare quante volte si 
ripete cancellandolo ogni volta che lo incontra in modo da non contarlo 
nuovamente.
#   Alla fine del ciclo dovrei ottenere un nuovo array con tutti i valori 
presenti nell'array originale, ma non ripetuti bensi' contati
# es. se @figli =  as , ad , af, as ae, cd, as
# l'array finale dovrebbe essere @new_figli =  3|as, 1|ad , 1|af, 1|ae, 1|cd
# purtroppo il ciclo sottostante e' palesemente sbagliato ma non riesco a 
scriverlo
$cont = 0;
$conta = 1;
while ($cont <33){
 $x1 = shift @figli;       # cattura il primo valore e lo elimina
 for my $y1 (@figli){
  if ($x1 eq $y1) {$conta ++ ;}    # verifica le ricorrenze
 }
 $newval ="$conta|$x1";
 push (@figli3,$newval);
 $conta = 0;
 $cont++;
}   print @figli3;
 

Scusa mi sono sfuggiti i  saluti......
CIAO :-)) 

Credo di esserci riuscito !!!  :-)))
Pero' prima di esultare, vorrei un tuo controllo.
So gia' che mi dirai che e' scritto male, e per questo mi scuso in anticipo.
Se si possono  rendere ciclici gli abbinamenti sarebbe perfetto, ma allo 
stato, con gli abbinamenti manuali,  mi sembra funzionare.
ecco il listato:
#!/bin/perl
system (cls);#esegue il cmd dos (non memorizza risultati)
print"\t\t        Quadrato di Punnett               .   .\n";
print " \n\n";
#------------------------------------- input con variabili




$c3  = "$a1$a2$a3$a44$a5 ";
$c4  = "$a1$a2$a3$a44$a55 ";



$cont =0;
while ($cont <32) {
 $x =$padre[$cont];
 $y =$madre[$cont];
 $xy = "$x$y";      # combina i valori padre e madre
    push (@figli,$xy); # inserisce valori in array definitivo
    $cont ++;
}
my %occorrenze;                     #In %occorrenze avrai il numero di 
occorrenze di ogni elemento.
    for my $elemento (@figli) {
       ++$occorrenze{$elemento};
    }
while(($chiave, $valore) = each(%occorrenze))
{
 # print "$chiave| $valore\n";
 #es. var. w6: estrae da $chiave una sottostringa di lunghezza 1 a partire 
dal carattere 8°
 $w1=substr($chiave,0,1);           #  01234 67890
 $w2=substr($chiave,6,1);           #  14570 afgjo |
 $w3=substr($chiave,1,1);
 $w4=substr($chiave,7,1);
 $w5=substr($chiave,2,1);
 $w6=substr($chiave,8,1);
 $w7=substr($chiave,3,1);
 $w8=substr($chiave,9,1);
 $w9=substr($chiave,4,1);
 $w0=substr($chiave,10,1);
 #crea variabili con alleli dello stesso tipo
    $q1="$w1$w2";
    $q2="$w3$w4";
    $q3="$w5$w6";
    $q4="$w7$w8";
    $q5="$w9$w0";
    # ordina gli alleli maiuscoli e minuscoli
    $r1 = join '', sort split //, $q1;
    $r2 = join '', sort split //, $q2;
    $r3 = join '', sort split //, $q3;
    $r4 = join '', sort split //, $q4;
    $r5 = join '', sort split //, $q5;
    $q ="$r1$r2$r3$r4$r5";
    push (@figliord,$q); # inserisce valori in array ordinato
}
my %occorrenze;                     #In %occorrenze avrai il numero di 
occorrenze di ogni elemento.
    for my $elemento (@figliord) {
       ++$occorrenze{$elemento};
    }
open(in, ">> p1.txt") || die("Errore nell'apertura del file 'dati'.\n\n");
$n_val= @figliord;   # conta i valori contenuti nell'array
while(($chiave, $valore) = each(%occorrenze))
{
   $perc = (($valore/$n_val)*100).'%';
   print in "$chiave|$valore|$perc\n";
  }
Grazie in anticipo e ciao.

Pero' prima di esultare, vorrei un tuo controllo.
Francamente, non mi ritengo qualificato a stabilire se un codice che non
capisco fa davvero una cosa che non so. Direi che, ad occhio, dovrebbe
terminare, e mi pare di aver già detto molto.
Ciao.

 ha scritto nel messaggio 
news:vkv5u2le6t5ee64r4...@4ax.com...




... e' proprio vero che TIMTOWTDI! :D
 Raffaello

> ... e' proprio vero che TIMTOWTDI! :D
scusa l'ignoranza , cosa vuol dire? 

 scusa l'ignoranza , cosa vuol dire? 
E' un celebre motto, che in un certo senso stai mettendo in pratica ;-)
http://en.wikipedia.org/wiki/There_is_more_than_one_way_to_do_it
E c'è anche un blog che vi si ispira ;-)
http://timtowtdi.blog.dada.net/
Ciao,
Emanuele.



Ma e' interessantissimo!!! ;)
 Raffaello

 ha scritto nel 
messaggio news:es2dqr$pft$2...@tdi.cu.mi.it...


E' un celebre motto, che in un certo senso stai mettendo in pratica ;-)
Veramente, il motto messo in pratica in questo caso mi sembrava piuttosto
TA2WTDI, ma immagino che anche l'acidità sia un segno degli anni che
passano.
Ciao.

 ha scritto nel messaggio 
news:1akau2hegsk19vt3o...@4ax.com...


 ha scritto nel messaggio 
news:pnJFh.11004$J11.2...@twister1.libero.it...
