What should do this code sample?
set l { A B C D }
lreplace $l 1 2 \[ \]
It returns {A {[} \] D}, however I want to have {A [ ] D}.
What am I doing wrong?
Your code does exactly what you want it to, you're just reading the string rep of your output and misunderstanding it:
% set l { A B C D }
A B C D
% foreach elem $l { puts $elem }
A
B
C
D
% set j [lreplace $l 1 2 \[ \]]
A {[} \] D
% foreach elem $j { puts $elem }
A
[
]
D
% join $j
A [ ] D
When you read the string rep, you're seeing it escape the [ and ]. As you can see from the foreach output, the actual values are what you're asking for. You can use join to get the string you're interested in if what you want is just a string with the characters in question.
Related
How can I write an AWK program that analyses a list of fields in CSV files, count the number of each different string in the specified field, and print out the count of each string that is found? I have only coded in C and Java, so I am completely confused on the syntax of AWK. I understand the simplest of concepts, however, AWK is structured much differently. Any time is appreciated, thank you!
BEGIN {
FS = ""
}
{
for(i = 1; i <= NF; i++)
freq[$i]++
PROCINFO ["sorted_in"] = "#val_num_desc" #this got the desired result
}
END {
for {this in freq)
printf "%s\t%d\n", this, freq[this]
}
On a CSV file containing:
Field1, Field2, Field3, Field4
A, B, C, D
A, E, F, G
Z, E, C, D
Z, W, C, Q
I am able to obtain the result:
A 2
B 1
C 3
Q 1
D 1
E 2
F 1
, 12
G 1
W 1
Field1,Field2,Field3,Field4 1
Z 2
This is the desired result:
A 10
C 7
D 2
E 2
Z 2
B 1
Q 1
Field1 1
Field2 1
F 1
Field3 1
G 1
Field4 1
W 1
There is an edit to my code which is commented.
Fixed your code:
$ awk '
BEGIN { # you need BEGIN block for FS
FS = ", *" # your data had ", " and "," seps
} # ... based on your sample output
{
for(i = 1; i <= NF; i++)
freq[$i]++
}
END {
for(this in freq) # fixed a parenthesis
printf "%s\t%d\n", this, freq[this]
}' file
Output (using GNU awk. Other awks displayed output in different order):
A 2
B 1
C 3
Q 1
D 2
Field1 1
E 2
Field2 1
F 1
Field3 1
G 1
Field4 1
W 1
Z 2
AWK really isn't the right tool for this job. While AWK can interpret Comma or Tab separated data, it has no concept of field enclosures or escapes. So it could handle a simple example like:
Month,Day
January,Sunday
February,Monday
but would fail with this valid example:
Month,Day
January,"Sunday"
February,"Monday"
Because of that, I would recommend considering another language. Something like Python:
import csv
o = open('a.csv')
for m in csv.DictReader(o):
print(m)
https://docs.python.org/library/csv.html
Or Ruby:
require 'csv'
CSV.table('a.csv').each do |m|
p m
end
https://ruby-doc.org/stdlib/libdoc/csv/rdoc/CSV.html
Or even PHP:
<?php
$r = fopen('a.csv', 'r');
$a_head = fgetcsv($r);
while (true) {
$a_row = fgetcsv($r);
if (feof($r)) {
break;
}
$m_row = array_combine($a_head, $a_row);
print_r($m_row);
}
https://php.net/function.fgetcsv
I want to create a table in Tcl/Tk gui. The minimum size of every boxes of the table will be (x=10, y=2) and if any words(inserted in any box) exceeds the box's size, then it will be adjusted towards Y-axis.
Please help me.
I have tried with this code :
proc table {w content args} {
frame $w -bg black
set r 0
foreach row $content {
set fields {}
set c 0
foreach col $row {
lappend fields [label $w.$r/$c -text $col]
incr c
}
eval grid $fields -sticky news -padx 1 -pady 1
incr r
}
set w
}
#--- Test:
table .t {
{Row Head1 Head2}
{1 abc 123123}
{2 bcd 12341234}
{3 cde 12345678901234567890}
}
pack .t
The target table will be like this :
I suggest the following. It doesn't cater for the case when a word in a sentence is longer than the maximum column size, but it works otherwise. It will word wrap if the text is a sentence (has a space in it), or character wrap otherwise.
Note that character wrap will still take effect if there is a word with length exceeding the maximum size of a column.
package require Tk
proc wrap {text len} {
if {[string len $text] <= $len} {
# No need for wrapping
} else {
if {[string first " " $text] > -1} {
# Word wrap
set flag "\\M"
} else {
# Character wrap
set flag ""
}
set re "^.{1,$len}$flag"
set result [list]
while {1} {
regexp $re [string trim $text] res
regsub $re [string trim $text] "" text
lappend result $res
if {$text eq ""} {break}
}
set text [join $result \n]
}
return $text
}
proc table {w content args} {
frame $w -bg black
set r 0
foreach row $content {
set fields {}
set c 0
foreach col $row {
set text [wrap $col 10]
lappend fields [label $w.$r/$c -text $text]
incr c
}
eval grid $fields -sticky news -padx 1 -pady 1
incr r
}
set w
}
table .t {
{Row Head1 Head2}
{1 abc 123123}
{2 bcd 12341234}
{3 cde 12345678901234567890}
{4 fgh 123456789098765432101234567890}
{5 ijk "Data Bits per Mask"}
}
pack .t
Output:
I have a following file.
File1
a b 1
c d 2
e f 3
File2
x l
y m
z n
I want to replace 1 by x at a time and save in a file3. next time 1 to y and save in file4.
Then files look like
File3
a b x
c d 2
e f 3
File4
a b y
c d 2
e f 3
once I finished x, y, z then 2 by l, m and n.
I start with this but it inserts but does not replace.
awk -v r=1 -v c=3 -v val=x -F, '
BEGIN{OFS=" "}; NR != r; NR == r {$c = val; print}
' file1 >file3
Here's a gnu awk script ( because it uses multidimensional arrays, array ordering ) that will do what you want:
#!/usr/bin/awk -f
BEGIN { fcnt=3 }
FNR==NR { for(i=1;i<=NF;i++) f2[i][NR]=$i; next }
{
fout[FNR][1] = $0
ff = $NF
if(ff in f2) {
for( r in f2[ff]) {
$NF = f2[ff][r]
fout[FNR][fcnt++] = $0
}
}
}
END {
for(f=fcnt-1;f>=3;f--) {
for( row in fout ) {
if( fout[row][f] != "" ) out = fout[row][f]
else out = fout[row][1]
print out > "file" f
}
}
}
I made at least one major assumption about your input data:
The field number in file2 corresponds exactly to the value that needs to be replaced in file1. For example, x is field 1 in file2, and 1 is what needs replacing in the output files.
Here's the breakdown:
Set fcnt=3 in the BEGIN block.
FNR==NR - store the contents of File2 in the f2 array by (field number, line number).
Store the original f1 line in fout as (line number,1) - where 1 is a special, available array position ( because fcnt starts at 3 ).
Save off $NF as ff because it's going to be reset
Whenever ff is a field number in the first subscript of the f2 array, then reset $NF to the value from file2 and then assign the result to fout at (line number, file number) as $0 ( recomputed ).
In the END, loop over the fcnt in reverse order, and either set out to a replaced line value or an original line value in row order, then print out to the desired filename.
It could be run like gawk -f script.awk file2 file1 ( notice the file order ). I get the following output:
$ cat file[3-8]
a b x
c d 2
e f 3
a b y
c d 2
e f 3
a b z
c d 2
e f 3
a b 1
c d l
e f 3
a b 1
c d m
e f 3
a b 1
c d n
e f 3
This could be made more efficient for memory by only performing the lookup in the END block, but I wanted to take advantage of the $0 recompute instead of needing calls to split in the END.
This drawing shows a tree of parent-child relationships. It is directed, without cycles. A child can have multiple parents.
The corresponding array of arrays in Perl is:
(
[A C],
[B C],
[D F G],
[C E D],
[E J X I],
[I J]
)
The first element in each sub-array is the parent of the rest, and the number of sub-arrays is the number of nodes who have at least one child.
Problem
I want to assign a number to each node which tells which level it is on in the graph. The level should also tell whether two nodes are independent, by which I mean they are not in direct parent-child relation. The answer to this specific example should (among many other answers) be:
[A B C D E F G X I J]
[1 1 2 3 3 4 4 4 4 5]
I solution can be implemented in any language, but Perl is preferred.
Still, non of the suggested solutions seems to work for this array:
(
[ qw( Z A )],
[ qw( B D E ) ],
[ qw( A B C ) ],
[ qw( G A E )],
[ qw( L B E )]
)
as does
(
[ qw/ M A / ],
[ qw/ N A X / ],
[ qw/ A B C / ],
[ qw/ B D E / ],
[ qw/ C F G / ],
[ qw/ F G / ]
[ qw/ X C / ]
)
The Graph::Directed module will make it simpler to handle this kind of data.
Multiple source nodes makes it potentially more complicated (for instance if there was another edge [Y, X]) but as long as all the sources are at the first level it is workable.
Here is some code that produces the information you say you expect. It assumes all nodes below the top level are accessible from the first source node and measures their path length from there, ignoring the second source.
use strict;
use warnings;
use feature 'say';
use Graph::Directed;
my #data = (
[ qw/ A C / ],
[ qw/ B C / ],
[ qw/ D F G / ],
[ qw/ C E D / ],
[ qw/ E J X I / ],
[ qw/ I J / ],
);
my $graph = Graph->new(directed => 1);
for my $item (#data) {
my $parent = shift #$item;
$graph->add_edge($parent, $_) for #$item;
}
my ($source) = $graph->source_vertices;
for my $vertex (sort $graph->vertices) {
my $path;
if ($graph->is_source_vertex($vertex)) {
$path = 0;
}
else {
$path = $graph->path_length($source, $vertex);
}
printf "%s - %d\n", $vertex, $path+1;
}
output
A - 1
B - 1
C - 2
D - 3
E - 3
F - 4
G - 4
I - 4
J - 4
X - 4
[This calculates, for each node, the length of the shortest path from a root. But the OP want the length of the longest of the shortest path from each root.]
All you have to do is find the root nodes, then do a breadth-first traversal.
my %graph = map { my ($name, #children) = #$_; $name => \#children } (
[qw( A C )],
[qw( B C )],
[qw( D F G )],
[qw( C E D )],
[qw( E J X I )],
[qw( I J )]
);
my %non_roots = map { $_ => 1 } map #$_, values(%graph);
my #roots = grep !$non_roots{$_}, keys(%graph);
my %results;
my #todo = map [ $_ => 1 ], #roots;
while (#todo) {
my ($name, $depth) = #{ shift(#todo) };
next if $results{$name};
$results{$name} = $depth;
push #todo, map [ $_ => $depth+1 ], #{ $graph{$name} }
if $graph{$name};
}
my #names = sort { $results{$a} <=> $results{$b} || $a cmp $b } keys(%results);
my #depths = #results{#names};
print "#names\n#depths\n";
Finally, I think I have solved the problem of finding correct levels, using Borodin's and ikegami's solutions (thanks guys, highly appreiciate your efforts):
#!/usr/local/perl -w
use strict;
use warnings;
use Graph::Directed;
use List::Util qw( min max );
# my #data = (
# [ qw/ M A/ ],
# [ qw/ N A X/ ],
# [ qw/ A B C / ],
# [ qw/ B D E F/ ],
# [ qw/ C F G / ],
# [ qw/ F G / ],
# [ qw/ X C G/ ],
# [ qw/ L A B /],
# [ qw/ Q M D/]
# );
# my #data = (
# [ qw( Z A )],
# [ qw( B D E ) ],
# [ qw( A B C ) ],
# [ qw( G A E )],
# [ qw( L B E )]
# );
# my #data = (
# [ qw/ M A / ],
# [ qw/ N A X / ],
# [ qw/ A B C / ],
# [ qw/ B D E / ],
# [ qw/ C F G / ],
# [ qw/ F G / ],
# [ qw/ X C / ]
# );
my #data = (
[ qw/ A M B C/ ],
[ qw/ B D F C/ ],
[ qw/ D G/ ],
[ qw/ F G/ ],
[ qw/ C G/ ],
[ qw/ M G/ ],
);
sub createGraph{
my #data = #{$_[0]};
my $graph = Graph->new(directed => 1);
foreach (#data) {
my ($parent, #children) = #$_;
$graph->add_edge($parent, $_) for #children;
}
my #cycleFound = $graph->find_a_cycle;
print "$_\n" for (#cycleFound);
$graph->is_dag() or die("Graph has cycles - unable to sort\n");
$graph->is_weakly_connected() or die "Graph not weakly connected - unable to analyze\n";
return $graph;
}
sub getLevels{
my #data = #{$_[0]};
my $graph = createGraph \#data;
my #artifacts = $graph->topological_sort();
chomp #artifacts;
print "--------------------------\n";
print "Topologically sorted list: \n";
print "$_ " for #artifacts;
print "\n--------------------------\n";
print "Initial levels (longest path):\n";
my #sources = $graph->source_vertices;
my %max_levels = map { $_=>[]} #artifacts;
my #levels = ();
for my $vertex (#artifacts) {
my $path = 0;
foreach(#sources){
if(defined($graph->path_length($_, $vertex))){
if ($graph->path_length($_, $vertex) > $path){
$path = $graph->path_length($_, $vertex)
}
}
}
printf "%s - %d\n", $vertex, $path;
push #levels, $path;
push #{$max_levels{$vertex}}, $path;
}
print "--------------------------\n";
for (my $i = 0; $i < #levels; $i++){
my $parent_level = $levels[$i];
my $parent = $artifacts[$i];
for (my $j = $i+1; $j < #levels; $j++){
my $child = $artifacts[$j];
for (#data){
my ($p, #c) = #{$_};
if($parent eq $p){
my #matches = grep(/$child/, #c);
if(scalar(#matches) != 0){
$levels[$j] = 1 + $parent_level;
push #{$max_levels{$child}},$levels[$j];
$levels[$j] = max #{$max_levels{$child}};
}
}
}
}
}
print "Final levels:\n";
my %sorted = ();
for (my $i = 0; $i < #levels; $i++){
$sorted{$artifacts[$i]} = $levels[$i];
}
my #orderedList = sort { $sorted{$a} <=> $sorted{$b} } keys %sorted;
print "$sorted{$_} $_\n" for #orderedList;
print "--------------------------\n";
return \%max_levels;
}
getLevels \#data;
Output:
--------------------------
Topologically sorted list:
A M B D C F G
--------------------------
Initial levels (longest path):
A - 0
M - 1
B - 1
D - 2
C - 1
F - 2
G - 2
--------------------------
Final levels:
0 A
1 M
1 B
2 F
2 C
2 D
3 G
--------------------------
The string in question (read from a file):
if (true) then
{
_this = createVehicle ["Land_hut10", [6226.8901, 986.091, 4.5776367e-005], [], 0, "CAN_COLLIDE"];
_vehicle_10 = _this;
_this setDir -2.109278;
};
Retrieved from a large list of similar (all same file) strings via the following:
get_stringR(string,"if","};")
And the function code:
def get_stringR(a,b,c)
b = a.index(b)
b ||= 0
c = a.rindex(c)
c ||= b
r = a[b,c]
return r
end
As so far, this works fine, but what I wanted to do is select the array after "createVehicle", the following (I thought) should work.
newstring = get_string(myString,"\[","\];")
Note get_string is the same as get_stringR, except it uses the first occurrence of the pattern both times, rather then the first and last occurrence.
The output should have been: ["Land_hut10", [6226.8901, 986.091, 4.5776367e-005], [], 0, "CAN_COLLIDE"];
Instead it was the below, given via 'puts':
["Land_hut10", [6226.8901, 986.091, 4.5776367e-005], [], 0, "CAN_COLLIDE"];
_vehicle_10 = _this;
_this setDir
Some 40 characters past the point it should have retrieve, which was very strange...
Second note, using both get_string and get_stringR produced the exact same result with the parameters given.
I then decided to add the following to my get_string code:
b = a.index(b)
b ||= 0
c = a.index(c)
c ||= b
if c > 40 then
c -= 40
end
r = a[b,c]
return r
And it works as expected (for every 'block' in the file, even though the strings after that array are not identical in any way), but something obviously isn't right :).
You want r = a[b..c] instead of r = a[b,c].
Difference is: b..c = start from b, go to c, while b,c = start from b and move c characters to the right.
Edit: You don't have to/shouldn't escape the [ and ] either, because you are using strings and not regexen. Also, you have to take the length of the end ("];") into consideration, or you will cut off parts of the end.
def get_stringR(a,b,c)
bp = a.index(b) || 0
cp = a.rindex(c) || bp
r = a[bp..cp + c.size - 1]
return r
end
def get_string(a,b,c)
bp = a.index(b) || 0
cp = a.index(c) || bp
r = a[bp..cp + c.size - 1]
return r
end