Stings vergleichen (gelöst) (Allgemeines zu Perl)

[thread]20382[/thread]

Stings vergleichen [gelöst]

Tags: perl5 Ähnliche Threads

Leser: 15

Articles: hide open all | hide show old branches

+12 replies

Rennofen

2017-10-12 22:23

User since
2017-10-12
6 Artikel
BenutzerIn
[default_avatar]

Hallo,

die Überschrift sagt es nicht ganz. Ich muss G-Code optimieren.
Dazu muss ich eine Textdatei nach Strings durchsuchen, die mit G oder F anfangen.
Und wenn zwei (oder mehr) Wörter mit F oder G hinter einander gleich sind (es können auch andere Wörter dazwischen sein) das 2. (oder weitere Löschen)

Irgendwie kriege keinen Ansatz hin, bin auch etwas eingerostet sei vier Jahren nix mehr mit Perl gemacht...

vielleicht kann mir hier einer weiter helfen hänge etwas fest.

Danke und Gruß Patrick
Last edited: 2017-10-13 08:48:27 +0200 (CEST)

+10 replies

Crian

2017-10-13 09:50

User since
2003-08-04
5872 Artikel
ModeratorIn

Was hast du denn bisher?

s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite

+9 replies

Rennofen

2017-10-13 11:45

User since
2017-10-12
6 Artikel
BenutzerIn
[default_avatar]

bisher habe ich folgendes:

Code (perl): (dl )

#!/bin/perl
use strict;
use warnings;
 
my $filename = '808.nc';
open(my $fh, '<:encoding(UTF-8)', $filename)
  or die "Could not open file '$filename' $!";
my $g="G";
my $f="F";
while (my $row = <$fh>) {
  chomp $row;
  my @words = split / /, $row;
    foreach (@words){
    my $Word=$_;
    my $char=substr($_, 0, 1);
     if ($char eq "G"){
      if($Word ne $g){
      $g=$Word;
      print "$Word "
      }
     }    
     elsif ($char eq "F"){
      if($Word ne $f){
      $f=$Word;
      print "$Word "
      }
     }    
     else {print "$Word "}
    }
  print "\n";
}

das macht aber nicht so richtig was es soll..

ab und an fehlt der erste Buchstabe einer Zeile

Beispiel.

aus:

Code: (dl )

N46 G1 X13 Y-18 Z-2 F2328
N48 G3 Z0 X15 Y-18 I0 K2 F2328
N49 G0 X15 Y-18 Z15
N51 (Planen2)
N52 G0 X10.102 Y-25.75
N53 G0 X10.102 Y-25.75 Z15
N54 G0 X10.102 Y-25.75 Z5
N55 G1 X10.102 Y-25.75 Z1 F2328
N57 G2 Z-1 X8.102 Y-25.75 I-2 K0 F2328

mach das script:

Code: (dl )

N46 G1 X13 Y-18 Z-2 F2328
N48 G3 Z0 X15 Y-18 I0 K2 
 49 G0 X15 Y-18 Z15
 51 (Planen2)
 52 X10.102 Y-25.75
 53 X10.102 Y-25.75 Z15
 54 X10.102 Y-25.75 Z5
N55 G1 X10.102 Y-25.75 Z1 
N57 G2 Z-1 X8.102 Y-25.75 I-2 K0

bin wie gesagt ziemlich eingerostet...

+8 replies

clms

2017-10-13 12:02

User since
2010-08-29
373 Artikel
BenutzerIn
[default_avatar]

Und wie sollte das gewünschte Ergebnis aussehen?
Ich habe ehrlich gesagt die Aufgabenstellung nicht ganz verstanden...

+7 replies

Rennofen

2017-10-13 12:09

User since
2017-10-12
6 Artikel
BenutzerIn
[default_avatar]

Ich habe ein Speicherplatzproblem und muss daher redundante Daten aus code entfernen.

Meine Maschine merkt sich das letzten G Wort und das letzte F wort, daher will ich die aus meinem code entfernen sofern aufeinander folgende Sätze (Zeilen) die gleichen G oder F wörter enthalten.

Also aus:

Code: (dl )

N46 G1 X13 Y-18 Z-2 F2328
N48 G3 Z0 X15 Y-18 I0 K2 F2328
N49 G0 X15 Y-18 Z15
N51 (Planen2)
N52 G0 X10.102 Y-25.75
N53 G0 X10.102 Y-25.75 Z15
N54 G0 X10.102 Y-25.75 Z5
N55 G1 X10.102 Y-25.75 Z1 F2328
N57 G2 Z-1 X8.102 Y-25.75 I-2 K0 F2328

soll

Code: (dl )

N46 G1 X13 Y-18 Z-2 F2328
N48 G3 Z0 X15 Y-18 I0 K2 
N49 G0 X15 Y-18 Z15
N51 (Planen2)
N52 X10.102 Y-25.75
N53 X10.102 Y-25.75 Z15
N54 X10.102 Y-25.75 Z5
N55 G1 X10.102 Y-25.75 Z1
N57 G2 Z-1 X8.102 Y-25.75 I-2 K0

werden.

+6 replies

Rennofen

2017-10-13 12:42

User since
2017-10-12
6 Artikel
BenutzerIn
[default_avatar]

chomp war der Fehler, ich hatte keine eindeutigen Zeilenumbrüche.

Code (perl): (dl )

#!/bin/perl
use strict;
use warnings;
 
my $filename = '808.nc';
open(my $fh, '<:encoding(UTF-8)', $filename)
  or die "Could not open file '$filename' $!";
my $g="G";
my $f="F";
while (my $row = <$fh>) {
  $row =~ s/\r?\n$//;
  my @words = split / /, $row;
      foreach (@words){
    my $Word=$_;
    my $char=substr($_, 0, 1);
     if ($char eq "N"){
     print "$Word"
     }
     
     elsif ($char eq "G"){
      if($Word ne $g){
      $g=$Word;
      print " $Word"
      }
     }
     
     elsif ($char eq "F"){
      if($Word ne $f){
            $f=$Word;
      print " $Word"
            }
     }
     else {print " $Word"}
    }
    print "\n";
}

macht jetzt was es soll.

Danke!

+5 replies

lichtkind

2017-10-13 13:38

User since
2004-03-22
5697 Artikel
ModeratorIn + EditorIn

Sieh was dir davon gefällt. Hab es mal in einen Stil umgeschrieben den ich bekömmlicher finde. given könnt man auch verwenden:

Code (perl): (dl )

#!/bin/perl
use v5.18;
use warnings;

my ($g, $f) = ('G', 'F');
my $filename = '808.nc';
open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open file '$filename' $!";

while (my $row = <$fh>) {
    $row =~ s/\r?\n$//;
    for my $word (split / /, $row){
        say '';
        given (substr($word, 0, 1)) {
            when ('N') { }
            when ('G') { if ($word ne $g) { $g = $word } else { next } }
            when ('F') { if ($word ne $f) { $f = $word } else { next } }
        }
        print " $word";
    }
}

Ich glaube aber nicht das macht was du wirklich willst. leg dir zwei hashes an und schau immer on exists $g{$word}. wenn ja next ansonst $g{$word}++. und welche bedeutung hat überhaupt N?
Last edited: 2017-10-13 13:53:54 +0200 (CEST)

Tutorien in der Wiki, mein zeug:
kephra, baumhaus, garten, gezwitscher

Es beginnt immer mit einer Entscheidung.

Rennofen

2017-10-13 14:49

User since
2017-10-12
6 Artikel
BenutzerIn
[default_avatar]

Ich habe nie gesagt, dass ich schönen Code mache.
N sind Zeilennummern, bei Gcode kann man so Schleifen basteln.
Ich fange das ab um später ggf die Zeilennummer auch noch zu löschen
Ist halt Maschinensteuerung nach DIN.
Heute würde man sich um Codereduzierung Keinen kopf machen, Speicher ist ja kein Mangel. Ich muss aber mit 20Kbyte auskommen, da schaut man dann schon, wo man einzelne Zeichen einspaaren kann.

Aber danke für dein Beispiel es macht exakt was ich will habe es nur nen bisschen angepasst. Kurz ich hole mir ggf einen Dateinamen aus der Commandline und ein weiteres Argument ob die Zeilennummern entfernt werden sollen.

Code (perl): (dl )

#!/bin/perl
use v5.18;
use warnings;

my ($g, $f) = ('G', 'F');
my $filename = '1001.nc';
if ($ARGV[0]){$filename=$ARGV[0];}
my $arg1 = 0;
if ($ARGV[1]){$arg1=$ARGV[1];}

open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open file '$filename' $!";

while (my $row = <$fh>) {
    $row =~ s/\r?\n$//;
    my $newrow;
    for my $word (split / /, $row){
     #   say '';
        given (substr($word, 0, 1)) {
            when ('N') { if ($arg1 == 1) {next} }
            when ('G') { if ($word ne $g) { $g = $word } else { next } }
            when ('F') { if ($word ne $f) { $f = $word } else { next } }
        }
        $newrow=$newrow. " $word";
    }
    $newrow=~ s/^\s+|\s+$//g;
    $newrow=$newrow."\n";
    print $newrow;
}

Danke Patrick

+3 replies
lichtkind

2017-10-13 15:05
User since
2004-03-22
5697 Artikel
ModeratorIn + EditorIn
nagut du warst eine weile weg und kennstnicht die neusten tricks,
aber was ich eingangs verstand kann der code gar nicht leisten. Du willst ja alle Duplikate entfernen, was heisst: du musst beim "G123" alle vorherigen G-werte kennen um entscheiden zu können, ob der Wert übernommen wird oder nicht. $g kann nur einen wert beinhalten. Ansonst hab ich paar weitere Stellen vereinfacht:
Code (perl): (dl )

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

#!/bin/perl use v5.18; use warnings; my $filename = shift // '1001.nc'; my $arg1 = shift // 0; open(my $fh, '<:encoding(UTF-8)', $filename) or die "Could not open file '$filename' $!"; my ($g, $f) = ('G', 'F'); while (my $row = <$fh>) { $row =~ s/\r?\n$//; my $newrow; for my $word (split / /, $row){ given (substr($word, 0, 1)) { when ('N') { next if $arg1 == 1 } when ('G') { if ($word ne $g) { $g = $word } else { next } } when ('F') { if ($word ne $f) { $f = $word } else { next } } } $newrow .= " $word"; } $newrow =~ s/^\s+|\s+$//g; say $newrow; }
Last edited: 2017-10-13 15:43:35 +0200 (CEST)
Tutorien in der Wiki, mein zeug:
kephra, baumhaus, garten, gezwitscher

Es beginnt immer mit einer Entscheidung.
- +2 replies
- lichtkind
  
  2017-10-14 14:53
  
  User since
  2004-03-22
  5697 Artikel
  ModeratorIn + EditorIn
  
  habs jetzt verstanden dir gehts uimmer nur um das letzte vorkommen. es geht um eine art registermaschine
  Tutorien in der Wiki, mein zeug:
  kephra, baumhaus, garten, gezwitscher
  
  Es beginnt immer mit einer Entscheidung.
  - Rennofen
    
    2017-10-16 10:26
    
    User since
    2017-10-12
    6 Artikel
    BenutzerIn
    
    Genau. Konkret geht es um eine CNC Fräse aus den 80ern, die zwar nach langer Zuwendung wieder sauber läuft, aber erschreckend wenig Speicher hat.
    
    Erschreckend wie schnell man vergisst wie man Programmiert, wenn man das lange nicht mehr gemacht hat. Das kommt langsamer zurück als man vermutet. Aber es kommt mit Hilfe zurück.
    
    Vielen Dank für Deine (Eure) Hilfe!

GwenDragon

2017-10-13 11:40

User since
2005-01-17
14757 Artikel
Admin1

Ungetestet:
s/((F[^F]+)([^F]*))\2/\1/g
Vergesst es. Regexparsen ist nicht meins.
Last edited: 2017-10-13 11:56:46 +0200 (CEST)
die Drachin Gwen

Meine Perl-Artikel · perldev – verschiedene Perl-Versionen unter Windows starten

View all threads created 2017-10-12 22:23.